diff --git a/lib/Plack/Middleware/Debug/Logger.pm b/lib/Plack/Middleware/Debug/Logger.pm new file mode 100644 index 000000000..d1fea0017 --- /dev/null +++ b/lib/Plack/Middleware/Debug/Logger.pm @@ -0,0 +1,45 @@ +package Plack::Middleware::Debug::Logger; +use 5.008; +use strict; +use warnings; +use parent qw(Plack::Middleware::Debug::Base); +use Sub::Uplevel (); +our $VERSION = '0.07'; + +sub run { + my ($self, $env, $panel) = @_; + + my $wrap_logger = $env->{'psgix.logger'}; + my %output; + $env->{'psgix.logger'} = sub { + my ($args) = @_; + my $caller = (caller(1))[3] . '[' . (caller(0))[2] . '] '; + my $message = $args->{message}; + $message =~ s/\n\s*/\n /msxg; + $message =~ s/\n?\z/\n/msx; + $output{lc $args->{level}} ||= ''; + $output{lc $args->{level}} .= $caller . $message; + if ($wrap_logger) { + Sub::Uplevel::uplevel 1, $wrap_logger, @_; + } + }; + + return sub { + my $res = shift; + + if ($wrap_logger) { + $env->{'psgix.logger'} = $wrap_logger; + } + my $content = ''; + for my $level ( qw(info debug warn error fatal) ) { + if ($output{$level}) { + $content .= "

\u$level

"; + $content .= '
' . $self->render_lines($output{$level}) . '
'; + } + } + $panel->content($content); + }; +} + +1; + diff --git a/lib/Plack/Middleware/Debug/MySQLTrace.pm b/lib/Plack/Middleware/Debug/MySQLTrace.pm new file mode 100644 index 000000000..3e936b4de --- /dev/null +++ b/lib/Plack/Middleware/Debug/MySQLTrace.pm @@ -0,0 +1,103 @@ +package Plack::Middleware::Debug::MySQLTrace; +use 5.008; +use strict; +use warnings; +use parent qw(Plack::Middleware::Debug::Base); +use Plack::Util::Accessor qw(skip_packages); +use Sub::Uplevel (); +our $VERSION = '0.07'; + +sub run { + my($self, $env, $panel) = @_; + + my $old_trace; + my @output; + my $queries = 0; + if (defined &DBI::trace) { + $old_trace = DBI->trace; + open my $trace_handle, '>:via(Plack::Middleware::Debug::MySQLTrace::IO)', { + skip_packages => $self->skip_packages, + logger => sub { + my $sql = shift; + $sql =~ s/\s+\z//; + $sql =~ s/\A\s+//; + $queries++; + push @output, sprintf('%s - %s[%s]', $queries, (caller 1)[3], (caller 0)[2]), $sql; + }, + }; + DBI->trace('2,SQL', $trace_handle); + } + else { + return $panel->disable; + } + + return sub { + my $res = shift; + + if (defined $old_trace) { + DBI->trace($old_trace); + $panel->title('MySQL Trace'); + $panel->nav_title('MySQL Trace'); + $panel->nav_subtitle($queries . ' Queries'); + $panel->content('
' . $self->render_list_pairs(\@output) . '
'); + } + }; +} + +package Plack::Middleware::Debug::MySQLTrace::IO; +use strict; +use 5.008; + +our $VERSION = '0.01'; + +sub PUSHED { + my ($class, $mode, $fh) = @_; + return bless {}, $class; +} + +sub OPEN { + my ($self, $logger, $mode, $fh) = @_; + %$self = %$logger; + return 1; +} + +sub WRITE { + my ($self, $buf, $fh) = @_; + if ($buf =~ /\ABinding parameters: /) { + my $sql = $buf; + $sql =~ s/\ABinding parameters: //; + my $depth; + for ( $depth = 1; caller($depth); $depth++) { + my $package = caller($depth); + next + if $package =~ /\ADB[ID](?:\z|::)/; + next + if $package =~ /::(?:st|db)\z/; + next + if $self->{skip_packages} && $package =~ $self->{skip_packages}; + last; + } + + Sub::Uplevel::uplevel $depth + 1, $self->{logger}, $sql; + } + return length($buf); +} + +sub CLOSE { + my $self = shift; + return 0; +} + +1; + +__END__ + +=head1 NAME + +Plack::Middleware::Debug::MySQLTrace - DBI MySQL trace panel + +=head1 SEE ALSO + +L + +=cut diff --git a/lib/WebGUI/Middleware/Session.pm b/lib/WebGUI/Middleware/Session.pm index c123d5d22..2165e14b4 100644 --- a/lib/WebGUI/Middleware/Session.pm +++ b/lib/WebGUI/Middleware/Session.pm @@ -70,7 +70,18 @@ sub call { if ($debug) { $app = Plack::Middleware::StackTrace->wrap($app); $app = Plack::Middleware::Debug->wrap( $app, - panels => [qw(Environment Response Timer Memory Session DBITrace PerlConfig Response WgLogger)] ); + panels => [ + 'Environment', + 'Response', + 'Timer', + 'Memory', + 'Session', + 'PerlConfig', + [ 'MySQLTrace', skip_packages => qr/\AWebGUI::SQL(?:\z|::)/ ], + 'Response', + 'Logger', + ], + ); } # Turn exceptions into HTTP errors diff --git a/lib/WebGUI/Session/ErrorHandler.pm b/lib/WebGUI/Session/ErrorHandler.pm index 6e2fc5c42..9c4e24421 100644 --- a/lib/WebGUI/Session/ErrorHandler.pm +++ b/lib/WebGUI/Session/ErrorHandler.pm @@ -70,9 +70,10 @@ Whatever message you wish to insert into the log. =cut sub audit { - my $self = shift; - my $message = shift; - $self->info($self->session->user->username." (".$self->session->user->userId.") ".$message); + my $self = shift; + my $message = shift; + @_ = ($self->session->user->username." (".$self->session->user->userId.") ".$message); + goto $self->can('info'); } @@ -161,29 +162,12 @@ The message you wish to add to the log. =cut sub debug { - my $self = shift; - my $message = shift; - local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 2; - $self->getLogger->({ level => 'debug', message => $message }); - $self->{_debug_debug} .= $message."\n"; + my $self = shift; + my $message = shift; + @_ = ({ level => 'debug', message => $message }); + goto $self->getLogger; } - -#------------------------------------------------------------------- - -=head2 DESTROY ( ) - -Deconstructor. - -=cut - -sub DESTROY { - my $self = shift; - undef $self; -} - - - #------------------------------------------------------------------- =head2 error ( message ) @@ -197,12 +181,10 @@ The message you wish to add to the log. =cut sub error { - my $self = shift; - my $message = shift; - local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 2; - $self->getLogger->({ level => 'error', message => $message}); - $self->getLogger->({ level => 'debug', message => "Stack trace for ERROR ".$message."\n".$self->getStackTrace() }); - $self->{_debug_error} .= $message."\n"; + my $self = shift; + my $message = shift; + @_ = ({ level => 'error', message => $message}); + goto $self->getLogger; } @@ -219,49 +201,10 @@ The message to use. =cut sub fatal { - my $self = shift; - my $message = shift; - - local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 2; - $self->getLogger->({ level => 'fatal', message => $message }); - $self->getLogger->({ level => 'debug', message => "Stack trace for FATAL ".$message."\n".$self->getStackTrace() }); - - my $error; - if (! defined $self->session->db(1)) { - # We can't even _determine_ whether we can show the debug text. Punt. - $error = q{

Fatal Internal Error

}; - } - elsif ($self->canShowDebug()) { - my $stack = encode_entities($self->getStackTrace); - my $debug = $self->showDebug(); - $error = <WebGUI Fatal Error -

Something unexpected happened that caused this system to fault.

-

$message

-
$stack
-$debug -END_HTML - } - else { - # NOTE: You can't internationalize this because with some types of errors that would cause an infinite loop. - my $company = $self->session->setting->get("companyName"); - my $email = $self->session->setting->get("companyEmail"); - my $url = $self->session->setting->get("companyURL"); - - $error = <Problem With Request -We have encountered a problem with your request. Please use your back button and try again. -If this problem persists, please contact us with what you were trying to do and the time and date of the problem.
-
$company -
$email -
$url -END_HTML - } - - # Fatal errors cause an exception to be thrown - use WebGUI::Error::Fatal so - # that WebGUI knows to show this error message to all site users (instead of showing - # non-debug users the generic error screen) - WebGUI::Error::Fatal->throw( error => $error ); + my $self = shift; + my $message = shift; + @_ = ({ level => 'fatal', message => $message}); + goto $self->getLogger; } @@ -310,11 +253,10 @@ The message you wish to add to the log. =cut sub info { - my $self = shift; - my $message = shift; - local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 2; - $self->getLogger->({ level => 'info', message => $message }); - $self->{_debug_info} .= $message."\n"; + my $self = shift; + my $message = shift; + @_ = ({ level => 'info', message => $message}); + goto $self->getLogger; } #------------------------------------------------------------------- @@ -349,7 +291,7 @@ sub new { }; } - bless { _queryCount => 0, _session => $session, _logger => $logger }, $class; + bless { _session => $session, _logger => $logger }, $class; } #---------------------------------------------------------------------------- @@ -368,47 +310,6 @@ sub preventDebugOutput { $self->{_preventDebugOutput} = 1; } -#------------------------------------------------------------------- - -=head2 query ( sql ) - -Logs a sql statement for the debugger output. Keeps track of the #. - -=head3 sql - -A sql statement string. - -=cut - -sub query { - my $self = shift; - return unless $self->canShowDebug; # TODO - re-enable || $self->getLogger->is_debug; - my $query = shift; - my $placeholders = shift; - $self->{_queryCount}++; - my $plac; - if (defined $placeholders and ref $placeholders eq "ARRAY" && scalar(@$placeholders)) { - my @placeholders = map {ref $_ ? "$_" : $_} @$placeholders; # stringify objects - $plac = "\n with placeholders: " . JSON->new->encode(\@placeholders); - } - else { - $plac = ''; - } - my $depth = 0; - while (my ($caller) = caller(++$depth)) { - last - unless $caller eq __PACKAGE__ || $caller =~ /^WebGUI::SQL:?/; - } - - $query =~ s/^/ /gms; - $self->{_debug_debug} .= sprintf "query %d - %s(%s) :\n%s%s\n", - $self->{_queryCount}, (caller($depth + 1))[3,2], $query, $plac; - local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + $depth + 2; - $self->getLogger->({ level => 'debug', message => "query $self->{_queryCount}:\n$query$plac" }); -} - - - #------------------------------------------------------------------- =head2 security ( message ) @@ -422,10 +323,11 @@ The message you wish to add to the log. =cut sub security { - my $self = shift; - my $message = shift; - $self->warn($self->session->user->username." (".$self->session->user->userId.") connecting from " - .$self->session->env->getIp." attempted to ".$message); + my $self = shift; + my $message = shift; + @_ = ($self->session->user->username." (".$self->session->user->userId.") connecting from " + .$self->session->env->getIp." attempted to ".$message); + goto $self->can('warn'); } @@ -442,45 +344,6 @@ sub session { return $self->{_session}; } -#------------------------------------------------------------------- - -=head2 showDebug ( ) - -Creates an HTML formatted string of all internally stored debug information, warns, -errors, sql queries and form data. - -THIS METHOD IS DEPRECATED (See Plack::Middleware::Debug::WgLogger) - -=cut - -sub showDebug { - my $self = shift; - my $output = '
'; - my $text = $self->{_debug_error}; - $text = encode_entities($text); - $output .= '
'.$text."
"; - $text = $self->{_debug_warn}; - $text = encode_entities($text); - $output .= '
'.$text."
"; - $text = $self->{_debug_info}; - $text = encode_entities($text); - $output .= '
'.$text."
"; - my %form = %{ $self->session->form->paramsHashRef }; - $form{password} = "*******" - if exists $form{password}; - $form{identifier} = "*******" - if exists $form{identifier}; - $text = JSON->new->pretty->encode(\%form); - $text = encode_entities($text); - $output .= '
'.$text."
"; - $text = $self->{_debug_debug}; - $text = encode_entities($text); - $output .= '
'.$text."
"; - $output .= '
'; - return $output; -} - - #------------------------------------------------------------------- @@ -495,11 +358,10 @@ The message you wish to add to the log. =cut sub warn { - my $self = shift; - my $message = shift; - local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 2; - $self->getLogger->({ level => 'warn', message => $message }); - $self->{_debug_warn} .= $message."\n"; + my $self = shift; + my $message = shift; + @_ = ({ level => 'warn', message => $message}); + goto $self->getLogger; }