init III

Perl Skript template/MyClass.pm

@@ -0,0 +1,41 @@
+#!/usr/bin/perl 
+
+package MyClass;
+
+sub new
+{
+    my $class = shift;
+    my $self = {
+        _arg1 => shift,
+    };
+    # Print all the values just for clarification.
+    bless $self, $class;
+    return $self;
+}
+sub setarg1 {
+    my ( $self, $arg1 ) = @_;
+    $self->{_arg1} = $arg1 if defined($arg1);
+    return $self->{_arg1};
+}
+
+sub getarg1 {
+    my( $self ) = @_;
+    return $self->{_arg1};
+}
+
+1;
+
+#my $obj1 = new MyClass "obj1";
+#my $obj2 = MySubClass->new("obj2_1","obj2_2");
+
+#print "a1:" . $obj1->getarg1() . "\n";
+#$obj1->setarg1("arg1");
+#print "a2:" . $obj1->getarg1() . "\n";
+
+#print "b1:" . $obj2->getarg1() . "\n";
+#$obj2->setarg1("arg1");
+#print "b2:" . $obj2->getarg1() . "\n";
+
+#print "b3:" . $obj2->getarg2() . "\n";
+#$obj2->setarg2("arg2");
+#print "b4:" . $obj2->getarg2() . "\n";

Perl Skript template/MySubClass.pm

@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+package MySubClass;
+use MyClass;
+use strict;
+our @ISA = qw(MyClass);    # inherits from MyClass
+
+# Override constructor
+sub new {
+    my ($class) = @_;
+
+    # Call the constructor of the parent class, Person.
+    my $self = $class->SUPER::new( $_[1] );
+    # Add few more attributes
+    $self->{_arg2}   = $_[2];
+    bless $self, $class;
+    return $self;
+}
+
+# Override helper function
+sub getarg1 {
+    my( $self ) = @_;
+    # This is child class function.
+    return $self->{_arg1};
+}
+
+# Add more methods
+sub setarg2{
+    my ( $self, $arg2 ) = @_;
+    $self->{_arg2} = $arg2 if defined($arg2);
+    return $self->{_arg2};
+}
+
+sub getarg2 {
+    my( $self ) = @_;
+    return $self->{_arg2};
+}
+
+1;
+
+#my $obj1 = new MyClass "obj1";
+#my $obj2 = MySubClass->new("obj2_1","obj2_2");
+
+#print "a1:" . $obj1->getarg1() . "\n";
+#$obj1->setarg1("arg1");
+#print "a2:" . $obj1->getarg1() . "\n";
+
+#print "b1:" . $obj2->getarg1() . "\n";
+#$obj2->setarg1("arg1");
+#print "b2:" . $obj2->getarg1() . "\n";
+
+#print "b3:" . $obj2->getarg2() . "\n";
+#$obj2->setarg2("arg2");
+#print "b4:" . $obj2->getarg2() . "\n";

Perl Skript template/confdb.pm

