
| Current Path : /var/www/web-klick.de/dsh/90_akt/PPLTest.old/ |
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/90_akt/PPLTest.old/db.pl |
use DivBasicF::FileComSimple;
use Data::Dumper;
use Term::ReadLine;
my $com = DivBasicF::FileComSimple->new(["$PAR::database,cxtest",67002000,100,2]);
my $erg; my $zaehler; my $o; my $o1; my $prg1;
open(FFILE,"<".$prg);
my $text = join("",<FFILE>);
close(FFILE);
if ($prg eq "new.ppl") {
$text = <<'TEXT_ENDE';
sub test_item {
$v->{'name'} = "new";
$v->{'generator'} = "newtest";
$v->{'next'} = $v->{'generator'};
$v->{'dbfunc'} = ["status",1];
}
sub condition { 1; }
TEXT_ENDE
# $text =~ s/---USER---/$PAR::user/;
# $v->{'user'} = "---USER---";
}
if ($text =~ s/^CONTINUED... +(.*?) *\n//s) {
$com->connection($1);
while ($text =~ s/---xxx---([\n ]*)(.*?)([\n ]*)---xxx---/---xxx---/s) {
push(@$erg,$2);
}
$com->msg(["step",@$erg]);
$text = "WAITING... " . $com->get_connection() . "\n";
open(FFILE,">".$prg);
print FFILE $text;
close(FFILE);
# print $text;
}
if ($text =~ /^WAITING... +(.*?) *\n/s) {
$com->connection($1);
my $erg = $com->get(2,7);
if (ref($erg)) {
if ($prg !~ /\.ppl$/ and $erg->[1] !~ /^(unknown|xxx)$/) { #
$text = "." . $prg; #
} #
unlink($prg);
if ($erg->[0] =~ /^([a-z0-9]+)\_(.*)$/) {
$prg = $2 . ".ppl";
}
shift(@$erg);
open(FFILE,">".$prg);
$erg = join("\n\n---xxx---\n\n","",@$erg,"");
print FFILE "CONTINUED... " . $com->get_connection() . "\n" . $erg;
close(FFILE);
if (!$par) {
if ($prg !~ /\.ppl$/ and $text !~ /^\./) {
print $erg;
}
elsif (-f "/etc/hosts" and $erg =~ /\n[0-1a-z]\:/s) {
print $erg;
$o = Term::ReadLine->new(0)->readline("> ");
$erg =~ s/^(.*---xxx---)(.*?\n[0-1a-z]\: .*?)(---xxx---.*)$/$1\n\n$o\n\n$3/s;
print $erg;
open(FFILE,">".$prg);
print FFILE "CONTINUED... " . $com->get_connection() . "\n" . $erg;
close(FFILE);
}
elsif (-f "/etc/hosts") {
system("joe $prg");
}
else {
system("edit $prg");
}
}
print "Output to $prg ...\n";
} else {
print $text;
}
if ($text =~ s/^\.//) {
print "====================================================\n";
system("exec perl $0 $text");
}
}
elsif (!$text and $prg =~ s/\.ppl$//) {
$com->msg(["step","find",$prg]);
my $erg = $com->get(1000,7);
if (@$erg and $erg->[2]) {
open(FFILE,">".$prg.".ppl");
if ($erg->[4]) {
print FFILE "WAITING... " . $erg->[2] . "\n"
} else {
print FFILE "CONTINUED... " . $erg->[2] .
"\n\n---xxx---\n\nformular\n\n---xxx---\n";
}
close(FFILE);
}
$com->msg(["step","kill"]);
# print "$prg killed\n"; # Find-Prozess wird gekillt
}
elsif (!$text and $prg =~ /\./) {
$com->msg(["step",@ARGV]);
open(FFILE,">".$prg);
print FFILE "WAITING... " . $com->get_connection() . "\n";
close(FFILE);
system("exec perl $0 $prg");
}
elsif ($text and $prg =~ /^(.*)\.(.*)$/) {
$o = $1;
$o1 = $2;
$zaehler = 0;
opendir(DDIR,".");
while (0 == 0) {
$prg1 = readdir(DDIR);
last if (!$prg1);
if ($prg1 =~ /^$o\_\_(\d+)\.$o1/) {
$erg = $1;
if ($erg > $zaehler) {
$zaehler = $erg;
}
}
}
closedir(DDIR);
$prg1 = $o . "__" . sprintf("%03u",$zaehler+1) . "." . $o1;
$com->msg(["step",$text,@ARGV]);
$erg = "WAITING... " . $com->get_connection() . "\n";
open(FFILE,">".$prg1);
print FFILE $erg;
close(FFILE);
open(FFILE,">next.pl");
print FFILE "system(\"perl $0 $prg1 ___no_edit___\");\n";
close(FFILE);
print $erg . "Generated File: $prg1\n";
}
elsif ($prg !~ /\./) {
$com->msg(["step","list",$prg,@ARGV]);
my $erg = $com->get(1000,7);
shift(@$erg);
shift(@$erg);
print "FChance Sum Erg Name\n\n";
foreach $o (@$erg) { # [gesresult,conn,objlock,sleep,name,result,
# remark,user,info,dyndata,status]
if ($o->[12] == 1) { # Abfrage Status
print sprintf("%5.3f",0.001 * $o->[1]) . " " .
sprintf("%4u",$o->[0]) . " " . sprintf("%4u",$o->[6]) . " " .
$o->[5] . "\n";
}
elsif ($o->[12] == 2) {
print sprintf("%5.3f",0.001 * $o->[1]) . " " .
substr(" (" . sprintf("%1u",$o->[4] - time()) .
") ",0,11) . $o->[5] . "\n";
}
elsif ($o->[12] == 3) {
print sprintf("%5.3f",0.001 * $o->[1]) . " " .
sprintf("%4u",$o->[0]) . " " . sprintf("%4u",$o->[6]) . " (" .
$o->[5] . ")\n";
}
else {
print " ";
}
# print $o->[5] . "\n";
}
$com->msg(["step","kill"]);
}
else {
print "File not found...\n";
}
1;