| Current Path : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/DivBasicF/ |
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/50_dev2017/1300__perllib/DivBasicF/AutoRPC.new |
package DivBasicF::AutoRPC;
# RPC-Modul zum Verbinden mit Qooxdoo
use strict;
use DivBasicF::AutoServer;
use Data::Dumper;
use CGI::Session;
use DivBasicF::AutoSession;
sub DELIVER { 2 }
sub xxreport {
# Gibt zu einem $testtree Reporting-Informationen zum $testitem aus.
# Der Befehl: new,DivBasicF::AutoServer,<testtree>,client,<testitem>,d,<depth>,<archs>
# schreibt sich jetzt; report,<testtree>,<testitem>,<depth>,<archs>
my $self = shift;
my $testtree = shift;
#eval("use Time::HiRes");
#print STDERR "m1 " . sprintf("%16.5f",Time::HiRes::time()) . "\n";
my $testitem = shift;
my $depth = shift; # Ausgabetiefe
# wenn der Ausgabetiefe ein Minuszeichen vorangestellt
# wird, dann werden alle Requirements zu einem einzigen
# zusammengefasst, d.h. man bekommt damit dann den
# reinen Test-Tree.
my $archs = shift; # Liste der Architekturen, kommasepariert
# Wird diese Liste mit einem Punkt angefuehrt, erfolgt der return als String!
# $self->goto_testtree_directory($testtree);
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
if ($archs =~ s/^\s*(.*)\:\s*/$1\:/) {
if ($testitem =~ /^\s*(.*?)\:\:(.*?)\s*$/) {
$testitem = $2;
$archs = $archs . $1;
}
}
#print STDERR "m2 " . sprintf("%16.5f",Time::HiRes::time()) . "\n";
print STDERR "calling autoserver->new with testtree: $testtree,client,testitem: $testitem,d,depth: $depth, archs: $archs \n";
my $x1 = DivBasicF::AutoServer->new(".","client",$testitem,"d",$depth,$archs);
# my $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"d",$depth,$archs);
#print STDERR "m3 " . sprintf("%16.5f",Time::HiRes::time()) . "\n";
return($x1);
}
#****************************************************************
sub report {
# Gibt zu einem $testtree Reporting-Informationen zum $testitem aus.
# Der Befehl: new,DivBasicF::AutoServer,<testtree>,client,<testitem>,d,<depth>,<archs>
# schreibt sich jetzt; report,<testtree>,<testitem>,<depth>,<archs>
my $self = shift;
my $testtree = shift;
#eval("use Time::HiRes");
#print STDERR "m1 " . sprintf("%16.5f",Time::HiRes::time()) . "\n";
my $testitem = shift;
my $depth = shift; # Ausgabetiefe
# wenn der Ausgabetiefe ein Minuszeichen vorangestellt
# wird, dann werden alle Requirements zu einem einzigen
# zusammengefasst, d.h. man bekommt damit dann den
# reinen Test-Tree.
my $archs = shift; # Liste der Architekturen, kommasepariert
# Wird diese Liste mit einem Punkt angefuehrt, erfolgt der return als String!
# $self->goto_testtree_directory($testtree);
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
if ($archs =~ s/^\s*(.*)\:\s*/$1\:/) {
if ($testitem =~ /^\s*(.*?)\:\:(.*?)\s*$/) {
$testitem = $2;
$archs = $archs . $1;
}
}
#print STDERR "m2 " . sprintf("%16.5f",Time::HiRes::time()) . "\n";
print STDERR "calling autoserver->new with testtree: $testtree,client,testitem: $testitem,d,depth: $depth, archs: $archs \n";
my $x1 = DivBasicF::AutoServer->new(".","client",$testitem,"d",$depth,$archs);
# my $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"d",$depth,$archs);
#print STDERR "m3 " . sprintf("%16.5f",Time::HiRes::time()) . "\n";
return($x1);
}
#****************************************************************
sub server_proc {
my $self = shift;
my $testtree = shift;
my $repeats = shift;
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
# print STDERR "calling autoserver->new with testtree: $testtree,client,testitem: $testitem,t\n";
my $x1 = DivBasicF::AutoServer->new(".","server",$repeats);
# my $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"t");
return($x1);
}
#****************************************************************
sub get_item_text {
my $self = shift;
my $testtree = shift;
my $testitem = shift;
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
print STDERR "calling autoserver->new with testtree: $testtree,client,testitem: $testitem,t\n";
my $x1 = DivBasicF::AutoServer->new(".","client",$testitem,"t");
# my $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"t");
return($x1);
}
#****************************************************************
sub run_item {
my $self = shift;
my $testtree = shift;
my $testitem = shift;
my $mode = shift;
my $arch = shift;
my $user = shift;
# if ($^O eq 'MSWin32') {
# my @vars = split('/', $testtree);
# my $testproj = @vars[2];
# chdir "../test_projects/$testproj/";
# #..\\..\\..\\..\\perl\\bin\\perl p DivBasicF::AutoServer::server
# DivBasicF::ProcessServer->startProcess($testproj, "start_server.bat","");
# print STDERR "calling autoserver->run_item with testtree: $testtree,client,testitem: $testitem, testproj: $testproj \n";
# }
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
my @params = ();
if ($arch) {
push(@params,"ARCH_" . $arch);
push(@params,1);
}
if ($user) {
push(@params,"USER_" . $user);
push(@params,1);
}
my $x1 = DivBasicF::AutoServer->new(".","client",$testitem,$mode,@params);
# my $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"r");
# return("OK");
return($x1);
}
#****************************************************************
sub store_item_text {
my $self = shift;
my $testtree = shift;
my $testitem = shift;
my $text = shift;
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
# eval($text);
# if ($@ and $@ !~ /^Can(.*?)t +locate/i) {
# return("ERROR $@");
# }
print STDERR "calling autoserver->new with testtree: $testtree,client,testitem: $testitem,e, text...\n";
my $x1 = DivBasicF::AutoServer->new(".","client",$testitem,"e",$text);
# my $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"e",$text);
return($x1);
}
#****************************************************************
sub testtrees {
my $self = shift;
my $user = shift;
my $password = shift;
eval("use DivBasicF::AutoSettings");
return("ERROR 100 " . $@) if ($@);
my $settings = DivBasicF::AutoSettings::settings();
my $o = $settings->{'USER:'.$user};
my $o1 = "";
if ($o =~ s/^(.+?)\,//) {
$o1 = $1;
}
return("ERROR101") if (!$o1); # Fehler: User nicht gefunden;
return("ERROR102") if ($o1 ne $password); # Fehler: Passwort falsch
print STDERR "PASSWORD\n";
my $erg = [];
foreach $o1 (split(/\,/,$o)) {
$o1 = [split(/\,/,$settings->{'TREE:'.$o1})];
next if (!@$o1);
push(@$erg,$o1);
}
return($erg);
}
#****************************************************************
# Hier werden Informationen zu Testprojekten bzw. zu in Ordnern
# befindlichen Testprojekten ausgegeben und ggfs. upgedated.
#
# Ausserdem werden hier User-Management Operationen ermoeglicht.
sub manage_testtrees {
my $self = shift;
my $aktpath = shift; # Generell der aktuelle Pfad im Projektverzeichnis, der zu behandeln ist
my $user = shift; # User, unter dem die Operation auszufuehren ist.
my $changes = shift; # Aenderungs-String
# print STDERR "123 $aktpath $user $changes\n";
# 1. Die Datei AutoSettings wird ausgelesen
eval("use DivBasicF::AutoSettings");
return("ERROR100 AutoSettings has errors") if ($@);
my $users = DivBasicF::AutoSettings::settings();
my $recursive = 0;
my $o = $users->{'R'};
$recursive = 1 if ($o);
$o = $o || $users->{'P'};
return("ERROR101 Path of projects not found") if (!$o);
$o =~ s/[\\\/]$//;
delete ($users->{'R'});
delete ($users->{'P'});
# 2. Password-Operationen
# Diese werden durch spezielle Schluesselwoerter in $aktpath angesteuert,
# naemlich ___password_check___ bzw. ___password_change___
#
# Man kann User und das entsprechechende Passwort statisch setzen in
# der AutoSettings.pm. Ausserdem besteht die Moeglichkeit, User
# und die zugehoerigen Passwoerter in der Datei account.txt im
# Testprojekte-Verzeichnis abzulegen, dort als einfache Text-Datei,
# deren Eintraege Zeilen der Form sind: <user>[.:]password.
# . bedeutet: einfacher User,
# : bedeutet: Admin-User, darf an den User-Einstellungen Aenderungen machen
# Password-Check fuer einen statischen User:
if ($aktpath eq "___password_check___" and substr($users->{$user},1) eq $changes) {
DivBasicF::AutoSession::login(keys($users));
return($o);
}
if ($aktpath eq "___password_change___" and $users->{$user}) {
return("ERROR102 Password of static user is not changeable");
}
my $erg = {};
my $text;
if ($aktpath =~ /^___password_(.*?)___/) { # wenn Passwort-Operationen auszufuehren sind
open(FFILE,"<$o/account.txt"); # dann Einlesen der accounts.txt
$text = join("",<FFILE>);
close(FFILE);
while ($text =~ s/\n\s*([A-Za-z0-9\_?]+)\s*([.:])\s*([A-Za-z0-9\_?]+)\s*\n/\n/s) {
$users->{$1} = $2.$3;
}
}
if ($aktpath eq "___password_check___") {
return($o) if (substr($users->{$user},1) eq $changes);
return("ERROR104 Wrong password") if ($users->{$user});
return("ERROR103 User $user does not exist");
}
if ($aktpath eq "___password_change___") {
$erg->{$user} = $changes;
}
if ($aktpath eq "___password_newuser___") {
if ($users->{$user} =~ /^\./) {
return("ERROR105 Not granted to create new user");
}
$users->{$changes} = $changes; # Setzen eines Standard-Passwortes
}
if ($aktpath eq "___password_deleteuser___") {
if ($users->{$user} =~ /^\./) {
return("ERROR106 Not granted to delete user");
}
delete ($users->{$changes});
}
if ($aktpath =~ /^___password_(.*?)___/) { # wenn Passwort-Operationen auszufuehren sind
open(FFILE,">$o/account.txt");
foreach $o (keys %$users) {
next if ($users->{$o} !~ /^[\.\:]/);
print FFILE $o . "," . $users->{$o} . "\n";
}
close(FFILE);
return("OK");
}
# Nach Passwort-Operationen wird diese Funktion spaetestens HIER verlassen!
#------------------------------------------------------------
# 2. Testtree-Operationen
#print STDERR "QQAKT: $o $aktpath\n";
if ($aktpath !~ s/^\#//) {
$aktpath = $o . $aktpath;
chdir($aktpath); # zunaechst wird in das aktuelle Verzeichnis gewechselt
}
if (-f "testtree.db" and $changes !~ /^\;/) { # wenn es sich um ein Testprojekt handelt ...
$o = DivBasicF::AutoServer->new(".","client","0","u",$user,$changes);
$o = [ map { $o->{$_} . $_ } keys %$o];
return($o);
}
opendir(DDIR,"."); # wenn es sich um ein sonstiges Verzeichnis handelt
my $mode;
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
next if (!(-d($o)));
if (-f "$o/testtree.db") {
chdir($o);
$mode = DivBasicF::AutoServer->new(".","client","0","u",$user);
if ($mode->{$user} eq ":") {
$erg->{$o} = "+"; # Admin-granted Testproject
}
if ($mode->{$user} eq ".") {
$erg->{$o} = "*"; # User-granted Testproject
}
chdir("..");
}
elsif ($recursive) { # nur Unterverzeichnisse anzeigen, wenn
$erg->{$o} = "-"; # Rekursiv-Flag gesetzt ist.
}
}
closedir(DDIR);
foreach $o (split(/,/,$changes)) {
$mode = substr($o,0,1);
$o = substr($o,1);
print STDERR "make directory: $aktpath $o --- $erg->{$o}\n";
if ($mode eq "+" and $erg->{$o} eq "+") { # ist und bleibt ein Testprojekt
1;
}
elsif ($mode eq "+" and $erg->{$o} eq "*") { # Aenderung eines User-Testprojekts
1; # in ein Admin-Testprojekt ist nicht moeglich
}
elsif ($mode eq "+" and $erg->{$o} eq "-") { # Aenderung eines Testprojekts in ein
1; # normales Verzeichnis ist nicht moeglich
}
elsif ($mode eq "+" and (!(exists $erg->{$o}))) { # neues Testprojekt anlegen
print STDERR "QQQ: $o\n";
mkdir($o);
chdir($o);
#system("chmod a+rwx .");
open(FFILE,">$o.pm");
print FFILE "package " . $o . "\;\n" . <<'TEXT_ENDE';
use strict;
use vars qw(@ISA);
use DivBasicF::AutoItem;
@ISA = qw(DivBasicF::AutoItem);
sub result { 1 }
sub remark { "OK" }
sub user { "" }
sub requ { [ "Standard" => 0.01 ] }
1;
TEXT_ENDE
close(FFILE);
# system("chmod a+rwx $o.pm"); # ist (doch nicht ...) wichtig, wenn das abgeschaltet ist, kann man die Testprojekte nicht mnerh sehen
DivBasicF::AutoServer->new(".","client",$o,"i");
# system("chmod a+rwx testtree.db"); # ist (doch nicht...) wichtig, wenn das abgeschaltet ist, kann man die Testprojekte nicht mnerh sehen
DivBasicF::AutoServer->new(".","client","0","u",$o,":".$user); # Default-User als Admin
DivBasicF::AutoServer->new(".","client","0","u",$user,"=".$o); # Primaer-User loeschen
$erg->{$o} = "+";
chdir("..");
}
elsif ($mode eq "-" and $erg->{$o} eq "+") { # Aenderung eines normalen Directories
1; # in ein Testprojekt ist nicht moeglich
}
elsif ($mode eq "-" and $erg->{$o} eq "*") { # Aenderung eines normalen Directories
1; # in ein Testprojekt ist nicht moeglich
}
elsif ($mode eq "-" and $erg->{$o} eq "-") { # ist und bleibt ein Directory
1;
}
elsif ($mode eq "-" and (!(exists $erg->{$o}))) { # Anlegen eines Directory
mkdir ($o);
if (-d $o) { $erg->{$o} = "-"; } # im Erfolgsfall
}
elsif ($mode eq "=" and $erg->{$o} eq "+") { # Loeschen des Testprojekts
$mode = [localtime(time())];
rename($o,".".$o."_deleted_at_". # Directory wird verschoben
sprintf("%04u",$mode->[5]+1900) .
sprintf("%02u",$mode->[4]+1) .
sprintf("%02u",$mode->[3]) . "_" .
sprintf("%02u",$mode->[2]) .
sprintf("%02u",$mode->[1]) .
sprintf("%02u",$mode->[0]));
delete($erg->{$o});
}
elsif ($mode eq "=" and $erg->{$o} eq "*") { # Loeschen eines User-Testprojekts
rename($o,".".$o) # ist nicht moeglich
}
elsif ($mode eq "=" and $erg->{$o} eq "-") { # Loeschen des Directory
opendir(DDIR,$o);
while (0 == 0) { # erstmal ueberpruefen, ob noch was
$mode = readdir(DDIR); # drin ist im Directory
last if (!$mode);
next if ($mode =~ /^\./); # zum Loeschen markierte Unterverzeichnisse
$o = ""; # werden uebersprungen
last;
}
closedir(DDIR);
if ($o) { # Wenn nein: Directory wird verschoben
$mode = [localtime(time())];
rename($o,".".$o."_deleted_at_".
sprintf("%04u",$mode->[5]+1900) .
sprintf("%02u",$mode->[4]+1) .
sprintf("%02u",$mode->[3]) . "_" .
sprintf("%02u",$mode->[2]) .
sprintf("%02u",$mode->[1]) .
sprintf("%02u",$mode->[0]));
if (!(-d $o)) { delete($erg->{$o});} # im Erfolgsfall
}
}
elsif ($mode eq "=" and (!(exists $erg->{$o}))) { # Loeschen eines nichtexistenten Elements
1; # bleibt unberuecksichtigt
}
elsif ($mode eq ";") { # Namensaenderung
if ($aktpath =~ /^(.*)[\/\\](.*)$/) {
chdir(".."); # hier ist die einzige Stelle, wo der $aktpath verlassen wird!
$aktpath = $1;
rename($2,$o);
$erg->{$2} = $erg->{$o};
delete ($erg->{$o});
$o = DivBasicF::AutoRPC::manage_testtrees($self,"\#".$aktpath,$user);
return($o);
}
}
}
return( [ sort map { $erg->{$_} . $_ } keys %$erg ] );
}
#********************************************************************************
# Architekturen-Management:
# Sind $arch und $remark nicht leer, dann wird die Architektur $arch
# eingetragen/geupdated mit dem Erlaueterungs-String $remark.
# Ist $remark = "___DELETE___", dann wird die Architektur geloescht
# Ist $arch leer, dann geschieht nichts.
# In jedem Fall wird ein Hash aller Architekturen (Keys) mit
# den Remarks (Values) zurueckgegeben.
sub architectures {
my $self = shift;
my $testtree = shift;
my $arch = shift;
my $remark = shift;
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
my $archs = DivBasicF::AutoServer->new(".","client","0","z",$arch,$remark);
my $o1; my $o;
if (ref($archs) eq "HASH") {
my $archs1 = {};
foreach $o (keys %$archs) {
$o1 = $o;
$o1 =~ s/^ARCH_(.*)//gs;
$archs1->{$o1} = $archs->{$o};
}
return($archs1);
}
return($archs);
# return( DivBasicF::AutoServer->new($testtree,"client","","z",$arch,$remark) );
}
#********************************************************************************
sub start_item_server {
my $self = shift;
my $testtree = shift;
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
chdir($dir."/".$testtree);
if (!(fork())) {
DivBasicF::AutoServer(".","server");
}
return(["Server started"]);
}
#********************************************************************************
sub is_logged_in {
my $self = shift;
return DivBasicF::AutoSession::is_logged_in();
}
sub get_user_name {
my $self = shift;
return DivBasicF::AutoSession::user();
}
sub set_active_project {
my $self = shift;
my $project = shift;
DivBasicF::AutoSession::set_active_project($project);
}
sub get_active_project {
my $self = shift;
my $project = shift;
DivBasicF::AutoSession::get_active_project();
}
sub set_active_node_path {
my $self = shift;
my $path = shift;
DivBasicF::AutoSession::set_active_node_path($path);
}
sub get_active_node_path {
my $self = shift;
DivBasicF::AutoSession::get_active_node_path();
}
sub logout {
DivBasicF::AutoSession::logout();
}
1;