@@ -0,0 +1,142 @@
+package confdb;
+require Exporter;
+
+use database;
+use HTTP::Request::Common;
+use LWP::UserAgent;
+use URL::Encode qw/:all/;
+use Crypt::Lite;
+use Digest::MD5 qw(md5_hex);
+use JSON;
+use CGI;
+
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = 1.00;
+@ISA     = qw(Exporter);
+###############################################################################
+@EXPORT = qw/
+get_config
+get_profiles
+set_config
+send_config
+
+/;
+
+our $db_name="1_configurations";
+our $db_host="config.andregeissler.de";
+our $db_type="mysql";
+our $db_user="1_Config01";
+our $db_pass="Config01";
+our $db_port="3306";
+our $db_hand;
+
+
+sub get_profiles {
+	my $app_name=shift;
+	db_connect ($db_hand, $db_type, $db_name, $db_host, $db_port, $db_user, $db_pass);
+	my @ret=db_select($db_hand, "	SELECT profiles.profilename FROM apps INNER JOIN profiles ON apps.ID = profiles.appid where apps.appname = '$app_name'");
+	#my @ret=db_select($db_hand, "SELECT profile FROM apps WHERE appname = '$app_name'");
+	db_disconnect ($db_hand);
+	my @rets;
+	foreach my $r (@ret) {
+		foreach (@$r) { push @rets, $_; }
+	}
+	#return @{$ret[0]};
+	return @rets;
+}
+
+sub get_config_from_db {
+	my $app_name=shift;
+	my $app_profile=shift;
+	my @re;
+	db_connect ($db_hand, $db_type, $db_name, $db_host, $db_port, $db_user, $db_pass);
+	$select="SELECT configs.config FROM apps INNER JOIN profiles ON apps.ID = profiles.appid INNER JOIN configs ON profiles.id = configs.profileid where apps.appname = '$app_name' and profiles.profilename = '$app_profile'";
+	my @ret=db_select($db_hand, $select);
+	db_disconnect ($db_hand);
+	return @{$ret[0]};
+}
+
+sub set_config_to_db {
+	my $app_name=shift;
+	my $app_profile=shift;
+	my $app_config=shift;	
+	my @ret;
+	my $s;
+	db_connect ($db_hand, $db_type, $db_name, $db_host, $db_port, $db_user, $db_pass);
+	# id ermitteln um profil zuweisen zu können, select id from apps where apps.appname and apps.key
+	$s="select id from apps where apps.appname = '$app_name'";
+	@ret = db_select ($db_hand, $s);
+	my $app_id = ${$ret[0]}[0];
+	
+	# id ermitteln um config zuweisen zu können, select id from profiles where profiles.appid=APPID
+	$s="select id from profiles where profiles.profilename = '$app_profile' and profiles.appid = '$app_id'";
+	@ret = db_select ($db_hand, $s);
+	my $profile_id = ${$ret[0]}[0];
+	
+	# neue config anlegen, insert configs.config configs.profileid
+	$s="update configs set config='$app_config' where profileid = '$profile_id'";
+	db_exec ($db_hand, $s);
+}
+
+
+sub get_config {
+	$app_name = shift;
+	$app_profile = shift;
+	$app_pass = shift;
+	
+	$app_daten = $app_name . ";" . $app_profile;
+
+	$md5_pass = md5_hex("$app_pass");
+
+	$c_daten = url_encode_utf8($app_daten);
+
+	$ua = LWP::UserAgent->new;
+	$re = $ua->request(POST 'http://config.andregeissler.de/cgi-bin/index.pl', [data => "$c_daten"]);
+
+	$content = $$re{_content};
+	@c_re_daten = $content =~ /###(.*)###/gm;
+
+	foreach (@c_re_daten) {
+	 $crypt = Crypt::Lite->new( debug => 0, encoding => 'hex8' );
+	 $re_daten = $crypt->decrypt($_, $md5_pass);
+	 ($aa, $bb) = $re_daten =~ /^(.{9}).*(.{9})$/;
+	}
+
+	$array_ref = decode_json($re_daten);
+	@array = @{$array_ref};
+
+	return @array;
+}
+
+sub set_config {
+	$app_name = shift;
+	$app_profile = shift;
+	$app_pass = shift;
+	$md5_pass = md5_hex("$app_pass");
+	@app_config = ( {key1 => "value1", key2 => "value2" }, 88, { key3 => "value3", key4 => "value4" }, { key5 => "value5" } );
+	$array_ref = \@app_config;
+	$app_config = encode_json($array_ref);
+	$crypt = Crypt::Lite->new( debug => 0, encoding => 'hex8' );
+	$c_daten = $crypt->encrypt($app_config, $md5_pass);
+	print "app_name $app_name\napp_pass $app_pass\nmd5_pass $md5_pass\napp_profile $app_profile\napp_config $app_config\nc_daten $c_daten\n";
+	set_config_to_db ($app_name, $app_profile, $c_daten);
+}
+
+sub send_config {
+	$titel = shift;
+	$q = new CGI;
+	$c_daten = $q->param("data");
+	$daten = url_decode_utf8($c_daten);
+	($app, $profil) = split/;/,$daten;
+	$titel .= " für $app $profil";
+	@ret = get_config_from_db($app, $profil);
+	printf "Content-type: text/html\n\n<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n<html>\n<head>\n<meta content=\"text/html\">\n<title>$titel</title>\n</head>\n<body>\n";
+	 foreach (@ret) {
+	  printf "###$_###\n";
+	 }
+	printf "</body>\n</html>\n";
+}
+
+
+1;
+

