From 732e4cf8c9a035bd6d5aa9c986d4d696d566d971 Mon Sep 17 00:00:00 2001 From: nasseeder1 Date: Sat, 10 Dec 2022 15:15:20 +0000 Subject: [PATCH] 93_DbLog: contrib 5.5.3 git-svn-id: https://svn.fhem.de/fhem/trunk@26828 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/contrib/DS_Starter/93_DbLog.pm | 272 ++++++++++++++++------------ 1 file changed, 161 insertions(+), 111 deletions(-) diff --git a/fhem/contrib/DS_Starter/93_DbLog.pm b/fhem/contrib/DS_Starter/93_DbLog.pm index 2c41d6493..0750955c0 100644 --- a/fhem/contrib/DS_Starter/93_DbLog.pm +++ b/fhem/contrib/DS_Starter/93_DbLog.pm @@ -2103,7 +2103,7 @@ sub DbLog_execMemCacheAsync { $memc->{cdataindex} = $data{DbLog}{$name}{cache}{index}; # aktuellen Index an Subprozess übergeben - undef $data{DbLog}{$name}{cache}{memcache}; # sicherheitshalber Memory freigeben: https://perlmaven.com/undef-on-perl-arrays-and-hashes , bzw. https://www.effectiveperlprogramming.com/2018/09/undef-a-scalar-to-release-its-memory/ + undef %{$data{DbLog}{$name}{cache}{memcache}}; # sicherheitshalber Memory freigeben: https://perlmaven.com/undef-on-perl-arrays-and-hashes , bzw. https://www.effectiveperlprogramming.com/2018/09/undef-a-scalar-to-release-its-memory/ $error = DbLog_SBP_sendLogData ($hash, 'log_asynch', $memc); # Subprocess Prozessdaten senden, Log-Daten sind in $memc->{cdata} gespeichert return if($error); @@ -2156,7 +2156,7 @@ sub DbLog_execMemCacheSync { my $memc; for my $key (sort(keys %{$data{DbLog}{$name}{cache}{memcache}})) { - Log3 ($name, 5, "DbLog $name - Store contains: $key -> ".$data{DbLog}{$name}{cache}{memcache}{$key}); + Log3 ($name, 5, "DbLog $name - TempStore contains: $key -> ".$data{DbLog}{$name}{cache}{memcache}{$key}); $memc->{cdata}{$key} = delete $data{DbLog}{$name}{cache}{memcache}{$key}; # Subprocess Daten, z.B.: 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47| } @@ -2241,7 +2241,7 @@ sub DbLog_SBP_onRun { } if ($dbstorepars) { # DB Verbindungsparameter speichern - Log3 ($name, 3, "DbLog $name - DB connection parameters are stored in SubProcess ..."); + Log3 ($name, 3, "DbLog $name - DB connection parameters are stored in SubProcess"); $store->{dbparams}{dbconn} = $memc->{dbconn}; $store->{dbparams}{dbname} = (split /;|=/, $memc->{dbconn})[1]; @@ -2256,7 +2256,14 @@ sub DbLog_SBP_onRun { $store->{dbparams}{current} = $memc->{current}; # Name current-Tabelle $store->{dbparams}{dbstorepars} = $memc->{dbstorepars}; # Status Speicherung DB Parameter 0|1 - Log3 ($name, 5, "DbLog $name - DB Parameter stored in SubProcess: \n".Dumper $store->{dbparams}); + if ($verbose == 5) { + Log3 ($name, 5, "DbLog $name - DB Parameter stored in SubProcess:"); + + for my $dbp (sort keys %{$store->{dbparams}}) { + next if(!defined $store->{dbparams}{$dbp}); + Log3 ($name, 5, "DbLog $name - $dbp -> ".$store->{dbparams}{$dbp}); + } + } $ret = { name => $name, @@ -2277,6 +2284,7 @@ sub DbLog_SBP_onRun { for my $idx (sort {$a<=>$b} keys %{$cdata}) { $logstore->{$idx} = $cdata->{$idx}; + Log3 ($name, 4, "DbLog $name - stored: $idx -> ".$logstore->{$idx}); } @@ -2314,7 +2322,7 @@ sub DbLog_SBP_onRun { sltjm => $store->{dbparams}{sltjm}, sltcs => $store->{dbparams}{sltcs} }; - + if (!defined $store->{dbh}) { ($error, $dbh) = _DbLog_SBP_onRun_connectDB ($params); @@ -2335,7 +2343,7 @@ sub DbLog_SBP_onRun { } $store->{dbh} = $dbh; - + Log3 ($name, 3, "DbLog $name - SubProcess connected to $store->{dbparams}{dbname}"); } @@ -2365,8 +2373,6 @@ sub DbLog_SBP_onRun { $subprocess->writeToParent($retjson); next; } - - Log3 ($name, 3, "DbLog $name - SubProcess connected to $store->{dbparams}{dbname}"); }; @@ -2586,15 +2592,20 @@ sub _DbLog_SBP_onRun_Log { else { Log3 ($name, 5, "DbLog $name - Primary Key usage suppressed by attribute noSupportPK"); } - - if (defined $logstore) { # temporär gespeicherte Daten hinzufügen + + + my $ln = scalar keys %{$logstore}; + if ($ln) { # temporär gespeicherte Daten hinzufügen + for my $index (sort {$a<=>$b} keys %{$logstore}) { - $cdata->{$index} = $logstore->{$index}; - Log3 ($name, 4, "DbLog $name - add stored data: $index -> ".$logstore->{$index}); + + $cdata->{$index} = delete $logstore->{$index}; } - undef $logstore; + undef %{$logstore}; + + Log3 ($name, 4, "DbLog $name - logstore deleted - $ln stored datasets added for processing"); } my $ceti = scalar keys %{$cdata}; @@ -2677,7 +2688,7 @@ sub _DbLog_SBP_onRun_Log { else { __DbLog_SBP_commitOnly ($name, $dbh, $history); } - + $ret = { name => $name, msg => $error, @@ -2690,6 +2701,8 @@ sub _DbLog_SBP_onRun_Log { $subprocess->writeToParent ($retjson); return; }; + + __DbLog_SBP_commitOnly ($name, $dbh, $history); if($ins_hist == $ceti) { Log3 ($name, 4, "DbLog $name - $ins_hist of $ceti events inserted into table $history".($usepkh ? " using PK on columns $pkh" : "")); @@ -2812,7 +2825,7 @@ sub _DbLog_SBP_onRun_Log { $nins_cur++; } - + if(!$nins_cur) { Log3 ($name, 4, "DbLog $name - ".($#device_cur+1)." of ".($#device_cur+1)." events inserted into table $current ".($usepkc ? " using PK on columns $pkc" : "")); } @@ -2871,7 +2884,7 @@ sub _DbLog_SBP_onRun_Log { my @n2hist; my $rowhref; - + $error = __DbLog_SBP_beginTransaction ($name, $dbh, $useta); eval { @@ -2910,34 +2923,45 @@ sub _DbLog_SBP_onRun_Log { } else { Log3 ($name, 2, "DbLog $name - WARNING - only ".($ceti-$nins_hist)." of $ceti events inserted into table $history"); - + my $bkey = 1; for my $line (@n2hist) { $rowhref->{$bkey} = $line; $bkey++; } - } + } } + + if(defined $rowhref) { # nicht gespeicherte Datensätze ausgeben + Log3 ($name, 2, "DbLog $name - The following data are faulty and were not saved:"); + + for my $df (sort {$a <=>$b} keys %{$rowhref}) { + Log3 ($name, 2, "DbLog $name - $rowhref->{$df}"); + } + } + + __DbLog_SBP_commitOnly ($name, $dbh, $history); + 1; } or do { $error = $@; - Log3 ($name, 2, "DbLog $name - Error table $history - $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:"); - + for my $df (sort {$a <=>$b} keys %{$rowhref}) { Log3 ($name, 2, "DbLog $name - $rowhref->{$df}"); } - } - + } + __DbLog_SBP_commitOnly ($name, $dbh, $history); # eingefügte Array-Daten bestätigen } }; @@ -4093,18 +4117,18 @@ return; sub DbLog_SBP_CheckAndInit { my $hash = shift; my $name = $hash->{NAME}; - + my $err = q{}; - + if (defined $hash->{SBP_PID} && defined $hash->{HELPER}{LONGRUN_PID}) { # Laufzeit des letzten Kommandos prüfen -> timeout my $to = AttrVal($name, 'timeout', $dblog_todef); my $rt = time() - $hash->{HELPER}{LONGRUN_PID}; # aktuelle Laufzeit - + if ($rt >= $to) { # SubProcess beenden, möglicherweise tot Log3 ($name, 2, qq{DbLog $name - The Subprocess >$hash->{SBP_PID}< has exceeded the timeout of $to seconds}); - + DbLog_SBP_CleanUp ($hash); - + Log3 ($name, 2, qq{DbLog $name - The last running operation was canceled}); } } @@ -4412,7 +4436,7 @@ sub DbLog_SBP_Read { if($reqdbdat) { # Übertragung DB Verbindungsparameter ist requested my $rst = DbLog_SBP_sendConnectionData ($hash); if (!$rst) { - Log3 ($name, 3, "DbLog $name - requested DB connection parameters are transmitted ..."); + Log3 ($name, 3, "DbLog $name - requested DB connection parameters are transmitted"); } } @@ -4660,9 +4684,9 @@ return; sub _DbLog_ConnectNewDBH { my $hash = shift; my $name = $hash->{NAME}; - + my ($useac,$useta) = DbLog_commitMode ($name, AttrVal($name, 'commitMode', $dblog_cmdef)); - + my $params = { name => $name, dbconn => $hash->{dbconn}, dbname => (split /;|=/, $hash->{dbconn})[1], @@ -4674,11 +4698,11 @@ sub _DbLog_ConnectNewDBH { sltjm => AttrVal ($name, 'SQLiteJournalMode', 'WAL'), sltcs => AttrVal ($name, 'SQLiteCacheSize', 4000) }; - + my ($error, $dbh) = _DbLog_SBP_onRun_connectDB ($params); - return $dbh if(!$error); + return $dbh if(!$error); return; } @@ -4789,10 +4813,10 @@ sub DbLog_Get { if($outf eq "int") { $outf = "-"; $internal = 1; - } + } elsif($outf eq "array") { - } + } elsif(lc($outf) eq "webchart") { # redirect the get request to the DbLog_chartQuery function return DbLog_chartQuery($hash, @_); } @@ -4927,13 +4951,13 @@ sub DbLog_Get { if($readings[$i]->[3] && ($readings[$i]->[3] eq "delta-h" || $readings[$i]->[3] eq "delta-d")) { $deltacalc = 1; - + Log3($name, 4, "DbLog $name - deltacalc: hour") if($readings[$i]->[3] eq "delta-h"); # geändert V4.8.0 / 14.10.2019 Log3($name, 4, "DbLog $name - deltacalc: day") if($readings[$i]->[3] eq "delta-d"); # geändert V4.8.0 / 14.10.2019 } my ($stm); - + if($deltacalc) { $stm = "SELECT Z.TIMESTAMP, Z.DEVICE, Z.READING, Z.VALUE from "; @@ -5031,17 +5055,17 @@ sub DbLog_Get { # Select Auswertung #################################################################################### my $rv = 0; - + while ($sth->fetch()) { $rv++; - + no warnings 'uninitialized'; # geändert V4.8.0 / 14.10.2019 my $ds = "PID: $$, TS: $sql_timestamp, DEV: $sql_device, RD: $sql_reading, VAL: $sql_value"; # geändert V4.8.0 / 14.10.2019 - - Log3 ($name, 5, "$name - SQL-result -> $ds"); - + + Log3 ($name, 5, "$name - SQL-result -> $ds"); + use warnings; # geändert V4.8.0 / 14.10.2019 - + $writeout = 0; # eingefügt V4.8.0 / 14.10.2019 ############ Auswerten des 5. Parameters: Regexp ################### @@ -5120,7 +5144,7 @@ sub DbLog_Get { } elsif ($readings[$i]->[3] && $readings[$i]->[3] eq "delta-h") { # Berechnung eines Delta-Stundenwertes %tstamp = DbLog_explode_datetime($sql_timestamp, ()); - + if($lastd[$i] eq "undef") { %lasttstamp = DbLog_explode_datetime($sql_timestamp, ()); $lasttstamp{hour} = "00"; @@ -5141,7 +5165,7 @@ sub DbLog_Get { $hour = '0'.$j if $j<10; $cnt[$i]++; $out_tstamp = DbLog_implode_datetime($tstamp{year}, $tstamp{month}, $tstamp{day}, $hour, "30", "00"); - + if ($outf =~ m/(all)/) { # Timestamp: Device, Type, Event, Reading, Value, Unit $retvaldummy .= sprintf("%s: %s, %s, %s, %s, %s, %s\n", $out_tstamp, $sql_device, $type, $event, $sql_reading, $out_value, $unit); @@ -5244,13 +5268,13 @@ sub DbLog_Get { $min[$i] = $out_value; $mind[$i] = $out_tstamp; } - + if($out_value > $max[$i]) { $max[$i] = $out_value; $maxd[$i] = $out_tstamp; } } - + $maxval = $sql_value; } else { @@ -5293,7 +5317,7 @@ sub DbLog_Get { $lastd[$i] = $sql_timestamp; } } #### while fetchrow Ende ##### - + Log3 ($name, 4, "$name - PID: $$, rows count: $rv"); ######## den letzten Abschlusssatz rausschreiben ########## @@ -5310,7 +5334,7 @@ sub DbLog_Get { $out_tstamp = DbLog_implode_datetime($lasttstamp{year}, $lasttstamp{month}, $lasttstamp{day}, $lasttstamp{hour}, "30", "00") if($readings[$i]->[3] eq "delta-h"); $out_tstamp = DbLog_implode_datetime($lasttstamp{year}, $lasttstamp{month}, $lasttstamp{day}, "12", "00", "00") if($readings[$i]->[3] eq "delta-d"); } - + $sum[$i] += $out_value; $cnt[$i]++; @@ -6979,7 +7003,7 @@ sub DbLog_chartQuery { } my ($hash, @a) = @_; - + my $dbhf = _DbLog_ConnectNewDBH($hash); return if(!$dbhf); @@ -7073,9 +7097,9 @@ return $jsonstring; ################################################################ sub DbLog_dbReadings { my($hash,@a) = @_; - + my $history = $hash->{HELPER}{TH}; - + my $dbh = _DbLog_ConnectNewDBH($hash); return if(!$dbh); @@ -7381,47 +7405,67 @@ return;
+