clean up debug logger

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 $logger = $env->{'psgix.logger'};
-    my %output;
+
+    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;
+        push @$log_output, $args->{level} => $caller . $message;
-        $message =~ s/\n?\z/\n/msx;
+        if ($logger) {
-        $output{lc $args->{level}} ||= '';
+            goto $logger;
-        $output{lc $args->{level}} .= $caller . $message;
-        if ($wrap_logger) {
-            Sub::Uplevel::uplevel 1, $wrap_logger, @_;
         }
     };
 
     return sub {
         my $res = shift;
 
-        if ($wrap_logger) {
+        if ($logger) {
-            $env->{'psgix.logger'} = $wrap_logger;
+            $env->{'psgix.logger'} = $logger;
         }
-        my $content = '';
+        $panel->nav_subtitle(scalar @$log_output / 2 . ' messages');
-        for my $level ( qw(info debug warn error fatal) ) {
+        if (@$log_output) {
-            if ($output{$level}) {
+            $panel->content('<div style="white-space: pre">' . $self->render_list_pairs( $log_output ) . '</div>');
-                $content .= "<h1 style=\"font-size: 125%\">\u$level</h1>";
-                $content .= '<div style="white-space: pre">' . $self->render_lines($output{$level}) . '</div>';
-            }
         }
-        $panel->content($content);
     };
 }
 

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;

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;
+    $_[0]->{_logger};
-    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} );
-    };
 }
 
-
-#-------------------------------------------------------------------
-
-=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;
 }