| 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/DBComSimple1.pm |
package DivBasicF::DBComSimple;
# Kommunikation zwischen Prozessen auf Datenbankebene
#
# Dieses Modul ermoeglicht eine Kommunikation zwischen Prozessen
# ueber eine Datenbank.
#
# Erster Prozess (Server);
#
# my $com1 = DivBasicF::DBComSimple->new([ <db-string>,<port>,...],
#
#
# Zweiter Prozess (Client):
#
# my $com2 = DivBasicF::DBComSimple->new([ <db-string>,<port>,...],
#
#
# Beide Prozesse koennen nun ueber die Funktionen $com->msg(<array>)
# und $com->get() Daten in Form von anonymen Arrays per Handshaking
# austauschen. Liegt eine Antwort noch nicht vor, dann liefert get()
# nichts zurueck, dann muss zu einem spaeteren Zeitpunkt noch mal
# nachgefragt werden.
#
#
#
#
# Die Methode run bietet die Moeglichkeit, einen Multisession-Server
# laufen zu lassen. Zu uebergebende Parameter sind:
#
# 1. ein Applikationsobjekt (z.B. DivBasicF::Beispiel->new());
# 2. Anzahl gleichzeitiger Start-Prozess (z.B. 3)
# 3. Anzahl gleichzeitiger laufender Prozesse (z.B. 3)
# 4. Standard-Wait-time (hier immer: -1)
#
# Der Server lauscht auf dem Standard-Port, der dem Konstruktor mitgegeben
# wurde. Empfaengt er eine Nachricht der Form [func,<param1>, ...],
# dann wird aufegrufen:
#
# $application_object->$func(<param1>,...]
#
# Rueckgabewert dieser Methode muss wiederum ein anonymes Array sein.
#
# Hat das Ergebnis-Array die Form: ["___NEXT<n>___",func1,<param1>,...],
# dann wird <n> Sekunden gewartet, und danach aufgerufen:
#
# $application_object->$func1(<param1>,...]
#
# usw. ___NEXT___ bedeutet ___NEXT0___
# Ist die Wartezeit groesser als die Standard-Wartezeit (siehe new),
# dann wird der Prozess in eine Prozesstabelle gedumpt und erst nach der
# vereinabrten Slepp-Time wieder aufgeweckt.
#
# Ansonsten wird das Ergebnis ueber msg dem Client zurueckgegeben,
# der dann das Ergebnis mit get() abholen kann, und ggfs. weitere
# Anfragen stellen kann.
#
# Soll der Prozess auf der Serverseite tatsaechlich beendet werden, dann
# muss als Ergebnis das Array ["___END___"] gegeben werden, denn ansonsten
# verbleibt der gestartete Prozess im Server und wird jeweils in der
# Prozesstabelle gehalten, bis weitere Anfragen kommen. Beendet wird
# der Prozess auch, wenn der Client ein ["___END___"] schickt. Fuer
# $com->msg(["___END___"]) kann auch kurz geschrieben werden: $com->stop() .
#
# Wird in der new-Methode des Servers ein Indices-String angegeben, dann
# werden die entsprechenden Spalten in der Prozesstabelle zusaetzlich
# angelegt. Beim Dumpen des Prozesses wird dann jeweils der Rueckgabewert
# von $application_object->INDEX(<spaltenname>) fuer jede
# angegebene Spalte eingetragen. Auf diese Weise koennen Prozesse
# gezielt gesucht und dann auch fortgesetzt werden: Die Spalte
# conn enthaelt naemlich den aktuellen Kommunikations-Port, auf dem
# der Prozess lauscht, und der damit angesprochen werden kann.
# Der Client, der das tun will, muss nur seinen Kommunikationsport
# entsprechend setzen, mit: $com->connection(<port>).
use strict;
use POSIX ":sys_wait_h";
use Fcntl ":flock";
use vars qw(@ISA);
# use DivBasicF::COMsimple;
# use Server::frezthaw;
use DBD::SQLite;
use Time::HiRes;
use Data::Dumper;
use Digest::MD5;
# @ISA = qw(DivBasicF::COMsimple);
#******************************************************************
# Parameter:
#
# <dbstring>, <port>, [<indices>,] [<serializer>,] [<wait_time>,] [<wait_frequenz>]
#
#
# <dbstring>: eine kommaseparierte Liste mit den folgenden Angaben:
#
# DB-Connection-String (SQLite3 oder mySQL), Parameter kommasepariert
# optional: Name der Connection-Tabelle (default: conn)
# optional: Name der Prozess-Tabelle (default: conn_store)
# optional: Name der Locking-Tabelle (default: conn_lock)
# optional: Name der Semaphoren-Tabelle (default: conn_sema)
#
# <port>: Connection-String: acht Zeichen langer String aus
# Kleinbuchstaben und Zahlen, auf dem initial gelauscht wird
#
#
# <indices>: Kommaseparierte Liste von Spaltennamen, in denen
# Index-Strings zu gespeicherten Prozessen abgelegt werden.
#
# <wait_time>: Standard-Wartezeit von get() in Sekunden, default: 20
#
# <wait_frequenz>: Standard-Anzahl der Polls von get() pro Sekunde, default: 25
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
my @pars = @_;
# 1. Variablen abspeichern
my $o;
my $dbh = shift(@pars);
($self->{'DBSTRING'},$self->{'CONN'},$self->{'STORE'},$self->{'LOCK'},
$self->{'SEMA'}) = split(/,/,$dbh); # Datenbank-Connectionstring
$self->{'CONNECTION'} = shift(@pars); # Initiale Connection-ID
my $o;
while (@pars) {
$o = shift(@pars);
if ($o =~ /[a-zA-Z\_]/) {
$self->{'INDEX'} = $o; # Indexe fuer Storing
}
elsif (!($self->{'WAIT_TIME'})) {
$self->{'WAIT_TIME'} = $o; # Maximale Antwort-Wartezeit in Minuten
}
else {
$self->{'FREQUENZ'} = $o; # Abfrageintervall pro Sekunde
}
}
# 2. Weitere Variablen und Defaultwerte:
$self->{'RESET_ID'} = $self->{'CONNECTION'};
if (!($self->{'CONN'})) { $self->{'CONN'} = "conn"; }
if (!($self->{'STORE'})) { $self->{'STORE'} = "conn_store"; }
if (!($self->{'LOCK'})) { $self->{'LOCK'} = "conn_lock"; }
if (!($self->{'SEMA'})) { $self->{'SEMA'} = "conn_sema"; }
if (!($self->{'FREQUENZ'})) { $self->{'FREQUENZ'} = 25; }
if (!($self->{'WAIT_TIME'})) { $self->{'WAIT_TIME'} = 20; }
($self->{'CYCLES'},$self->{'INTERVAL'}) =
$self->cycles_interval($self->{'WAIT_TIME'},$self->{'FREQUENZ'});
# 3. Datenbankeinrichtung vorbereiten
my $conn = $self->{'CONN'};
my $store = $self->{'STORE'};
my $lock = $self->{'LOCK'};
my $sema = $self->{'SEMA'};
my $create_index = "create_index";
$dbh = DBI->connect(split(/ +/,$self->{'DBSTRING'}), { PrintError => 0 } );
if ($self->{'DBSTRING'} =~ /SQLite/) { # SQLite DB
$dbh->do("pragma journal_mode=off");
$create_index = "create index if not exists ";
}
elsif ($self->{'DBSTRING'} =~ /^(.*)\:(.*)\:(.*)\:(.*)$/) { # MySQL DB
$self->{'MYSQL'} = ["dbi:mysql:host=$1\;database=$2",$3,$4];
$dbh = DBI->connect(@{$self->{'MYSQL'}}, { PrintError => 0 } );
}
# 4. Datentabellen einrichten, wenn noetig
$o = "," . $self->{'INDEX'} . ",";
$o =~ s/\,([a-zA-Z0-9\_]+)/\,$1 text/g;
$o =~ s/^(,*)(.*?)(,*)$/$2/;
if ($o) { $o = "," . $o; }
$dbh->do("create table if not exists $conn " .
"(id varchar(23),replynr varchar(8)," .
"msgid varchar(8),text text,connlock varchar(8))");
$dbh->do("create table if not exists $lock " .
"(id varchar(8) unique)");
$dbh->do("create table if not exists $sema " .
"(id varchar(30) unique,text text,semalock varchar(1))");
$dbh->do("create table if not exists $store ".
" (conn varchar(8),sleep int,id varchar(22) unique," .
" text text,objlock varchar(1),status varchar(1)".$o.")");
# 5. Indexe einrichten, wenn noetig
$dbh->do("$create_index $conn"."_replynr__idx on $conn (replynr)");
$dbh->do("$create_index $conn"."_msgid__idx on $conn (msgid)");
$dbh->do("$create_index $conn"."_oid__idx on $conn (id)");
$dbh->do("$create_index $lock"."__idx on $lock (id)");
$dbh->do("$create_index $sema"."__idx on $sema (id)");
foreach $o (split(/\,/,"conn,sleep,id,".$self->{'INDEX'})) {
next if ($o !~ /^([a-zA-Z0-9\_]+)$/);
$dbh->do("$create_index $store"."_".$o."_idx on $store ($o)");
}
$self->{'INDEX'} = [split(/,/,$self->{'INDEX'})];
$dbh->disconnect();
delete($self->{'DBH'});
undef($dbh);
return($self);
}
#******************************************************************
sub connection { my $self = shift; $self->{'CONNECTION'} = shift; }
sub get_connection { my $self = shift; return($self->{'CONNECTION'}); }
sub max_time { return(4099887766); }
sub stop { my $self = shift; $self->msg(["___END___"]); }
#******************************************************************
# Hilfsfunktion
sub cycles_interval {
my $self = shift;
my $wait_time = shift;
my $frequenz = shift;
my $cycles = $self->{'CYCLES'};
my $interval = $self->{'INTERVAL'};
if ($wait_time < 0) {
return(1,0);
}
if ($frequenz) {
if (!$wait_time) {
$wait_time = $self->{'WAIT_TIME'};
}
$cycles = $wait_time * $frequenz;
$interval = 1 / $frequenz;
}
elsif ($wait_time) {
$cycles = $wait_time * $self->{'FREQUENZ'};
$cycles = 1 if ($cycles < 1);
}
return($cycles,$interval);
}
#********************************************************************
sub dbh {
my $self = shift;
if (!($self->{'DBH'})) {
$self->{'DBH'} =
DBI->connect(split(/ +/,$self->{'DBSTRING'}), { PrintError => 0 } );
}
return($self->{'DBH'});
}
#******************************************************************
# Allgemeine Query
sub query {
my $self = shift;
my $query = shift;
my $dbh = $self->dbh();
my $cursor = $dbh->prepare($query,{},@_);
$cursor->execute();
my $erg = [];
my @ee;
while (0 == 0) {
@ee = $cursor->fetchrow();
last if (!@ee);
push(@$erg,[@ee]);
}
$cursor->finish();
return($erg);
}
#******************************************************************
# Senden einer Message als anonymes Array
sub msg {
my $self = shift;
my $text = shift;
my $msg_id; my $cursor; my $erg; my @ee;
my $pattern = [qw(0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k),
qw(l m n o p q r s t u v w x y z z z z)];
my $dbh = $self->dbh();
my $conn = $self->{'CONN'};
my $lock = $self->{'LOCK'};
if (length($self->{'ID'}) > 20) { # wenn es schon eine gueltige ID gibt
$cursor = $dbh->prepare("select id from $lock where id='" .
$self->{'CONNECTION'} . "'");
$cursor->execute();
@ee = $cursor->fetchrow();
$cursor->finish();
if (!@ee) { # wenn keine Rueckliefer-ID gesperrt ist, wartet niemand mehr ...
print("NOT FOUND. CONNECTION $self->{'CONNECTION'} INTERRUPTED\n");
return("NOT FOUND. CONNECTION $self->{'CONNECTION'} INTERRUPTED");
}
}
while (0 == 0) { # Erstellung der neuen Message-Id
$msg_id = [];
while ($#{$msg_id} < 7) {
push(@$msg_id,$pattern->[int rand(35)]);
}
$msg_id = join("",@$msg_id);
next if ($msg_id eq $self->{'RESET_ID'});
$erg = $dbh->do("insert into $lock (id) values ('$msg_id')",
{ PrintError => 0 }); # locken
last if ($erg ne "0E0"); # wenn erfolgreich eingetragen
}
my $erg = $dbh->do("insert into $conn (id,replynr,msgid,text,connlock) " .
" values ('" . $self->{'ID'} .
"','" . $self->{'CONNECTION'} . "','$msg_id',?,'0')",
{},Dumper($text));
# print("insert into $conn (id,replynr,msgid,text,connlock) " .
# " values ('" . $self->{'ID'} .
# "','" . $self->{'CONNECTION'} . "','$msg_id',?,'0')\n".
# $text."\n");
return("") if ($erg eq "0E0");
$self->{'CONNECTION'} = $msg_id;
return($msg_id);
}
#*********************************************************************
# Holen einer Message
sub get {
my $self = shift;
my $wait_time = shift; # Wartezeit
my $frequenz = shift; # Warte-Frequenz pro Sekunde
my ($cycles,$interval) = $self->cycles_interval($wait_time,$frequenz);
my $zaehler = 0;
my $text; my $o; my $reply_nr; my $cursor; my @ee; my $mark;
my $dbh = $self->dbh();
my $conn = $self->{'CONN'};
my $lock = $self->{'LOCK'};
while (0 == 0) {
$zaehler = $zaehler + 1;
return() if ($zaehler > $cycles);
select(undef,undef,undef,$interval); # sleep 1;
$cursor = $dbh->prepare("select msgid from $conn where replynr='" .
$self->{'CONNECTION'} . "' limit 1");
# print("select msgid from $conn where replynr='" .
# $self->{'CONNECTION'} . "' limit 1\n");
# $cursor = $dbh->prepare("select msgid from $conn");
$cursor->execute();
@ee = $cursor->fetchrow();
$cursor->finish();
next if (!@ee);
next if (!($ee[0]));
$o = $ee[0];
$mark = sprintf("%1u",int(1000000 + rand(8999990)));
$text = $dbh->do("update $conn set connlock='$mark' where replynr='" .
$self->{'CONNECTION'} . "' and msgid='$o' " .
"and connlock='0'");
last if ($text ne "0E0");
select(undef,undef,undef,$interval); # sleep 1;
}
$cursor = $dbh->prepare("select id,msgid,text from $conn " .
"where replynr='" . $self->{'CONNECTION'} .
"' and msgid='$o' and connlock='$mark'");
$cursor->execute();
@ee = $cursor->fetchrow();
$cursor->finish();
$dbh->do("delete from $conn where replynr='" . $self->{'CONNECTION'} .
"' and msgid='$o' and connlock='$mark'");
$self->{'ID'} = $ee[0] if ($ee[0]);
# if ($self->{'ID'}) { # unlocking, wenn Session schon identifiziert ist
$dbh->do("delete from $lock where id='".$self->{'CONNECTION'}."'");
# }
$self->{'CONNECTION'} = $ee[1];
$text = $ee[2];
if (length($self->{'ID'}) > 20) { # eindeutige Session-ID
if ($self->{'ID'} =~ s/\_$//) { 1; } # toggeln
else {$self->{'ID'} = $self->{'ID'} . "_"; }
} else {
if (!($self->{'ID'})) {
$self->{'ID'} = Dumper($self).time().sprintf("%1u",int rand(100000));
}
$self->{'ID'} = Digest::MD5->md5_base64($self->{'ID'});
$self->{'ID'} =~ s/\//\_/g;
$self->{'ID'} =~ s/\+/\-/g;
}
my $VAR1;
eval($text);
if ($VAR1) {
return($VAR1);
}
return("___ERROR_TEXT___");
}
#*****************************************************************
sub run { # Multisession-Server-Mode
my $self = shift;
$self->{'OBJ'} = shift;
my $max_new = shift;
my $max_run = shift;
my $wait = shift; # Maximale Zeit, die Prozesse im Hauptspeicher
# warten sollen
my $param_file = shift;
if (time() > 1340000000) {
print "ERROR 522\n";
exit;
}
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Indent = 1;
# $Data::Dumper::Purity = 1; # damit NICHT immer die CODE-DUMMY-
# Meldungen angezeigt werden, ist das
# hier auskommentiert
my $counter_new = {};
my $counter_run = {};
my $sleeptime = 0;
my $text; my $o; my $o1;
my $VAR1 = Dumper([$self->{'OBJ'},[]]);
my $IDX = [];
$self->{'STATUS'} = 0;
Time::HiRes::time() =~ /(\d\d\d)$/;
srand(sprintf("%1u",0.001*($$||1000)*$1));
my $WAIT = 0; my $NEW = 0;
my $d0; my $d1;
while (0 == 0) {
if ($self->lock_semaphore("__proc_nr__")) {
$o = $self->read_semaphore() + 1;
$self->write_semaphore("__proc_nr__",$o);
$self->unlock_semaphore("__proc_nr__");
}
last if ($o);
print "WAITING for Semaphore ...\n";
Time::HiRes::usleep(500000);
}
while (0 == 0) {
$o = [keys %$counter_new];
$o1 = [keys %$counter_run];
$d1 = "COUNT " . $#{$o} . " " . $#{$o1} . "\n";
print ($d1) if ($d0 ne $d1);
$d0 = $d1;
$o = "";
if (length(join("",values %$counter_run)) < $max_run
and $self->fetch()) {
$WAIT = 1;
my $dbh = $self->dbh();
$dbh->disconnect();
delete($self->{'DBH'});
undef($dbh);
$o = fork();
if ($o) {
$counter_run->{$o} = 1;
$WAIT = 0;
} else {
Time::HiRes::time() =~ /(\d\d\d)$/;
srand(sprintf("%1u",0.001*($$||1000)*$1));
$VAR1 = shift(@{$self->{'___DATA___'}});
$IDX = $self->{'___DATA___'};
$self->{'ID'} = $self->{'___DUMP___'}->[0];
$self->{'CONNECTION'} = $self->{'___DUMP___'}->[1];
$self->{'STATUS'} = $self->{'___DUMP___'}->[3];
$self->{'FETCHED'} = 1;
}
delete ($self->{'___DUMP___'});
delete ($self->{'___DATA___'});
}
elsif (length(join("",values %$counter_new)) < $max_new) {
$NEW = 1;
my $dbh = $self->dbh();
$dbh->disconnect();
delete($self->{'DBH'});
undef($dbh);
$o = fork();
if ($o) {
$counter_new->{$o} = 1;
$WAIT = 0;
} else {
Time::HiRes::time() =~ /(\d\d\d)$/;
srand(sprintf("%1u",0.001*($$||1000)*$1));
}
}
else {
$o = "mainproc";
$text = waitpid(-1,WNOHANG);
if ($text and $text != -1) {
$WAIT = 0;
delete ($counter_new->{$text});
delete ($counter_run->{$text});
}
elsif ($ENV{'SIG_INT'}) {
if (!$max_new and !$max_run) {
sleep 1;
} else {
$max_new = 0;
$max_run = 0;
}
print "Waiting for ...\n" . join("\n",keys %$counter_run) . "\n";
}
elsif ($param_file and (-f $param_file)) {
open(FFILE,"<".$param_file);
$WAIT = join("",<FFILE>);
close FFILE;
unlink($param_file);
if ($WAIT =~ /(\d+)\,(\d+)/) {
$max_new = $1;
$max_run = $2;
}
$WAIT = 0;
}
else {
Time::HiRes::usleep(10000) if $WAIT;
$WAIT = 1;
}
}
last if (!$o);
if (!$max_new and !$max_run and !%$counter_run) {
print "STOP ...\n";
foreach $o (keys %$counter_new) {
kill(15,$o);
}
while (0 == 0) {
if ($self->lock_semaphore("__proc_nr__")) {
$o = $self->read_semaphore("__proc_nr__");
if ($o == 1) {
$self->delete_all_semaphores();
} else {
$self->write_semaphore("__proc_nr__",sprintf("%1u",$o-1));
$self->unlock_semaphore("__proc_nr__");
}
exit;
}
Time::HiRes::usleep(300000);
}
}
}
#--------------------------------------------
if (!$VAR1) { exit; }
eval($VAR1); print $@;
$self->{'OBJ'} = $VAR1->[0];
$self->{'TEXT'} = $VAR1->[1];
if ($@) { print "FEHLER in DBComSimple: $@\n"; exit; }
foreach $o (@{$self->{'INDEX'}}) { # Manuell geaenderte Indexe
$self->{$o} = shift(@$IDX); # nachziehen
}
if ($self->load_classes($self->{'OBJ'})) { # die fehlenden Klassen
$self->{'OBJ'}->{'PARENT'} = $self; # im wiederaufgetauten
} # Prozess nachladen
print "STATUS: " . $self->{'STATUS'};
while (0 == 0) {
if ($self->{'STATUS'} == 0) { # Neuer Task
$self->{'TEXT'} = $self->get($self->max_time());
$self->{'STATUS'} = 2;
}
elsif ($self->{'STATUS'} == 1) { # Warten auf Anfrage DBComSimple
$o = $self->get();
if (ref($o)) {
$self->{'TEXT'} = $o;
}
$self->{'STATUS'} = 2;
if ($self->{'TEXT'}->[0] eq "___END___") {
$sleeptime = -1;
}
}
elsif ($self->{'STATUS'} == 2) { # Verzweigen in das
# Applikations-Objekt
$o = shift(@{$self->{'TEXT'}});
if (!($self->{'OBJ'})) {
eval("use $o"); print $@;
if ($@) {
$self->{'TEXT'} = ["___END___","ERROR in Module $o: $@"];
} else {
$self->{'OBJ'} = $o->new();
if (@{$self->{'TEXT'}}) {
unshift(@{$self->{'TEXT'}},"___NEXT___");
} else {
$self->{'TEXT'} = ["Module $o loaded"];
}
}
} else {
$self->{'TEXT'} = $self->{'OBJ'}->$o(@{$self->{'TEXT'}});
}
if ($self->{'TEXT'}->[0] =~ /^___(NEXT)(\d*)___$/) {
$sleeptime = $2; # warten, dann weiter in dem Objekt
shift(@{$self->{'TEXT'}});
if ($sleeptime <= $wait) {
sleep($sleeptime); # weiter ohne Freeze
$sleeptime = 0;
}
} else {
$self->{'STATUS'} = 4; # Rueckgabe einer Message
}
}
elsif ($self->{'STATUS'} == 4) { # Rueckgabe an den Client, dann Warten
if ($self->{'TEXT'}->[0] =~ /^___(WAIT)(\d*)___$/) {
$sleeptime = $2 || 1;
shift(@{$self->{'TEXT'}});
} else {
$sleeptime = $self->max_time();
}
$self->msg($self->{'TEXT'});
if ($self->{'TEXT'}->[0] eq "___END___") {
$sleeptime = -1;
}
$self->{'STATUS'} = 1;
}
last if ($sleeptime);
}
print " ---> $self->{'ID'}: waiting $sleeptime sec for: $self->{'CONNECTION'} \n";
my $idx = {};
foreach $o (@{$self->{'INDEX'}}) {
$idx->{$o} = $self->{$o};
}
$o = 1;
while ($o < 30) {
$text = $self->push($sleeptime,$idx,$self->{'CONNECTION'});
return() if ($sleeptime == -1);
return() if (!$text);
sleep 1;
$o = $o + 1;
}
}
#******************************************************************
# Nachladen der benoetigten Klassen nach fetch
sub load_classes {
my $self = shift;
my $obj = shift;
print "Re-Loaded OBJ: $obj\n" if ($obj);
my $rtype = ref($obj);
my $o;
if ($rtype eq "ARRAY") {
foreach $o (@$obj) {
$self->load_classes($o);
}
}
elsif ($rtype eq "HASH") {
foreach $o (values %$obj) {
$self->load_classes($o);
}
}
else {
eval("use $rtype");
}
return($obj);
}
#******************************************************************
sub fetch {
my $self = shift;
my $file; my $o1; my $id; my $conn_id; my @ee;
my $list;
my $dbh = $self->dbh();
my $conn = $self->{'CONN'};
my $store = $self->{'STORE'};
$file = $dbh->prepare("select id,conn,sleep,status from $store" .
" where sleep < ".time().
" limit 1");
$file->execute(); # einen Prozess holen, dessen Sleeptime abgelaufen ist
@ee = $file->fetchrow();
$file->finish();
if (@ee) { if ($ee[1] =~ /^\.run\./) { @ee = (); } } # wenn Objekt schon in Bearbeitung
if (!@ee) { # einen Prozess holen, fuer den ein Request vorliegt
# print("select $store.id,$store.conn,$store.sleep,$conn.replynr from $store,$conn " .
# "where $store.conn = $conn.replynr limit 1\n");
$file = $dbh->prepare("select $store.id,$store.conn,$store.sleep,$store.status from $store,$conn " .
"where $store.conn = $conn.replynr " .
"limit 1");
$file->execute();
@ee = $file->fetchrow();
$file->finish();
if (!@ee) { return(0); }
}
$self->{'___DUMP___'} = [@ee];
while (0 == 0) {
$file = $dbh->do("update $store set objlock='1' where id like '" .
$ee[0] . "' and objlock='0'");
last if ($file ne "0E0");
print "___UPDATE_FAILED___\n";
Time::HiRes::usleep(100000);
}
$file = $dbh->prepare("select text" . join(",","",@{$self->{'INDEX'}}) .
" from $store where id='" .
$self->{'___DUMP___'}->[0] .
"' and objlock='1' limit 1");
# print("select text" . join(",","",@{$self->{'INDEX'}}) .
# " from $store where id='" .
# $self->{'___DUMP___'}->[0] .
# "' and objlock='1' limit 1\n");
$file->execute();
@ee = $file->fetchrow();
$file->finish();
if (!@ee) { print "FEHLER beim Locking 1...\n"; exit; }
$self->{'___DATA___'} = \@ee;
$file = $dbh->do("update $store set conn='.run.', " .
"objlock='0' where id='" . $self->{'___DUMP___'}->[0]
. "' and objlock='1'");
# print "update $store set conn='.run.', " .
# "objlock='0' where id='" . $self->{'___DUMP___'}->[0]
# . "' and objlock='1'\n";
if ($file eq "0E0") { print "FEHLER beim Locking 2...\n"; exit; }
return(1);
}
#******************************************************************
sub push {
my $self = shift;
my $sleeptime = shift;
my $idx = shift;
my $conn_id = shift;
my $o; my $o1; my $o2; my @ee; my $file;
my $dbh = $self->dbh();
my $store = $self->{'STORE'};
my $lock = $self->{'LOCK'};
if ($self->{'OBJ'}) { delete ($self->{'OBJ'}->{'PARENT'}); }
# $dbh->do("delete from $lock where id='".$self->{'CONNECTION'}."'");
if ($sleeptime == 0) {
$sleeptime = time() - 1;
}
elsif ($sleeptime > 0) {
$sleeptime = time() + $sleeptime;
if ($sleeptime > $self->max_time()) { $sleeptime = $self->max_time(); }
}
if ($sleeptime == -1) {
$self->get(1);
$o = $dbh->do("delete from $store where id='"
. substr($self->{'ID'},0,22) . "'");
return("___DELETED___");
}
elsif (!($self->{'FETCHED'})) { # Objekt ist noch nicht in der Datenbank
$o1 = ""; $o2 = ""; @ee = ();
foreach $o (keys %$idx) {
$o1 = $o1 . "," . $o;
$o2 = $o2 . ",?";
push(@ee,$idx->{$o});
}
$o = $dbh->do("insert into $store (conn,sleep,id,text,objlock,status$o1) " .
" values ('$conn_id',$sleeptime,?,?,'0'," .
$self->{'STATUS'} . "$o2)",
{},substr($self->{'ID'},0,22),
Dumper([$self->{'OBJ'},
$self->{'TEXT'}]),
@ee);
if ($o eq "0E0") {
print "___INSERT_FAILED___\n";
return("___INSERT_FAILED___\n");
}
}
else {
$o1 = ""; $o2 = ""; @ee = ();
foreach $o (keys %$idx) {
$o1 = $o1 . " ," . $o . "=?";
push(@ee,$idx->{$o});
}
$o = $dbh->do("update $store set conn='$conn_id', sleep=$sleeptime, " .
"text=?, objlock='0', status=" .
$self->{'STATUS'} . " $o1 where id=?",
{},
Dumper([$self->{'OBJ'},
$self->{'TEXT'}]),
@ee,
substr($self->{'ID'},0,22));
if ($o eq "0E0") {
print "___UPDATE_FAILED___\n";
print "$self->{'ID'} update $store set conn='$conn_id', sleep=$sleeptime, " .
"text=?, objlock='0' $o1 where id=?\n";
return("___UPDATE_FAILED___") if ($o eq "0E0");
}
}
return(0);
}
#******************************************************************
#******************************************************************
sub lock_semaphore {
my $self = shift;
my $id = shift;
my $dbh = $self->dbh();
my $cursor = $dbh->prepare("select semalock from " . $self->{'SEMA'} .
" where id='$id' limit 1");
$cursor->execute();
my @ee = $cursor->fetchrow();
$cursor->finish();
if (!@ee) {
$ee[0] = $dbh->do("insert into " . $self->{'SEMA'} .
" (id,text,semalock) values ('$id','',1)",
{ PrintError => 0 });
return(1) if ($ee[0] ne "0E0");
}
$ee[0] = $dbh->do("update " . $self->{'SEMA'} . " set semalock='1' " .
"where id like '$id' and semalock='0'",
{ PrintError => 0 });
return(0) if ($ee[0] eq "0E0");
return(1);
}
#******************************************************************
sub read_semaphore {
my $self = shift;
my $id = shift;
my $dbh = $self->dbh();
my $cursor = $dbh->prepare("select text from " . $self->{'SEMA'} .
" where id='$id' and semalock='1' limit 1");
$cursor->execute();
my @ee = $cursor->fetchrow();
$cursor->finish();
if (!@ee) {
return("___NO_SEMAPHORE_$id\_FOUND___");
}
return($ee[0]);
}
#******************************************************************
sub write_semaphore {
my $self = shift;
my $id = shift;
my $text = shift;
my $dbh = $self->dbh();
my $o = $dbh->do("update " . $self->{'SEMA'} . " set text='$text' " .
"where id='$id' and semalock='1'",
{ PrintError => 0 });
return(0) if ($o eq "0E0");
return(1);
}
#******************************************************************
sub unlock_semaphore {
my $self = shift;
my $id = shift;
my $dbh = $self->dbh();
my $o = $dbh->do("update " . $self->{'SEMA'} . " set semalock='0' " .
"where id='$id' and semalock='1'",
{ PrintError => 0 });
return(0) if ($o eq "0E0");
return(1);
}
#******************************************************************
sub delete_semaphore {
my $self = shift;
my $id = shift;
my $dbh = $self->dbh();
my $o = $dbh->do("delete from " . $self->{'SEMA'} . " where id='$id'",
{ PrintError => 0 });
return(0) if ($o eq "0E0");
return(1);
}
#******************************************************************
sub delete_all_semaphores {
my $self = shift;
my $id = shift;
my $dbh = $self->dbh();
my $o = $dbh->do("delete from " . $self->{'SEMA'} .
" where id like '$id\%'",
{ PrintError => 0 });
return(0) if ($o eq "0E0");
return(1);
}
#******************************************************************
1;