Welcome To Our Shell

Mister Spy & Souheyl Bypass Shell

package DivBasicF::AutoServer;

use strict;
use DivBasicF::ObjTask;
use DivBasicF::AutoItem;
use Data::Dumper;
use Cwd;


#   Dies ist das User Interface zu AutoTest. Es laesst sich gleichzeitig
#   fuer Konsolenzugriffe verwenden als auch fuer RPC-Calls ueber
#   Qooxdoo.
#


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

#  Die new-Funktion bekommt als ersten Parameter den Ort des gewuenschten
#  Test-Trees (oder ein Unterverzeichnis dazu); das Programm wechselt dann in das
#  entsprechende Testtree-Verzeichnis. Ist der erste Parameter nicht angegeben, dann
#  bleibt das Programm im aktuellen Verzeichnis. Befindet sich das Programm in
#  einem Unterverzeichnis des Testtrees, dann wird solange im Verzeichnisbaum
#  nach oben gegangen, bis das Wurzel-Item bzw. die Testtree-Datenbank gefunden ist
#  und somit die richtige Position des Testtree-Verzeichnisses erreicht ist.
#  (Diese Funktionalitaet ermoeglicht im Konsolenmodus das direkte Wechseln
#  in die Directory-Struktur des Test-Trees und das Dort-Ausfuehren der
#  Kommandos.
#
#  Wenn noch weitere Parameter angegeben werden  ($func, $p1, $p2, ...), dann wird
#  gleich zu der Funktion  $self->$func($p1,$p2,....) verzweigt.
#
#  Ein RPC-Call geht also so:
#
#   Service-Adresse:   DivBasicF.AutoServer
#     callSync('new','DivBasicF::AutoServer',<testtree-directory>,<func>,<p1>,<p2>,....)
#


sub new {
   my $class = shift;
   $class    = shift if ($class =~ m/Qooxdoo/);
   my $o     = shift;
   my $self  = { @_ };
   $self->{'EDITOR'} = $main::ENV{'proceditor'};
   $self->{'SLASH'}  = "/";
   if (!($self->{'EDITOR'})) {
      if (-d "/etc") {
         $self->{'EDITOR'} = "joe";
      } else {
         $self->{'EDITOR'} = "notepad";
         $self->{'SLASH'}  = "\\";
      }
   }
   bless($self,$class);
   if ($o) { chdir($o); }

   $self->{'XDIR'} = "";
   while (0 == 0) {
      last if ($self->init($o));
      last if (Cwd::cwd() !~ /^(.*)([\/\\])(.*)$/);
      $self->{'XDIR'} = $3 . $2 . $self->{'XDIR'};
      chdir($1."/");
   }
   $self->{'XDIR'} = "" if (!($main::ENV{'procdir'}));

   if (!($main::ENV{'procdb'})) {
      $o = $main::ENV{'procdir'} . "/testtree.db";
      $main::ENV{'procdb'} = "dbi:SQLite:" . $o;
      if ( (stat($o))[7] < 1000) {
         open(FFILE,"<".$o);
         $o = join("",<FFILE>);
         close(FFILE);
         $o =~ s/\n//gs;
         $main::ENV{'procdb'} = $o if ($o =~ /^dbi\:/i);
      }
   }

   return($self) if (!@_);
   $o = shift(@_);
   return($self->$o(@_));  #  wenn als qooxdoo-rpc-Schnittstelle verwendet

}

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

#  Diese Routine setzt die Environment-Variablen
#  procdir, procdb und procspecial, falls es sie nicht gibt

sub init {

   my $self = shift;

   my $o; my $file; my $text;
   if (!($main::ENV{'procdir'})) {  #  wenn ein Testtree-Baum gefunden wird
      foreach $o (".",@INC) {
#         print STDERR `pwd` . "\n";
         next if (!(-f "$o/testtree.db"));
         $main::ENV{'procdir'} = $o;
         last;
      }
   }

   if (!($main::ENV{'procdir'})) {  #  ansonsten, wenn ein Wurzel-Item gefunden wird
      foreach $o (".",@INC) {
      print STDERR $o . "\n";
         opendir(DDIR,$o);
         while (0 == 0) {
            $file = readdir(DDIR);
            last if (!$file);
            next if ($file !~ /\.pm$/);
            open(FFILE,"<".$o."/".$file);
            $text = join("",<FFILE>);
            close(FFILE);
            next if ($text !~ /use +DivBasicF\:\:(AutoItem|ObjProcess)/);
            $main::ENV{'procdir'}  = $o;
            $file =~ s/\.pm$//;
            $self->{'OBJTEMPLATE'} = $file;
            last;
         }
         closedir(DDIR);
         last if ($main::{'procdir'});
      }
   }
#   print "Testtree Directory: $main::ENV{'procdir'}\n";
   return($main::ENV{'procdir'});
   
   
}

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

#  Diese Routine muss im Hintergrund laufen. Sie sorgt dafuer, dass
#  Prtozesse nach ihrer Schlafenszeit aufgeweckt und weitergefuehrt werden.

sub server { 

   my $self      = shift;
   my $no_repeat = shift;
   my $task      = DivBasicF::ObjTask->new($self->{'OBJTEMPLATE'});

   my $obj; my $func; my $pars; my $conn;
   
   while (0 == 0) {
      ($obj,$conn) = $task->fetch("MESSAGE","lock");
      if ($conn) {
         $task->connection($conn);
         $pars = $task->get();
         $func = shift(@$pars);
         $obj->$func(@$pars);
      }
      return(0) if ($no_repeat);
      sleep 1;
   }
   
}

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

#  Diese Routine stellt verschiedene Funktionalitaeten zur Verfuegung
#
#   Erster Parameter:   Test-Item (wenn leer, dann wird automatisch
#                              das Wurzel-Item genommen)
#                       Das Test-Item kann auch statt mit :: mit / sowie
#                       mit einer Endung  .pm  angegeben werden (das erleichtert die
#                       Bedienung in der Konsole, weil man so die File-Expandierung
#                       der bash benutzen kann.
#
#
#   Zweiter Parameter: Subkommando <cmd> <paramater>
#
#       r   (run):      Starten des Test-Items. Es wird ein Child-Item angelegt, dessen
#                       Name zurueckgegeben wird.
#
#       e   (edit):     Editieren des Test-Item (d.h. der Variable $self->{'program'}).
#                       Den geanderten Inhalt kann man weiteren Parameter mitgeben.
#
#       c   (continue): Weiterfuehren des Programmlaufs (Setzen der Sleep-Time auf Null)
#
#       q   (query):    Beliebige Datenbankabfrage. Wird weitergereicht an das Test-Item.
#                       (siehe Methode  info  in DivBasicF::AutoItem)
#                       Uebergeben wird ein SQL-String, der die folgenden Platzhalter
#                       substituiert:
#                         ---STORE---:   Tabelle mit Test-Items
#                         ---CONN---:    Message-Tabelle
#
#       d   (report):   Gibt eine Uebersicht der Requirements und der zugehoerigen Testfaelle
#                       aus zu den im <parameter> kommaseparierten Architekturen
#
#       x   (export):   Exportiert ein Test-Item ins Dateisystem
#       a   (all):      Exportiert ein Test-Item und alle seine Unter-Items ins Dateisystem
#       i   (import):   Importiert ein Test-Item vom Dateisystem in die Datenbank
#       m   (multi):    Importiert ein Test-Item und alle seine Unter-Items
#                       vom Dateisystem in die Datenbank

sub client {

   my $self    = shift;
   my $process = shift || $self->{'OBJTEMPLATE'};
   my $action  = shift;
   my $filter  = "";
   if ($action =~ s/^(.*)\-(.*)$/$1/) {
      $filter = $2;
   }

   return() if ($action eq "null" and $self->{'NULL'}->{$process});
   my $obj; my $conn; my $o; my $file;
   my @pars = @_;
   while (@pars and !($pars[$#pars])) { pop(@pars); }

   $process = $self->{'XDIR'} . $process;
   $process =~ s/[\/\\]/\:\:/gs;
   $process =~ s/\.pm$//;
   $self->{'XDIR'} = "";

print STDERR "ACTION: $action, ITEM: $process $self->{'OBJTEMPLATE'}\n";
   
   $action = "x" if ($action eq "export");
   $action = "d" if ($action eq "report");
   if    ($action =~ /^x/i) { $action = "export";    }
   elsif ($action =~ /^d/i) { $action = "report";    }
   elsif ($action =~ /^a/i) { $action = "all";       }
   elsif ($action =~ /^r/i) { $action = "run";       }
   elsif ($action =~ /^e/i) { $action = "edit";      }
   elsif ($action =~ /^i/i) { $action = "import";    }
   elsif ($action =~ /^m/i) { $action = "multi";     }
   elsif ($action =~ /^c/i) { $action = "continue";  }
   elsif ($action =~ /^q/i) { $action = "query";     }
   elsif ($action =~ /^t/i) { $action = "text";      }
   if ($filter and $action eq "export") {
      $filter = " and ( " . $filter . " ) ";
   } else {
      $filter = "";
   }
   
   my $task = DivBasicF::ObjTask->new($self->{'OBJTEMPLATE'});

#  1. Serialisierung des Objekts im Dateisystem

   my $text = "";
# print  "IDX.pkgstart = '$process"."::'\n"; sleep 2;
   $o = "IDX.pkgstart = '$process"."::'";
   $o = "IDX.level = '000'" if (!$process);
   ($obj,$conn) = $task->fetch($o.$filter);
   if (!$conn and $process =~ /^(.*)\:\:(.*)$/) {
      $self->client($1,"null");
      ($obj,$conn) = $task->fetch($o.$filter);
   }

#    print STDERR "OBJ: " . Dumper($obj) . "\n";
   if ($conn and (exists ($obj->{'program'})) ) {
      $self->editor($process,$obj->{'program'}); # ohne Editieren abspeichern
   }
   
   $text = $self->editor($process,1);  # Korrigieren des gespeicherten Items
   eval("use $process") if ($process); print STDOUT $@;
   $self->{'NULL'}->{$process} = 1;

   if ($action eq "run") {
#      return("ERROR: no package $process") if ($text !~ /package/);
#      return("ERROR at compile-time of $process: $@") if ($@);
      $o = $process->new()->sleep(0,'',@pars);
#      return("ERROR at run-time of $process: $@") if ($@);
      return("CREATED: " . $o);
   }

   if ($action eq "text") {
      return($obj->{'program'});
   }

   if ($action eq "edit") {
   print STDERR "DD 124 $_[0]\n";
      if ($_[0]) { $self->{'EDITTEXT'} = $_[0]; }
      $text = $self->editor($process);  #  Editieren des Items
      if ($conn) {
#         if ($text =~ /package +(.*?)\;/) {
#            $o = $1;
#            if ($process eq $o) {  #  Wenn der Package-Name gleich bleibt
#               $task->change_idx($conn,"program",$text);
#            } else {
               $obj->{'program'} = $text;
               $task->push($obj,$conn); # unter der gleichen ID wieder gespeichert
#            }
#         } else {
#            $task->change_idx($conn,"program",$text);
#         }
         return("___DATABASE_OBJECT___");
      }
      return("___FILESYSTEM_OBJECT___");
   }

   if ($action eq "export" or $action eq "all" ) {
      $file = [];
      eval("\$file = \$process->new()->childs()");
      foreach $o (@$file) {
         $self->client($o,"null") if ($action eq "export");
         $self->client($o,"all")  if ($action eq "all");
      }
   }

   if ($action eq "continue") {
      if ($conn) {
         $task->push($obj,$conn,-1); # sofort ausfuehren
         return("___DATABASE_OBJECT_STARTED___");
      }
      return("___FILESYSTEM_OBJECT_NOT_STARTED___");
   }

   if ($action eq "import") {
      if (!$conn) {
         $obj = "DivBasicF::AutoItem";
         if ($process =~ /^(.*)\:\:(.*)$/) {
            $obj  = $1;
            $self->client($obj,"null");
         }
         $obj  = $obj->new();
         $obj->{'program'} = $text;
         $obj->{'package'} = $process;
         $task->connection();
         $conn = $task->get_connection();
      }
      $o = "";
      eval("use $process");          if ($@)  { print STDERR $@; return("___ERROR___"); }
      eval("\$o = $process->new()"); if ($@)  { print STDERR $@; return("___ERROR___"); }
      if ($o and ref($obj)) {
         eval("\$obj->{'result'} = \$o->result()");
         eval("\$obj->{'remark'} = \$o->remark()");
         eval("\$obj->{'user'}   = \$o->user()");
         eval("\$o = \$o->requ()");
         $obj->{'requ'} = { @$o } if (ref($o) eq "ARRAY");
      }
      $task->push($obj,$conn);
      return("___IMPORTED___");
   }

   if ($action eq "multi") {
      $o    = $self->{'SLASH'};
      $file = $main::ENV{'procdir'} . "::" . $process;
      $file =~ s/\:\:/$o/gs;
      if (-d $file) {
         $obj  = [];
         $conn = [];
         opendir(DDIR,$file);
         while (0 == 0) {
            $o = readdir(DDIR);
            last if (!$o);
            next if ($o =~ /^\./);
            if (-d $file . $self->{'SLASH'} . $o) {
               if (!(-f($file.$self->{'SLASH'}.$o.".pm"))) {
                  $self->editor($process."::".$o,
                      "package PACKAGE\;\n\n__PACKAGE__\n\nsub DUMMY\n");
                  push(@$obj,$o);
               }
print STDERR "Directory Dummy:  $o\n";
               push(@$conn,$o);
            }
            next if ($o !~ s/\.pm$//);
print STDERR "Import File:      $o\n";
            push(@$obj,$o);
         }
         closedir(DDIR);
         foreach $o (@$obj) {
            $self->client($process."::".$o,"import");
         }
         foreach $o (@$conn) {
            $self->client($process."::".$o,"multi");
         }
      }
      if (-f $file.".pm") {
         $self->client($process,"import");
      }
      return("___MULTI___");
   }

   if ($action eq "report") {
      if (!$process) {
         if    ($pars[0] ==  1) { $pars[0] =  0.1; }
         elsif ($pars[0] == -1) { $pars[0] = -0.1; }
         elsif ($pars[0]  >  0) { $pars[0] = $pars[0] - 1; }
         elsif ($pars[0]  <  0) { $pars[0] = $pars[0] + 1; }
      }
      $o = $obj->report(@pars);
      return( $o );
   }
   
   if ($action eq "query") {   #  Allgemeine DB-Abfrage
      $o = $obj->info(@pars);
      return( $o );
   }
   
}


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

sub editor {

   my $self     = shift;
   my $package  = shift;
   my $text     = shift;
   my $slash    = $self->{'SLASH'};
#   $slash = "/";

   my $file     = $main::ENV{'procdir'} . $slash . $package;
   $file        =~ s/\:\:/$slash/gs;

   my $text0;
   if (exists ($self->{'EDITTEXT'}) ) {
      $text0 = $self->{'EDITTEXT'};
      delete ($self->{'EDITTEXT'});
   } else {
#      print($self->{'EDITOR'} . " " . $file . ".pm\n") if (!$text);
      system($self->{'EDITOR'} . " " . $file . ".pm") if (!$text);
      open(FFILE,"<".$file.".pm");
      $text0 = join("",<FFILE>);
      close(FFILE);
   }
   $text0  =~ s/
//gs;

   if (!$text) {
      $text  = $text0;
      $text0 = "";
   }
   elsif ($text == 1)  {
      $text  = $text0;
   }
   else {
      return($text0) if ($text0 =~ /^ *package /); # nicht ueberschreiben von Package-Files
   }
   
#   if ($text !~ /^ *package +$package *\;/) {
#      $text0 = "" if ($text =~ s/^ *package +(\S+?) *\;/package $package\;/);
#   }
   my $o; my $text1;
   if ($text =~ /__PACKAGE__/ and $text =~ /^( *package +\S+ *\;\n)(.*?__PACKAGE__.*?)(\n *\n)/s) {
      $o       = $2;
      $o       =~ s/^(.*?)(\s*)$/$1\n\n/s;
      $text1   = <<'TEXT_ENDE';

use strict;
use vars qw(@ISA $PKG);
$PKG = __PACKAGE__;
while ($PKG =~ s/^(.*)\:\:.*$/$1/) { eval("use $PKG"); next if ($@); @ISA = ($PKG); last }

TEXT_ENDE

      if ($o ne $text1) {
         $text  =~ s/^( *package +\S+ *\;\n)(.*?__PACKAGE__.*?)(\n *\n)/$1$text1$3/s;
         $text0 = "";
      }
      $text0 = "" if ($text =~ s/sub DUMMY/1\;/);
   }
   
    
   if ($text0 ne $text or (!(-f($file.".pm")))) {
      if ($file =~ /^(.*)[\\\/](.*)$/) {
print STDERR "CREATING DIR $1\n"  if (!(-d($1)));
         mkdir($1) if (!(-d($1)));
      }
print STDERR "EDITING: $file\n";
      open(FFILE,">".$file.".pm");
      print FFILE $text;
      close(FFILE);
   }
   
   unlink($file.".pm~");
   $text = "" if (!(-f($file.".pm")));
   if ($text =~ /^ *package / and $text !~ /^ *package +$package *\;/) {
#      print "TT: $o  $package\n"; sleep 8;
      unlink($file.".pm");
   }
   return($text);
   
}

1;


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

sub make_batch {

   my $class       = shift;

   open(FFILE,">ot.bat");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::AutoServer; print DivBasicF::AutoServer->new()->client('%1','%2','%3','%4','%5','%6','%7,'%8','%9').\"\n\"";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">ox.bat");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::AutoServer; DivBasicF::AutoServer->new()->server()";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">or.bat");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::AutoReport; DivBasicF::AutoReport->new()->client('$1','$2',$3)";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">ot");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::AutoServer; print DivBasicF::AutoServer->new()->client('$1','$2','$3','$4','$5','$6','$7,'$8','$9').\"\n\"";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">ox");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::AutoServer; DivBasicF::AutoServer->new()->server()";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">or");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::AutoReport; DivBasicF::AutoReport->new()->start('$1','$2',$3)";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">howto.txt");
   print FFILE <<'TEXT_ENDE'; close(FFILE) } 1;
Hier eine Kurzbeschreibung zur Installation:

1. Installation von Perl von der Site:
   www.activestate.com/activeperl/downloads

2. Verschieben der Verzeichnisse DivBasicF, SpreadSheet, Qooxdoo und AutoQX in den
   Perl-Include-Pfad, oder entsprechendes Anpassen der Environment-Variable
   perl5lib. Am einfachsten ist es, die beiden Verzeichnisse in das
   Verzeichnis C:\perl\lib zu verschieben.

3. In ein im Pfad liegendes Verzeichnis wechseln (z.B. C:\perl\bin), und
   dann aufrufen:
   
   perl -e "use DivBasic::AutoServer; DivBasicF::AutoServer->make_batch()"
   
   Es entstehen im aktuellen Verzeichnis dann die Aufrufdateien ot.bat, ox.bat und or.bat
   sowie eine howto.txt-Datei (diese kann geloescht oder verschoben werden).
   
4. Aufsetzen eines Test-Trees:

   In ein Verzeichnis wechseln (Test-Tree-Verzeichnis).
   
   Es muss mindestens ein festes Perl-Modul geben, und zwar im Test-Tree-Verezichnis
   direkt. Dieses zentrale Modul muss von  DivBasicF::AutoItem  erben.
   Es ist zugleich das Wurzel-Item des ganzen Test-Trees.
   Weitere feste Module koennen hinzugefuegt werdn, am besten in entsprechenden
   Unterverzeichnissen.
   
5. Anwendung der Konsolen-GUI:

   ot  <Test-Item>  run <par1> <par2> ...:     Test-Item ausfuehren
   ot  <Test-Item>  edit:                      Test-Item editieren
   ot  <Test-Item>  import:                    Test-Item aus dem Test-Tree
                                               in die Datenbank kopieren
   ot  <Test-Item>  import:                    Test-Item aus dem Test-Tree
                                               zusammen mit allen Unterverzeichnissen
                                               in die Datenbank kopieren
                                               
   Damit die Testfaelle durchlaufen, muss in einer weiteren Konsole ein
   weiterer sog. Server-Prozess laufen, der einfach mit   ox  gestartet wird.
   Es koennen zur Steigerung der Performanz auch mehrere solcher Server-Prozesse
   laufen.
   
   Reporting:
   
   ot  d  <Test-Item>  <Tiefe>   <Architekturen>
   
   Hiermit wird eine Excel-Liste erstellt, die die Test-Ergebnisse fuer den
   Unter-Tree zum <Test-Item> darstellt, und zwar hinsichtlich der
   angegebenen <Architekturen> (kommaseparierte Liste). Die optionale <Tiefe>
   ist eine Zahlö, die angibt, bis zu welcher Tiefe Unter-Items angezeigt
   werden sollen. Ist die Tiefe = 9999, dann werden genau alle Testlaeufe
   nicht angezeigt, sondern nur die entsprechend hoeher aggregierte Ebene
   der Testfaelle.
   
6. Interpretation der Testergebnisse:

   Jedes Test-Item enthaelt relativ zu gegebenen Architekturen Angaben fuer
   Fehlerfindewahrscheinlichkeiten bestimmter Requirements (Relevanzen).
   Die Fehlerfindewahrscheinlichkeit x zu einem gegebenen Requirement
   R und einer gegebenen Architektur A sagt aus aus: Wenn das Test-Target
   fuer das Requirement R fehlerhaft implementiert ist, dann wuerde das
   Test-It-em mit einer Wahrscheinlichkeit x auch tatsaechlich als Ergebnis
   einen Fehler anzeigen.
   Fuer uebergeordnete Test-Items werden die entsprechenden Werte
   (fuer jede Architektur und jedes Requirements) aus den Child-Items
   hochgerechnet. Das kumulierte Testresult (fuer jede Architektur und
   jedes Requirement) ist einfach das Maximum aller Child-Items.


7. Hello World!

   

TEXT_ENDE



1;