Welcome To Our Shell

Mister Spy & Souheyl Bypass Shell

package DivBasicF::EvaluateArgs;

#use BSH::BSH_strict;

use strict;


#  This module covers the checks of parameters, and manages channels for
#  output, It is the frame for a standard command script.
#
#  The constructor  new  takes the following arguments:
#
#  1. Program Name
#  2. Version number
#  3. Usage Info
#  4. Temp Dir
#  5. Operating System  (sunos, xp, linux)
#  6. Environment Hash
#
#  The Usage Info should be a string of the form:
#[-u=<userid>]
#[-p=<password>]
#[-g=<group>]
#-item_id=<id> -rev=<rev> -datasetname=<datasetname> |  -input_liste
#-outdir=<output directory>
#-definition=<definition file>
#[-logfile=<logfile>]
#[-format=dxf|dwg] 
#[-debug]
#[-dryrun]
#[-help]
#
# because of checks of valid parameters
#

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

sub new {

   my $class            = shift;
   my $self             = {};
   bless($self,$class);
   $self->{'PRGNAME'}   = shift;
   $self->{'VERSION'}   = shift;
   $self->{'USAGE'}     = shift;
   $self->{'TEMPDIR'}   = shift;
   $self->{'OS'}        = shift;
   $self->{'ENV'}       = shift;
   $self->{'KONSOLEINFO'} = "";
   $self->{'ERRORINFO'}   = "";
   $self->{'LOGINFO'}     = "";
   $self->{'DEBUGINFO'}   = "";
   $self->{'READYINFO'}   = "";
   $self->{'COMMON'}      = DivBasicF::Common->new();

   my $vp = ",";
   my $text = $self->{'USAGE'};
   while ($text =~ s/\-([a-zA-Z0-9\_]+)/ /) {
      $vp = $vp . $1 . ",";
   }
   $self->{'VALID_PARAMETERS'} = $vp;
   return($self);

}
   
#********************************************************************

sub par  {

   my $self = shift;
   my $pars = [@_];

   my $o;
   foreach $o (@$pars) {
      if ($self->{'HPARAM'}->{$o}) {
         $o = $self->{'HPARAM'}->{$o};
      }
   }

   if (@$pars) { return($pars); }
   return($self->{'HPARAM'});

}

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

sub tpar         { my $self = shift; return($self->{'TPARAM'});      }

#  This methods return the contents of the channels
#  KONSOLE, ERROR, LOG, DEBUG, READY

sub konsoleinfo  { my $self = shift; return($self->{'KONSOLEINFO'}); }
sub errorinfo    { my $self = shift; return($self->{'ERRORINFO'});   }
sub loginfo      { my $self = shift; return($self->{'LOGINFO'});     }
sub debuginfo    { my $self = shift; return($self->{'DEBUGINFO'});   }
sub readyinfo    { my $self = shift; return($self->{'READYINFO'});   }

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

sub xxerrortext {   # Obsolete, see DivBasivF::Common

   my $self = shift;
   my $nr   = shift;
   my @pars = shift;  #  Parameters of the error message
   my $o1; my $o2; my $o3; my $o4; my $zaehler;

   if ($nr =~ /^(\d+)\. *(.*)$/) {
      $o1 = $2;
      $nr = $1;
   } else {
      if (!($self->{'ERRORTEXT'})) {
         if ( open(FFILE,"<".$self->{'ERROR_MESSAGES'})) {
            $o1 = join("",<FFILE>);
            $o1 =~ s/\#(.*?)\n//gs;
            $o1 = $o1 . "\nxxx\n";
            close(FFILE);
            $self->{'ERRORTEXT'} = {};
            while ($o1 =~ s/(\d+)\; *(.*?)\n([^ ])/\n$3/s) {
               $self->{'ERRORTEXT'}->{$1} = $2;
            }
         } else {
            $self->{'ERRORTEXT'} = {
               4001   =>   'No parameters.',
               4002   =>   'Parameter -PAR1- is invalid.',
               4003   =>   'Logfile -PAR1- cannot be opened.',
               4004   =>   'Logfile is mandatory.',
               4010   =>   'Environment not correct.',
               4011   =>   'The following rule does not match: -PAR1-'
            }
         }
      }
      $o1 = $self->{'ERRORTEXT'}->{$nr};
      if (!$o1) { $o1 = "Unknown Error " . $nr; }
   }
      
   $zaehler = 0;
   while (@pars) {
      $o2      = shift(@pars);
      $zaehler = sprintf("%1u",$zaehler+1);
      $o3      = "-PAR" . $zaehler . "-";
      $o1      =~ s/$o3/$o2/gs;
   }
   return($o1) if ($pars[0] eq "raw");
   return("ERROR " . $nr . ": " . $o1) if ($o1 > 999 or $o1 == 0);
   return("ERROR " . $nr . " (Warning): " . $o1);

}

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

