2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-01-31 18:59:33 +00:00

93_DbLog: contrib 5.5.11

git-svn-id: https://svn.fhem.de/fhem/trunk@27013 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
nasseeder1 2023-01-09 16:39:51 +00:00
parent 170c6be412
commit cae3c49dec

View File

@ -1,5 +1,5 @@
############################################################################################################################################
# $Id: 93_DbLog.pm 26923 2023-01-08 10:28:14Z DS_Starter $
# $Id: 93_DbLog.pm 26923 2023-01-09 10:28:14Z DS_Starter $
#
# 93_DbLog.pm
# written by Dr. Boris Neubert 2007-12-30
@ -38,7 +38,8 @@ no if $] >= 5.017011, warnings => 'experimental::smartmatch';
# Version History intern by DS_Starter:
my %DbLog_vNotesIntern = (
"5.5.10" => "07.01.2023 more code rework (_DbLog_SBP_onRun_checkDiscDelpars) and others, use dbh quote in _DbLog_SBP_onRun_LogBulk ".
"5.5.11" => "09.01.2023 more code rework / structured subroutines ",
"5.5.10" => "07.01.2023 more code rework (_DbLog_SBP_checkDiscDelpars) and others, use dbh quote in _DbLog_SBP_onRun_LogBulk ".
"configCheck changed to use only one db connect + measuring the connection time, universal DBHU ",
"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 ",
@ -84,7 +85,7 @@ my %DbLog_vNotesIntern = (
"4.9.7" => "13.01.2020 change datetime pattern in valueFn of DbLog_addCacheLine. Forum: #107285 ",
"4.9.6" => "04.01.2020 fix change off 4.9.4 in default splitting. Forum: #106992 ",
"4.9.5" => "01.01.2020 do not reopen database connection if device is disabled (fix) ",
"4.9.4" => "08.01.2023 all version informationen deleted from v 1.8.1 to v 4.9.4 ",
"4.9.4" => "08.01.2023 all version informationen from v 1.8.1 to v 4.9.4 deleted ",
"1.7.1" => "15.12.2016 initial rework "
);
@ -2104,7 +2105,6 @@ sub DbLog_SBP_onRun {
my $error = q{};
my $doNext = 0;
my $dbh;
my $ret;
## Vorbereitungen
@ -2113,7 +2113,7 @@ sub DbLog_SBP_onRun {
$attr{$name}{verbose} = $verbose if(defined $verbose); # verbose Level übergeben
my $bst = [gettimeofday]; # Background-Startzeit
# prüfen ob Datenbankverbindung beendet werden soll
$doNext = _DbLog_SBP_onRun_checkDiscDelpars ({ subprocess => $subprocess,
$doNext = _DbLog_SBP_checkDiscDelpars ({ subprocess => $subprocess,
name => $name,
memc => $memc,
store => $store
@ -2188,83 +2188,20 @@ sub DbLog_SBP_onRun {
## Verbindungsaufbau Datenbank
################################
my $isNew = 0; # wurde Database Handle neu erstellt ?
my $params = { name => $name,
dbconn => $store->{dbparams}{dbconn},
dbname => $store->{dbparams}{dbname},
dbuser => $store->{dbparams}{dbuser},
dbpassword => $store->{dbparams}{dbpassword},
utf8 => $store->{dbparams}{utf8},
useac => $useac,
model => $store->{dbparams}{model},
sltjm => $store->{dbparams}{sltjm},
sltcs => $store->{dbparams}{sltcs},
cofaults => $store->{dbparams}{cofaults}
};
if (!defined $store->{dbh}) {
($error, $dbh) = _DbLog_SBP_onRun_connectDB ($params);
if ($error) {
Log3 ($name, 4, "DbLog $name - Database Connection impossible. Transferred data is returned to the cache.");
$ret = {
$doNext = _DbLog_SBP_manageDBconnect ({ subprocess => $subprocess,
name => $name,
msg => $error,
ot => 0,
oper => $operation,
rowlback => $cdata # Rückgabe aller übergebenen Log-Daten
};
memc => $memc,
store => $store,
operation => $operation,
useac => $useac
}
);
$store->{dbparams}{cofaults}++;
__DbLog_SBP_sendToParent ($subprocess, $ret);
if ($doNext) {
_DbLog_SBP_doWait (1000000);
next;
}
$store->{dbparams}{cofaults} = 0;
$isNew = 1;
$store->{dbh} = $dbh;
Log3 ($name, 3, "DbLog $name - SubProcess connected to $store->{dbparams}{dbname}");
}
$dbh = $store->{dbh};
if (!$isNew) { # kein neuer Database Handle
my $bool = _DbLog_SBP_pingDB ($name, $dbh);
if (!$bool) { # DB Session dead
delete $store->{dbh};
Log3 ($name, 4, "DbLog $name - Database Connection dead. Try reconnect ...");
($error, $dbh) = _DbLog_SBP_onRun_connectDB ($params);
if ($error) {
Log3 ($name, 4, "DbLog $name - Database Connection impossible. Transferred data is returned to the cache.");
$ret = {
name => $name,
msg => $error,
ot => 0,
oper => $operation,
rowlback => $cdata # Rückgabe aller übergebenen Log-Daten
};
$store->{dbparams}{cofaults}++;
__DbLog_SBP_sendToParent ($subprocess, $ret);
_DbLog_SBP_doWait (1000000);
next;
}
$store->{dbparams}{cofaults} = 0;
$store->{dbh} = $dbh;
}
}
## Event Logging
#########################################################
if ($operation =~ /log_/xs) {
@ -2366,7 +2303,7 @@ return;
# prüfen ob Datenbankverbindung beendet werden soll und ob die
# gespeicherten Verbindungsparameter gelöscht werden sollen
###################################################################################
sub _DbLog_SBP_onRun_checkDiscDelpars {
sub _DbLog_SBP_checkDiscDelpars {
my $paref = shift;
my $subprocess = $paref->{subprocess};
@ -2423,17 +2360,104 @@ sub _DbLog_SBP_doWait {
return;
}
#################################################################
# Datenbank Ping
#################################################################
sub _DbLog_SBP_pingDB {
my $name = shift;
my $dbh = shift;
###################################################################################
# Verbindungsmanagement Datenbank
###################################################################################
sub _DbLog_SBP_manageDBconnect {
my $paref = shift;
my $bool;
eval { $bool = $dbh->ping; };
my $subprocess = $paref->{subprocess};
my $name = $paref->{name};
my $memc = $paref->{memc};
my $store = $paref->{store}; # Datenspeicher
my $useac = $paref->{useac};
my $operation = $paref->{operation};
return $bool;
my $isNew = 0; # wurde Database Handle neu erstellt ?
my $doNext = 0;
my ($err, $dbh, $ret);
my $params = { name => $name,
dbconn => $store->{dbparams}{dbconn},
dbname => $store->{dbparams}{dbname},
dbuser => $store->{dbparams}{dbuser},
dbpassword => $store->{dbparams}{dbpassword},
utf8 => $store->{dbparams}{utf8},
useac => $useac,
model => $store->{dbparams}{model},
sltjm => $store->{dbparams}{sltjm},
sltcs => $store->{dbparams}{sltcs},
cofaults => $store->{dbparams}{cofaults}
};
if (!defined $store->{dbh}) {
($err, $dbh) = _DbLog_SBP_connectDB ($params);
if ($err) {
Log3 ($name, 4, "DbLog $name - Database Connection impossible. Transferred data is returned to the cache.");
$ret = {
name => $name,
msg => $err,
ot => 0,
oper => $operation,
rowlback => $memc->{cdata} # Rückgabe aller übergebenen Log-Daten
};
$doNext = 1;
$store->{dbparams}{cofaults}++;
__DbLog_SBP_sendToParent ($subprocess, $ret);
return $doNext;
}
$store->{dbparams}{cofaults} = 0;
$isNew = 1;
$store->{dbh} = $dbh;
Log3 ($name, 3, "DbLog $name - SubProcess connected to $store->{dbparams}{dbname}");
}
$dbh = $store->{dbh};
if (!$isNew) { # kein neuer Database Handle
my $bool = _DbLog_SBP_pingDB ($name, $dbh);
if (!$bool) { # DB Session dead
delete $store->{dbh};
Log3 ($name, 4, "DbLog $name - Database Connection dead. Try reconnect ...");
($err, $dbh) = _DbLog_SBP_connectDB ($params);
if ($err) {
Log3 ($name, 4, "DbLog $name - Database Reconnect impossible. Transferred data is returned to the cache.");
$ret = {
name => $name,
msg => $err,
ot => 0,
oper => $operation,
rowlback => $memc->{cdata} # Rückgabe aller übergebenen Log-Daten
};
$doNext = 1;
$store->{dbparams}{cofaults}++;
__DbLog_SBP_sendToParent ($subprocess, $ret);
return $doNext;
}
$store->{dbparams}{cofaults} = 0;
$store->{dbh} = $dbh;
}
}
return $doNext;
}
###################################################################################
@ -2445,7 +2469,7 @@ return $bool;
# (which typically results in errors being printed to the screen
# when encountered)
###################################################################################
sub _DbLog_SBP_onRun_connectDB {
sub _DbLog_SBP_connectDB {
my $paref = shift;
my $name = $paref->{name};
@ -2529,6 +2553,44 @@ sub _DbLog_SBP_onRun_connectDB {
return ($err, $dbh);
}
############################################################################
# Datenbank Ping
# ohne alarm (timeout) bleibt ping hängen wenn DB nicht
# errichbar ist
# https://perldoc.perl.org/functions/alarm
#
# andere: Variante (hat nicht funktioniert):
# local $SIG{ALRM} = sub { die "Timeout\n" };
# -> https://blogs.perl.org/users/leon_timmermans/2012/01/what-you-should-know-about-signal-based-timeouts.html
############################################################################
sub _DbLog_SBP_pingDB {
my $name = shift;
my $dbh = shift;
my $to = shift // 10;
my $bool;
eval {
POSIX::sigaction(SIGALRM, POSIX::SigAction->new(sub {die "Timeout"}));
alarm $to;
eval { $bool = $dbh->ping;
};
alarm 0;
if ($@ && $@ =~ /Timeout/xs) {
Log3 ($name, 2, "DbLog $name - Database Ping Timeout of >$to seconds< reached");
}
};
alarm 0; # Schutz vor Race Condition
return $bool;
}
#################################################################
# SubProcess - Log-Routine
# Bulk-Insert
@ -4863,7 +4925,7 @@ sub _DbLog_getNewDBHandle {
};
my ($error, $dbh) = _DbLog_SBP_onRun_connectDB ($params);
my ($error, $dbh) = _DbLog_SBP_connectDB ($params);
return $dbh if(!$error);
@ -4897,7 +4959,9 @@ sub _DbLog_prepExecQueryOnly {
@sr = $sth->fetchrow_array;
no warnings 'uninitialized';
Log3 ($name, 4, "DbLog $name - SQL result: ".join ' ', @sr);
use warnings;
return ($err, @sr);
}