Perl Skript template/config

@@ -0,0 +1,9 @@
+DB_TYPE:mysql
+DB_HOST:10.101.0.2
+DB_PORT:3306
+DB_NAME:dyndns
+DB_USER:dyndns
+DB_PASS:dyndns
+
+
+require "config2"

Perl Skript template/config2

@@ -0,0 +1,2 @@
+@TAGE:12.12;13.12.2013; 14.12 ; 23.12.2013
+%TAGE:ostern#1.1;pfingsten#3.3

Perl Skript template/database.pm

@@ -0,0 +1,82 @@
+package database;
+require Exporter;
+
+use DBI;
+
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = 1.00;
+@ISA     = qw(Exporter);
+###############################################################################
+@EXPORT = qw/
+db_connect
+db_disconnect
+db_exec
+db_select
+
+
+/;
+
+our $FUNC_STATEMENT_HANDLE;
+
+
+######## Datenbank Funktionen und Beispielnutzung
+# my $DB_HANDLE;
+# my $ok = db_connect ($DB_HANDLE, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'});
+# exit if (!$ok);
+# my @ret = db_select ($DB_HANDLE, "select password from passwd where user='test'");
+# my $i=0; my $j;
+#foreach my $x (@ret) {
+#   $j=0;
+#   foreach my $y (@{$x}) {
+#      p "i: $i, j: $j, wert: '$y'";
+#      $j++;
+#   }
+#   $i++;
+#}
+# db_disconnect ($DB_HANDLE);
+
+sub db_connect {
+   # call: db_connect($DB_HANDLE, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'});
+   my $ok = eval {
+      $_[0] = DBI->connect("DBI:$_[1]:$_[2]:$_[3]:$_[4]", "$_[5]", "$_[6]");
+      return 0 if ($_[0] == undef);
+      return 1;
+   };
+   return $ok;
+}
+
+sub db_disconnect {
+   # call: db_disconnect($DB_HANDLE);
+   $_[0]->disconnect();
+}
+
+sub db_exec {
+   # call: db_exec($DB_HANDLE, "insert|update|delete|alter...");
+   $FUNC_STATEMENT_HANDLE = $_[0]->prepare ("$_[1]");
+   $FUNC_STATEMENT_HANDLE->execute();
+   $FUNC_STATEMENT_HANDLE->finish();
+}
+
+sub db_select {
+   # call: db_select($DB_HANDLE, "select ... from ...");
+   # return: @
+   my @data;
+   my $i;
+   my $j;
+   my @ret;
+   $FUNC_STATEMENT_HANDLE = $_[0]->prepare ("$_[1]");
+   $FUNC_STATEMENT_HANDLE->execute();
+   $i=0;
+   while (@data = $FUNC_STATEMENT_HANDLE->fetchrow_array()) {
+      $j=0;
+      foreach (@data) {
+         $ret[$i][$j]=$_;
+         $j++;
+      }
+   $i++;
+   }
+   return @ret;
+}
+
+1;
+

Perl Skript template/datum.pm

