Welcome To Our Shell

Mister Spy & Souheyl Bypass Shell

package DivBasicF::AutoSkriptParser;
use strict;
use Parse::RecDescent;
$Parse::RecDescent::skip = ' *';

sub DELIVER { 2 }


sub parse {

   my $text               = shift;
   my $autoskript_grammar = <<'_AUTOSCRIPTGRAMMAR_';
CODE          :  /(^|^.*?\n)([a-zA-Z0-9\-\:\_]+)/s  LINES  { ---PKG---header($2) . $item[2]; }
#  { "package $2;\n\n$item[2]" }

LINES         : LINE /\n/ LINES                        { shift(@item); join("",@item) }
              | LINE
              
LINE          : ASSIGNMENT
              | RESULT
              | REMARK
              | USER
              | REQUIREMENT
              | FUNCTION
              | SLEEP
              | SETREQU
              | ASSERT
              | /.*/
 
#--------------------------------------------------------------------------

ASSIGNMENT    :  VAR '=' EXPRESSIONS                   { shift(@item); join(" ",@item) .";" }

EXPRESSIONS   : EXPRESSION /[\+\-\*\:]/ EXPRESSIONS    { shift(@item); join(" ",@item) }
              | EXPRESSION

EXPRESSION    :  VAR                          
              |  /[0-9\.\-]+/
              |  /\'.*?\'/s
              | '(' EXPRESSIONS ')'                    { shift(@item); join(" ",@item) }
           

VAR           :  /[A-Z][A-Z0-9]*/                      { "\$self->{'".$item[1]."'}" }


#---------------------------------------------------------------------------

RESULT        : /RESULT/       /[0-9]+/      { "sub result \{ " . $item[2] . " \}" }
REMARK        : /REMARK/       /\'.*?\'/s    { "sub remark \{ " . $item[2] . " \}" }
USER          : /USER/         /\'.*?\'/s    { "sub user   \{ " . $item[2] . " \}" }
REQUIREMENT   : /REQUIREMENT/  /[a-zA-Z0-9\_\-]+/  /[0-9\.\-]+/ 
              { "sub requ   \{ \[\n               '$item[2]'   =>  $item[3],\n---RUN---\n" }


ASSERT        : /ASSERT/ /\(/  EXPRESSIONS /\=[\>\<\=]/ EXPRESSIONS /\)/ /\d+/  /\'.*?\'/
                                       { ---PKG---assert(@item);  }

FUNCTION      : /[A-Z][A-Z\_0-9]*/ /\(/ PARAMETERS /\)/  { ---PKG---func($item[1],$item[3]) }

SLEEP         : /SLEEP/  /\d+/                           { ---PKG---sleep($item[2]) }


PARAMETERS    : EXPRESSIONS /,/ PARAMETERS               { shift(@item); join(" ",@item) }
              | EXPRESSIONS

SETREQU       : /SETREQU/  /[a-zA-Z0-9\_\-]+/  /[0-9\.\-]+/  { "\$self->add_requ($item[3],\'$item[2]\')\;" }


_AUTOSCRIPTGRAMMAR_

   my $pkg = __PACKAGE__;
   $autoskript_grammar =~ s/---PKG---/$pkg\:\:/g;
   my $parser  = Parse::RecDescent->new($autoskript_grammar);
   $text = $parser->CODE($text);
# return($text);
   my $rest_code = "";
   $text =~ s/---RUN---[ \n]+sub requ *\{ *\[\n//gs;
   if ($text =~ /^(.*)---RUN---(.*?)(\nsub .*$|$)/s) { $rest_code = $3; $text = $1 . <<'TEXT_ENDE'; }
] }


sub run {

   my $self = shift;
   $self->test_start();
TEXT_ENDE

   my $o =  $2;
   $o    =~ s/\n/\n   /gs;
   $text = $text . "   " . $o . <<'TEXT_ENDE' . $rest_code;
   
   $self->test_end();
   
}
TEXT_ENDE

   my $zaehler = "01";
   while ($text =~ s/---COUNT---/$zaehler/) {
      $zaehler = sprintf("%02u",$zaehler+1);
   }
      
   return($text . "\n\n1;\n");
   
}

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

sub header {

   my $package = shift;
   my $lines   = shift;
   return("package ") if ($package eq "package");
   
   my $text = "package $package\; \n\n" . <<'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

   return($text);
   
}

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

sub func {

   my $fkt  = shift;
   my $text = shift;
   my $o; 
   my $text1      = [];
   my $answervars = [];
   my $querytext;

   foreach $o (split(/ *, */,$text)) {
      if ($o =~ /^ *\$self-\>\{ *\' *(.*?) *\'\} *$/) {
         push(@$answervars,"'$1'");
         push(@$text1,"'VAR:$1'");
      } else {
         push(@$text1,$o);
      }
   }


#   if ($fkt eq "WAEHLE1") {
#      return("\$self->$fkt ( $text )");
#   } else {
      $querytext  = "\$self->queries(\"$fkt\"," . join(",",@$text1) . ");\n";
      $querytext .= "\$self->sleep(-1); } sub t---COUNT--- \{ my \$self = shift\;\n";
#      $querytext = <<'TEXT_ENDE';
#eval("$self->---FKT--- ( ---TEXT--- )");
#if ($@) {
#TEXT_ENDE
#      $querytext =~ s/---FKT---/$fkt/;
#      $querytext =~ s/---TEXT---/$text/;
#      $querytext =~ s/\$self/\\\$self/g;
#      $querytext .= "   \$self->{'log'} = \"Interactive dialog:\\n------------------------\\n\"\;\n";
#      foreach $o (split(/ *, */,$text)) {
##         if ($o =~ /^ *\$self-\>\{ *\' *(.*?) *\'\} *$/) {
#            $querytext  .= "   \$self->\{\'log\'} .= \'$1:\';\n";
#            push(@answervars,"'$1'");
#         }
#         $querytext .= "   \$self->\{\'log\'} .= " . $o . " . \"\\n\"\;\n";
#      }
#      $querytext .= "\}\n\$self->sleep(\$\@?-1:0); \} sub t---COUNT--- \{ my \$self = shift\;\n";
      $querytext .= "\$self->answers(" . join(",",@$answervars) . ");\n";
      return("\n\#-------- QUERY ---------------------------\n" .
             $querytext . "\#------------------------------------------\n");
#   }
   
}

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

sub sleep {

   my $sleeptime = shift;

   my $text = "\$self->sleep($sleeptime); \} sub t---COUNT--- \{ my \$self = shift\;\n";
   return($text . "\n\#------------------------------------------\n");
   
}

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

sub assert {

   my @item =  @_;
   
   my $text   = "if ( $item[3] $item[4] $item[5] ) \{\n";
   $text      = $text . "   \$self->\{\'result\'\} = $item[7]\;\n" if ($item[7]);
   $text      = $text . "   \$self->\{\'remark\'\} = $item[8]\;\n" if ($item[8]);
   $text      = $text . "   return \$self->test_end()\;\n\}\n";
   return($text);   

}

1;