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     foreach $key (split m/[ ,]/, $key) {
  17       $watched_variables{$key} = $value;
  18       if ($value) {
  19         $main::lxdebug->_write("WATCH", "Starting to watch '$key' with current value '$this->{$key}'");
  20       } else {
  21         $main::lxdebug->_write("WATCH", "Stopping to watch '$key'");
  22       }
  23     }
  24
  25     return;
  26   }
  27
  28   if ($watched_variables{$key}
  29         && ($this->{$key} ne $value)) {
  30     my $subroutine = (caller 1)[3];
  31     my ($self_filename, $self_line) = (caller)[1, 2];
  32     $main::lxdebug->_write("WATCH",
  33                            "Value of '$key' changed from '$this->{$key}' to '$value' "
  34                              . "in ${subroutine} at ${self_filename}:${self_line}");
  35     if ($watched_variables{$key} > 1) {
  36       my $level = 1;
  37       my ($dummy, $filename, $line);
  38
  39       while (($dummy, $filename, $line, $subroutine) = caller $level) {
  40         $main::lxdebug->_write("WATCH", "  ${subroutine} from ${filename}:${line}");
  41         $level++;
  42       }
  43     }
  44   }
  45
  46   $this->{$key} = $value;
  47 }
  48
  49 sub DELETE {
  50   my ($this, $key) = @_;
  51
  52   if ($watched_variables{$key} && ($this->{$key} ne "")) {
  53     my $subroutine = (caller 1)[3];
  54     my ($self_filename, $self_line) = (caller)[1, 2];
  55     $main::lxdebug->_write("WATCH",
  56                            "Value of '$key' changed from '$this->{$key}' to '' "
  57                              . "in ${subroutine} at ${self_filename}:${self_line}");
  58     if ($watched_variables{$key} > 1) {
  59       my $level = 1;
  60       my ($dummy, $filename, $line);
  61
  62       while (($dummy, $filename, $line, $subroutine) = caller $level) {
  63         $main::lxdebug->_write("WATCH", "  ${subroutine} from ${filename}:${line}");
  64         $level++;
  65       }
  66     }
  67   }
  68
  69   delete $this->{$key};
  70 }
  71
  72 1;