1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
package CGI::Application::Plugin::DevPopup::Timing;
{
$CGI::Application::Plugin::DevPopup::Timing::VERSION = '1.08';
}
use strict;
use base qw/Exporter/;
use Time::HiRes qw/gettimeofday tv_interval/;
my $start = [gettimeofday];
sub import
{
my $c = scalar caller;
$c->add_callback( 'devpopup_report', \&_timer_report );
$c->new_hook('devpopup_addtiming');
$c->add_callback( 'devpopup_addtiming', \&_add_time );
foreach my $stage (qw/ init prerun load_tmpl /)
{
$c->add_callback( $stage, sub { _add_time( shift(), $stage, @_ ) } );
}
goto &Exporter::import;
}
sub _timer_report
{
my $app = shift;
my $self = _new_or_self($app);
unshift @$self, { dec => 'start', tod => $start };
_add_time( $app, 'postrun' );
$app->devpopup->add_report(
title => 'Timings',
summary => 'Total runtime: ' . tv_interval( $self->[1]{tod}, $self->[-1]{tod} ) . ' sec.',
report => '<style>
th { text-align:left; border-bottom:solid 1px black; }
</style>' .
'Application started at: ' . scalar( gmtime( $start->[0] ) ) . ' GMT<br/>' .
'<table width="100%"><tr><th>From</th><th>To</th><th>Time taken</th></tr>' .
join(
$/,
map {
my $time = tv_interval( $self->[$_]{tod}, $self->[ $_ + 1 ]{tod} );
"<tr><td>$self->[$_]{desc}</td><td>$self->[ $_ + 1 ]{desc}</td><td>$time sec.</td></tr>"
} ( 1 .. $#$self - 1 )
)
. '</table>'
);
}
sub _add_time
{
my $app = shift;
my $stage = shift;
$stage .= '(' . $_[-1] . ')' if $stage =~ /load_tmpl/;
my $self = _new_or_self($app);
push @$self, { desc => $stage, tod => [gettimeofday] };
}
sub _new_or_self
{
my $app = shift;
my $self = $app->param('__CAP_DEVPOPUP_TIMER');
unless ($self)
{
$self = bless [], __PACKAGE__;
$app->param( '__CAP_DEVPOPUP_TIMER' => $self );
}
return $self;
}
1; # End of CGI::Application::Plugin::DevPopup::Timing
__END__
=head1 NAME
CGI::Application::Plugin::DevPopup::Timing - show timing information about cgiapp stages
=head1 VERSION
version 1.08
=head1 SYNOPSIS
use CGI::Application::Plugin::DevPopup;
use CGI::Application::Plugin::DevPopup::Timing;
The rest of your application follows
...
Output will look roughly like this:
Timings
Total runtime: 3.1178 sec.
Application started at: Thu Sep 22 02:55:35 2005
From To Time taken
-------------------------------------------------------------------------
init prerun 0.107513 sec.
prerun before expensive operation 0.000371 sec.
before expensive operation after expensive operation 3.006688 sec.
after expensive operation load_tmpl(dp.html) 0.000379 sec.
load_tmpl(dp.html) postrun 0.002849 sec.
=head1 ADD_TIMING
You can add your own timing points within your application by calling the hook at C<devpopup_addtiming> with a short label. The table above was created with the following code:
$self->call_hook('devpopup_addtiming', 'before expensive operation');
sleep 3;
$self->call_hook('devpopup_addtiming', 'after expensive operation');
=head1 SEE ALSO
L<CGI::Application::Plugin::DevPopup>, L<CGI::Application>
=head1 AUTHOR
Rhesa Rozendaal, L<rhesa@cpan.org>
=head1 BUGS
Please report any bugs or feature requests to
L<bug-cgi-application-plugin-devpopup@rt.cpan.org>, or through the web
interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-Plugin-DevPopup>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 COPYRIGHT & LICENSE
Copyright 2005 Rhesa Rozendaal, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
|
