Welcome To Our Shell

Mister Spy & Souheyl Bypass Shell

package DivBasicF::COMTest;

use strict;
use Data::Dumper;
use Time::HiRes;
use DivBasicF::DB;

#**********************************************************************

sub new {

   my $class = shift;
   my $self  = {};
   $self->{'TESTMODUL'} = shift;
   bless($self,$class);
   return($self);
   
}

#**********************************************************************

sub test_item {

   my $self   = shift;
   my $text   = shift;
   my $user   = shift;

   DivBasicF::DB->new($self)->edit($text);
   
   my $o = "";
   while (0 == 0) {
      $o = $self->{'PARENT'}->lock_semaphore($self->{'name'});
      last if ($o);
      print "COMTest: Waiting for Semaphore ...\n";
      sleep 1;
   }

   $o = $self->{'PARENT'}->read_semaphore($self->{'name'});
   $o =~ s/^(.*)\_\_(\d+)$/$2/;

   my $dbh    = $self->{'PARENT'}->dbh();
   my $cursor = $dbh->prepare("select idx__name from " .
                    $self->{'PARENT'}->{'STORE'} .
                    " where idx__name like '" . $self->{'name'} .
                    "__\%'" . " order by idx__name desc");
   $cursor->execute();
   my @ee = $cursor->fetchrow_array();
   $ee[0] =~ s/^(.*)\_\_(\d+)$/$2/;
   $cursor->finish();
   if ($o > $ee[0]) { $ee[0] = $o; }
   $o = $self->{'name'};
   $self->{'name'} = $self->{'name'} . "__" . sprintf("%03u",$ee[0]+1);

   $self->{'PARENT'}->write_semaphore($o,$self->{'name'});
   $self->{'PARENT'}->unlock_semaphore($o);

   $self->{'status'} = "9";
   
   $self->{'user'} = $self->{'user'} . "," . $user;
   while ($self->{$user} =~ /^(.*\,)(\d+)(\..*)$/) {
      @ee = localtime($2); # Sekundenformat in lesbares Format umwandeln
      $self->{'user'} = $1 .
               sprintf("%04u",$ee[5]+1900) .   sprintf("%02u",$ee[4]+1) .
               sprintf("%02u",$ee[3]) . "_" .  sprintf("%02u",$ee[2]) .
               sprintf("%02u",$ee[1]) .        sprintf("%02u",$ee[0]) . $3;
   }
   $self->{'user'} =~ s/^,//;

   
   return(["___NEXT1___",$self->{'interpreter'}]);
   
}

#**************************************************************

sub edit {

   my $self = shift;
   my $mode = shift;
   my $text = shift;
   
   if ($text) {
      $self->read_in($text);
   } else {
      $self->actualize();
   }
   
   return(["___SLEEP___","edit",$self->{'prg_pars'}]);
   
}

#**************************************************************

sub find {

   my $self   = shift;
   my $mode   = shift;
   my $name   = shift;
   my $dbh    = $self->{'PARENT'}->dbh();
   
   my $cursor = $dbh->prepare("select conn,status from " .
                              $self->{'PARENT'}->{'STORE'} .
                              " where idx__name = '" . $name . "' and " .
                              " status = '1'");
   $cursor->execute();
   my @ee  = $cursor->fetchrow_array();
   $cursor->finish();
   if (@ee) {
      return([$ee[0]]);
   }
   return([]);
   
}

#******************************************************************

#  Abfrage nach Items aus der Datenbank