@@ -0,0 +1,247 @@
+package datum;
+require Exporter;
+
+use Date::Calc qw/Add_Delta_Days Day_of_Week/;
+
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = 1.00;
+@ISA     = qw(Exporter);
+###############################################################################
+@EXPORT = qw/
+find_day
+work_day
+trade_day
+business_day
+
+/;
+
+our $MOD_YY;    # Jahr 2 stellig
+our $MOD_YYYY;  # Jahr 4 stellig
+our $MOD_MM;    # Monat
+our $MOD_DD;    # Tag
+our $MOD_HH;    # Stunde 24
+our $MOD_hh;    # Stunde 12
+our $MOD_APM;   # a.m. oder p.m.
+our $MOD_mm;    # Minute
+our $MOD_ss;    # Sekunde
+our $MOD_DST;   # Daylight Saving Time
+
+######## Datum Funktionen und Beispielnutzung
+#my $s = "%04s-%02s-%02s %02s(%s %s):%02s:%02s %s";
+#my $v = "YYYY,MM,DD,HH,hh,AP,mm,ss,DST";
+#my $o = 0;
+#my $d = find_day($o, "$s", "$v");
+#printf "Offset %3s, Format \"%s\", \"%s\"          => %s\n", $o, $s, $v, $d;
+#$s = "%02s-%02s-%04s";
+#$v = "DD,MM,  YYYY";
+#$o = -5;
+#$d = find_day($o+6, "$s", "$v");
+#printf "Offset %3s, Format \"%s\", \"%s\"          => %s\n", $o, $s, $v, $d;
+#$s = "%s";
+#$v = "DST";
+#$o = 0;
+#$d = find_day($o, "$s", "$v");
+#printf "Keine " if ($d == 0);
+#print "Sommerzeit\n";
+
+#our @bu = qw /25.12.2013 27.12.2013/;
+#$d = business_day(0, \@bu, "", "");
+#print "Kein " if !$d;
+#print "Arbeitstag\n";
+
+#our @bu = qw /25.12.2013 27.12.2013/;
+#$s = "%02s-%02s-%04s";
+#$v = "DD,MM,YYYY";
+#$o = -4;
+#$d = business_day($o, \@bu, "$s", "$v");
+#printf "Offset %3s, Format \"%s\", \"%s\"          => %s\n", $o, $s, $v, $d;
+
+# Datum in den Formaten zulässig
+# DD.MM.YYYY   DD.MM.YY->DD.MM.20YY    DD.MM    DD.MM.
+our @work  = qw /24.12.13 25.12 26.12. 31.12. 01.01/;
+our @trade = qw /         25.12 26.12.        01.01/;
+
+sub find_day {
+   my $o=shift; # Offset .... -1 gestern, 0: heute, 1 morgen ....
+   my $f=shift; # "%04s-%02s-%02s"
+   my $s=shift; # "YY,MM,DD";
+
+   calc_var();
+   #offset berechnen
+   ($MOD_YYYY,$MOD_MM,$MOD_DD) = Add_Delta_Days($MOD_YYYY,$MOD_MM,$MOD_DD,$o);
+   $MOD_YY= $MOD_YYYY % 100;
+   
+   my @s=replace_var($s);
+   my $ret=sprintf($f, @s);
+   return $ret;
+}
+
+sub work_day {
+   my $o=shift; # Offset .... -1 gestern, 0: heute, 1 morgen ...., Ist Offset 0: liefert Funktion 1 für Arbeitstag und 0 für keinen Arbeitstag
+   my $f=shift; # "%04s-%02s-%02s"
+   my $s=shift; #
+   calc_var();
+   
+   if ($o == 0) {
+      if (is_work_day($MOD_YYYY,$MOD_MM,$MOD_DD)) {
+         return 1;
+      }
+      return 0;
+   }
+   
+   my $oa = abs($o);
+   my $i = 1;
+   $i = -1 if ($o < 0);   
+   
+   for my $j (1 .. $oa) {
+      do {
+         ($MOD_YYYY,$MOD_MM,$MOD_DD) = Add_Delta_Days($MOD_YYYY,$MOD_MM,$MOD_DD,$i);
+      } while (!is_work_day($MOD_YYYY,$MOD_MM,$MOD_DD));
+   }
+   my @s=replace_var($s);
+   $ret=sprintf($f,@s);
+   return $ret;
+}
+
+sub trade_day {
+   my $o=shift; # Offset .... -1 gestern, 0: heute, 1 morgen ...., Ist Offset 0: liefert Funktion 1 für Arbeitstag und 0 für keinen Arbeitstag
+   my $f=shift; # "%04s-%02s-%02s"
+   my $s=shift; #
+   calc_var();
+   
+   if ($o == 0) {
+      if (is_trade_day($MOD_YYYY,$MOD_MM,$MOD_DD)) {
+         return 1;
+      }
+      return 0;
+   }
+   
+   my $oa = abs($o);
+   my $i = 1;
+   $i = -1 if ($o < 0);   
+   
+   for my $j (1 .. $oa) {
+      do {
+         ($MOD_YYYY,$MOD_MM,$MOD_DD) = Add_Delta_Days($MOD_YYYY,$MOD_MM,$MOD_DD,$i);
+      } while (!is_trade_day($MOD_YYYY,$MOD_MM,$MOD_DD));
+   }
+   my @s=replace_var($s);
+   $ret=sprintf($f,@s);
+   return $ret;
+}
+
+sub business_day {
+   my $o=shift; # Offset .... -1 gestern, 0: heute, 1 morgen ...., Ist Offset 0: liefert Funktion 1 für Arbeitstag und 0 für keinen Arbeitstag
+   my $k=shift; # Array Ref, Array enthält Feiertage
+   my @k=@{$k};
+   my $f=shift; # "%04s-%02s-%02s"
+   my $s=shift; #
+   calc_var();
+   
+   if ($o == 0) {
+      if (is_business_day(\@k,$MOD_YYYY,$MOD_MM,$MOD_DD)) {
+         return 1;
+      }
+      return 0;
+   }
+   
+   my $oa = abs($o);
+   my $i = 1;
+   $i = -1 if ($o < 0);   
+   
+   for my $j (1 .. $oa) {
+      do {
+         ($MOD_YYYY,$MOD_MM,$MOD_DD) = Add_Delta_Days($MOD_YYYY,$MOD_MM,$MOD_DD,$i);
+      } while (!is_business_day(\@k,$MOD_YYYY,$MOD_MM,$MOD_DD));
+   }
+   my @s=replace_var($s);
+   $ret=sprintf($f,@s);
+   return $ret;
+}
+
+sub calc_var {
+   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(); #1388148859); # Freitag 27.12.2013 13:54 Uhr 19s
+   $MOD_YYYY = $year + 1900;
+   $MOD_YY   = $year % 100;
+   $MOD_MM   = $mon + 1;
+   $MOD_DD   = $mday;
+   $MOD_HH   = $hour;
+   $MOD_hh   = $hour;
+   $MOD_hh  -= 12     if ($MOD_hh > 12);
+   $MOD_mm   = $min;
+   $MOD_ss   = $sec;
+   $MOD_APM  = 'a.m.';
+   $MOD_APM  = 'p.m.' if ($MOD_HH >= 12);
+   $MOD_DST  = $isdst;
+   $MOD_WD   = $wday;
+}
+
+sub replace_var {
+   my $s=shift;
+   $s =~ s/\s//g;
+   $s =~ s/YYYY/$MOD_YYYY/g;
+   $s =~ s/YY/$MOD_YY/g;
+   $s =~ s/MM/$MOD_MM/g;
+   $s =~ s/DD/$MOD_DD/g;
+   $s =~ s/HH/$MOD_HH/g;
+   $s =~ s/hh/$MOD_hh/g;
+   $s =~ s/mm/$MOD_mm/g;
+   $s =~ s/ss/$MOD_ss/g;
+   $s =~ s/AP/$MOD_APM/g;
+   $s =~ s/DST/$MOD_DST/g;
+   my @s=split /,/,$s;
+   return @s;
+}
+
+sub is_work_day {
+   my $y=shift;
+   my $m=shift;
+   my $d=shift;
+   my $dow = Day_of_Week($y,$m,$d);
+   my $is=1;
+   $is=0 if ($dow > 5); # Samstag (6) oder Sonntag (7)
+   foreach (@work) {
+      my $a=sprintf("%02s.%02s.%04s", $d,$m,$y);
+      $is=0 if ($_ eq $a);
+   }
+   return $is;
+}
+
+sub is_trade_day {
+   my $y=shift;
+   my $m=shift;
+   my $d=shift;
+   my $dow = Day_of_Week($y,$m,$d);
+   my $is=1;
+   $is=0 if ($dow > 5); # Samstag (6) oder Sonntag (7)
+   foreach (@trade) {
+      my $a=sprintf("%02s.%02s.%04s", $d,$m,$y);
+      $is=0 if ($_ eq $a);
+   }
+   return $is;
+}
+
+sub is_business_day {
+   my $k=shift;
+   my @k=@{$k};
+   my $y=shift;
+   my $m=shift;
+   my $d=shift;
+   my $dow = Day_of_Week($y,$m,$d);
+   my $is=1;
+   $is=0 if ($dow > 5); # Samstag (6) oder Sonntag (7)
+   foreach my $dat (@k) {
+      my $a=sprintf("%02s.%02s.%04s", $d,$m,$y);
+      # wenn datum im array ($_) kein jahr beinhaltet, akteuelles Jahr nutzen
+      if ($dat =~ /^([0-9]{2})\.([0-9]{2})\.([0-9]{2})$/) {
+         $dat = $1.".".$2."."."20".$3;
+      }
+      $dat .= ".$MOD_YYYY" if ($dat =~ /^[0-9]{2}\.[0-9]{2}$/);
+      $dat .= "$MOD_YYYY"   if ($dat =~ /^[0-9]{2}\.[0-9]{2}\.$/);
+      $is=0 if ($dat eq $a);
+   }
+   return $is;
+}
+
+1;
+

