| Current Path : /var/www/web-klick.de/dsh/10_customer2017/1204__intel/Testframework/ |
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/1204__intel/Testframework/SmartCM.pm |
package SmartCM;
use strict;
use vars qw(@ISA);
use TestTree;
use Data::Dumper;
@ISA = qw(TestTree);
# use Cwd::cwd;
use ClearCase::CtCmd qw(cleartool);
use ClearCase::MtCmd;
#****************************************************
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return($self);
}
#*****************************************************
sub write_par {
my $self = shift;
my $x = shift;
my $y = MIME::Base64::encode_base64($x,"");
return($y);
}
#*******************************************************
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); }
#******************************************************************
sub uncheckout {
my $self = shift;
my $p = shift;
my $indent = shift;
my $l = length($indent);
my ($stat,$out,$err) = cleartool("lsco","-s");
my $o;
foreach $o (split(/\n/,$out)) {
next if ($o =~ /^\.+$/);
if (chdir($o)) {
print $indent . "Entering directory $o\n"; # if ($p);
$self->uncheckout($p," " . $indent);
chdir("..");
}
print $indent . "Uncheckout element $o\n"; # if ($p);
($stat,$out,$err) = cleartool("unco","-rm",$o);
print "ERROR: " . $err . "\n" if ($stat);
}
}
#****************************************************
sub create_taskbranch { # tbd and be tested
my $self = shift;
my $func = shift;
my @pars = @_;
if ($func =~ /^(.*)\:\:(.*)$/) {
my $o = $1;
my $o1 = $2;
eval("use $o");
my $o2 = $o->new($self);
return($o2->$o1(@pars));
}
return ( $self->$func(@pars) );
}
#*****************************************************
sub mk_new_acs { # tbd and to be checked, via smartilu
my $self = shift;
my $cnd = shift;
my $cndname = shift;
my $prj = shift;
my $acs = shift;
my $acsname = shift;
my $b = $self;
system("ssh slc\@ccaseux01.lz.imc.local " .
"etc/suidscripts/testmodules_helper.pl '" .
$b->write_par($cnd) . "' ' " .
$b->write_par($cndname) . "' '" .
$b->write_par($prj) . "' '" .
$b->write_par($acs) . "' '" .
$b->write_par($acsname) . "'"
);
}
#*******************************************************
sub generate_tree {
my $self = shift;
my $number = shift;
my $maxdepth = shift;
my $list = shift;
my $dir = shift;
my $b = $self;
if (!$list) { $list = []; }
if (!$dir) { $dir = "."; }
my $maxelem = $b->choose_between(int($number/2),int($number));
my $zaehler = 0;
my $aktdepth = $dir;
$aktdepth =~ s/[^\/]//gs;
$aktdepth = length($aktdepth);
my $o; my $dir1;
while (0 == 0) {
$zaehler = $zaehler + 1;
last if ($zaehler > $maxelem);
$o = $b->choose(0,1,1,1,1);
if ($o == 1) {
push(@$list,"f " . $dir . "/" . $self->_generate_tree_generate_filename());
} else {
$dir1 = $dir . "/" . $self->_generate_tree_generate_dirname();
push(@$list,"d " . $dir1);
if ( ($maxdepth < 0 and $#$list < -$maxdepth) or
($maxdepth > 0 and $aktdepth < $maxdepth) ) {
$self->generate_tree($number*1.25,$maxdepth,$list,$dir1);
}
}
}
return(Dumper($list));
}
#******************************************************************
sub _generate_tree_generate_filename {
my $self = shift;
my $b = $self;
my $erg = join("",$b->mchoose($b->choose_between(10,25),"A-9")) .
"." . join("",$b->mchoose(3,"a-z"));
return($erg);
}
#******************************************************************
sub _generate_tree_generate_dirname {
my $self = shift;
my $b = $self;
my $erg = join("",$b->mchoose($b->choose_between(10,25),"A-9"));
return($erg);
}
#******************************************************************
sub mk_test_tree_in_vob {
my $self = shift;
my $root_dir = shift;
my $tree = shift; # data structure taking the tree information
if (-f $tree) {
open(FFILE,"<".$tree);
$tree = join("",<FFILE>);
close(FFILE);
}
my $o; my $stat; my $out; my $err; my $VAR1;
my $dir; my $element; my $mode;
eval($tree);
$tree = $VAR1;
my $pwd = `pwd`;
chdir($root_dir);
foreach $o (@$tree) {
next if ($o !~ /^([fd]) +(.*)\/(.*)$/);
$mode = $1;
$mode = ($mode eq "f") ? "file" : "directory";
$dir = $2;
$element = $3;
chdir($dir);
($stat,$out,$err) = cleartool("co","-nc",".");
if ($stat and $err !~ /already checked out/) {
print "[WARNING] Cannot unlock directory $dir\n$out$err\n";
}
($stat,$out,$err) = cleartool("mkelem","-c",
"new element created from TestModules_Basic",
"-eltype",$mode,$element);
print "[WARNING] Cannot create $mode element $o\n" if ($stat);
print "... $mode element $o created\n" if (!$stat);
}
chdir($pwd);
}
#***********************************************************
sub scmerge_test {
my $self = shift;
my $tree1 = shift;
my $tree2 = shift;
my $label = shift;
system("scwa -acs Playground:S4GV2#HEAD -utp_id test -comment test tb_$label"."_1");
$self->mk_tree_from_data($tree1);
system("scwa -commit");
$self->scintegrate();
system("scwa -acs Playground:S4GV3#HEAD -utp_id test -comment test tb_$label"."_2");
$self->mk_tree_from_data($tree2);
system("scmerge -branch tb_$label"."_1");
}
#***********************************************************
1;
__END__
=head1 NAME
SmartCM.pm - the root item for the SmartCM tests
=head1 SYNOPSIS
$this = new SmartCM;
$this->choose(@pars);
$this->choose_between($a,$b);
$this->choose_until($nr):
$this->mchoose(@pars);
$this->mchoose_between($a,$b);
$this->mchoose_until($nr);
$this->sets(@pars);
$this->max(@pars);
$this->create_taskbranch($taskbranch_name);
$this->mk_new_acs($acs_name);
$this->generate_tree($nr,$depth);
$this->mk_test_tree_in_vob($data_structure);
=head1 DESCRIPTION
This is the SmartCM root item for test purposes. It has different methods
for generating test (data) and running test cases. All child items
inherit from it.
=head1 METHODS
=over
=item B<set>
Returns a list generated by its poarameters.
Format:
<x1>,<x2>,...
Each entry <xn> expands. Rules:
If the entry <xn> is:
<X>-<Y> where <X> and <Y> are letters
---> all letters between <X> and <Y>
<X>.<Y> where <X> and <Y> are letters
---> a randomally chosen letter between <X> and <Y>
<N>-<M> where <N> and <M> are numbers
---> a randomally chosen number between <N> and <M>
<dd.mm.yy>-<dd.mm.yy>
---> a randomally chosen date between the both dates
=item B<choose> (@pars)
Chooses randomally one parameter of its parameter list.
=item B<choose_until> ($nr)
Chooses randomally a natural number lower than $nr
=item B<choose_until> ($a,$b)
Chooses randomally a natural number between $a and $b
=item B<mchoose> ($i,@pars)
Chooses randomally $i times one parameter of its parameter list
and returns the chosen values as a list.
=item B<mchoose_until> ($i,$nr)
Chooses randomally $i times a natural number lower than $nr
and returns the chosen values as a list.
=item B<mchoose_until> ($i,$a,$b)
Chooses randomally $ times a natural number between $a and $b
and returns the chosen values as a list.
=item B<create_taskbranch> ($name)
Generates a new task branch with name $name.
This function has to be completed!
=item B<mk_new_acs>
Generates a new acs on the ACS-Server
This function has to be completed!
=item B<generate_tree> (
Generates a new acs on the ACS-Server
This function has to be completed!
=item B<generate_tree> ($number,$depth)
This method generates a data structure which represents
a consistent tree of files and sub-directories. This
data structure can be given to mk_test_tree_in_vob
to perform this action.
The parameters $number (estimated number of elements) and
$depth (maximal depth of sub-directories) drive the
randomally running process.
=item B<mk_test_tree_in_vob> ($number,$depth)
This method generates elements from a data structure.
This data structure can be taken from generate_tree.
=back
=head1
See also: p0, TestTree.pm
=cut