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;