Pflichtenheftversion nach Ă„nderung Basisdaten invalidieren
[kivitendo-erp.git] / SL / Watchdog.pm
1 package SL::Watchdog;
2
3 use Data::Dumper;
4
5 require Tie::Hash;
6
7 our @ISA = qw(Tie::StdHash);
8
9 use strict;
10
11 my %watched_variables;
12
13 sub STORE {
14   my ($this, $key, $value) = @_;
15
16   if (substr($key, 0, 10) eq "Watchdog::") {
17     substr $key, 0, 10, "";
18     foreach $key (split m/[ ,]/, $key) {
19       $watched_variables{$key} = $value;
20       if ($value) {
21         $main::lxdebug->_write("WATCH", "Starting to watch '$key' with current value '$this->{$key}'");
22       } else {
23         $main::lxdebug->_write("WATCH", "Stopping to watch '$key'");
24       }
25     }
26
27     return;
28   }
29
30   if ($watched_variables{$key}
31         && ($this->{$key} ne $value)) {
32     my $subroutine = (caller 1)[3];
33     my ($self_filename, $self_line) = (caller)[1, 2];
34     $main::lxdebug->_write("WATCH",
35                            "Value of '$key' changed from '$this->{$key}' to '$value' "
36                              . "in ${subroutine} at ${self_filename}:${self_line}");
37     if ($watched_variables{$key} > 1) {
38       my $level = 1;
39       my ($dummy, $filename, $line);
40
41       while (($dummy, $filename, $line, $subroutine) = caller $level) {
42         $main::lxdebug->_write("WATCH", "  ${subroutine} from ${filename}:${line}");
43         $level++;
44       }
45     }
46   }
47
48   $this->{$key} = $value;
49 }
50
51 sub DELETE {
52   my ($this, $key) = @_;
53
54   if ($watched_variables{$key} && ($this->{$key} ne "")) {
55     my $subroutine = (caller 1)[3];
56     my ($self_filename, $self_line) = (caller)[1, 2];
57     $main::lxdebug->_write("WATCH",
58                            "Value of '$key' changed from '$this->{$key}' to '' "
59                              . "in ${subroutine} at ${self_filename}:${self_line}");
60     if ($watched_variables{$key} > 1) {
61       my $level = 1;
62       my ($dummy, $filename, $line);
63
64       while (($dummy, $filename, $line, $subroutine) = caller $level) {
65         $main::lxdebug->_write("WATCH", "  ${subroutine} from ${filename}:${line}");
66         $level++;
67       }
68     }
69   }
70
71   delete $this->{$key};
72 }
73
74 1;