sub list {

   my $self    = shift;
   my $mode    = shift;
   my $name    = shift;
   my $pattern = shift;
   my $faktor  = shift;
   my $group   = "";
   my $o; my $o1; my $nr; my $name; my $name1; my $requ; my $requ1;
   
   if ($name =~ s/^(.*),(.*)$/$1/) {
      $group = $2;
   }

   if ($pattern > 0) {
      $o       = $faktor;
      $faktor  = $pattern;
      $pattern = $o;
   }
   if ($faktor == 0) { $faktor = 1; }
   my $dbh     = $self->{'PARENT'}->dbh();
   
   my $cursor = "select conn,objlock,sleep," .
                "idx__name,idx__result,idx__remark,idx__weight,idx__user," .
                "idx__requ,idx__status from " .
                 $self->{'PARENT'}->{'STORE'};

   if ($name =~ s/^(\_+)([cw])(\d*)//i) {
      $o  = $2;
      $nr = $3;
      if ($o eq "w") { $o = "1"; } else { $o = "0"; }
      $cursor = $dbh->prepare($cursor . " where objlock = '$o' limit $nr");
   } else {
      $o = " where AND ";
      if ($name ne "ALL") {
         $o =  " where idx__name like '$name\%'";
      }
      $cursor = $cursor . $o;
      foreach $o (split(/,/,$pattern)) {
         $cursor = $cursor . " AND idx__requ like '\%$o\%'";
      }
      $cursor =~ s/AND +AND//;
      $cursor =~ s/where +AND//;
print "SEARCHSTRING: $cursor\n";
      $cursor = $dbh->prepare($cursor);
   }                  
   $cursor->execute();

   my $erg = {};  #  Hash der konsolidierten Ergebnisse des Test-Items
   my @ee;
   
   #  Den Ergebnissen der Datenbankabfrage wird als erstes Element
   #  das konsolidierte Tree-Ergebniss vorangestellt

   my $requ_maxlength = "11111111";
   while (@ee = $cursor->fetchrow_array()) {
      $name = $ee[3];
      $erg->{$name} = [0,0,@ee,0];
      $o  = $ee[8];
      $o  =~ s/[a-zA-Z0-9\_\-]/1/g;
      $o = [reverse(sort(split(/,/,$o),$requ_maxlength))];
      $requ_maxlength = $o->[0];
   }
   $cursor->finish();
   $requ_maxlength = length($requ_maxlength);

   foreach $name (keys %$erg) {
      @ee = @{$erg->{$name}};
      $requ = [split(/,/, $erg->{$name}->[10]) ];  #  Durchgang durch alle Requirements
      if (!@$requ) { $requ = []; }      
      push(@$requ,"_GLOBAL_");
      foreach $o (@$requ) {
         next if (!$o);
         $o = substr($o . "__________________________________________",0,$requ_maxlength);
         $name1 = $o . "__" . $ee[5];
         delete ($erg->{$name});
         $erg->{$name1} = [@ee];
         $erg->{$name1}->[5] = $name1;
      }
   }
   
   foreach $name (keys %$erg) {
      @ee = @{$erg->{$name}};
      $o  = $ee[10];
      $o  =~ s/[a-zA-Z0-9\_\-]/1/g;
      $o = [reverse(sort(split(/,/,$o),$requ_maxlength))];
      $requ_maxlength = $o->[0];
      while (0 == 0) { # Ermittlung der konsolidierten Bewertung des Test-Items
         if ($erg->{$name}) {
            if ($ee[11] == 1) {
               if ($ee[8]) {
                  $erg->{$name}->[0] = ($erg->{$name}->[0] > $ee[6]) ?
                                        $erg->{$name}->[0] : $ee[6];
               }
               $erg->{$name}->[1] = 1000 - (1000 - $erg->{$name}->[1]) *
                                           (1000 - $ee[8]*$faktor) * 0.001;
            }
         } else {
            $erg->{$name} = [$ee[6],$ee[8],"","","",$name,"","","","","",3,1];
         }
         last if ($name !~ s/^(.*[a-zA-Z0-9])\_\_+(.*)$/$1/);
      }
   }

   return([sort {$a->[5] cmp $b->[5]} values %$erg]);
   #  Rueckgabe:
   #  $erg->[0]:   Konsolidiertes Result
   #  $erg->[1]:   Konsolidiertes Gewicht
   #  $erg->[2]:   conn
   #  $erg->[3]:   objlock
   #  $erg->[4]:   sleep
   #  $erg->[5]:   name
   #  $erg->[6]:   result
   #  $erg->[7]:   remark
   #  $erg->[8]:   weight
   #  $erg->[9]:   user 
   #  $erg->[10]:  requ
   #  $erg->[11]:  status
   #  $erg->[12]:  type
   
}

#******************************************************************

#  Abfrage nach Items aus der Datenbank

