clean up debug logger
This commit is contained in:
Graham Knop
parent
907a148313
commit
30b7e4bdb3
3 changed files with 47 additions and 117 deletions
|
|
@ -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 .= "<h1 style=\"font-size: 125%\">\u$level</h1>";
|
||||
$content .= '<div style="white-space: pre">' . $self->render_lines($output{$level}) . '</div>';
|
||||
}
|
||||
$panel->nav_subtitle(scalar @$log_output / 2 . ' messages');
|
||||
if (@$log_output) {
|
||||
$panel->content('<div style="white-space: pre">' . $self->render_list_pairs( $log_output ) . '</div>');
|
||||
}
|
||||
$panel->content($content);
|
||||
};
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue