convert performance indicators to a Plack::Middleware::Debug panel
This commit is contained in:
Graham Knop
parent
30fc3fab10
commit
f2ce1eff85
7 changed files with 98 additions and 31 deletions
|
|
@ -313,7 +313,6 @@ sub view {
|
|||
|
||||
my @found;
|
||||
my $newStuff;
|
||||
my $showPerformance = $self->session->errorHandler->canShowPerformanceIndicators();
|
||||
foreach my $position (@positions) {
|
||||
my @assets = split(",",$position);
|
||||
foreach my $asset (@assets) {
|
||||
|
|
|
|||
|
|
@ -327,7 +327,7 @@ Show performance indicators for the Layout and all children if enabled.
|
|||
sub view {
|
||||
my $self = shift;
|
||||
my $session = $self->session;
|
||||
my $showPerformance = $session->errorHandler->canShowPerformanceIndicators;
|
||||
my $perfLog = $session->log->performanceLogger;
|
||||
my @parts = split $self->{_viewSplitter},
|
||||
$self->processTemplate($self->{_viewVars}, undef, $self->{_viewTemplate});
|
||||
my $output = "";
|
||||
|
|
@ -342,9 +342,10 @@ sub view {
|
|||
my ($assetId, $outputPart) = split '~~', $part, 2;
|
||||
my $asset = $self->{_viewPlaceholder}{$assetId};
|
||||
if (defined $asset) {
|
||||
my $t = [Time::HiRes::gettimeofday()] if ($showPerformance);
|
||||
my $t = $perfLog ? [Time::HiRes::gettimeofday()] : undef;
|
||||
my $assetOutput = $asset->view;
|
||||
$assetOutput .= "Asset:".Time::HiRes::tv_interval($t) if ($showPerformance);
|
||||
$perfLog->({ asset => $asset, 'time' => Time::HiRes::tv_interval($t), type => 'Layout' })
|
||||
if $perfLog;
|
||||
if ($self->{_viewPrintOverride}) {
|
||||
$session->output->print($assetOutput);
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -83,28 +83,11 @@ sub handler {
|
|||
my ($session) = @_;
|
||||
my ($errorHandler, $http, $var, $asset, $request, $config) = $session->quick(qw(errorHandler http var asset request config));
|
||||
my $output = "";
|
||||
if ($errorHandler->canShowPerformanceIndicators) { #show performance indicators if required
|
||||
if (my $perfLog = $errorHandler->performanceLogger) { #show performance indicators if required
|
||||
my $t = [Time::HiRes::gettimeofday()];
|
||||
$output = page($session);
|
||||
$t = Time::HiRes::tv_interval($t) ;
|
||||
if ($output =~ /<\/title>/) {
|
||||
$output =~ s/<\/title>/ : ${t} seconds<\/title>/i;
|
||||
}
|
||||
else {
|
||||
# Kludge.
|
||||
my $mimeType = $http->getMimeType();
|
||||
if ($mimeType eq 'text/css') {
|
||||
$session->output->print("\n/* Page generated in $t seconds. */\n");
|
||||
}
|
||||
elsif ($mimeType =~ m{text/html}) {
|
||||
$session->output->print("\nPage generated in $t seconds.\n");
|
||||
}
|
||||
else {
|
||||
# Don't apply to content when we don't know how
|
||||
# to modify it semi-safely.
|
||||
}
|
||||
}
|
||||
}
|
||||
$perfLog->({ time => Time::HiRes::tv_interval($t), type => 'Page'});
|
||||
}
|
||||
else {
|
||||
|
||||
my $asset = getAsset($session, getRequestedAssetUrl($session));
|
||||
|
|
|
|||
|
|
@ -43,7 +43,8 @@ Defaults to 'url'. But if you want to use an assetId as the first parameter, the
|
|||
#-------------------------------------------------------------------
|
||||
sub process {
|
||||
my ($session, $identifier, $type) = @_;
|
||||
my $t = ($session->errorHandler->canShowPerformanceIndicators()) ? [Time::HiRes::gettimeofday()] : undef;
|
||||
my $perfLog = $session->log->performanceLogger;
|
||||
my $t = $perfLog ? [Time::HiRes::gettimeofday()] : undef;
|
||||
my $asset;
|
||||
if ($type eq 'assetId') {
|
||||
$asset = eval { WebGUI::Asset->newById($session, $identifier); };
|
||||
|
|
@ -79,8 +80,8 @@ sub process {
|
|||
$asset->toggleToolbar;
|
||||
$asset->prepareView;
|
||||
my $output = $asset->view;
|
||||
$output .= "AssetProxy:" . Time::HiRes::tv_interval($t)
|
||||
if $t;
|
||||
$perfLog->({ asset => $asset, time => Time::HiRes::tv_interval($t), type => 'Proxy'})
|
||||
if $perfLog;
|
||||
return $output;
|
||||
}
|
||||
return '';
|
||||
|
|
|
|||
77
lib/WebGUI/Middleware/Debug/Performance.pm
Normal file
77
lib/WebGUI/Middleware/Debug/Performance.pm
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
package WebGUI::Middleware::Debug::Performance;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use parent qw(Plack::Middleware::Debug::Base);
|
||||
our $VERSION = '0.07';
|
||||
|
||||
sub panel_name { 'Asset Performance' }
|
||||
|
||||
sub run {
|
||||
my ($self, $env, $panel) = @_;
|
||||
|
||||
my $perf_log = [];
|
||||
$env->{'webgui.perf.logger'} = sub {
|
||||
my $args = shift;
|
||||
my $asset = $args->{asset};
|
||||
my $log_data = {
|
||||
'time' => $args->{time},
|
||||
'type' => $args->{type},
|
||||
'message' => $args->{message},
|
||||
$asset ? (
|
||||
'viewUrl' => $asset->getUrl,
|
||||
'editUrl' => $asset->getUrl('func=edit'),
|
||||
'assetTitle' => $asset->title,
|
||||
) : (),
|
||||
};
|
||||
push @$perf_log, $log_data;
|
||||
};
|
||||
|
||||
return sub {
|
||||
my $res = shift;
|
||||
|
||||
$panel->nav_subtitle(scalar @$perf_log . ' events');
|
||||
if (@$perf_log) {
|
||||
$panel->content($self->render_log($perf_log));
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
my $log_template = __PACKAGE__->build_template(<<'EOTMPL');
|
||||
<table>
|
||||
<thead>
|
||||
<tr>
|
||||
<th>Time</th>
|
||||
<th>Type</th>
|
||||
<th>Item</th>
|
||||
</tr>
|
||||
</thead>
|
||||
<tbody>
|
||||
% my $i;
|
||||
% for my $event ( @{ $_[0]->{list} } ) {
|
||||
<tr class="<%= ++$i % 2 ? 'plDebugOdd' : 'plDebugEven' %>">
|
||||
<td><%= $event->{time} %></td>
|
||||
<td><%= $event->{type} %></td>
|
||||
<td>
|
||||
% if ($event->{message}) {
|
||||
<%= $event->{message} %>
|
||||
% }
|
||||
% if ($event->{assetTitle}) {
|
||||
<a href="<%= $event->{viewUrl} %>">View</a>
|
||||
<a href="<%= $event->{editUrl} %>">Edit</a>
|
||||
<%= $event->{assetTitle} %>
|
||||
% }
|
||||
</td>
|
||||
</tr>
|
||||
% }
|
||||
</tbody>
|
||||
</table>
|
||||
EOTMPL
|
||||
|
||||
sub render_log {
|
||||
my ($self, $events) = @_;
|
||||
$self->render($log_template, { list => $events });
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -7,6 +7,7 @@ use WebGUI::Utility ();
|
|||
use Try::Tiny;
|
||||
use Plack::Middleware::StackTrace;
|
||||
use Plack::Middleware::Debug;
|
||||
use WebGUI::Middleware::Debug::Performance;
|
||||
use WebGUI::Middleware::HTTPExceptions;
|
||||
use Plack::Middleware::ErrorDocument;
|
||||
use Plack::Middleware::SimpleLogger;
|
||||
|
|
@ -81,6 +82,7 @@ sub call {
|
|||
[ 'MySQLTrace', skip_packages => qr/\AWebGUI::SQL(?:\z|::)/ ],
|
||||
'Response',
|
||||
'Logger',
|
||||
sub { WebGUI::Middleware::Debug::Performance->wrap($_[0]) },
|
||||
],
|
||||
);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ use JSON;
|
|||
use HTML::Entities qw(encode_entities);
|
||||
use Log::Log4perl;
|
||||
use WebGUI::Exception;
|
||||
use Sub::Uplevel;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
|
@ -84,10 +85,13 @@ Returns true if the user meets the conditions to see performance indicators and
|
|||
|
||||
=cut
|
||||
|
||||
sub canShowPerformanceIndicators {
|
||||
my $self = shift;
|
||||
return 0 unless $self->session->setting->get("showPerformanceIndicators");
|
||||
return $self->canShowBasedOnIP('debugIp');
|
||||
sub performanceLogger {
|
||||
my $self = shift;
|
||||
my $request = $self->session->request;
|
||||
return
|
||||
unless $request;
|
||||
my $logger = $request->env->{'webgui.perf.logger'};
|
||||
return $logger;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue