Welcome To Our Shell

Mister Spy & Souheyl Bypass Shell

package DivBasicF::ObjServer;

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

sub new {

   my $class = shift;
   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 == 1) { $o = "."; }
   if ($o) { $main::ENV{'procdir'} = $o; }
   $self->init();
   
print "$main::ENV{'procdir'}  $main::ENV{'procspecial'}\n";
   return($self);
   
}

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

#  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'})) {
      foreach $o (".",@INC) {
         next if (!(-f "$o/testtree.db"));
         $main::ENV{'procdir'} = $o;
         last;
      }
   }

   if (!($main::ENV{'procdir'})) {
      foreach $o (".",@INC) {
         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\:\:AutoProcess/);
            $main::ENV{'procdir'} = $o;
            last;
         }
         closedir(DDIR);
         last if ($main::{'procdir'});

      }
   }
   
   $main::ENV{'procspecial'} = "DivBasicF::AutoDB";
   
}

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

sub server {

   my $self = shift;
   my $task = DivBasicF::ObjTask->new();

   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);
      }
      sleep 1;
   }
   
}

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

sub client {

   my $self    = shift;
   my $action  = shift;
   my $process = shift;

   return() if ($action eq "null" and $self->{'NULL'}->{$process});

print "ACTION: $action, ITEM: $process \n";
   
   my $obj; my $conn; my $o; my $file;

   $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 = "queries";   }
   
   my $task = DivBasicF::ObjTask->new();
   
#  1. Serialisierung des Objekts im Dateisystem

   my $text = "";

   ($obj,$conn) = $task->fetch("IDX.package = '$process'");
   if (!$conn and $process =~ /^(.*)\:\:(.*)$/) {
      $self->start("null",$1);
      ($obj,$conn) = $task->fetch("IDX.package = '$process'");
   }
   if ($conn) {
      $self->editor($process,$obj->{'program'});
   }
   
   $self->editor($process,1);
   eval("use $process"); print $@;
   $self->{'NULL'}->{$process} = 1;

   if ($action eq "run") {
      $o = $process->new(@_)->sleep(0,"",@_);
      return("CREATED: " . $o);
   }

   if ($action eq "edit") {
      $text = $self->editor($process);
      if ($conn) {
         $obj->{'program'} = $text;
         $task->push($obj,$conn); # unter der gleichen ID wieder gespeichert
         return("___DATABASE_OBJECT___");
      }
      return("___FILESYSTEM_OBJECT___");
   }

   if ($action eq "export") {
      if ($conn) {
         $file = $obj->childs();
         foreach $o (@$file) {
            $self->client("null",$o);
         }
      }
   }

   if ($action eq "all") {
      if ($conn) {
         $file = $obj->childs();
         foreach $o (@$file) {
            $self->client("all",$o);
         }
      }
   }

   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 and $process =~ /^(.*)\:\:(.*)$/) {
         $obj  = $1;
         $self->start("null",$obj);
         $obj  = $obj->new();
         $obj->{'program'} = $text;
         $task->connection();
         $conn = $task->get_connection();
      }
      $obj->{'program'} = $self->editor($process,1);
      $o = "";
      eval("use $process"); print $@;
      eval("\$o = $process->new()"); print $@;
      if ($o) {
         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 = $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 "Directory Dummy:  $o\n";
               push(@$conn,$o);
            }
            next if ($o !~ s/\.pm$//);
print "Import File:      $o\n";
            push(@$obj,$o);
         }
         closedir(DDIR);
         foreach $o (@$obj) {
            $self->start("import",$process."::".$o);
         }
         foreach $o (@$conn) {
            $self->start("multi",$process."::".$o);
         }
      }
      return("___MULTI___");
   }

   if ($action eq "report") {
      $o = $obj->report(@_);
      return( Dumper ($o) );
   }
   
}


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