sub excel_report {

   my $self    = shift;
   my $mode    = shift;
   my $name    = shift;
   my $file    = shift;  #  Export-File-Name
   my $filter  = shift;  #  Filter-Ausdruck
   my $arch    = shift;  #  Architektur-Liste

   my $zaehler; my $o; my $o1; my $date; my $user; my $arch_data;
   my $item; my $row;

   eval("use Spreadsheet::WriteExcel");

   my $workbook  = Spreadsheet::WriteExcel->new($file);
   my $worksheet = $workbook->add_worksheet();
   my $format_ueberschrift = $workbook->add_format();
   $format_ueberschrift->set_bold();
   my $format_error = $workbook->add_format();
   $format_error->set_color("red");
   $arch         = [split(/,/,$arch)];
   if (!@$arch) {
      $arch = [""];
   }

   $worksheet->set_column(1,1,30);  #  Name des Tests
   $worksheet->write(1,1,"TEST REPORT $date by $user");
   my $last_arch = 0;        #  Nummer der letzten Architektur-Spalte
   my $data  = [];
   my $items = {};
   foreach $o ($#{$arch}) {
      $o1 = "";
      if ($o) {
         $o1 = ",ARCH:$o";
      }
      $arch_data = $self->query(["list",$filter.$o1]);
      foreach $o1 (@$arch_data) {
         $items->{$o1->[5]} = 1;
      }
      push(@$data,$arch_data);
      $last_arch = $last_arch + 1;
      $worksheet->set_column(1+$last_arch,1,30);  #  Architektur-Spalte
      $worksheet->write(5,$last_arch,$o,$format_ueberschrift);
   }
   $worksheet->set_column($last_arch+1,1,30);  #  Spalte Bemerkung
   $worksheet->write(5,$last_arch+1,"Remark",$format_ueberschrift);
   
   my $col_nr = 7;
   foreach $item (sort keys(%$items)) {
      $row = $row + 1;
      $worksheet->write($row,1,$item);
      $zaehler = -1;
      foreach $arch_data (@$data) {
         $zaehler = $zaehler + 1;
         if ($arch_data->[5] eq $item) {
            $o1 = shift(@$arch_data);
            $worksheet->write($row,1+$zaehler,$o1->[0]);
            if ($last_arch == 1) { # wenn es nur eine Architektur gibt, lohnen
                                   # die anderen Spalten auch
               $worksheet->write($row,3,$o1->[1]);
               $worksheet->write($row,4,$o1->[6]);
               $worksheet->write($row,5,$o1->[7]);
            }
         }
      }
   }         
   return(["OK"]);
      
   
}

#*******************************************************

#sub parse_prgstack {
#
#   my $self = shift;
#   my $text = shift;
#
#   $text =  "\n" . $text . "\n";
#   $text =~ s/\n( +)/\n/gs;
#   $text =~ s/( +)\n/\n/gs;
#   $text =~ s/\#(.*?)\n/\n/gs;
#   $text =~ s/\n([a-zA-Z0-9\_]+)\(/\n$1\,/gs;
#   $text =~ s/\)\n/\n/gs;
#   $text =~ s/(\"?)\,(\"?)/,/gs;
#   $text =~ s/\"\n/\n/gs;
#   $text =~ s/^(\s*)(.*?)(\s*)$/$2/gs;
#   while ($text =~ s/\n *\n/\n/gs) { 1; }
#
#   my $o; my $erg = [];
#   foreach $o (split(/\n/,$text)) {
#      push(@$erg,[split(/,/,$o)]);
#   }
#
#   return($erg);
#   
#}

#*******************************************************

