SL/Watchdog.pm

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