diff --git a/lib/Plack/Middleware/Debug/Logger.pm b/lib/Plack/Middleware/Debug/Logger.pm index d1fea0017..4cd3efe2e 100644 --- a/lib/Plack/Middleware/Debug/Logger.pm +++ b/lib/Plack/Middleware/Debug/Logger.pm @@ -3,41 +3,34 @@ 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; + my $logger = $env->{'psgix.logger'}; + + my $log_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, @_; + push @$log_output, $args->{level} => $caller . $message; + if ($logger) { + goto $logger; } }; return sub { my $res = shift; - if ($wrap_logger) { - $env->{'psgix.logger'} = $wrap_logger; + if ($logger) { + $env->{'psgix.logger'} = $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->nav_subtitle(scalar @$log_output / 2 . ' messages'); + if (@$log_output) { + $panel->content('
' . $self->render_list_pairs( $log_output ) . '
'); } - $panel->content($content); }; } diff --git a/lib/WebGUI/Middleware/Session.pm b/lib/WebGUI/Middleware/Session.pm index 2165e14b4..b05c28d00 100644 --- a/lib/WebGUI/Middleware/Session.pm +++ b/lib/WebGUI/Middleware/Session.pm @@ -3,6 +3,7 @@ use strict; use parent qw(Plack::Middleware); use WebGUI::Config; use WebGUI::Session; +use WebGUI::Utility (); use Try::Tiny; use Plack::Middleware::StackTrace; use Plack::Middleware::Debug; @@ -37,7 +38,7 @@ sub call { weaken $self->{config}; my $config = $self->config or die 'Mandatory config parameter missing'; - + # Logger fallback if (!$env->{'psgix.logger'}) { $app = Plack::Middleware::SimpleLogger->wrap( $app ); @@ -66,7 +67,7 @@ sub call { # Perhaps I'm being paranoid.. weaken $session->{_config}; - my $debug = $session->log->canShowDebug; + my $debug = $self->canShowDebug($env); if ($debug) { $app = Plack::Middleware::StackTrace->wrap($app); $app = Plack::Middleware::Debug->wrap( $app, @@ -112,4 +113,22 @@ sub call { ); } +sub canShowDebug { + my $self = shift; + my $env = shift; + my $session = $env->{'webgui.session'}; + + my $canShow = $session->setting->get("showDebug"); + return + unless $canShow; + + my $ips = $session->setting->get('ipDebug'); + return 1 + if $ips eq ''; + $ips =~ s/\s+//g; + my @ips = split /,/, $ips; + my $ok = WebGUI::Utility::isInSubnet($session->env->getIp, [ @ips ] ); + return $ok; +} + 1; diff --git a/lib/WebGUI/Session/ErrorHandler.pm b/lib/WebGUI/Session/ErrorHandler.pm index 96f6a4dd6..8fa2f454d 100644 --- a/lib/WebGUI/Session/ErrorHandler.pm +++ b/lib/WebGUI/Session/ErrorHandler.pm @@ -76,64 +76,6 @@ sub audit { goto $self->can('info'); } - -#------------------------------------------------------------------- - -=head2 canShowBasedOnIP ( $ipSetting ) - -Returns true if the the user's IP address matches the requested IP setting. - -=head3 ipSetting - -The setting to pull from the database. It should containt a CSV list of IP -addresses in CIDR format. - -=cut - -sub canShowBasedOnIP { - my $self = shift; - my $ipSetting = shift; - return 0 unless $ipSetting; - return 1 if ($self->session->setting->get($ipSetting) eq ""); - my $ips = $self->session->setting->get($ipSetting); - $ips =~ s/\s+//g; - my @ips = split(",", $ips); - my $ok = WebGUI::Utility::isInSubnet($self->session->env->getIp, [ @ips] ); - return $ok; -} - -#------------------------------------------------------------------- - -=head2 canShowDebug ( ) - -Returns true if the user meets the condition to see debugging information and debug mode is enabled. -This method caches its value, so long processes may need to manually clear the cached in $self->{_canShowDebug}. - -=cut - -sub canShowDebug { - my $self = shift; - - # if we have a cached false value, we can use it - # true values need additional checks - if (exists $self->{_canShowDebug} && !$self->{_canShowDebug}) { - return 0; - } - - ##This check prevents in infinite loop during startup. - return 0 unless ($self->session->hasSettings); - - # Allow programmers to stop debugging output for certain requests - return 0 if $self->{_preventDebugOutput}; - - my $canShow = $self->session->setting->get("showDebug") - && $self->canShowBasedOnIP('debugIp'); - $self->{_canShowDebug} = $canShow; - - return $canShow - && substr($self->session->http->getMimeType(),0,9) eq "text/html"; -} - #------------------------------------------------------------------- =head2 canShowPerformanceIndicators ( ) @@ -217,47 +159,9 @@ Returns a reference to the logger. =cut sub getLogger { - my $self = shift; - if (my $req = $self->session->request) { - my $logger = $req->logger; - return $logger - if $logger; - } - - # Thanks to Plack, wG has been decoupled from Log4Perl - # However when called outside a web context, we currently still fall back to Log4perl - # (pending a better idea) - Log::Log4perl->init_once( $self->session->config->getWebguiRoot . "/etc/log.conf" ); - my $log4perl = Log::Log4perl->get_logger( $self->session->config->getFilename ); - sub { - my $args = shift; - my $level = $args->{level}; - $log4perl->$level( $args->{message} ); - }; + $_[0]->{_logger}; } - -#------------------------------------------------------------------- - -=head2 getStackTrace ( ) - -Returns a text formatted message containing the current stack trace. - -=cut - -sub getStackTrace { - my $self = shift; - my $i = 2; - my $output; - while (my @data = caller($i)) { - $output .= "\t".join(",",@data)."\n"; - $i++; - } - return $output; -} - - - #------------------------------------------------------------------- =head2 info ( message ) @@ -294,6 +198,20 @@ sub new { my $session = shift; my $logger = $session->request && $session->request->logger; + if ( !$logger ) { + + # Thanks to Plack, wG has been decoupled from Log4Perl + # However when called outside a web context, we currently still fall back to Log4perl + # (pending a better idea) + Log::Log4perl->init_once( $session->config->getWebguiRoot . "/etc/log.conf" ); + my $log4perl = Log::Log4perl->get_logger( $session->config->getFilename ); + $logger = sub { + my $args = shift; + my $level = $args->{level}; + $log4perl->$level( $args->{message} ); + }; + } + bless { _session => $session, _logger => $logger }, $class; }