sub block {

   my $self = shift;
   my $mode = shift;
   my @pars = @_;

#  Update der SOLL-Variable aus den uebergebenen Parametern

   my $o; my $o1; my $o2; my $cmd; my $cmd1;
   foreach $o (@pars) {
      if ($o =~ /^(.*?)\: *(\S+?) *$/) {
         $self->{'SOLL'}->{lc($1)} = $2;
      }
   }

#  Naechstes Kommando vom Stack holen

   while (0 == 0) {
      $cmd = "";
      if ($self->{'prgstack'} =~ s/^(.*?)\n+(.*)$/$2/s) {
         $cmd = $1;
      } else {
         return(["___SLEEP___",$self->{'name'},"Prg-Stack empty"]);
      }
      $cmd =~ s/^(.*?)\#/$1/;
      last if ($cmd !~ /^ *$/);
   }

#  Substitution der Platzhalter durch SOLL-Variablen

   my @erg  = ();
   my $text = "";
   $o       = $cmd;
   while ($cmd =~ /---([a-zA-Z0-9\_]+?)---/) {
      $o1 = $1;
      if (exists($self->{'SOLL'}->{lc($o1)})) {
         $o2   = $self->{'SOLL'}->{lc($o1)} || "NOT_FOUND_" . $o1;
         $text = $text . "$o1 substituted by $o2\n";
         $o1   = "---" . $o1 . "---";
         $cmd  =~ s/$o1/$o2/g;
      } else {
         push(@erg,lc($o1). ": ");
         $o1 = "---" . $o1 . "---";
      }
      $cmd =~ s/$o1//g;
   }

   if (@erg) {  # es gibt noch Nachfragen, daher Interaktion und zuruek
                            # nach  block()
      $self->{'prgstack'} = $o . "\n" . $self->{'prgstack'};
      return(["___SLEEP___","block",
          "Block:\n\n$o\n\n$text\nmissing variables:",@erg,$self->{'log'}]);
   }
   
#  Uebergabe des Tastendrucks in die Kommando-History

   if ($cmd =~ /^taste,(.*)$/) {
      $cmd1 = $1;
      $self->{'TIME0'} = $self->{'TIME1'};
      $self->{'TIME1'} = $self->{'TIME'} || time();
      delete($self->{'TIME'});
      if (!($self->{'TIME0'})) { $self->{'TIME0'} = $self->{'TIME1'}; }
      unshift(@{$self->{'SOLL'}->{'trace'}},
                 [$cmd1,$self->{'TIME1'} - $self->{'TIME0'}]);
   }

   print "KOMMANDO: $cmd\n";
   $self->{'log'} = $self->{'log'} .
           "\n=======================================================\n\n";
   $self->{'log'} = $self->{'log'} . "Aktion: $cmd\n\n";
   
#  Ausfuehrung des Kommandos

   return(["___NEXT___",split(/,/,$cmd)]);

}

#*******************************************************

sub sollwert {

   my $self = shift;
   my $mode = shift;
   
#   if (!($self->{'PARSED_RULES'})) {
#      $self->{'PARSED_RULES'} = $self->parse_rules($self->sollwert_tables());
#   }
#   
#   return(1) if ($self->rules($self->{'PARSED_RULES'},$self->{'SOLL'}));

   my $PARSED_RULES = $self->parse_rules($self->sollwert_tables());
   $self->rules($PARSED_RULES,$self->{'SOLL'});

#   $self->sollwert();  # Sollwert-Berechnung, d.h. Aktualisierung der
#                       # Variable  SOLL
   my $o = {%{$self->{'SOLL'}}};
   delete ($o->{'trace'});
   $o = Dumper($o);
   $o =~ s/\'//gs;
   $self->{'log'} = $self->{'log'} . "\nSollwert: $o\n";

   return(["___NEXT___","block"]);
   
}

#*******************************************************

sub parse_rules {

   my $self   = shift;
   my $tables = shift;
   
   my $parsed_table = [];  #  Ergebnis-Tabelle von Hash-Werten;
   my $table_bez; my $table; my $zeile; my $o;

   foreach $table (@$tables) {
   
      $zeile      = 0;  # naechste Zeile der Tabelle
      $table_bez  = []; # Liste der Tabellenbezeichner

      while (@$table) {

         if (!$zeile) {  # Einlesen der Spaltenbezeichner
            $o = shift(@$table);
            if ($o =~ /^\-+$/) { # hier Ende der Spaltenbezeichner
               $zeile = {}; # erste Zeile startet
            } else {
               push(@$table_bez,$o);
            }
         } else {
            foreach $o (@$table_bez) {
               $zeile->{$o} = shift(@$table);
            }
            push(@$parsed_table,$zeile);
            $zeile = {};
         }
         
      }
      
   }
   return($parsed_table);
   
}

