FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-02-25 09:55:38 +00:00
Code Issues Releases Wiki Activity

93_DbLog: contrib 5.5.6

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@26847 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
nasseeder1 2022-12-12 21:44:27 +00:00
parent 56cdd01230
commit d160d7ca2e
1 changed files with 110 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
fhem/contrib/DS_Starter/93_DbLog.pm
View File

@ -1,5 +1,5 @@
############################################################################################################################################ ############################################################################################################################################
# $Id: 93_DbLog.pm 26750 2022-12-11 16:38:54Z DS_Starter $ # $Id: 93_DbLog.pm 26750 2022-12-12 16:38:54Z DS_Starter $
# #
# 93_DbLog.pm # 93_DbLog.pm
# written by Dr. Boris Neubert 2007-12-30 # written by Dr. Boris Neubert 2007-12-30
@ -22,10 +22,10 @@
package main; package main;
use strict; use strict;
use warnings; use warnings;
eval "use DBI;1" or my $DbLogMMDBI = "DBI"; eval "use DBI;1;" or my $DbLogMMDBI = "DBI"; ## no critic 'eval'
eval "use FHEM::Meta;1" or my $modMetaAbsent = 1; eval "use FHEM::Meta;1;" or my $modMetaAbsent = 1; ## no critic 'eval'
eval "use FHEM::Utility::CTZ qw(:all);1" or my $ctzAbsent = 1; eval "use FHEM::Utility::CTZ qw(:all);1;" or my $ctzAbsent = 1; ## no critic 'eval'
eval "use JSON;1;" or my $jsonabs = "JSON"; ## no critic 'eval' # Debian: apt-get install libjson-perl eval "use Storable qw(freeze thaw);1;" or my $storabs = "Storable"; ## no critic 'eval'
#use Data::Dumper; #use Data::Dumper;
use Time::HiRes qw(gettimeofday tv_interval usleep); use Time::HiRes qw(gettimeofday tv_interval usleep);
@ -38,6 +38,8 @@ no if $] >= 5.017011, warnings => 'experimental::smartmatch';
# Version History intern by DS_Starter: # Version History intern by DS_Starter:
my %DbLog_vNotesIntern = ( my %DbLog_vNotesIntern = (
"5.5.6" => "12.12.2022 Serialize with Storable instead of JSON ",
"5.5.5" => "11.12.2022 Array Log -> may be better error processing ",
"5.5.4" => "11.12.2022 Array Log -> print out all cache not saved, DbLog_DelayedShutdown processing changed ", "5.5.4" => "11.12.2022 Array Log -> print out all cache not saved, DbLog_DelayedShutdown processing changed ",
"5.5.3" => "10.12.2022 more internal code rework ", "5.5.3" => "10.12.2022 more internal code rework ",
"5.5.2" => "09.12.2022 _DbLog_ConnectPush function removed ", "5.5.2" => "09.12.2022 _DbLog_ConnectPush function removed ",
@ -380,14 +382,19 @@ sub DbLog_Define {
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my @a = split "[ \t][ \t]*", $def; my @a = split "[ \t][ \t]*", $def;
my $err;
if($DbLogMMDBI) { if($DbLogMMDBI) {
Log3($name, 1, "DbLog $name - ERROR - Perl module ".$DbLogMMDBI." is missing. DbLog module is not loaded ! On Debian systems you can install it with \"sudo apt-get install libdbi-perl\" "); $err = "Perl module ".$DbLogMMDBI." is missing. On Debian you can install it with: sudo apt-get install libdbi-perl";
return "Error: Perl module ".$DbLogMMDBI." is missing. Install it on Debian with: sudo apt-get install libdbi-perl"; Log3($name, 1, "DbLog $name - ERROR - $err");
return "Error: $err";
} }
if($jsonabs) { if ($storabs) {
Log3($name, 1, "DbLog $name - ERROR - Perl module ".$jsonabs." is missing. Install it on Debian with: sudo apt-get install libjson-perl"); $err = "Perl module ".$storabs." is missing. On Debian you can install it with: sudo apt-get install libstorable-perl";
return "Error: Perl module ".$jsonabs." is missing. Install it on Debian with: sudo apt-get install libjson-perl"; Log3($name, 1, "DbLog $name - ERROR - $err");
return "Error: $err";
} }
return "wrong syntax: define <name> DbLog configuration regexp" if(int(@a) != 4); return "wrong syntax: define <name> DbLog configuration regexp" if(int(@a) != 4);
@ -2207,10 +2214,10 @@ sub DbLog_SBP_onRun {
my $logstore; # temporärer Logdatenspeicher my $logstore; # temporärer Logdatenspeicher
while (1) { while (1) {
my $json = $subprocess->readFromParent(); my $serial = $subprocess->readFromParent();
if(defined($json)) { if(defined $serial) {
my $memc = eval { decode_json($json) }; my $memc = eval { thaw ($serial) };
my $dbstorepars = $memc->{dbstorepars}; # 1 -> DB Parameter werden zum Speichern übermittelt, sonst 0 my $dbstorepars = $memc->{dbstorepars}; # 1 -> DB Parameter werden zum Speichern übermittelt, sonst 0
my $dbdelpars = $memc->{dbdelpars}; # 1 -> gespeicherte DB Parameter sollen gelöscht werden my $dbdelpars = $memc->{dbdelpars}; # 1 -> gespeicherte DB Parameter sollen gelöscht werden
@ -2223,7 +2230,6 @@ sub DbLog_SBP_onRun {
my $error = q{}; my $error = q{};
my $dbh; my $dbh;
my $ret; my $ret;
my $retjson;
## Vorbereitungen ## Vorbereitungen
############################################################################# #############################################################################
@ -2592,7 +2598,6 @@ sub _DbLog_SBP_onRun_Log {
my $nins_hist = 0; my $nins_hist = 0;
my $ret; my $ret;
my $retjson;
if ($tl) { # Tracelevel setzen if ($tl) { # Tracelevel setzen
$dbh->{TraceLevel} = "$tl|$tf"; $dbh->{TraceLevel} = "$tl|$tf";
@ -2930,6 +2935,18 @@ sub _DbLog_SBP_onRun_Log {
eval { eval {
($tuples, $rows) = $sth_ih->execute_array( { ArrayTupleStatus => \@tuple_status } ); ($tuples, $rows) = $sth_ih->execute_array( { ArrayTupleStatus => \@tuple_status } );
};
if ($@) {
$error = $@;
Log3 ($name, 2, "DbLog $name - Error table $history - $error");
if($useta) {
$rowlback = $cdata; # nicht gespeicherte Datensätze nur zurück geben wenn Transaktion ein
__DbLog_SBP_rollbackOnly ($name, $dbh, $history);
}
};
no warnings 'uninitialized'; no warnings 'uninitialized';
@ -2974,36 +2991,13 @@ sub _DbLog_SBP_onRun_Log {
} }
} }
if(defined $rowhref) { # nicht gespeicherte Datensätze ausgeben
Log3 ($name, 2, "DbLog $name - The following data are faulty and were not saved:");
__DbLog_SBP_logHashContent ($name, $rowhref);
}
__DbLog_SBP_commitOnly ($name, $dbh, $history); __DbLog_SBP_commitOnly ($name, $dbh, $history);
1;
}
or do { $error = $@;
Log3 ($name, 2, "DbLog $name - Error table $history - $error");
if($useta) {
$rowlback = $cdata; # nicht gespeicherte Datensätze nur zurück geben wenn Transaktion ein
__DbLog_SBP_rollbackOnly ($name, $dbh, $history);
}
else {
if(defined $rowhref) { # nicht gespeicherte Datensätze ausgeben if(defined $rowhref) { # nicht gespeicherte Datensätze ausgeben
Log3 ($name, 2, "DbLog $name - The following data are faulty and were not saved:"); Log3 ($name, 2, "DbLog $name - The following data are faulty and were not saved:");
__DbLog_SBP_logHashContent ($name, $rowhref); __DbLog_SBP_logHashContent ($name, $rowhref);
__DbLog_SBP_commitOnly ($name, $dbh, $history); # eingefügte Array-Daten bestätigen
} }
else {
__DbLog_SBP_logHashContent ($name, $cdata);
}
}
};
} }
if (lc($DbLogType) =~ m(current)) { # insert current mit/ohne primary key if (lc($DbLogType) =~ m(current)) { # insert current mit/ohne primary key
@ -3220,7 +3214,6 @@ sub _DbLog_SBP_onRun_deleteOldDays {
my $error = q{}; my $error = q{};
my $numdel = 0; my $numdel = 0;
my $ret; my $ret;
my $retjson;
my $cmd = "delete from $history where TIMESTAMP < "; my $cmd = "delete from $history where TIMESTAMP < ";
@ -3305,7 +3298,6 @@ sub _DbLog_SBP_onRun_userCommand {
my $error = q{}; my $error = q{};
my $res; my $res;
my $ret; my $ret;
my $retjson;
Log3 ($name, 4, qq{DbLog $name - userCommand requested: "$sql"}); Log3 ($name, 4, qq{DbLog $name - userCommand requested: "$sql"});
@ -3379,9 +3371,7 @@ sub _DbLog_SBP_onRun_importCachefile {
my $rowlback = q{}; my $rowlback = q{};
my $crows = 0; my $crows = 0;
my $nins_hist = 0; my $nins_hist = 0;
my $res;
my $ret; my $ret;
my $retjson;
if (open(FH, $infile)) { if (open(FH, $infile)) {
binmode (FH); binmode (FH);
@ -3481,7 +3471,6 @@ sub _DbLog_SBP_onRun_reduceLog {
my $error = q{}; my $error = q{};
my $res; my $res;
my $ret; my $ret;
my $retjson;
my @a = split " ", $arg; my @a = split " ", $arg;
@ -4152,8 +4141,8 @@ sub __DbLog_SBP_sendToParent {
my $subprocess = shift; my $subprocess = shift;
my $ret = shift; my $ret = shift;
my $json = eval {encode_json($ret)}; my $serial = eval { freeze ($ret) };
$subprocess->writeToParent ($json); $subprocess->writeToParent ($serial);
return; return;
} }
@ -4238,14 +4227,14 @@ sub DbLog_SBP_sendDbDisconnect {
$memc->{dbdisconn} = 1; # Statusbit command disconnect $memc->{dbdisconn} = 1; # Statusbit command disconnect
$memc->{operation} = 'dbDisconnect'; $memc->{operation} = 'dbDisconnect';
my $json = eval { encode_json($memc); my $serial = eval { freeze ($memc);
} }
or do { $err = $@; or do { $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err"); Log3 ($name, 1, "DbLog $name - JSON error: $err");
return $err; return $err;
}; };
$subprocess->writeToChild($json); $subprocess->writeToChild ($serial);
return; return;
} }
@ -4287,14 +4276,14 @@ sub DbLog_SBP_sendConnectionData {
$memc->{sltcs} = AttrVal ($name, 'SQLiteCacheSize', 4000); $memc->{sltcs} = AttrVal ($name, 'SQLiteCacheSize', 4000);
} }
my $json = eval { encode_json($memc); my $serial = eval { freeze ($memc);
} }
or do { $err = $@; or do { $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err"); Log3 ($name, 1, "DbLog $name - JSON error: $err");
return $err; return $err;
}; };
$subprocess->writeToChild($json); $subprocess->writeToChild ($serial);
return; return;
} }
@ -4326,14 +4315,14 @@ sub DbLog_SBP_sendLogData {
$memc->{verbose} = AttrVal ($name, 'verbose', 3); $memc->{verbose} = AttrVal ($name, 'verbose', 3);
$memc->{operation} = $oper; $memc->{operation} = $oper;
my $json = eval { encode_json($memc); my $serial = eval { freeze ($memc);
} }
or do { my $err = $@; or do { my $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err"); Log3 ($name, 1, "DbLog $name - JSON error: $err");
return $err; return $err;
}; };
$subprocess->writeToChild($json); $subprocess->writeToChild ($serial);
$hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel; $hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel;
@ -4368,7 +4357,7 @@ sub DbLog_SBP_sendCommand {
$memc->{operation} = $oper; $memc->{operation} = $oper;
$memc->{arguments} = $arg; $memc->{arguments} = $arg;
my $json = eval { encode_json($memc); my $serial = eval { freeze ($memc);
} }
or do { my $err = $@; or do { my $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err"); Log3 ($name, 1, "DbLog $name - JSON error: $err");
@ -4379,7 +4368,7 @@ sub DbLog_SBP_sendCommand {
$hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel; $hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel;
$subprocess->writeToChild($json); $subprocess->writeToChild ($serial);
return; return;
} }
@ -4442,7 +4431,7 @@ sub DbLog_SBP_CleanUp {
my $pid = $subprocess->pid(); my $pid = $subprocess->pid();
return if(!defined $pid); return if(!defined $pid);
Log3 ($name, 2, qq{DbLog $name - stopping Subprocess >$pid< ...}); Log3 ($name, 2, qq{DbLog $name - stopping SubProcess PID >$pid< ...});
#$subprocess->terminate(); #$subprocess->terminate();
#$subprocess->wait(); #$subprocess->wait();
@ -4450,7 +4439,7 @@ sub DbLog_SBP_CleanUp {
kill 'SIGKILL', $pid; kill 'SIGKILL', $pid;
waitpid($pid, 0); waitpid($pid, 0);
Log3 ($name, 2, qq{DbLog $name - Subprocess >$pid< stopped}); Log3 ($name, 2, qq{DbLog $name - SubProcess PID >$pid< stopped});
delete ($selectlist{"$name.$pid"}); delete ($selectlist{"$name.$pid"});
delete $hash->{FD}; delete $hash->{FD};
@ -4471,10 +4460,10 @@ sub DbLog_SBP_Read {
#my $name = $hash->{NAME}; #my $name = $hash->{NAME};
my $subprocess = $hash->{".fhem"}{subprocess}; my $subprocess = $hash->{".fhem"}{subprocess};
my $retjson = $subprocess->readFromChild(); # hier lesen wir aus der globalen Select-Schleife, was in der onRun-Funktion geschrieben wurde my $retserial = $subprocess->readFromChild(); # hier lesen wir aus der globalen Select-Schleife, was in der onRun-Funktion geschrieben wurde
if(defined($retjson)) { if(defined $retserial) {
my $ret = eval { decode_json($retjson) }; my $ret = eval { thaw ($retserial) };
return if(defined($ret) && ref($ret) ne "HASH"); return if(defined($ret) && ref($ret) ne "HASH");
@ -7722,8 +7711,8 @@ return;
<br><br> <br><br>
<b>Note</b> <br> <b>Note</b> <br>
If the sub-process is reinitialized during runtime, the RAM consumption is increased, which is normalized The re-initialization of the sub-process during runtime causes an increased RAM consumption until
again after a FHEM restart. to a FHEM restart .
</ul> </ul>
</li> </li>
<br> <br>
@ -9323,8 +9312,8 @@ attr SMA_Energymeter DbLogValueFn
<br><br> <br><br>
<b>Hinweis</b> <br> <b>Hinweis</b> <br>
Bei Neuinitialisierung des SubProzesses während der Laufzeit ergibt sich ein erhöhter RAM Verbrauch der sich Die Neuinitialisierung des SubProzesses während der Laufzeit verursacht einen erhöhten RAM Verbrauch bis
nach einem FHEM Neustart wieder normalisiert. zu einem FHEM Neustart .
</ul> </ul>
</li> </li>
<br> <br>
@ -10527,7 +10516,7 @@ attr SMA_Energymeter DbLogValueFn
"HttpUtils": 0, "HttpUtils": 0,
"Encode": 0, "Encode": 0,
"SubProcess": 0, "SubProcess": 0,
"JSON": 0 "Storable": 0
}, },
"recommends": { "recommends": {
"FHEM::Meta": 0, "FHEM::Meta": 0,