Perl Skript template/functions.pm

@@ -0,0 +1,191 @@
+use v5.10;
+
+package functions;
+require Exporter;
+require Term::ANSITable;
+require IO::Prompter;
+
+
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = 1.00;
+@ISA     = qw(Exporter);
+###############################################################################
+@EXPORT = qw/
+exit_on_error
+p
+clrscr
+discard_error_msg
+remove_doubles
+debug
+
+table
+table_short
+
+%conf
+/;
+
+
+our %conf;
+read_config("config");
+
+# Conf Format
+#Skalar
+#Variable:Wert
+#Array
+#@Variable:Wert1;Wert2;Wert3
+#Hash
+#%Variable:Key1#Wert1;Key2#Wert2;Key3#Wert3
+#print $conf{'DB_TYPE'} ."\n";
+#print $conf{'DB_HOST'} ."\n";
+#foreach ($conf{'@TAGE'}) {
+#   print "$_\n";
+#}
+#foreach my $k (keys $conf{'%TAGE'}) {
+#   print "k $k v $conf{'%TAGE'}{$k}\n";
+#}
+
+
+sub read_config {
+   my $configfile=shift;
+   my $vd=':'; # trennt var von wert
+   my $ad=';'; # trennt werte im array bzw. wertpaare im hash
+   my $hd='#'; # trennt wert von key im hash
+   open CF,"$configfile";
+   foreach (<CF>) {
+      chomp;
+      if ($_ =~ /require/) {
+         my ($f) = $_ =~ /require "(.*)"/;
+         read_config($f);
+      }
+      else {
+         my ($k,$v) = split /$vd/,$_; # trennung zwischen var-name und werten
+         
+         if ($k =~ /^@/) { # array variable
+            my @val=split /$ad/,$v;
+            foreach (@val) {
+               push @{$conf{"$k"}},$_;
+            }
+         }
+         if ($k =~ /^%/) { # hash variable
+            my @val=split /$ad/,$v;
+            foreach my $vp (@val) {
+               my ($k1,$v1) = split /$hd/,$vp;
+               $conf{"$k"}{"$k1"}=$v1;
+            }
+         }
+         else {
+            $conf{"$k"} = $v;
+         }
+      }
+   }
+}
+close CF;
+
+
+######## Allgemeine Funktionen und Beispielnutzung
+sub exit_on_error {
+   # call: exit_on_error("text");
+   my $m=shift;
+   print "\n\n   ### $m\n\n\n";
+   exit 1;
+}
+
+sub p {
+   # call p("text");
+   my $m = shift;
+   printf "$m\n";
+}
+
+
+sub clrscr {
+   # call clrscr(); Leert Bildschirminhalt
+   for (0..50) {
+      print "\n";
+   }
+}
+
+sub discard_error_msg {
+   my $d=shift;
+   if ($d==1) {
+      open STDERR, '>/dev/null';
+   }
+   else {
+      close STDERR;
+   }
+}
+
+sub remove_doubles {
+   # call my @arr=qw /a2 a2 a2 a2 a2 a2 a2 b3 b3 b3 b3/;
+   # @arr=remove_doubles(\@arr);
+   my $o=shift;
+   my @o=@{$o};
+   my %h;
+   foreach (@o) {
+      next if ($h{$_});
+      $h{$_}=1;
+   }
+   @o=();
+   foreach (keys %h) {
+      push @o, $_;
+   }   
+   return @o;
+}
+
+sub debug {
+	printf "%-10s:%s\n", $_[0], $_[1] if ($_[2] == 1);
+}
+
+
+########
+## my (@header,@rows,@row);
+## foreach my $line (@res) {
+##   my $status = ""; #
+##   $status = "I" if (${$line}[1] == 1);
+##   @row = [ "${$line}[0]", "$status", "${$line}[2]", "${$line}[3]" ];
+##   push @rows, @row;
+## }
+## @header=[ "ID", "A", "Name", "Beschreibung" ];
+## table_short (\@header, \@rows);
+
+
+sub table (@) {
+    my ($head, $rows) = @_;
+    my $at = Term::ANSITable->new( columns => @{$head} );
+
+    foreach my $row(@{$rows}) {
+        $at = $at->add_row($row);
+    }
+    #$at->{_table}->{cell_vpad} = 0;
+    $at->{_table}->{show_row_separator} = 1;
+    $at->refresh_table->draw();
+}
+
+sub table_short (@) {
+    my ($head, $rows) = @_;
+    my $at = Term::ANSITable->new( columns => @{$head} );
+
+    foreach my $row(@{$rows}) {
+        $at = $at->add_row($row);
+    }
+    #$at->{_table}->{cell_vpad} = 0;
+    $at->{_table}->{show_row_separator} = 0;
+    $at->refresh_table->draw();
+}
+
+# if ( $in =~ /^s/ and $in =~ /[tps]$/ ) {
+#      given (prompt -k1, "[A]ctive, (I)nactive, or al(L):", -keyletters) {
+#         when (/I/i) { $act3="inactive"; }
+#         when (/L/i) { $act3="all"; }
+#         default     { $act3="active"; }
+#      }
+#   }
+
+# my $anz = prompt ('Anzahl der Aktivitäten (0 für alle):', -integer, -must => { 'be in range' => [0..999] });
+
+# $in = prompt("\nAktivität angeben:", -guarantee=>[@pars1]);
+
+# $pw = prompt('Password:', -echo => '*');
+# $animal = prompt -guarantee=>['cat','dog','cow'];
+# $ok = prompt('Fertig:', -yn1s);
+
+1;

