| Current Path : /var/www/web-klick.de/dsh/10_customer2017/1210__delphi/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : /var/www/web-klick.de/dsh/10_customer2017/1210__delphi/TestTree.pm |
package DivBasicF::TestTree;
use strict;
use Data::Dumper;
#******************************************************************
ladösfsub new {
my $class = shift;
my $self = {};
bless($self,$class);
$self->init();
return($self);
}
sub choose { my $l = shift; my @pars = $l->sets(@_);
return($pars[int rand($#pars+1)]); }
sub choose_between { my $l = shift; my $a = shift; my $b = shift;
return($a + int rand(1 + $b - $a)); }
sub choose_until { my $l = shift;
my $b = shift; return(int rand(1 + $b)); }
sub mchoose { my $l = shift; my $nr = shift; my @pars = $l->sets(@_);
my @erg = (); while ($#erg < $nr-1) {
push(@erg,$l->choose(@pars)); } return(@erg); }
sub mchoose_between { my $l = shift;
my $nr = shift; my @erg = (); while ($#erg < $nr-1) {
push(@erg,$l->choose_between(@_)); } return(@erg); }
sub mchoose_until { my $l = shift;
my $nr = shift; my @erg = (); while ($#erg < $nr-1) {
push(@erg,$l->choose_until(@_)); } return(@erg); }
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 = Time::ParseDate::parsedate($1,UK=>1)/86400;
$xe = Time::ParseDate::parsedate($2,UK=>1)/86400;
$o1 = $self->choose_between($xa,$xe);
$o1 = Date::Format::time2str("%e.%L.%Y",$o1*86400);
$o1 =~ s/ //g;
push(@erg,$o1);
}
else {
push(@erg,$o);
}
}
return(@erg);
}
sub max { my $l = shift;
my $a = shift; my $b = shift; return($b) if ($a > $b); return($a); }
#******************************************************************
# to overload:
sub init { 1; }
sub result { my $self = shift; return(1); }
sub remark { my $self = shift; return("OK"); }
sub user { my $self = shift; return(""); }
sub requ { my $self = shift; return([]); }
#sub requ { my $self = shift; return([ 'Standard' => 0.01 ]); }
sub run {
my $self = shift;
$self->test_start(@_);
# $self->{'requ'} = { 'Standard' => 0.01 };
my $o = <<'TEXT_ENDE';
sub run {
my $self = shift;
$self->test_start(@_);
# $self->{'requ'} = { 'Standard' => 0.01 };
my $o = <<'TEXXT_ENDE';
---LOG---
TEXXT_ENDE
$o =~ s/---LOG---/$o/;
$o =~ s/TEXXT_ENDE(.*)\nTEXXT_ENDE/TEXT_ENDE$1\nTEXT_ENDE/s;
$self->{'log'} = $o;
$self->test_end();
}
TEXT_ENDE
$o =~ s/---LOG---/$o/;
$o =~ s/TEXXT_ENDE(.*)\nTEXXT_ENDE/TEXT_ENDE$1\nTEXT_ENDE/s;
$self->{'log'} = $o;
$self->test_end();
}
#******************************************************************
sub test_start {
my $self = shift;
my @pars = @_;
my @pars1 = ();
my $o; my @ee; my $o1;
while (@pars) { # Requirements werden mit uebergeben
last if ($pars[0] =~ /^(USER|ARCH)\_/); # ab einem Parameter, der beginnt mit USER_ oder ARCH_
push(@pars1,shift(@pars)); # ( <par1>, <par2>, ..., <requ1> => <gewicht1>, ...
}
$self->{'requ'} = { @pars };
# $self->{'requ'} = { @{$self->requ()}, @pars };
foreach $o (keys %{$self->{'requ'}}) { # Ein Requirement, das eingeschlossen ist
if ($o =~ /^___(.*)___$/) { # in ___ , wird als Objektvariable
$self->{$o} = $self->{'requ'}->{$o}; # betrachtet. Beispiel:
delete( $self->{'requ'}->{$o} ); # $self->{'requ'}->{'___abc___'} = "jr" ->
} # $self->{'abc'} = "jr"
}
$self->mk_package();
return(@pars1);
}
#*********************************************************************
sub mk_package {
my $self = shift;
my $file = ref($self);
my $file1 = $file;
$file1 =~ s/\:\:/\//gs;
mkdir($file1);
my $zaehler = 0;
while (0 == 0) {
$zaehler = sprintf("%03u",$zaehler+1);
last if (!(-f("$file1/$zaehler.pm")));
}
$self->{'package'} = $file . "::" . $zaehler;
}
#******************************************************************
sub test_end {
my $self = shift;
$self->{'log'} .= shift;
my $user1 = "xx";
if (!($self->{'requ'}) or !(%{$self->{'requ'}})) {
$self->{'requ'} = { "Standard" => 0.01 };
}
my $r = "";
my $l; my $o; my $o1; my @ee; my $dbh; my $cursor; my $nr;
# my $maxweight = $self->{'weight'} || 1;
foreach $o (sort keys %{$self->{'requ'}}) {
if ($o =~ /^user_(.*)$/i) {
$user1 = $1;
}
$l = length($o) + 2;
if ($l < 25) { $l = 25; }
$o1 = $self->{'requ'}->{$o};
# if ($o1 > $maxweight) { $o1 = $maxweight; }
$r = $r . " '" . substr($o."' ",0,$l + 2)
. " => " .
sprintf("%6.4f",$o1)
. " ,\n";
}
while ( $r =~ s/0( +),/ $1,/g ) { 1; }
while ( $r =~ s/\.( +),/ $1,/g ) { 1; }
my $text = <<'TEXT_ENDE';
package ---PACKAGE---;
use strict;
use vars qw(@ISA $PKG);
$PKG = __PACKAGE__;
while ($PKG =~ s/^(.*)\:\:.*$/$1/) { eval("use $PKG"); next if ($@); @ISA = ($PKG); last }
sub result { ---RESULT--- }
sub remark { "---REMARK---" }
sub user { "---USER---" }
sub requ { [
---REQUIREMENT---
] }
---FUNCTIONS---
1;
TEXT_ENDE
$o = $self->{'log'};
eval ( $o ); print STDERR "\n------------------\n\nThis is only a WARNING, NO ERROR:\n\n"
. $@ . "\n------------------\n\n" if ($@);
if ($@) {
$o = 'sub run { my $self = shift; $self->test_start(@_); $self->{'."'weight'".'} = 0; $self->test_end('."<<'LOG'".'); }' . "\n\nRun log of " . ref($self) .
"\n-------------------------------------\n\n\n" . $o . "\nLOG\n\n";
}
$text =~ s/---FUNCTIONS---/$o/gs;
$o = $self->{'package'} || ref($self) . "::001";
$text =~ s/---PACKAGE---/$o/gs;
$o = $self->user() . "," . time() . "." . $user1;
$o =~ s/^\,//;
while ($o =~ /^(.*\,)(\d+)(\..*)$/) {
@ee = localtime($2); # Sekundenformat in lesbares Format umwandeln
$o = $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;
}
$o =~ s/^,//;
$text =~ s/---USER---/$o/gs;
$text =~ s/---REQUIREMENT---/$r/gs;
# print $text; exit;
# Probeweises Einsetzen und pruefen, ob der Test-Item-Eintrag
# a) gueltiger Perl-Code ist
# b) ein gueltiges Perl-Package ist
$o1 = $text;
$o = $self->{'result'} || 1;
$o1 =~ s/---RESULT---/$o/gs;
$o = $self->{'remark'} || "";
$o1 =~ s/---REMARK---/$o/gs;
# jetzt fertigstellen
if ($self->{'result'} > 9900) {
$self->{'result'} = 1;
$self->{'remark'} = "OK";
}
$o = $self->{'result'} || 0;
$text =~ s/---RESULT---/$o/gs;
$o = $self->{'remark'} || "";
$text =~ s/---REMARK---/$o/gs;
$self->save_package($text);
}
#************************************************************
sub save_package {
my $self = shift;
my $text = shift;
my $o = $self->{'package'} . ".pm";
$o =~ s/\:\:/\//gs;
open(FFILE,">".$o);
print FFILE $text;
close(FFILE);
return("CREATED: $self->{'package'}");
}
#************************************************************
sub goto_next_function {
my $self = shift;
my $func; my $jump;
my %list_of_functions = eval("\%".ref($self)."::");
$list_of_functions{'run'} = 1;
my $tlist = [];
foreach $func (sort {
$a =~ /^(.*?)(0*)(\d*)$/; my $a1 = $3;
$b =~ /^(.*?)(0*)(\d*)$/; my $b1 = $3;
$a1 <=> $b1 } keys %list_of_functions) {
next if ($func !~ /^(r|run|t|test)(\d*)$/);
$jump = $func;
last if (!($self->{'___JUMP___'}));
if ($self->{'___JUMP___'} eq $func) {
delete ($self->{'___JUMP___'});
}
}
$self->{'___JUMP___'} = $jump;
if (!$jump) {
$func = "ERROR: No function found in " . ref($self) .
"::get_next_function\n";
print STDERR $jump;
} else {
print STDERR "Jump to: $jump\n";
}
return($jump);
}
#******************************************************************
sub sleep {
my $self = shift;
my $time = shift;
my $func = shift || $self->goto_next_function();
sleep($time);
$self->$func();
}
#*****************************************************************
sub simple_report {
my $self = shift;
my $rlist = shift; # Reportliste
my $erg = 0;
if (!$rlist) {
$rlist = {};
$erg = 1;
}
my $result = $self->result();
my $requs = $self->requ();
$requs = {@$requs};
my $o;
foreach $o (keys %$requs) {
if (!(exists($rlist->{$o}))) {
$rlist->{$o} = [0.00,0,0,0,0];
}
$rlist->{$o}->[0] = 1 - (1 - $rlist->{$o}->[0])*(1 - $requs->{$o});
$rlist->{$o}->[1] = $rlist->{$o}->[1] + 1;
if ($result == 1) {
$rlist->{$o}->[2] = $rlist->{$o}->[2] + 1;
}
elsif ($result < 1000) {
$rlist->{$o}->[3] = $rlist->{$o}->[3] + 1;
}
else {
$rlist->{$o}->[4] = $rlist->{$o}->[4] + 1;
}
}
my $pkg = ref($self);
my $dir = "./" . $pkg;
$dir =~ s/\:\:/\//g;
opendir(DDIR,"$dir");
my $subitems = [];
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o !~ s/\.pm$//);
push(@$subitems,$pkg . "::" . $o);
}
foreach $o (@$subitems) {
eval("use $o");
next if ($@);
$o->new()->report($rlist);
}
if ($erg) {
my $text = "\n\n\nRequirement " .
" Sensitivity All_Tests OK WARNING ERROR\n" .
"-----------------------------------------------------" .
"------------------------\n\n";
foreach $o (keys %$rlist) {
next if ($o eq "Standard");
next if ($o eq "run");
$text = $text . substr($o." ".$o,0,35) .
sprintf("%5.3f",$rlist->{$o}->[0]) . " " .
sprintf("%3u", $rlist->{$o}->[1]) . " " .
sprintf("%3u", $rlist->{$o}->[2]) . " " .
sprintf("%3u", $rlist->{$o}->[3]) . " " .
sprintf("%3u", $rlist->{$o}->[4]) . "\n";
}
return($text."\n\n\n");
}
return($rlist);
}
#************************************************************
sub add_log {
my $self = shift;
my $mode = shift;
my $text = shift;
$self->{'log'} = $self->{'log'} . $text . "\n";
print $text . "\n";
}
#************************************************************
sub add_req {
my $self = shift;
my $val = shift;
my $requ = shift;
$self->{'requ'}->{$requ} = $val;
$self->add_log(0," ---> Requirement $requ added with sensitivity $val");
}
#************************************************************
1;