1 package Catalyst::Stats;
4 use Time::HiRes qw/gettimeofday tv_interval/;
5 use Text::SimpleTable ();
6 use Tree::Simple qw/use_weak_refs/;
7 use Tree::Simple::Visitor::FindByUID;
9 has enable => (is => 'rw', required => 1, default => sub{ 1 });
13 default => sub{ Tree::Simple->new({t => [gettimeofday]}) },
14 handles => [qw/ accept traverse /],
20 default => sub { [ shift->tree ] }
26 return unless $self->enable;
30 $params{comment} = shift || "";
33 die "profile() requires a single comment parameter or a list of name-value pairs; found "
34 . (scalar @_) . " values: " . join(", ", @_);
38 $params{comment} ||= "";
43 my $t = [ gettimeofday ];
44 my $stack = $self->stack;
47 # parent is on stack; search for matching block and splice out
48 for (my $i = $#{$stack}; $i > 0; $i--) {
49 if ($stack->[$i]->getNodeValue->{action} eq $params{end}) {
50 my ($node) = splice(@{$stack}, $i, 1);
51 # Adjust elapsed on partner node
52 my $v = $node->getNodeValue;
53 $v->{elapsed} = tv_interval($v->{t}, $t);
57 # if partner not found, fall through to treat as non-closing call
59 if ($params{parent}) {
60 # parent is explicitly defined
61 $prev = $parent = $self->_get_uid($params{parent});
64 # Find previous node, which is either previous sibling or parent, for ref time.
65 $prev = $parent = $stack->[-1] or return undef;
66 my $n = $parent->getChildCount;
67 $prev = $parent->getChild($n - 1) if $n > 0;
70 my $node = Tree::Simple->new({
71 action => $params{begin} || "",
73 elapsed => tv_interval($prev->getNodeValue->{t}, $t),
74 comment => $params{comment},
76 $node->setUID($params{uid}) if $params{uid};
78 $parent->addChild($node);
79 push(@{$stack}, $node) if $params{begin};
85 return tv_interval(shift->{tree}->getNodeValue->{t});
91 my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
96 my $stat = $action->getNodeValue;
97 my @r = ( $action->getDepth,
98 ($stat->{action} || "") .
99 ($stat->{action} && $stat->{comment} ? " " : "") . ($stat->{comment} ? '- ' . $stat->{comment} : ""),
101 $stat->{action} ? 1 : 0,
103 # Trim down any times >= 10 to avoid ugly Text::Simple line wrapping
104 my $elapsed = substr(sprintf("%f", $stat->{elapsed}), 0, 8) . "s";
105 $t->row( ( q{ } x $r[0] ) . $r[1],
106 defined $r[2] ? $elapsed : '??');
110 return wantarray ? @results : $t->draw;
114 my ($self, $uid) = @_;
116 my $visitor = Tree::Simple::Visitor::FindByUID->new;
117 $visitor->searchForUID($uid);
118 $self->accept($visitor);
119 return $visitor->getResult;
126 my $stat = $node->getNodeValue;
128 # do we need to fake $stat->{ t } ?
129 if( $stat->{ elapsed } ) {
130 # remove the "s" from elapsed time
131 $stat->{ elapsed } =~ s{s$}{};
134 $self->tree->addChild( @_ );
141 # do we need to fake $stat->{ t } ?
142 if( $stat->{ elapsed } ) {
143 # remove the "s" from elapsed time
144 $stat->{ elapsed } =~ s{s$}{};
147 $self->tree->setNodeValue( @_ );
152 $self->tree->getNodeValue( @_ )->{ t };
156 __PACKAGE__->meta->make_immutable();
164 Catalyst::Stats - Catalyst Timing Statistics Class
170 $stats->profile($comment);
171 $stats->profile(begin => $block_name, comment =>$comment);
172 $stats->profile(end => $block_name);
173 $elapsed = $stats->elapsed;
174 $report = $stats->report;
180 This module provides the default, simple timing stats collection functionality for Catalyst.
181 If you want something different set C<< MyApp->stats_class >> in your application module,
184 __PACKAGE__->stats_class( "My::Stats" );
186 If you write your own, your stats object is expected to provide the interface described here.
188 Catalyst uses this class to report timings of component actions. You can add
189 profiling points into your own code to get deeper insight. Typical usage might
194 $c->stats->profile(begin => "mysub");
197 $c->stats->profile("starting critical bit");
200 $c->stats->profile("completed first part of critical bit");
203 $c->stats->profile("completed second part of critical bit");
206 $c->stats->profile(end => "mysub");
209 Supposing mysub was called from the action "process" inside a Catalyst
210 Controller called "service", then the reported timings for the above example
211 might look something like this:
213 .----------------------------------------------------------------+-----------.
215 +----------------------------------------------------------------+-----------+
216 | /service/process | 1.327702s |
217 | mysub | 0.555555s |
218 | - starting critical bit | 0.111111s |
219 | - completed first part of critical bit | 0.333333s |
220 | - completed second part of critical bit | 0.111000s |
222 '----------------------------------------------------------------+-----------'
224 which means mysub took 0.555555s overall, it took 0.111111s to reach the
225 critical bit, the first part of the critical bit took 0.333333s, and the second
235 $stats = Catalyst::Stats->new;
242 Enable or disable stats collection. By default, stats are enabled after object creation.
246 $stats->profile($comment);
247 $stats->profile(begin => $block_name, comment =>$comment);
248 $stats->profile(end => $block_name);
250 Marks a profiling point. These can appear in pairs, to time the block of code
251 between the begin/end pairs, or by themselves, in which case the time of
252 execution to the previous profiling point will be reported.
254 The argument may be either a single comment string or a list of name-value
255 pairs. Thus the following are equivalent:
257 $stats->profile($comment);
258 $stats->profile(comment => $comment);
260 The following key names/values may be used:
264 =item * begin => ACTION
266 Marks the beginning of a block. The value is used in the description in the
269 =item * end => ACTION
271 Marks the end of the block. The name given must match a previous 'begin'.
272 Correct nesting is recommended, although this module is tolerant of blocks that
273 are not correctly nested, and the reported timings should accurately reflect the
274 time taken to execute the block whether properly nested or not.
276 =item * comment => COMMENT
278 Comment string; use this to describe the profiling point. It is combined with
279 the block action (if any) in the timing report description field.
283 Assign a predefined unique ID. This is useful if, for whatever reason, you wish
284 to relate a profiling point to a different parent than in the natural execution
287 =item * parent => UID
289 Explicitly relate the profiling point back to the parent with the specified UID.
290 The profiling point will be ignored if the UID has not been previously defined.
294 Returns the UID of the current point in the profile tree. The UID is
295 automatically assigned if not explicitly given.
299 $elapsed = $stats->elapsed
301 Get the total elapsed time (in seconds) since the object was created.
305 print $stats->report ."\n";
306 $report = $stats->report;
307 @report = $stats->report;
309 In scalar context, generates a textual report. In array context, returns the
310 array of results where each row comprises:
312 [ depth, description, time, rollup ]
314 The depth is the calling stack level of the profiling point.
316 The description is a combination of the block name and comment.
318 The time reported for each block is the total execution time for the block, and
319 the time associated with each intermediate profiling point is the elapsed time
320 from the previous profiling point.
322 The 'rollup' flag indicates whether the reported time is the rolled up time for
323 the block, or the elapsed time from the previous profiling point.
325 =head1 COMPATABILITY METHODS
327 Some components might expect the stats object to be a regular Tree::Simple object.
328 We've added some compatability methods to handle this scenario:
346 Catalyst Contributors, see Catalyst.pm
350 This program is free software, you can redistribute it and/or modify
351 it under the same terms as Perl itself.
355 __PACKAGE__->meta->make_immutable;