#*****************************************************************

sub rules {

   my $self  = shift;
   my $rules = shift;
   my $soll  = shift;
   
   my $rule; my $bed; my $o; my $o1; my $o2; my $o3;
   
   foreach $rule (@$rules) {

#      print "CHECK RULE: " . Dumper($rule) .
#      Dumper($self->{'SOLL'});

      $bed = 1;
      foreach $o (keys %$rule) {
         next if ($o =~ /^\./);
         if ($o =~ /^taste(\d+)/) {  #  Tastendruck
            $o1 = "^" . $rule->{$o} . "\$";
            $o2 = $soll->{'trace'}->[$1-1]->[0];
            $o3 = "eq";
# print "RULE  $o $o1 $o2 $o3\n";
         }
         elsif ($o =~ /^(\d+)(tk|tg)(\d+)$/) {  #  Zeit
            $o1 = $rule->{$o};
            $o2 = $soll->{'trace'}->[$3-1]->[1];
            $o3 = $2;
         }
         else {
            $o1 = "^" . $rule->{$o} . "\$";
            $o2 = $soll->{$o};
            $o3 = "eq";
         }         
         next if ($o3 eq "eq" and $o1 eq "^\*\$");
         next if ($o3 eq "eq" and $o2 =~ /$o1/);
         next if ($o3 eq "tk" and $o2 >= $o1);
         next if ($o3 eq "tg" and $o2 <= $o1);
         $bed = 0;
         last;
      }

      if ($bed) {      
         foreach $o (keys %$rule) {
            next if ($o !~ /^\.(.*)$/);
            $soll->{$1} = $rule->{$o};
            delete($soll->{$1}) if ($soll->{$1} eq "-");
         }
         return(1);
      }
      
   }      
               
   return(0);
   
}

#*******************************************************

#  Hilfsfunktion, erzeugt aktuelles Datum in der Form
#  JJJJMMDD_HHMMSS

sub akt_date {

   my $self     = shift;
   my $akt_date = shift;
   if (!$akt_date) { $akt_date = time(); }
   $akt_date = sprintf("%04u",(localtime($akt_date))[5]+1900) .
               sprintf("%02u",(localtime($akt_date))[4]+1) .
               sprintf("%02u",(localtime($akt_date))[3]) . "_" . 
               sprintf("%02u",(localtime($akt_date))[2]) .
               sprintf("%02u",(localtime($akt_date))[1]) .
               sprintf("%02u",(localtime($akt_date))[0]);
   return($akt_date); 

}


#*********************************************************************

#  Funktionen zur zufaelligen Wahl von Werten:

#  Waehlt aus einer mit  sets  (s.u.)  bestimmten Parameterliste
#  einen zufaelligen Wert

