mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-22 02:10:32 +00:00
93_DbLog: contrib 5.5.10
git-svn-id: https://svn.fhem.de/fhem/trunk@26961 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
parent
d14b8f1c8c
commit
65d630c3ba
@ -1,5 +1,5 @@
|
|||||||
############################################################################################################################################
|
############################################################################################################################################
|
||||||
# $Id: 93_DbLog.pm 26907 2022-12-27 11:38:39Z DS_Starter $
|
# $Id: 93_DbLog.pm 26923 2022-12-29 10:28:14Z DS_Starter $
|
||||||
#
|
#
|
||||||
# 93_DbLog.pm
|
# 93_DbLog.pm
|
||||||
# written by Dr. Boris Neubert 2007-12-30
|
# written by Dr. Boris Neubert 2007-12-30
|
||||||
@ -8,7 +8,7 @@
|
|||||||
# modified and maintained by Tobias Faust since 2012-06-26 until 2016
|
# modified and maintained by Tobias Faust since 2012-06-26 until 2016
|
||||||
# e-mail: tobias dot faust at online dot de
|
# e-mail: tobias dot faust at online dot de
|
||||||
#
|
#
|
||||||
# redesigned and maintained 2016-2022 by DS_Starter with credits by: JoeAllb, DeeSpe
|
# redesigned and maintained 2016-2023 by DS_Starter with credits by: JoeAllb, DeeSpe
|
||||||
# e-mail: heiko dot maaz at t-online dot de
|
# e-mail: heiko dot maaz at t-online dot de
|
||||||
#
|
#
|
||||||
# reduceLog() created by Claudiu Schuster (rapster) adapted by DS_Starter
|
# reduceLog() created by Claudiu Schuster (rapster) adapted by DS_Starter
|
||||||
@ -38,6 +38,7 @@ 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.10" => "04.01.2023 more code rework (_DbLog_SBP_onRun_checkDiscDelpars), use dbh quote in _DbLog_SBP_onRun_LogBulk ",
|
||||||
"5.5.9" => "28.12.2022 optimize \$hash->{HELPER}{TH}, \$hash->{HELPER}{TC}, mode in Define ".
|
"5.5.9" => "28.12.2022 optimize \$hash->{HELPER}{TH}, \$hash->{HELPER}{TC}, mode in Define ".
|
||||||
"Forum: https://forum.fhem.de/index.php/topic,130588.msg1254073.html#msg1254073 ",
|
"Forum: https://forum.fhem.de/index.php/topic,130588.msg1254073.html#msg1254073 ",
|
||||||
"5.5.8" => "27.12.2022 two-line output of long state messages, define LONGRUN_PID threshold ",
|
"5.5.8" => "27.12.2022 two-line output of long state messages, define LONGRUN_PID threshold ",
|
||||||
@ -1489,10 +1490,10 @@ sub DbLog_Log {
|
|||||||
|
|
||||||
if($exc) {
|
if($exc) {
|
||||||
$exc =~ s/[\s\n]/,/g;
|
$exc =~ s/[\s\n]/,/g;
|
||||||
@excldr = split(",",$exc);
|
@excldr = split ',', $exc;
|
||||||
|
|
||||||
for my $excl (@excldr) {
|
for my $excl (@excldr) {
|
||||||
($ds,$rd) = split("#",$excl);
|
($ds,$rd) = split '#', $excl;
|
||||||
@exdvs = devspec2array($ds);
|
@exdvs = devspec2array($ds);
|
||||||
|
|
||||||
if(@exdvs) {
|
if(@exdvs) {
|
||||||
@ -1533,7 +1534,7 @@ sub DbLog_Log {
|
|||||||
my @v1 = split(/,/, $DbLogExclude);
|
my @v1 = split(/,/, $DbLogExclude);
|
||||||
|
|
||||||
for (my $i = 0; $i < int(@v1); $i++) {
|
for (my $i = 0; $i < int(@v1); $i++) {
|
||||||
my @v2 = split(/:/, $v1[$i]);
|
my @v2 = split /:/, $v1[$i];
|
||||||
$DoIt = 0 if(!$v2[1] && $reading =~ m,^$v2[0]$,); # Reading matcht auf Regexp, kein MinIntervall angegeben
|
$DoIt = 0 if(!$v2[1] && $reading =~ m,^$v2[0]$,); # Reading matcht auf Regexp, kein MinIntervall angegeben
|
||||||
|
|
||||||
if(($v2[1] && $reading =~ m,^$v2[0]$,) && ($v2[1] =~ m/^(\d+)$/)) { # Regexp matcht und MinIntervall ist angegeben
|
if(($v2[1] && $reading =~ m,^$v2[0]$,) && ($v2[1] =~ m/^(\d+)$/)) { # Regexp matcht und MinIntervall ist angegeben
|
||||||
@ -1554,10 +1555,10 @@ sub DbLog_Log {
|
|||||||
# Im Endeffekt genau die gleiche Pruefung, wie fuer DBLogExclude, lediglich mit umgegkehrtem Ergebnis.
|
# Im Endeffekt genau die gleiche Pruefung, wie fuer DBLogExclude, lediglich mit umgegkehrtem Ergebnis.
|
||||||
if($DoIt == 0) {
|
if($DoIt == 0) {
|
||||||
if($DbLogInclude && ($DbLogSelectionMode =~ m/Include/)) {
|
if($DbLogInclude && ($DbLogSelectionMode =~ m/Include/)) {
|
||||||
my @v1 = split(/,/, $DbLogInclude);
|
my @v1 = split /,/, $DbLogInclude;
|
||||||
|
|
||||||
for (my $i = 0; $i < int(@v1); $i++) {
|
for (my $i = 0; $i < int(@v1); $i++) {
|
||||||
my @v2 = split(/:/, $v1[$i]);
|
my @v2 = split /:/, $v1[$i];
|
||||||
$DoIt = 1 if($reading =~ m,^$v2[0]$,); # Reading matcht auf Regexp
|
$DoIt = 1 if($reading =~ m,^$v2[0]$,); # Reading matcht auf Regexp
|
||||||
|
|
||||||
if(($v2[1] && $reading =~ m,^$v2[0]$,) && ($v2[1] =~ m/^(\d+)$/)) { # Regexp matcht und MinIntervall ist angegeben
|
if(($v2[1] && $reading =~ m,^$v2[0]$,) && ($v2[1] =~ m/^(\d+)$/)) { # Regexp matcht und MinIntervall ist angegeben
|
||||||
@ -1729,6 +1730,8 @@ sub DbLog_Log {
|
|||||||
return if(defined $hash->{HELPER}{SHUTDOWNSEQ}); # Shutdown Sequenz läuft
|
return if(defined $hash->{HELPER}{SHUTDOWNSEQ}); # Shutdown Sequenz läuft
|
||||||
return if($hash->{HELPER}{REOPEN_RUNS}); # return wenn "reopen" mit Ablaufzeit gestartet ist
|
return if($hash->{HELPER}{REOPEN_RUNS}); # return wenn "reopen" mit Ablaufzeit gestartet ist
|
||||||
|
|
||||||
|
readingsSingleUpdate ($hash, 'CacheUsage', $memcount, 0);
|
||||||
|
|
||||||
$err = DbLog_execMemCacheSync ($hash);
|
$err = DbLog_execMemCacheSync ($hash);
|
||||||
DbLog_setReadingstate ($hash, $err) if($err);
|
DbLog_setReadingstate ($hash, $err) if($err);
|
||||||
}
|
}
|
||||||
@ -2232,7 +2235,7 @@ sub DbLog_execMemCacheSync {
|
|||||||
}
|
}
|
||||||
|
|
||||||
my $memc = _DbLog_copyCache ($name);
|
my $memc = _DbLog_copyCache ($name);
|
||||||
$err = DbLog_SBP_sendLogData ($hash, 'log_synch', $memc); # Subprocess Prozessdaten senden, Log-Daten sind in $memc->{cdata} gespeichert
|
$err = DbLog_SBP_sendLogData ($hash, 'log_synch', $memc); # Subprocess Prozessdaten senden, Log-Daten sind in $memc->{cdata} gespeichert
|
||||||
return $err if($err);
|
return $err if($err);
|
||||||
|
|
||||||
return;
|
return;
|
||||||
@ -2290,44 +2293,24 @@ sub DbLog_SBP_onRun {
|
|||||||
my $cdata = $memc->{cdata}; # Log Daten, z.B.: 3399 => 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47|
|
my $cdata = $memc->{cdata}; # Log Daten, z.B.: 3399 => 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47|
|
||||||
|
|
||||||
my $error = q{};
|
my $error = q{};
|
||||||
|
my $doNext = 0;
|
||||||
my $dbh;
|
my $dbh;
|
||||||
my $ret;
|
my $ret;
|
||||||
|
|
||||||
## Vorbereitungen
|
## Vorbereitungen
|
||||||
#############################################################################
|
####################
|
||||||
|
|
||||||
$attr{$name}{verbose} = $verbose if(defined $verbose); # verbose Level übergeben
|
$attr{$name}{verbose} = $verbose if(defined $verbose); # verbose Level übergeben
|
||||||
|
my $bst = [gettimeofday]; # Background-Startzeit
|
||||||
|
|
||||||
my $bst = [gettimeofday]; # Background-Startzeit
|
$doNext = _DbLog_SBP_onRun_checkDiscDelpars ({ subprocess => $subprocess,
|
||||||
|
name => $name,
|
||||||
|
memc => $memc,
|
||||||
|
store => $store
|
||||||
|
}
|
||||||
|
);
|
||||||
|
next if($doNext);
|
||||||
|
|
||||||
if ($dbdisconn) { # Datenbankverbindung soll beendet werden
|
|
||||||
$dbh = $store->{dbh};
|
|
||||||
|
|
||||||
if (defined $store->{dbh}) {
|
|
||||||
$dbh->disconnect();
|
|
||||||
}
|
|
||||||
|
|
||||||
delete $store->{dbh};
|
|
||||||
|
|
||||||
if ($dbdelpars) {
|
|
||||||
delete $store->{dbparams};
|
|
||||||
}
|
|
||||||
|
|
||||||
my $msg0 = $dbdelpars ? ' <br>Stored DB params in SubProcess were deleted.' : '';
|
|
||||||
my $msg1 = 'Database disconnected by request.'.$msg0;
|
|
||||||
|
|
||||||
Log3 ($name, 3, "DbLog $name - $msg1");
|
|
||||||
|
|
||||||
$ret = {
|
|
||||||
name => $name,
|
|
||||||
msg => $msg1,
|
|
||||||
oper => $operation,
|
|
||||||
ot => 0
|
|
||||||
};
|
|
||||||
|
|
||||||
__DbLog_SBP_sendToParent ($subprocess, $ret);
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($dbstorepars) { # DB Verbindungsparameter speichern
|
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");
|
||||||
@ -2550,6 +2533,55 @@ sub DbLog_SBP_onRun {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
###################################################################################
|
||||||
|
# prüfen ob Datenbankverbindung beendet werden soll und ob die
|
||||||
|
# gespeicherten Verbindungsparameter gelöscht werden sollen
|
||||||
|
###################################################################################
|
||||||
|
sub _DbLog_SBP_onRun_checkDiscDelpars {
|
||||||
|
my $paref = shift;
|
||||||
|
|
||||||
|
my $subprocess = $paref->{subprocess};
|
||||||
|
my $name = $paref->{name};
|
||||||
|
my $memc = $paref->{memc};
|
||||||
|
my $store = $paref->{store}; # Datenspeicher
|
||||||
|
|
||||||
|
my $dbdelpars = $memc->{dbdelpars}; # 1 -> gespeicherte DB Parameter sollen gelöscht werden
|
||||||
|
my $dbdisconn = $memc->{dbdisconn}; # 1 -> die Datenbankverbindung lösen/löschen
|
||||||
|
my $operation = $memc->{operation} // 'unknown';
|
||||||
|
my $doNext = 0;
|
||||||
|
|
||||||
|
if ($dbdisconn) {
|
||||||
|
if (defined $store->{dbh}) {
|
||||||
|
my $dbh = delete $store->{dbh};
|
||||||
|
$dbh->disconnect();
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($dbdelpars) {
|
||||||
|
delete $store->{dbparams};
|
||||||
|
}
|
||||||
|
|
||||||
|
my $msg0 = $dbdelpars ? ' <br>Stored DB params in SubProcess were deleted.' : '';
|
||||||
|
my $msg1 = 'Database disconnected by request.'.$msg0;
|
||||||
|
my $msg2 = $msg1;
|
||||||
|
$msg2 =~ s/<br>//xs;
|
||||||
|
|
||||||
|
Log3 ($name, 3, "DbLog $name - $msg2");
|
||||||
|
|
||||||
|
my $ret = {
|
||||||
|
name => $name,
|
||||||
|
msg => $msg1,
|
||||||
|
oper => $operation,
|
||||||
|
ot => 0
|
||||||
|
};
|
||||||
|
|
||||||
|
__DbLog_SBP_sendToParent ($subprocess, $ret);
|
||||||
|
|
||||||
|
$doNext = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $doNext;
|
||||||
|
}
|
||||||
|
|
||||||
###################################################################################
|
###################################################################################
|
||||||
# neue Datenbankverbindung im SubProcess
|
# neue Datenbankverbindung im SubProcess
|
||||||
#
|
#
|
||||||
@ -2723,14 +2755,26 @@ sub _DbLog_SBP_onRun_LogBulk {
|
|||||||
my @a = split "\\|", $row;
|
my @a = split "\\|", $row;
|
||||||
s/_ESC_/\|/gxs for @a; # escaped Pipe back to "|"
|
s/_ESC_/\|/gxs for @a; # escaped Pipe back to "|"
|
||||||
|
|
||||||
$a[3] =~ s/'/''/g; # escape ' with ''
|
#$a[3] =~ s/'/''/g; # escape ' with ''
|
||||||
$a[5] =~ s/'/''/g; # escape ' with ''
|
#$a[5] =~ s/'/''/g; # escape ' with ''
|
||||||
$a[6] =~ s/'/''/g; # escape ' with ''
|
#$a[6] =~ s/'/''/g; # escape ' with ''
|
||||||
$a[3] =~ s/\\/\\\\/g; # escape \ with \\
|
#$a[3] =~ s/\\/\\\\/g; # escape \ with \\
|
||||||
$a[5] =~ s/\\/\\\\/g; # escape \ with \\
|
#$a[5] =~ s/\\/\\\\/g; # escape \ with \\
|
||||||
$a[6] =~ s/\\/\\\\/g; # escape \ with \\
|
#$a[6] =~ s/\\/\\\\/g; # escape \ with \\
|
||||||
|
|
||||||
$sqlins .= "('$a[0]','$a[1]','$a[2]','$a[3]','$a[4]','$a[5]','$a[6]'),";
|
#$sqlins .= "('$a[0]','$a[1]','$a[2]','$a[3]','$a[4]','$a[5]','$a[6]'),";
|
||||||
|
|
||||||
|
# TIMESTAMP, DEVICE, TYPE, EVENT, READING, VALUE, UNIT
|
||||||
|
|
||||||
|
$a[0] = $dbh->quote($a[0]);
|
||||||
|
$a[1] = $dbh->quote($a[1]);
|
||||||
|
$a[2] = $dbh->quote($a[2]);
|
||||||
|
$a[3] = $dbh->quote($a[3]);
|
||||||
|
$a[4] = $dbh->quote($a[4]);
|
||||||
|
$a[5] = $dbh->quote($a[5]);
|
||||||
|
$a[6] = $dbh->quote($a[6]);
|
||||||
|
|
||||||
|
$sqlins .= qq{($a[0],$a[1],$a[2],$a[3],$a[4],$a[5],$a[6]),};
|
||||||
}
|
}
|
||||||
|
|
||||||
use warnings;
|
use warnings;
|
||||||
@ -7411,13 +7455,13 @@ sub DbLog_setVersionInfo {
|
|||||||
|
|
||||||
if($modules{$type}{META}{x_prereqs_src} && !$hash->{HELPER}{MODMETAABSENT}) { # META-Daten sind vorhanden
|
if($modules{$type}{META}{x_prereqs_src} && !$hash->{HELPER}{MODMETAABSENT}) { # META-Daten sind vorhanden
|
||||||
$modules{$type}{META}{version} = "v".$v; # Version aus META.json überschreiben, Anzeige mit {Dumper $modules{DbLog}{META}}
|
$modules{$type}{META}{version} = "v".$v; # Version aus META.json überschreiben, Anzeige mit {Dumper $modules{DbLog}{META}}
|
||||||
if($modules{$type}{META}{x_version}) { # {x_version} ( nur gesetzt wenn $Id: 93_DbLog.pm 26907 2022-12-27 11:38:39Z DS_Starter $ im Kopf komplett! vorhanden )
|
if($modules{$type}{META}{x_version}) { # {x_version} ( nur gesetzt wenn $Id: 93_DbLog.pm 26923 2022-12-29 10:28:14Z DS_Starter $ im Kopf komplett! vorhanden )
|
||||||
$modules{$type}{META}{x_version} =~ s/1\.1\.1/$v/xsg;
|
$modules{$type}{META}{x_version} =~ s/1\.1\.1/$v/xsg;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$modules{$type}{META}{x_version} = $v;
|
$modules{$type}{META}{x_version} = $v;
|
||||||
}
|
}
|
||||||
return $@ unless (FHEM::Meta::SetInternals($hash)); # FVERSION wird gesetzt ( nur gesetzt wenn $Id: 93_DbLog.pm 26907 2022-12-27 11:38:39Z DS_Starter $ im Kopf komplett! vorhanden )
|
return $@ unless (FHEM::Meta::SetInternals($hash)); # FVERSION wird gesetzt ( nur gesetzt wenn $Id: 93_DbLog.pm 26923 2022-12-29 10:28:14Z DS_Starter $ im Kopf komplett! vorhanden )
|
||||||
if(__PACKAGE__ eq "FHEM::$type" || __PACKAGE__ eq $type) {
|
if(__PACKAGE__ eq "FHEM::$type" || __PACKAGE__ eq $type) {
|
||||||
# es wird mit Packages gearbeitet -> Perl übliche Modulversion setzen
|
# es wird mit Packages gearbeitet -> Perl übliche Modulversion setzen
|
||||||
# mit {<Modul>->VERSION()} im FHEMWEB kann Modulversion abgefragt werden
|
# mit {<Modul>->VERSION()} im FHEMWEB kann Modulversion abgefragt werden
|
||||||
|
Loading…
x
Reference in New Issue
Block a user