Revision e7191bc2
Von Moritz Bunkus vor mehr als 17 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 132 | 132 |
|
| 133 | 133 |
my $self = {};
|
| 134 | 134 |
|
| 135 |
if ($LXDebug::watch_form) {
|
|
| 136 |
require SL::Watchdog; |
|
| 137 |
tie %{ $self }, 'SL::Watchdog';
|
|
| 138 |
} |
|
| 139 |
|
|
| 135 | 140 |
read(STDIN, $_, $ENV{CONTENT_LENGTH});
|
| 136 | 141 |
|
| 137 | 142 |
if ($ENV{QUERY_STRING}) {
|
| SL/LXDebug.pm | ||
|---|---|---|
| 15 | 15 |
|
| 16 | 16 |
my $data_dumper_available; |
| 17 | 17 |
|
| 18 |
our $global_level; |
|
| 19 |
our $watch_form; |
|
| 20 |
|
|
| 18 | 21 |
BEGIN {
|
| 19 | 22 |
eval("use Data::Dumper");
|
| 20 | 23 |
$data_dumper_available = $@ ? 0 : 1; |
| 21 | 24 |
|
| 22 | 25 |
$global_level = NONE; |
| 26 |
$watch_form = 0; |
|
| 23 | 27 |
} |
| 24 | 28 |
|
| 25 | 29 |
sub new {
|
| ... | ... | |
| 30 | 34 |
$self->{"file"} = "/tmp/lx-office-debug.log";
|
| 31 | 35 |
$self->{"target"} = FILE_TARGET;
|
| 32 | 36 |
$self->{"level"} = 0;
|
| 33 |
$self->{"watchedvars"} = {};
|
|
| 34 | 37 |
|
| 35 | 38 |
while ($_[0]) {
|
| 36 | 39 |
$self->{ $_[0] } = $_[1];
|
| ... | ... | |
| 57 | 60 |
my ($self, $level) = @_; |
| 58 | 61 |
$level *= 1; |
| 59 | 62 |
|
| 60 |
$self->check_watched_form_variables(); |
|
| 61 |
|
|
| 62 | 63 |
return 1 unless ($global_level & TRACE); # ignore if traces aren't active |
| 63 | 64 |
return 1 if $level && !($global_level & $level); # ignore if level of trace isn't active |
| 64 | 65 |
|
| ... | ... | |
| 82 | 83 |
my ($self, $level) = @_; |
| 83 | 84 |
$level *= 1; |
| 84 | 85 |
|
| 85 |
$self->check_watched_form_variables(); |
|
| 86 |
|
|
| 87 | 86 |
return 1 unless ($global_level & TRACE); # ignore if traces aren't active |
| 88 | 87 |
return 1 if $level && !($global_level & $level); # ignore if level of trace isn't active |
| 89 | 88 |
|
| ... | ... | |
| 103 | 102 |
sub message {
|
| 104 | 103 |
my ($self, $level, $message) = @_; |
| 105 | 104 |
|
| 106 |
$self->check_watched_form_variables(); |
|
| 107 | 105 |
$self->_write(level2string($level), $message) if (($self->{"level"} | $global_level) & $level || !$level);
|
| 108 | 106 |
} |
| 109 | 107 |
|
| ... | ... | |
| 151 | 149 |
join '/', qw(info debug1 debug2 query trace)[ grep { (reverse split //, sprintf "%05b", $_[0])[$_] } 0..4 ]
|
| 152 | 150 |
} |
| 153 | 151 |
|
| 154 |
sub watch_form_variable {
|
|
| 155 |
my ($self, $var) = @_; |
|
| 156 |
|
|
| 157 |
$self->{"watchedvars"}->{$var} = $main::form->{$var};
|
|
| 158 |
$self->_write("WATCH", "Adding \$form->{$var} with current value \"$main::form->{$var}\"");
|
|
| 159 |
} |
|
| 160 |
|
|
| 161 |
sub check_watched_form_variables {
|
|
| 162 |
my ($self) = @_; |
|
| 163 |
|
|
| 164 |
return unless $main::form; |
|
| 165 |
|
|
| 166 |
foreach my $var (sort(keys(%{ $self->{"watchedvars"} }))) {
|
|
| 167 |
if ($main::form->{$var} ne $self->{"watchedvars"}->{$var}) {
|
|
| 168 |
$self->_write("WATCH", "Variable \$form->{$var} changed from \"" .
|
|
| 169 |
$self->{"watchedvars"}->{$var} . "\" to \"" .
|
|
| 170 |
$main::form->{$var} . "\"");
|
|
| 171 |
$self->{"watchedvars"}->{$var} = $main::form->{$var};
|
|
| 172 |
} |
|
| 173 |
} |
|
| 174 |
} |
|
| 175 |
|
|
| 176 | 152 |
1; |
| 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 |
} |
|
| 34 |
|
|
| 35 |
$this->{$key} = $value;
|
|
| 36 |
} |
|
| 37 |
|
|
| 38 |
1; |
|
| lx-erp.conf | ||
|---|---|---|
| 1 | 1 |
use Cwd; |
| 2 |
use vars qw($userspath $spool $memberfile $templates $sendmail $language $sid $latex $eur $webdav $lizenzen $jscalendar); |
|
| 2 |
use vars qw($userspath $spool $memberfile $templates $sendmail $language $sid $latex $eur $webdav $lizenzen $jscalendar $watch_form_variables);
|
|
| 3 | 3 |
|
| 4 | 4 |
# path to user configuration files |
| 5 | 5 |
$userspath = "users"; |
| ... | ... | |
| 81 | 81 |
# |
| 82 | 82 |
# Beipiel: |
| 83 | 83 |
# $LXDebug::global_level = LXDebug::TRACE | LXDebug::QUERY; |
| 84 |
$LXDebug::global_level = LXDebug::ALL; |
|
| 84 |
$LXDebug::global_level = LXDebug::NONE; |
|
| 85 |
|
|
| 86 |
# ?berwachung der Inhalte von $form aktiviert oder nicht? Wenn ja, |
|
| 87 |
# dann k?nnen einzelne Variablen mit |
|
| 88 |
# $form->{"Watchdog::<variablenname>"} = 1;
|
|
| 89 |
# ?berwacht werden. Bedeutet aber auch einen Geschwindigkeitsverlust, |
|
| 90 |
# weshalb sie normalerweise deaktiviert ist. |
|
| 91 |
$LXDebug::watch_form = 0; |
|
| 85 | 92 |
|
| 86 | 93 |
1; |
| 87 | 94 |
|
Auch abrufbar als: Unified diff
Den zuletzt implementierten Mechanismus entfernt, um $form-Variablen zu überwachen, und dafür einen neuen Mechanismus implementiert, der auf tie basiert. Dadurch ist es möglich, immer die exakte Zeilennummer zu erfahren, in der eine Variable geändert wird.