sub choose {

   my $self = shift;
   my @pars = $self->sets(@_);
   return($pars[int rand($#pars+1)]);

}

#*********************************************************************

#  Wie choose, nur wird eine Liste mit Auswahlwerten zurueckgegeben.
#  Der erste Parameter gibt die Anzahl der Werte an, die ausgegegen
#  werden soll.

sub mchoose {

   my $self = shift;
   my $nr   = shift;
   my @pars = $self->sets(@_);

   if ($nr =~ /\-/) {
      $nr = ($self->sets($nr))[0];
   }
   
   my @erg = ();
   while ($#erg < $nr-1) {
      push(@erg,$self->choose(@pars));
   }

   return(@erg);

}

#*********************************************************************

#  Waehlt aus dem Zahlenintervall [$a,$b] einen zufaelligen Wert

sub choose_between {

   my $self = shift;
   my $a    = shift;
   my $b    = shift;
   return($a + int rand(1 + $b - $a));

}

#**************************************************************************

#  Wie choose_between, nur wird eine Liste mit Auswahlwerten zurueckgegeben.
#  Der erste Parameter gibt die Anzahl der Werte an, die ausgegegen
#  werden soll.

sub mchoose_between {

   my $self = shift;
   my $nr   = shift;
   my $a    = shift;
   my $b    = shift;
   my @erg  = ();

   while ($#erg < $nr-1) {
      push(@erg,$self->choose_between($a,$b));
   } 
   return(@erg);

}

#*********************************************************************

#  Hilfsfunktion, die eine Auswahlmenge definiert und als Liste zurueckgibt
#
#   Als Parameter koennen uebergeben werden:
#
#   1. <x>:       Ein beliebiger Wert (einelementige Menge)
#
#   2. <x>-<y>:   <x> und <y>  sind alphanumerische Zeichen
#                 alle Zeichen zwischen <x> und <y> werden in die Auswahlliste
#                 geschrieben
#
#   3. <x>.<y>:   <x> und <y>  sind alphanumerische Zeichen
#                 ein zufaellig ausgewaehltes Zeichen aus <x>-<y>
#                 wird in die Auswahlliste geschrieben
#
#   4. <n>-<m>:   ein zufaellig ausgewaehlter Wert zwischen den
#                 Zahlen  <n>  und  <m>  wird in die Auswahlliste geschrieben
#
#   5. <date1>-<date2>: ein zufaellig ausgewaehltes Datum zwischen
#                 <date1>  und  <date2>  wird in die Auswahlliste
#                 geschrieben. Datumsformat:  DD.MM.JJ
#


sub sets {

   my $self = shift;
   my @pars = @_;
   my @erg  = ();
   my $o; my $o1; my $o2; my $start; my $xa; my $xe;

   foreach $o (@pars) {
       
      if ($o =~ /^([A-Za-z0-9])(\.|\-)([A-Za-z0-9])$/) {
         $xa    = $1;
         $o2    = $2;
         if ($o2 eq ".") {
            $o2 = [];
         } else {
            $o2 = "";
         }
         $xe    = $3;
         $start = 0;
         foreach $o1 (qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
                         a b c d e f g h i j k l m n o p q r s t u v w x y z
                         0 1 2 3 4 5 6 7 8 9)) {
            if ($o1 eq $xa) { $start = 1; }
            if ($start) { 
               if ($o2) {
                  push(@$o2,$o1);
               } else {
                  push(@erg,$o1);
               }
            }
            last if ($o1 eq $xe);
         }
         if ($o2) { push(@erg,$self->choose(@$o2)); }
      }
      elsif ($o =~ /^([\-\+]?\d+)\-([\-\+]?\d+)$/) {
         push(@erg,$self->choose_between($1,$2));
      }
      elsif ($o =~ /^(\d+\.\d+\.\d+)\-(\d+\.\d+\.\d+)$/) {
         $xa = AutoTest::ParseDate::parsedate($1,UK=>1)/86400;
         $xe = AutoTest::ParseDate::parsedate($2,UK=>1)/86400;
         $o1 = $self->choose_between($xa,$xe);
         $o1 = AutoTest::Format::time2str("%e.%L.%Y",$o1*86400);
         $o1 =~ s/ //g;
         push(@erg,$o1);
      }
      elsif (!@erg and $o =~ /^x(\d+)/) {
         $o1 = $1;
         $o2 = 0;
         while ($o2 < $o1) {
            push(@erg,$pars[1]);
            $o2 = $o2 + 1;
         }
         return($self->sets(@erg));
      }
      else {
         push(@erg,$o);
      }

   }

   return(@erg);

}


#*******************************************************
#*******************************************************

<<'OBSOLETE';

sub xxnewtest1 {

   $v->{'result'}    = 1;
   $v->{'remark'}    = "Please Edit New Test-Item";
   $v->{'generator'} = "newtest";
   $v->{'prgstack'}  = "";
   $v->{'data'}      = "\"new data\"\;";
   
   $v->{'condition'} = <<'TEXT_ENDE';
sub condition {
   my $d = shift;
   return(1);
}
TEXT_ENDE

   $v->{'sleep'}     = 1;
   $v->{'next'}      = "test_end";

}

#*******************************************************************

sub xxtest_end {

   if (!($v->{'dyndata'})) {
      $v->{'dyndata'} = <<'TEXT_ENDE';
sub test_item {
   $v->{'name'}      = "---NAME---";
   $v->{'result'}    = ---RESULT---;
   $v->{'remark'}    = "---REMARK---";
   $v->{'weight'}    = ---WEIGHT---;
   $v->{'user'}      = "---USER---";
   $v->{'requ'}      = "---INFO---";

   $v->{'generator'} = "---GENERATOR---";
   $v->{'prgstack'}  = ---PRGSTACK---
   $v->{'data'}      = ---DATA---
   
   $v->{'next'}      = $v->{'generator'};
   $v->{'dbfunc'}    = ["status",9];
}

TEXT_ENDE

      if (!($v->{'prgstack'})) { $v->{'prgstack'} = "\"\"\;"; }
      if (!($v->{'data'}))     { $v->{'data'}     = "\"\"\;"; }
      $v->{'dyndata'} = $v->{'dyndata'} . $v->{'condition'};
   }

   $v->{'dyndata'} =~ s/\-\-\-([A-Z0-9]+)\-\-\-/$v->{lc($1)}/gs;
   eval($v->{'dyndata'});
   if ($@) {
      $v->{'status'}  = 1;
      $v->{'next'}    = "edit";
      $v->{'query'}   = [$@ . $v->{'dyndata'}];
   } else {
      my $o = func($v,"condition",$v->{'dyndata'});
      if (!$o) {
         $v->{'next'}   = $v->{'generator'};
      }
      elsif ($o =~ /^ERROR/) {
         $v->{'status'}  = 1;
         $v->{'next'}    = "edit";
         $v->{'query'}   = [$o];
      }
      else {
         $v->{'status'} = "1";
         $v->{'next'}   = "edit";
         $v->{'query'}  = [$v->{'dyndata'}];
      }
   }
   
}

#*******************************************************

sub xxnewtest {


   $v->{'dyndata'} = <<'TEXT_ENDE1';
sub test_item {
   $v->{'name'}      = "---NAME---";
   $v->{'result'}    = 1;
   $v->{'remark'}    = "New Test-Item";
   $v->{'weight'}    = 10;
   $v->{'user'}      = "---USER---";
   $v->{'requ'}      = "---INFO---";
   $v->{'generator'} = "";
   $v->{'prgstack'}  = "";
   $v->{'data'}      = "";
   
   $v->{'next'}      = $v->{'generator'};
   $v->{'dbfunc'}    = ["status",9];
}

sub condition {
   my $d = shift;
   return(1);
}
TEXT_ENDE1

   $v->{'sleep'}     = 1;
   $v->{'next'}      = "test_end";

}

#*******************************************************

sub xxedit {

   my $dyndata = $v->{'answer'}->[0];
   if ($dyndata and $dyndata !~ /^ERROR/) {
      $v->{'dyndata'} = $dyndata;
      $dyndata =~ s/\$v->\{/\$v0->\{/gs;
      eval($dyndata . <<'TEXT_ENDE');
&test_item();
$v->{'name'}   = $v0->{'name'};
$v->{'result'} = $v0->{'result'};
$v->{'remark'} = $v0->{'remark'};
$v->{'weight'} = $v0->{'weight'};
$v->{'user'}   = $v0->{'user'};
$v->{'requ'}   = $v0->{'requ'};
#$v->{'status'} = $v0->{'dbfunc'}->[1];
TEXT_ENDE
      if ($@) {
         $v->{'dyndata'} = "ERROR: $@\n" . $v->{'dyndata'};
      }
   }
   $v->{'next'}  = "edit";
   $v->{'query'} = [$v->{'dyndata'}];

}

#*******************************************************

sub xxfind {
   $v->{'dbfunc'} = ["find",$v->{'answer'}->[0]];
   $v->{'next'}   = "find_1";
}

sub xxfind_1 {
   $v->{'next'}  = "xxx";
   $v->{'query'} = [$v->{'conn'},$v->{'dyndata'},$v->{'lock'}];
}

#*******************************************************

sub xxlist {
   $v->{'dbfunc'} = ["list",$v->{'answer'}->[0],$v->{'answer'}->[1]];
   $v->{'next'}   = "list_1";
}

sub xxlist_1 {
   $v->{'next'}  = "xxx";
   $v->{'query'} = [@{$v->{'list'}}];
}

OBSOLETE

1;