X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FLXDebug.pm;h=6517d9c4c3f4806fe07384b5c519c284599e62b3;hb=dbda14c263efd93aca3b7114015a47d86b8581e3;hp=2f80caccda5fd4e76d6349d851052d19c6fc9034;hpb=c90d35589e7281211481bf9dace5163fe115bff3;p=kivitendo-erp.git diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm index 2f80caccd..6517d9c4c 100644 --- a/SL/LXDebug.pm +++ b/SL/LXDebug.pm @@ -8,34 +8,29 @@ 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 WARN => 1 << 7; -use constant TRACE2 => 1 << 8; -use constant ALL => (1 << 9) - 1; +use constant REQUEST => 1 << 7; +use constant WARN => 1 << 8; +use constant TRACE2 => 1 << 9; +use constant ALL => (1 << 10) - 1; use constant DEVEL => INFO | DEBUG1 | QUERY | TRACE | BACKTRACE_ON_ERROR | REQUEST_TIMER; use constant FILE_TARGET => 0; use constant STDERR_TARGET => 1; +use Data::Dumper; use POSIX qw(strftime getppid); use Time::HiRes qw(gettimeofday tv_interval); use YAML; +use SL::Request (); use strict; -my ($data_dumper_available, $text_diff_available); +my ($text_diff_available); -our $global_level; -our $watch_form; +our $global_level = NONE(); +our $watch_form = 0; our $file_name; -BEGIN { - eval("use Data::Dumper"); - $data_dumper_available = $@ ? 0 : 1; - - $global_level = NONE; - $watch_form = 0; -} - sub new { my $type = shift; my $self = {}; @@ -119,7 +114,7 @@ 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 : ''; + my $time = $self->want_request_timer ? $self->get_request_time || '' : ''; if (!defined($package)) { $self->_write('sub' . $level, $indent . "/ $time top-level?\n"); @@ -157,33 +152,31 @@ sub warn { } 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 ($self, $level, $name, $variable, %options) = @_; - my $dumper = Data::Dumper->new([$variable]); - $dumper->Sortkeys(1); - $self->message($level, "dumping ${name}:\n" . $dumper->Dump()); + my $password; + if ($variable && ('Form' eq ref $variable) && defined $variable->{password}) { + $password = $variable->{password}; + $variable->{password} = 'X' x 8; + } - $variable->{password} = $password if (defined $password); + my $dumper = Data::Dumper->new([$variable]); + $dumper->Sortkeys(1); + $dumper->Indent(2); + $dumper->$_($options{$_}) for keys %options; + my $output = $dumper->Dump(); + $self->message($level, "dumping ${name}:\n" . $output); - # 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 }; - } + $variable->{password} = $password if (defined $password); - } else { - $self->message($level, - "dumping ${name}: Data::Dumper not available; " - . "variable cannot be dumped"); + # 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 }; } + + return $output; } sub dump_yaml { @@ -260,14 +253,19 @@ sub _write { local *FILE; chomp($message); + $self->_write_raw("${date}${message}\n"); +} +sub _write_raw { + my ($self, $message) = @_; + local *FILE; if ((FILE_TARGET == $self->{"target"}) && open(FILE, ">>", $self->{"file"})) { - print(FILE "${date}${message}\n"); - close(FILE); + print FILE $message; + close FILE; } elsif (STDERR_TARGET == $self->{"target"}) { - print(STDERR "${date}${message}\n"); + print STDERR $message; } } @@ -331,6 +329,44 @@ sub level_by_name { return $global_level & $self->_by_name($level); } +sub is_request_logging_enabled { + my ($self) = @_; + return $global_level & REQUEST; +} + +sub add_request_params { + my ($self, $key, $value) = @_; + return unless $self->is_request_logging_enabled; + return if $key =~ /password/; + + push @{ $::request->{debug}{PARAMS} ||= [] }, [ $key => $value ]; +} + +sub log_request { + my ($self, $type, $controller, $action) = @_; + return unless $self->is_request_logging_enabled; + + my $session_id = $::auth->create_or_refresh_session; + + my $template = <_write('Request', $template); + + my $params = join "\n ", map { + "$_->[0] = $_->[1]" + } @{ $::request->{debug}{PARAMS} || [] }; + + $self->_write_raw(< at the earliest possible moment. @@ -418,7 +454,7 @@ Shortcut for C. =head1 CONFIGURATION C gets its configuration from the C<[debug]> section of -the C configuration file. The available options +the C configuration file. The available options are: =over 4 @@ -453,32 +489,6 @@ following would not trigger a change: # This does trigger: $::form->{some_hash} = { something => 'else' }; -=item C - -A boolean (C<1> or C<0>). If turned on then certain debug facilities -are available from the v1 menu. These include e.g. - -=over 6 - -=item * - -restarting the FastCGI process by forcefully exiting after the -request, - -=item * - -enabling and disabling function tracing, - -=item * - -enabling and disabling certain debug levels. - -=back - -Note that these are only useful if Lx-Office is running as a FastCGI -application because otherwise the changes would be lost when the -process exits in a normal CGI environment. - =item C A boolean (C<1> or C<0>). If turned on then certain temporary files