Perl Skript template/http.pm

@@ -0,0 +1,85 @@
+package http;
+require Exporter;
+
+use CGI;
+
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = 1.00;
+@ISA     = qw(Exporter);
+###############################################################################
+@EXPORT = qw/
+cgi_header
+html_refresh
+html_title
+html_header
+html_body
+html
+
+/;
+
+
+######## HTML Funktionen und Beispielnutzung
+# my @header=(html_refresh(5, "URL"), html_title("titel"));
+# my @body=("inhalt 1<br>", "inhalt 2<br>");
+# my @html=html(\@header, \@body);
+# foreach (@html) {
+# print "$_\n";
+# }
+
+sub cgi_header {
+my @a = ("Content-type: text/html","<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">");
+return @a;
+}
+
+sub html_refresh {
+   my $s=shift;
+   my $u=shift;
+   my @ret = ("<meta http-equiv=\"refresh\" content=\"$s; URL=$u\">");
+   return @ret;
+}
+
+sub html_title {
+   my $a=shift;
+   my @ret = ("<title>$a</title>");
+   return @ret;
+}
+
+sub html_header {
+   my $a=shift;
+   my @a=@{$a};
+   my @ret;
+   push @ret, "<head>";
+   foreach (@a) {
+      push @ret, "$_";
+   }
+   push @ret, "</head>";
+   return @ret;
+}
+
+sub html {
+   my $h=shift;
+   my $b=shift;
+   my @h=@{$h};
+   my @b=@{$b};
+   my @ret;
+   push @ret, cgi_header();
+   push @ret, "<html>";
+   push @ret, html_header(\@h);
+   push @ret, html_body(\@b);
+   push @ret, "</html>";
+   return @ret;
+}
+
+sub html_body {
+   my $a=shift;
+   my @a=@{$a};
+   my @ret;
+   push @ret, "<body>";
+   foreach (@a) {
+      push @ret, "$_";
+   }
+   push @ret, "</body>";
+   return @ret
+}
+
+1;

Perl Skript template/menu.pm

@@ -0,0 +1,77 @@
+package menu;
+require Exporter;
+
+use functions;
+
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = 1.00;
+@ISA     = qw(Exporter);
+###############################################################################
+@EXPORT = qw/
+show_menu
+menu_back
+
+
+/;
+
+
+######## Menu Funktionen und Beispielnutzung
+# x|y|z x:reihenfolge y:zeichen für die auswahl z:Text im Menü
+# my %menu = (
+#   '1|1|P1' => \&ebene1_a,
+#   '97' => 'blank',
+#   '98' => 'line',
+#   '99|0|ende' => \&ebene1_quit,
+#   );
+#show_menu(\%menu, "Hauptmenü");
+#sub ebene1_a {
+#   my %menu = (
+#   '1|1|blabla' => \&ebene1_b,
+#   '97' => 'blank',
+#   '98' => 'line',
+#   '99|0|zurück' => \&menu_back,
+#   );
+#   show_menu(\%menu, "Untermenü");
+#}
+#sub ebene1_b {
+#}
+#sub ebene1_quit {
+#   exit 0;
+#}
+
+sub show_menu {
+   my $m=shift;
+   my $t=shift;
+   my %m=%{$m};
+   my %menu;
+   my $k, $e;
+
+   while (1) {
+      clrscr();
+      printf "\n      $t\n\n";
+      foreach my $l (sort keys %m) {      
+         if ($m{$l} eq "blank") {
+            printf "\n";
+         }
+         elsif ($m{$l} eq "line") {
+            for (1..26) { printf "-"; } printf "\n";
+         }
+         else {
+            my ($r,$k,$e) = split /\|/, $l;
+            $menu{$k}=$m{$l};
+            printf " %2s   %-20s\n", $k, $e;
+         }
+      }
+      print "\nAuswahl: ";
+      my $in = <STDIN>;
+      chomp $in;
+      $menu{$in}->() unless ($menu{$in} == "");
+   }     
+}
+
+sub menu_back {
+   # call: nur in Verwendung mit show_menu sinnvoll
+   last;
+}
+
+1;

Perl Skript template/program.pl

@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+use strict;
+use confdb;
+
+###############################################################################
+# main program
+###############################################################################
+
+my $app = "testapp";
+
+my @ret = get_profiles($app);
+foreach my $a (@ret) {
+	print "$a\n";
+}
+
+0; # end with exit code 0
+###############################################################################
+# subs
+###############################################################################
+
+