kivitendo/SL/Watchdog.pm @ 7b1da9c3
| e7191bc2 | Moritz Bunkus | package SL::Watchdog;
|
||
use Data::Dumper;
|
||||
require Tie::Hash;
|
||||
| 76c486e3 | Sven Schöling | our @ISA = qw(Tie::StdHash);
|
||
use strict;
|
||||
| e7191bc2 | Moritz Bunkus | |||
my %watched_variables;
|
||||
sub STORE {
|
||||
my ($this, $key, $value) = @_;
|
||||
if (substr($key, 0, 10) eq "Watchdog::") {
|
||||
substr $key, 0, 10, "";
|
||||
| a259bc65 | Moritz Bunkus | foreach $key (split m/[ ,]/, $key) {
|
||
$watched_variables{$key} = $value;
|
||||
if ($value) {
|
||||
$main::lxdebug->_write("WATCH", "Starting to watch '$key' with current value '$this->{$key}'");
|
||||
} else {
|
||||
$main::lxdebug->_write("WATCH", "Stopping to watch '$key'");
|
||||
}
|
||||
| e7191bc2 | Moritz Bunkus | }
|
||
| a259bc65 | Moritz Bunkus | return;
|
||
| e7191bc2 | Moritz Bunkus | }
|
||
if ($watched_variables{$key}
|
||||
&& ($this->{$key} ne $value)) {
|
||||
my $subroutine = (caller 1)[3];
|
||||
my ($self_filename, $self_line) = (caller)[1, 2];
|
||||
$main::lxdebug->_write("WATCH",
|
||||
"Value of '$key' changed from '$this->{$key}' to '$value' "
|
||||
. "in ${subroutine} at ${self_filename}:${self_line}");
|
||||
| e51c5028 | Moritz Bunkus | if ($watched_variables{$key} > 1) {
|
||
my $level = 1;
|
||||
my ($dummy, $filename, $line);
|
||||
while (($dummy, $filename, $line, $subroutine) = caller $level) {
|
||||
$main::lxdebug->_write("WATCH", " ${subroutine} from ${filename}:${line}");
|
||||
$level++;
|
||||
}
|
||||
}
|
||||
| e7191bc2 | Moritz Bunkus | }
|
||
$this->{$key} = $value;
|
||||
}
|
||||
| ff575015 | Moritz Bunkus | sub DELETE {
|
||
my ($this, $key) = @_;
|
||||
if ($watched_variables{$key} && ($this->{$key} ne "")) {
|
||||
my $subroutine = (caller 1)[3];
|
||||
my ($self_filename, $self_line) = (caller)[1, 2];
|
||||
$main::lxdebug->_write("WATCH",
|
||||
"Value of '$key' changed from '$this->{$key}' to '' "
|
||||
. "in ${subroutine} at ${self_filename}:${self_line}");
|
||||
if ($watched_variables{$key} > 1) {
|
||||
my $level = 1;
|
||||
my ($dummy, $filename, $line);
|
||||
while (($dummy, $filename, $line, $subroutine) = caller $level) {
|
||||
$main::lxdebug->_write("WATCH", " ${subroutine} from ${filename}:${line}");
|
||||
$level++;
|
||||
}
|
||||
}
|
||||
}
|
||||
delete $this->{$key};
|
||||
}
|
||||
| e7191bc2 | Moritz Bunkus | 1;
|