sub editor {

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


   my $edit     = 0;
   my $file     = $ENV{'procdir'} . $slash . $package;
   $file        =~ s/\:\:/$slash/gs;
   my $o;
   if (!$text) {
#      print($self->{'EDITOR'} . " " . $file . ".pm\n") if (!$text);
      system($self->{'EDITOR'} . " " . $file . ".pm") if (!$text);
      $edit = 1;
   }

   if (!$text or $text == 1) {
      open(FFILE,"<".$file.".pm");
      $text = join("",<FFILE>);
      close(FFILE);
   } else {
      $edit = 1;
   }
   $text =~ s/
//gs;

   if ($text !~ /^ *package +$package *\;/) {
      $edit = 1 if ($text =~ s/^ *package +(\S+?) *\;/package $package\;/);
   }
   if ($text =~ /__PACKAGE__/ and $text =~ /^( *package +\S+ *\;\n)(.*?)(\nsub )/s) {
      $o       = $2;
      $o       =~ s/^(.*?)(\s*)$/$1\n\n/s;
      $package = <<'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 $package) {
         $text =~ s/^( *package +\S+ *\;\n)(.*?)(\nsub )/$1$package$3/s;
         $edit = 1;
      }
      $edit = 1 if ($text =~ s/sub DUMMY/1\;/);
   }                  
    
   if ($edit) {
      if ($file =~ /^(.*)[\\\/](.*)$/) {
print "CREATING DIR $1\n"  if (!(-d($1)));
         mkdir($1) if (!(-d($1)));
      }
print "EDITING: $file\n";
      open(FFILE,">".$file.".pm");
      print FFILE $text;
      close(FFILE);
   }
   
   unlink($file.".pm~");
   $text = "" if (!(-f($file.".pm")));
   return($text);
   
}

1;


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

sub make_batch {

   my $class       = shift;

   open(FFILE,">ot.bat");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::ObjClient; print DivBasicF::ObjServer->new()->client('%1','%2').\"\n\"";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">ox.bat");
   print FFILE << 'TEXT_ENDE';
perl -e "use DivBasicF::ObjServer; DivBasicF::ObjServer->new()->server()";
TEXT_ENDE
   close(FFILE);
   
   open(FFILE,">or.bat");
   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 und SpreadSheet 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::ObjClient; DivBasicF::ObjClient->make_batch('<procdb>','<procdir>')"
   
   wobei:
      <procdb>  der Datenbank-Connection-String ist, also z.B. dbi:SQLite:/ppl/DB/test5.db
                  (/ppl/DB/test5.db ist hier die SQLite-Datenbank-Datei)
      <procdir> der absolute Pfad des Test-Tree-Verzeichnisses.
      
   Laesst man diese Angaben weg, dann muessen diese Angaben gemacht werden, indem
   die Umgebungsvariablen  procdb  und procdir  in der Shell entsprechend gesetzt werden.
   
   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:

   Ein Test-Tree ist durch zwei Koordinaten gegeben: der Ort des Test-Tree-Verzeichnisses
   <procdir> und die dazugehoerige Datenbank, repraesentiert durch den
   Datenbank-Connection-String <procdb>. Diese Parameter werden durch Schritt 3 in den
   Aufrufdateien ot.bat, ox.bat und or.bat entweder fest gesetzt oder muessen anderenfalls
   ueber die Environment-Variablen <procdir> und <procdb> angegeben werden.

   Im Test-Tree-Verzeichnis werden Test-Items temporaer als Perl-Module abgelegt.
   Ausserdem finden hier die zum jeweiligen Testprojekt noetigen festen
   Perl-Module ihren Platz.
   
   Es muss mindestens ein festes Perl-Modul geben, und zwar im Test-Tree-Verezichnis
   direkt. Dieses zentrale Modul muss von  DivBasicF::AutoProcess  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:
   
   or  <Test-Item>  <Architekturen>  <Tiefe>
   
   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;