#   This function analyzes a field of parameter entries as
#   it comes from an @ARGV-field. For example:
#
#   @ARGV = ("-g","xyz,"-dryrun","-c=command","par -d jj");
#
#   In this example, this field is transformed (by joining it
#   with spaces) into the string ("=" will be transformed to spaces).
#
#      -g xyz -dryrun -c   command par
#
#   An option in this string is a pattern combined from literals
#   and numbers with a leading "-". All patterns (space-separated)
#   followed by the option are interpreted as the value of the option.
#
#   and  read_pars  returns a hash containing all options with
#   the respective values:
#
#     "g"       =>   "xyz"
#     "dryrun"  =>   ""
#     "c"       =>   "command par"
#     "d"       =>   "jj"
#

sub read_pars {

   my $self     = shift;
   my @cmd_line = @_;   #  here to hand over the field, for example  @ARGV
   my $pars     = pop(@cmd_line);
   if (!(ref($pars))) { push(@cmd_line,$pars); $pars = {}; }
   my $usage = $self->show_usage();
  
   if (!@cmd_line) {
      $self->c(1,$usage);
      $self->c(2,$self->{'COMMON'}->errortext(4001));
      return(4001);
   }

   my $o; my $o1; my $o2; my $o3; my @ee;
   push(@cmd_line,"-___END___XYZ___");
   my $pp = {};
   my $text = join(" ",@cmd_line);
   $text =~ s/\=/ /g;
   $text =~ s/\n/ /g;
   @cmd_line = split(" ",$text);
   $text = " " . $text . " ";
   if ($text =~ /-f\s(\S*)/) {
      open(FFILE,"<".$1);
      $o = "";
      while ($o1 = <FFILE>) {
         next if ($o1 =~ /^(\s*)\#/);
         $o = $o . $o1;
      }
      close(FFILE);
      $o1 = " ";
      $o  =~ s/\n/$o1/g;
      @ee = split(/\s+/,$o);
      @cmd_line = (@ee,@cmd_line);
   }

   $text = " ";
   $o1   = "";
   while (0 == 0) {
      last if (!@cmd_line);
      $o = pop(@cmd_line);
      if (substr($o,0,1) eq "-") {
         $text =~ s/\s\s//;
         if ($text eq " ") { $text = 1; }
         $pp->{substr($o,1)} = $text;
         $o1 = $o1 . substr($o1,1) . "\:" . $text . "\n";
         $text = " ";
      } else {
         $text = $o . " " . $text;
      }
   }
   delete($pp->{"___END___XYZ___"});
   if ($pp->{"help"} or $pp->{"h"}) {
      $self->c(1,$usage);
      return(9999);
   }

   $self->{'HPARAM'} = $pp;
   $self->{'TPARAM'} = $o1;

#  Instantiate the external variables
#

#  Check Valid Parameters
#

   if ($self->{'VALID_PARAMETERS'}) {
      $o = "," . $self->{'VALID_PARAMETERS'} . ",";
      foreach $o1 (keys %$pp) {
         $o2 = "," . $o1 . ",";
         if ($o !~ /$o2/) {
            $self->c(1,$usage);
            $self->c(2,$self->{'COMMON'}->errortext(4002,$o1));
            return(4002);
         }
      }
   }

#  Initialisation of external variables

   foreach $o (keys %$pars) {
      next if (ref($pars->{$o}) ne "SCALAR");
      ${$pars->{$o}} = $pp->{$o};
   }

   return($pp);

}

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

#  This method checks parameters with respect to validity.
#
#  The only parameter is a hash, wich takes some information
#  what has to be checked. For example:
#
#   {
#         MANDATORY => "logfile,outdir,definition,u=p and p=g,item_id=rev and item_id=datasetname and item_id!=input_liste",
#         EW        => "outdir,export_logs",
#         G         => "logfile,readyfile",
#         FR        => "input_liste",
#       "ENV:IMAN_ROOT,IMAN_DATA,IMAN_BIN" => "\nThere is no I-MAN environment.\nPlease start the program with the correct settings.\n\n",
#       "ENV:UGII_BASE_DIR,UGII_ROOT_DIR"  => "\nThere is no UG environment.\nPlease start the program with the correct settings.\n\n"
#   }
#
# The mandatory field is a comma separated list of parameters which
# have to be existing. Complex conditions with logical operators are
# supported, too. The expression <par1>=<par2>  is true if both
# parameters exist, or both exist not.
#
# Fields consisting of the letters DEFGWR contains comma-separated
# lists of files resp. directories with the following attributes:
#
# D: is a directory
# E: maybe a directory, to be created
# F: is a file
# G: maybe a file, to be created
# R: is readable
# W: is writetable
#
# Fields beginning with  ENV:  takes in the key a list of Environment
# variables which have to be defined, The value is a special error
# message if the condition is not fulfilled.




sub check_pars {

   my $self  = shift;
   my $pars  = shift;
   my $usage = $self->show_usage();
   my $o; my $o1; my $o2; my $o3; my @ee; my $o8; my $o9;
   my $pp = $self->{'HPARAM'};

   delete ($self->{'DISPATCHER'});

#  4. Open Log-, Debug- and Ready-Files
#     Dryrun is handled in the same way ("Dryrun-File" only for
#     compatibility reasons)

   foreach $o (["logfile",   "LOG",   "Log-File"],
               ["debug",     "DEBUG", "Debug-File"],
               ["readyfile", "READY", ""],
               ["dryrun",    "DRYRUN","Dryrun-File"]) {
      $o1 = $pp->{$o->[0]};  #  Filename  or  1
      $o2 = $o->[1];
      $o8 = $o1;
      $o9 = "";
      $o3 = "/dev/null";
      if ($self->{'OS'} eq "xp") {
         $o3 = "NUL";
      }
      while ($o8 =~ s/^(.*?[\/\\])//) {
         $o9 = $o9 . $1;
         if ($o9 =~ /^(.+)[\/\\]$/) {
            system("mkdir $1 2> " . $o3);
         }
      }
      if ($o1) {
         $self->{$o2} = 1;
         if ($o1 != 1) {
            if ($o2 eq "READY") {
               if (-f $o1) {
                  if ($o1 =~ /^(.*)\.(.*)/) {
                     $o8 = $1 . "_";
                     $o9 = $2;
                  }
                  my $zaehler = 0;
                  while (0 == 0) {
                     $zaehler = sprintf("%03u",$zaehler+1);
                     last if (!(-f "$o8$zaehler.$o9"));
                  }
                  if ($self->{'OS'} eq "xp") {
                     system("move $o1 $o8$zaehler.$o9 > NUL");
                  }
                  else {
                     system("mv     $o1 $o8$zaehler.$o9 2> /dev/null");
                  }
               }
            }
            if (open(FFILE,">".$o1)) {
               $self->{$o2} = $o1;
               if ($o->[2]) {
                  print FFILE $o->[2] . "\n\n";
               }
               print FFILE $self->{$o2."INFO"};
               close(FFILE);
            } else {
               if ($o2 eq "LOG") {
                  $self->c(2,$self->{'COMMON'}->errortext(4003,$o1));
                  return(4003);
               }
            }
         } else {
            if ($o2 eq "LOG") {
               $self->c(2,$self->{'COMMON'}->errortext(4004));
               return(4004);
            }
         }
      }
   }

#  1. Check the Environment
#

   foreach $o (keys %$pars) {
      next if ($o !~ /^ENV\:(.*)$/);
      foreach $o1 (split(/,/,$1)) {
         if (!($self->{'ENV'}->{$o1})) {
            $self->c(2,$self->{'COMMON'}->errortext(4010));
            $self->c(2,$pars->{$o});
            return(4010);
         }
      }
   }


#  3. Access-Check

   my $path_mode = {};
   foreach $o (keys %$pars) {
      if ($o =~ /^[DFEGRWB]+$/) {
         foreach $o1 (split(/,/,$pars->{$o})) {
            next if (!($pp->{$o1}));
            $path_mode->{$o1} = $path_mode->{$o1} . $o;
         }
      }
   }
   $o1 = "";
   foreach $o (keys %$path_mode) {
      $o2 = $path_mode->{$o};
      $o2 =~ s/(.)(.*)\1/$1$2/g;
      $o1 = $o1 . "," . $o2 . "(" . $o . ")";
   }




#  2. Check Mandatory Parameters
#

   if ($pars->{'MANDATORY'}.$o1) {
      foreach $o (split(/,/,$pars->{'MANDATORY'}.$o1)) {
         next if (!$o);
         $o1 = $o;
         $o1 =~ s/([a-zA-Z0-9\_]+)/O\($1\)/g;
         $o1 =~ s/O\(([a-zA-Z]+)\)\(/$1\(/g;
         $o1 =~ s/([a-zA-Z]+)\(O\(([a-zA-Z0-9\_]+)\)\)/$1\($2\)/g;
         $o2 =  $o1;

         $o1 =~ s/O\((and|or|not)\)/$1/g;
         $o1 =~ s/([^\=\!])\=([^\=])/$1\=\=$2/g;
         $o1 =~ s/([A-Z]+)\(/\$self->check\(\"$1\",\"/g;
         $o1 =~ s/\)/\"\)/g;

         $o2 =~ s/O\((and|or|not)\) */$1\n/g;
         $o2 =~ s/O\(([a-zA-Z0-9\_]+)\)/\(existence of option $1\)/g;
         while ($o2 =~ s/([a-zA-Z]+)\(([a-zA-Z0-9\_]+)\)/\($pp->{$2}___XXX___\)/) {
            $o3 = $1;
            $o3 =~ s/([a-z])/\!$1/g;
            $o3 =~ s/\!D/ is not a directory,/g;
            $o3 =~ s/\!E/ cannot be a directory,/g;
            $o3 =~ s/\!F/ is not a file,/g;
            $o3 =~ s/\!W/ is not writeable,/g;
            $o3 =~ s/\!R/ is not readable,/g;
            $o3 =~ s/\!G/ must not be a writeable file,/g;
            $o3 =~ s/D/ is directory,/g;
            $o3 =~ s/E/ can be a directory,/g;
            $o3 =~ s/F/ is file,/g;
            $o3 =~ s/W/ is writeable,/g;
            $o3 =~ s/R/ is readable,/g;
            $o3 =~ s/G/ maybe a writeable file,/g;
            $o3 =~ s/,$//;
            $o2 =~ s/___XXX___/$o3/;
         }
         if (!(eval($o1))) {
            $self->c(1,$usage);
            $self->c(2,$self->{'COMMON'}->errortext(4011,$o2));
            return(4011);
         }
      }
   }
   

   return(0);

}

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

#  Qualifies an option

sub check {

   my $self   = shift;
   my $mode   = shift;
   my $option = shift;
   my $par    = $self->{'HPARAM'};
   my $value  = $par->{$option};

   my $bed; my $o;
   while ($mode) {
      $o    = substr($mode,0,1);
      $mode = substr($mode,1);
      if    ($o eq "O") { return(0) if (!(exists ($par->{$option}))); }
      elsif ($o eq "o") { return(0) if (  exists ($par->{$option}));  }
      elsif ($o eq "F") { return(0) if (!(-f $value)); }
      elsif ($o eq "f") { return(0) if   (-f $value);  }
      elsif ($o eq "D") { return(0) if (!(-d $value)); }
      elsif ($o eq "d") { return(0) if   (-d $value);  }
      elsif ($o eq "E") { if (!(-d $value)) {
         if ($self->{'OS'} eq "xp") {
            system("mkdir $value 2> NUL");
         }
         else {
            system("mkdir $value 2> /dev/null");
         }
         return(0) if (!(-d $value));
      } }
      elsif ($o eq "W") { return(0) if (!(-W $value)); }
      elsif ($o eq "w") { return(0) if   (-W $value);  }
      elsif ($o eq "R") { return(0) if (!(-r $value)); }
      elsif ($o eq "r") { return(0) if   (-r $value);  }
      elsif (lc($o) eq "g") {
         if (-f $value) {
            $bed = (-W $value);
         } else {
            if (open(FFILE,">>".$value)) {
               close(FFILE);
               unlink($value);
               $bed = 1;
            } else {
               $bed = 0;
            }
         }
         if ($o eq "G") { return($bed); } else { return(1-$bed); }
      }
   }
   return(1);

}


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


#   Mapping of Out-Streams in Out-Channels
#
#   All messages are assigned to a 'Type'. The Types are:
#
#   Mode 1:  User    Info
#   Mode 2:  Error   Info
#   Mode 3:  Log     Info
#   Mode 4:  Debug   Info
#   Mode 5:  Ready   Info
#   Mode 6:  Konsole Info
#   Mode 9:  Execute          
#
#   The first parameter of this function takes the Type. Types
#   can be mixed, for example:
#
#   $self->c(23,"This is an Debug AND Error Info");
#
#
#   The different types of messages are sent in different channels.
#   There are the following channels:
#
#   Channel K: Konsole
#   Channel E: Error-Stream
#   Channel L: Logfile
#   Channel D: Debugfile
#   Channel R: Readyfile
#   Channel X: Execute

sub c {

   my $self  = shift;
   my $mode  = shift;
   my $text  = shift;
   my $cmd   = $text;
   if ($text !~ /\n$/) {
      $text = $text . "\n";
   }
   my $o; my $o1; my $o2;

#  Here the types are assigned to channels:

   if (!($self->{'DISPATCHER'})) {
      $self->{'DISPATCHER'} = {};

      $self->{'DISPATCHER'}->{1} = "KL";   #  User Info

      $self->{'DISPATCHER'}->{2} = "KL";   #  Error Info

      $self->{'DISPATCHER'}->{3} = "L";    #  Log Info

      $self->{'DISPATCHER'}->{4} = "KDL";  #  Debug Info

      $self->{'DISPATCHER'}->{5} = "KRL";  #  Ready Info

      $self->{'DISPATCHER'}->{6} = "K";    #  Konsole Info
      
      $o = "X";                            #  Execute
      if ($self->{'DRYRUN'}) { $o = "L"; }
      $self->{'DISPATCHER'}->{9} = $o;

   }

#  Collecting Channels in string $channels. Multiple incidence
#  will be eliminated.

   my $channels = "";
   while ($mode) {
      $channels = $channels . $self->{'DISPATCHER'}->{substr($mode,0,1)};
      $mode = substr($mode,1);
   }


#  Equipping channels

   if ($channels =~ /K/) {
      print STDOUT $text;
      $self->{'KONSOLEINFO'} = $self->{'KONSOLEINFO'} . $text;
   }

   if ($channels =~ /E/) {
      print STDERR $text;
      $self->{'ERRORINFO'} = $self->{'ERRORINFO'} . $text;
   }

   if ($channels =~ /L/) {
      if (open(LOG,">>".$self->{'LOG'})) {
         print LOG $text;
         close(LOG);
      }
      $self->{'LOGINFO'} = $self->{'LOGINFO'} . $text;
   }      

   if ($channels =~ /R/) {
      if (open(READY,">>".$self->{'READY'})) {
         print READY $text;
         close(READY);
      }
      $self->{'READYINFO'} = $self->{'READYINFO'} . $text;
   }      

   if ($channels =~ /D/) {
      if (open(DEBUG,">>".$self->{'DEBUG'})) {
         print DEBUG $text;
         close(DEBUG);
      }
      $self->{'DEBUGINFO'} = $self->{'DEBUGINFO'} . $text;
   }      

   if ($channels =~ /X/) {
      $o1 = $self->{'TEMPDIR'} . "tmp_$$.txt";
#      $o = `$cmd 2>\&1`;
      $o = `$cmd 2>$o1`;
      open(FFILE,"<".$o1);
      $o2 = join("",<FFILE>);
      close(FFILE);
      unlink($o1);
      if ($o and $o  !~ /\n$/) { $o  = $o  . "\n"; }
      if ($o2) {
         if ($o2 !~ /\n$/) { $o2 = $o2 . "\n"; }
         $o = $o . "___ERROR___\n" . $o2;
      }
      if($o) { $o = $o . "\n"; }
      return($o);
   }

}

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

sub show_usage {

   my $self = shift;
   my $text = $self->{'USAGE'};
   my $text1 = "";

   if ($text =~ /^(.*?)\n\s*\n(.*)$/s) {
      $text1 = $2;
      $text  = $1;
   }

   my $o    = "Usage : " . $self->{'PRGNAME'} . " ";
   my $space = substr("                                                ",
                       0,length($o));
   $text    =~ s/\n/\n$space/gs;
   $text =~ s/^\n//s;

   $text = "\n" . $self->{'PRGNAME'} . " Version " . $self->{'VERSION'} .
           "\n\n" . $o . $text . "\n\n";

   return($text.$text1);

}   

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

sub cleardir {

   my $self = shift;
   my $dir  = shift;
   my $sl   = shift;

   opendir(DDIR,$dir);
   my @entries = readdir(DDIR);
   closedir(DDIR);

   my $o;
   foreach $o (@entries) {
      next if ($o eq ".");
      next if ($o eq "..");
      if (-f $o) { unlink($dir.$sl.$o); }
      if (-d $o) { $self->cleardir($dir.$sl.$o,$sl); }
   }

   system("rmdir $dir");

}

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


1;