| 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.pm |
package DivBasicF::AutoRPC;
# RPC-Modul zum Verbinden mit Qooxdoo
use strict;
use DivBasicF::AutoServer;
use DivBasicF::AutoTest;
use Data::Dumper;
# use CGI::Session;
use File::Copy;
use File::Path;
use DivBasicF::AutoSession;
sub DELIVER { 2 }
#****************************************************************
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;
# print STDERR "TESTtree: $testtree\n";
#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!
# print STDERR "QQQQ:$archs\n";
# $self->goto_testtree_directory($testtree);
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
$dir = $dir . "/" . $testtree;
$dir =~ s/([\\\/])[\\\/]*/$1/g;
chdir($dir);
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";
my $x1;
if ($main::___PYTHON___) {
$x1 = DivBasicF::AutoTest->new()->collect_data($testitem,$depth,".".$archs,"");
} else {
$x1 = DivBasicF::AutoServer->new(".","client",$testitem,"d",$depth,$archs);
# $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"d",$depth,$archs);
}
#print STDERR "m3 " . sprintf("%16.5f",Time::HiRes::time()) . "\n";
#print STDERR "ABC " . Dumper($x1);
return($x1);
}
#****************************************************************
sub xxserver_proc {
my $self = shift;
my $testtree = shift;
my $repeats = shift;
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
$dir = $dir . "/" . $testtree;
$dir =~ s/([\\\/])[\\\/]*/$1/g;
chdir($dir);
# 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'};
$dir =~ s/([\\\/])[\\\/]*/$1/g;
chdir($dir);
$testtree =~ s/([\\\/])[\\\/]*/$1/g;
$testtree =~ s/[\\\/]$//;
$testitem =~ s/([\\\/])[\\\/]*/$1/g;
$testitem =~ s/[\\\/]$//;
#say STDERR "GET1 : testtree = ".$testtree." testitem = ".$testitem;
my $x1;
if ($main::___PYTHON___) {
print STDERR "getting item text of $testitem in $testtree\n";
if (!(open(FFILE,"<".$testtree."/".$testitem))) {
$testtree =~ s/^(.*)[\\\/](.*)$/$1/;
if (!(open(FFILE,"<".$testtree."/".$testitem."/item.py"))) {
if (!(open(FFILE,"<".$testtree."/".$testitem."/item.pm"))) {
return("___NO_ITEM_TEXT_FOUND___");
}
}
}
#say STDERR "GET2 : testtree = ".$testtree." testitem = ".$testitem;
$x1 = join("",<FFILE>);
close(FFILE);
} else {
print STDERR "calling autoserver->new with testtree: $testtree,client,testitem: $testitem,t\n";
$x1 = DivBasicF::AutoServer->new(".","client",$testitem,"t");
# $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'};
$dir =~ s/([\\\/])[\\\/]*/$1/g;
chdir($dir);
$testtree =~ s/([\\\/])[\\\/]*/$1/g;
$testtree =~ s/[\\\/]$//;
$testitem =~ s/([\\\/])[\\\/]*/$1/g;
$testitem =~ s/[\\\/]$//;
my @params = ();
if ($arch) {
push(@params,"ARCH_" . $arch);
push(@params,1);
}
if ($user) {
push(@params,"USER_" . $user);
push(@params,1);
}
my $x1;
if ($main::___PYTHON___) {
print STDERR "running the testitem $testitem with mode $mode\n";
$testtree =~ s/^(.*)[\\\/](.*)$/$1/;
$testitem = $testitem . "/item.py" if ($testitem !~ /\.p[ym]$/);
if ($mode eq 'r'){
open(FFILE,">>wakelist.run");
print FFILE "$testtree/$testitem ___RUN___ " . join(" ",@params) . "\n";
close(FFILE);
$x1 = "___ITEM_RUN___";
}
elsif ($mode eq 'c'){
open(FFILE,"<$testtree/$testitem");
my $text = join("",<FFILE>);
close(FFILE);
if ($text =~ s/\:REMARK\:( *)SLEEP\d+/\:REMARK\:$1SLEEP0/){
open(FFILE,">$testtree/$testitem");
print FFILE $text;
close(FFILE);
}
}
} else {
print STDERR "running the testitem $testitem with mode $mode\n";
$x1 = DivBasicF::AutoServer->new(".","client",$testitem,$mode,@params);
# $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;
my $sleep0 = shift; # for continuing a test item by setting back the sleep time
my $x1 = "1";
if ($sleep0) {
$text =~ s/(RESULT\: +SLEEP)(\d+)/$1$x1/;
}
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
$dir =~ s/([\\\/])[\\\/]*/$1/g;
chdir($dir);
$testtree =~ s/([\\\/])[\\\/]*/$1/g;
$testtree =~ s/[\\\/]$//;
$testitem =~ s/([\\\/])[\\\/]*/$1/g;
$testitem =~ s/[\\\/]$//;
# $testtree = "/test_projects";
#say STDERR "STORE1 : testtree = ".$testtree." testitem = ".$testitem;
if ($main::___PYTHON___) {
print STDERR "storing item text of $testitem in $testtree\n";
if (-f "$testtree/$testitem") {
open(FFILE,">".$testtree."/".$testitem);
} else {
$testtree =~ s/^(.*)[\\\/](.*)$/$1/;
if (-f "$testtree/$testitem/item.py") {
open(FFILE,">$testtree/$testitem/item.py");
}
elsif (-f "$testtree/$testitem/item.pm") {
open(FFILE,">$testtree/$testitem/item.pm");
}
else {
return("___ITEM_NOT_FOUND_TO_STORE___");
}
}
#say STDERR "STORE2 : testtree = ".$testtree." testitem = ".$testitem;
print FFILE $text;
close(FFILE);
$x1 = "___ITEM_STORED___";
} else {
print STDERR "calling autoserver->new with testtree: $testtree,client,testitem: $testitem,e, text...\n";
$x1 = DivBasicF::AutoServer->new(".","client",$testitem,"e",$text);
# $x1 = DivBasicF::AutoServer->new($testtree,"client",$testitem,"e",$text);
}
return($x1);
}
#****************************************************************
sub xxtesttrees {
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 $rel_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
my $password = shift;
# 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'});
my $o1; my $mode; my $u;
my $static_users = [keys %$users];
# 2. Password-Operationen
# Diese werden durch spezielle Schluesselwoerter in $rel_aktpath angesteuert,
# naemlich ___password_check___ bzw. ___password_change___
#
# Man kann User und das entsprechende Passwort statisch setzen in
# der AutoSettings.pm. Ausserdem besteht die Moeglichkeit, User
# und die zugehoerigen Passwoerter in der Datei accounts.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
my $erg = {};
my $text;
open (MYFILE, "$o/accounts.txt");
while (<MYFILE>) {
my $line = $_;
if ($line =~ s/\s*(\w+)\s*(.|:)\s*(\w+)//){
$users->{$1} = $2.$3;
}
}
my $user_is_admin = ($users->{$user} =~ /^\:/);
if ($rel_aktpath eq "___password_check___") {
return("OK") if (substr($users->{$user},1) eq $changes);
return("ERROR104 Wrong password") if exists ($users->{$user});
return("ERROR103 User $user does not exist");
}
if ($rel_aktpath eq "___password_change___") {
my $target_user = $changes;
return("ERROR Invalid password!") if $password !~ /\w/;
unless (exists $users->{$target_user}){
return("ERROR: user ".$target_user." doesn't exists!");
}
my $target_is_admin = ($users->{$target_user} =~ /^\:/);
$password = $target_is_admin ? ":" : "." . $password;
if ($user !~ $target_user){
return("ERROR Insufficient permissions to change password of other users") unless $user_is_admin;
$users->{$target_user} = $password;
} else{
$users->{$target_user} = $password;
}
}
if ($rel_aktpath eq "___password_newuser___") {
if (exists $users->{$changes}){
return("ERROR: user already exists!");
}
if ($users->{$user} =~ /^\./) {
return("ERROR105 Not granted to create new user");
}
$users->{$changes} = $password; # Name als erstes, Passwort als zweites Array-Element
}
if ($rel_aktpath eq "___password_deleteuser___") {
if ($users->{$user} =~ /^\./) {
return("ERROR106 Not granted to delete user");
}
delete ($users->{$changes});
}
if ($rel_aktpath =~ /^___password_(.*?)___/) { # wenn Passwort-Operationen auszufuehren sind
open(FFILE,">$o/accounts.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
my $aktpath = "";
if ($rel_aktpath !~ s/^\#//) {
$aktpath = $o . "/" . $rel_aktpath;
$aktpath =~ s/([\\\/])[\\\/]*/$1/g; # doppelte Slashes zur Sicherheit beseitigen
chdir($aktpath); # zunaechst wird in das aktuelle Verzeichnis gewechselt
}
if (-f "testtree.db" and $changes !~ /^\;/) { # wenn es sich um ein Testprojekt handelt ...
if ($main::___PYTHON___) {
open(FFILE,"<testtree.db");
$text = join("",<FFILE>);
close(FFILE);
foreach $o1 (split(/,/,$changes)) {
next if ($o1 !~ /(.|:)(\w+)/);
$mode = $1;
$u = $2;
return("ERROR entry already exists") if ($text =~ /(^|\n)$o1/); # Eintrag ist schon vorhanden
if ($text =~ /(^|\n)\:$user\n/) { # Administrator-Operation
if ($mode eq "=") { # Loeschen eines Eintrags
$text =~ s/(^|\n)[\.\:]$u\n/$1/s;
}
elsif ($text !~ s/(^|\n)[\.\:]$u\n/$1$mode$u\n/s) { # Eintrag aendern
$text = "$mode$u\n" . $text; # Eintrag hinzufuegen
}
}
}
open(FFILE,">testtree.db");
print FFILE $text;
close(FFILE);
$o = [];
while ($text =~ s/(^|\n)([\.\:].*?)\n/\n/) {
push(@$o,$2) if exists $users->{substr $2 , 1}; # only return users that are also stored in accounts.txt
}
} else {
$o = DivBasicF::AutoServer->new(".","client","0","u",$user,$changes);
$o = [ map { $o->{$_} . $_ } keys %$o];
}
return($o);
}
if (-f "accounts.txt" and $aktpath) { # wenn es sich um den Testprojekte-Ordner handelt ...
open (MYFILE, "accounts.txt");
my $root_accounts = {};
while (<MYFILE>) {
my $line = $_;
if ($line =~ s/\s*(\w+)\s*(.|:)\s*(\w+)//){
$root_accounts->{$1} = $2;
$erg->{$2.$1} = "#";
}
}
}
opendir(DDIR,"."); # wenn es sich um ein sonstiges Verzeichnis handelt
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
next if (!(-d($o)));
if (-f "$o/testtree.db") {
chdir($o);
if ($main::___PYTHON___) {
open(FFILE,"<testtree.db");
$text = join("",<FFILE>) . "\n";
close(FFILE);
$mode = {};
while ($text =~ s/(^|\r?\n)([\.\:])(.*?)\r?\n/\n/s) {
$mode->{$3} = $2;
}
} else {
$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 .");
if ($main::___PYTHON___) {
open(FFILE,">testtree.db");
print FFILE ":" . $user . "\n";
close(FFILE);
open(FFILE,">__init__.py");
print FFILE "";
close(FFILE);
my $backendPath = DivBasicF::AutoSettings::settings()->{'C'};
my $newProjPath = $aktpath."/".$o;
chdir($backendPath);
$newProjPath =~ s&(.*)\.\/\/(.*)&$1$2&; # ".//" beseitigen
use Config;
if ($Config{osname} eq 'linux'){
system("\.\/or item.py > \"$newProjPath/item.py\"");
} else {
system("or item.py > \"$newProjPath/item.py\"");
}
chdir($newProjPath);
} else {
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'};
$dir = $dir . "/" . $testtree;
$dir =~ s/([\\\/])[\\\/]*/$1/g;
chdir($dir);
my $o; my $o1; my $text; my $archs; my $archs1;
if ($main::___PYTHON___) {
open(FFILE,"<testtree.db");
$text = join("",<FFILE>);
close(FFILE);
if ($arch) {
$remark =~ s/^\s*(.*?)\s*/$1/s;
if ($remark eq "___DELETE___") {
$text =~ s/\[$arch\].*?\n(\[|$)//; # Loeschen des Architektur-Remark
}
elsif ($text !~ s/(\[$arch\]).*?\n(\[|$)/$1\n$remark\n$2/s) { # Aendern des Architektur-Remark
$text =~ s/^(.*?)\s*/$1/s;
$text = $text . "\n\[$arch\]\n$remark\n"; # Anhaengen einer neuen Architektur
}
}
open(FFILE,">testtree.db");
print FFILE $text;
close(FFILE);
$archs = {};
while ($text =~ s/\[(\S+)\](.*?)(\[|$)/\n$3/s) {
$o = $1;
$o1 = $2;
$o1 =~ s/^\s*(.*?)\s*$/$1/s;
$archs->{$o} = $o1;
}
my $backend_dir = DivBasicF::AutoSettings::settings()->{'C'};
if ($^O=~/Win/){
$text = `$backend_dir/grep -R ":ARCH:" --include=*.p* .`;
} else {
$text = `grep -R ":ARCH:" --include=*.p* .`;
}
foreach $o (split(/\n/,$text)) {
next if ($o !~ /^(.*)\:ARCH\: +(\S+)/);
$archs->{$2} = $archs->{$2};
}
} else {
$archs = DivBasicF::AutoServer->new(".","client","0","z",$arch,$remark);
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 xxstart_item_server {
my $self = shift;
my $testtree = shift;
eval("use DivBasicF::AutoSettings");
my $dir = DivBasicF::AutoSettings::settings();
$dir = $dir->{'R'} || $dir->{'P'};
$dir = $dir . "/" . $testtree;
$dir =~ s/([\\\/])[\\\/]*/$1/g;
chdir($dir);
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;