X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FLXDebug.pm;h=43ad76a99375558c7277d9c4821b4339e865b21c;hb=d4f9d559a4a4d5e8fa2bb10be268e24634169b5e;hp=059e0ca5e653e5ea2c0018b0cce68a653bb0f668;hpb=3ac44613aaf706c083d74bee399ee445420a5f54;p=kivitendo-erp.git diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm index 059e0ca5e..43ad76a99 100644 --- a/SL/LXDebug.pm +++ b/SL/LXDebug.pm @@ -7,14 +7,15 @@ use constant DEBUG2 => 1 << 2; use constant QUERY => 1 << 3; use constant TRACE => 1 << 4; use constant BACKTRACE_ON_ERROR => 1 << 5; -use constant ALL => (1 << 6) - 1; -use constant DEVEL => INFO | QUERY | TRACE | BACKTRACE_ON_ERROR; +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; @@ -23,6 +24,7 @@ my $data_dumper_available; our $global_level; our $watch_form; +our $file_name; BEGIN { eval("use Data::Dumper"); @@ -37,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; @@ -73,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"); } @@ -96,11 +99,12 @@ 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; } @@ -192,22 +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 $self->{level} & TRACE; + 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); @@ -227,4 +231,32 @@ 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 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;