X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FLXDebug.pm;h=e3778d44fd9f9d6e0684d7c0e35cbb783b7cd089;hb=bb578fc435b512f24dd72935796c3f8e925d7134;hp=87bfd7f7cb40d0649fc18577a0efe871a1b743b7;hpb=c4c2f760ece99afd4738c28ce17e635a4f24d102;p=kivitendo-erp.git diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm index 87bfd7f7c..e3778d44f 100644 --- a/SL/LXDebug.pm +++ b/SL/LXDebug.pm @@ -1,25 +1,30 @@ package LXDebug; -use constant NONE => 0; -use constant INFO => 1; -use constant DEBUG1 => 2; -use constant DEBUG2 => 4; -use constant QUERY => 8; -use constant TRACE => 16; -use constant BACKTRACE_ON_ERROR => 32; -use constant ALL => 63; +use constant NONE => 0; +use constant INFO => 1; +use constant DEBUG1 => 1 << 1; +use constant DEBUG2 => 1 << 2; +use constant QUERY => 1 << 3; +use constant TRACE => 1 << 4; +use constant BACKTRACE_ON_ERROR => 1 << 5; +use constant REQUEST_TIMER => 1 << 6; +use constant ALL => (1 << 7) - 1; +use constant DEVEL => INFO | QUERY | TRACE | BACKTRACE_ON_ERROR | REQUEST_TIMER; use constant FILE_TARGET => 0; use constant STDERR_TARGET => 1; -use POSIX qw(strftime); - +use POSIX qw(strftime getppid); +use Time::HiRes qw(gettimeofday tv_interval); use YAML; +use strict; + my $data_dumper_available; our $global_level; our $watch_form; +our $file_name; BEGIN { eval("use Data::Dumper"); @@ -34,7 +39,7 @@ sub new { my $self = {}; $self->{"calldepth"} = 0; - $self->{"file"} = "/tmp/lx-office-debug.log"; + $self->{"file"} = $file_name || "/tmp/lx-office-debug.log"; $self->{"target"} = FILE_TARGET; $self->{"level"} = 0; @@ -70,12 +75,13 @@ sub enter_sub { my ($dummy1, $self_filename, $self_line) = caller(0); my $indent = " " x $self->{"calldepth"}++; + my $time = $self->get_request_time || ''; if (!defined($package)) { - $self->_write('sub' . $level, $indent . "\\ top-level?\n"); + $self->_write('sub' . $level, $indent . "\\ $time top-level?\n"); } else { $self->_write('sub' . $level, $indent - . "\\ ${subroutine} in " + . "\\ $time ${subroutine} in " . "${self_filename}:${self_line} called from " . "${filename}:${line}\n"); } @@ -93,19 +99,20 @@ sub leave_sub { my ($dummy1, $self_filename, $self_line) = caller(0); my $indent = " " x --$self->{"calldepth"}; + my $time = $self->want_request_timer ? $self->get_request_time : ''; if (!defined($package)) { - $self->_write('sub' . $level, $indent . "/ top-level?\n"); + $self->_write('sub' . $level, $indent . "/ $time top-level?\n"); } else { - $self->_write('sub' . $level, $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n"); + $self->_write('sub' . $level, $indent . "/ $time ${subroutine} in " . "${self_filename}:${self_line}\n"); } return 1; } sub show_backtrace { - my ($self) = @_; + my ($self, $force) = @_; - return 1 unless ($global_level & BACKTRACE_ON_ERROR); + return 1 unless ($force || ($global_level & BACKTRACE_ON_ERROR)); $self->message(BACKTRACE_ON_ERROR, "Starting full caller dump:"); my $level = 0; @@ -127,9 +134,25 @@ sub dump { my ($self, $level, $name, $variable) = @_; if ($data_dumper_available) { + my $password; + if ($variable && ('Form' eq ref $variable) && defined $variable->{password}) { + $password = $variable->{password}; + $variable->{password} = 'X' x 8; + } + my $dumper = Data::Dumper->new([$variable]); $dumper->Sortkeys(1); $self->message($level, "dumping ${name}:\n" . $dumper->Dump()); + + $variable->{password} = $password if (defined $password); + + # Data::Dumper does not reset the iterator belonging to this hash + # if 'Sortkeys' is true. Therefore clear the iterator manually. + # See "perldoc -f each". + if ($variable && (('HASH' eq ref $variable) || ('Form' eq ref $variable))) { + keys %{ $variable }; + } + } else { $self->message($level, "dumping ${name}: Data::Dumper not available; " @@ -151,23 +174,16 @@ sub dump_sql_result { return; } - my %column_lengths; - my $first_row = 1; + my %column_lengths = map { $_, length $_ } keys %{ $results->[0] }; foreach my $row (@{ $results }) { - if ($first_row) { - map { $column_lengths{$_} = length $_ } keys %{ $row }; - $first_row = 0; - } - map { $column_lengths{$_} = length $row->{$_} if (length $row->{$_} > $column_lengths{$_}) } keys %{ $row }; } my @sorted_names = sort keys %column_lengths; my $format = join '|', map { '%' . $column_lengths{$_} . 's' } @sorted_names; - $prefix =~ s|\s*$||; - $prefix .= ' ' if $prefix; + $prefix .= ' ' if $prefix; $self->message($level, $prefix . sprintf($format, @sorted_names)); $self->message($level, $prefix . join('+', map { '-' x $column_lengths{$_} } @sorted_names)); @@ -180,17 +196,22 @@ sub dump_sql_result { sub enable_sub_tracing { my ($self) = @_; - $self->{level} | TRACE; + $global_level |= TRACE; } sub disable_sub_tracing { my ($self) = @_; - $self->{level} & ~ TRACE; + $global_level &= ~ TRACE; +} + +sub is_tracing_enabled { + my ($self) = @_; + return $global_level & TRACE; } sub _write { my ($self, $prefix, $message) = @_; - my $date = strftime("%Y-%m-%d %H:%M:%S $$ ${prefix}: ", localtime(time())); + my $date = strftime("%Y-%m-%d %H:%M:%S $$ [" . getppid() . "] ${prefix}: ", localtime(time())); local *FILE; chomp($message); @@ -210,4 +231,38 @@ sub level2string { join '/', qw(info debug1 debug2 query trace error_call_trace)[ grep { (reverse split //, sprintf "%05b", $_[0])[$_] } 0..5 ] } +sub begin_request { + my $self = shift; + return 1 unless want_request_timer(); + $self->set_request_timer; +} + +sub end_request { + my $self = shift; + return 1 unless want_request_timer(); + $self->_write("time", $self->get_request_time); + + $self->{calldepth} = 0; +} + +sub log_time { + my $self = shift; + return 1 unless want_request_timer(); + $self->_write("time", $self->get_request_time); +} + +sub get_request_time { + my $self = shift; + return $self->want_request_timer && $self->{request_start} ? tv_interval($self->{request_start}) : undef; +} + +sub set_request_timer { + my $self = shift; + $self->{request_start} = [gettimeofday]; +} + +sub want_request_timer { + $global_level & REQUEST_TIMER; +} + 1;