1 package Catalyst::Stats;
4 use Time::HiRes qw/gettimeofday tv_interval/;
5 use Text::SimpleTable ();
7 use Tree::Simple qw/use_weak_refs/;
8 use Tree::Simple::Visitor::FindByUID;
10 use namespace::clean -except => 'meta';
12 has enable => (is => 'rw', required => 1, default => sub{ 1 });
16 default => sub{ Tree::Simple->new({t => [gettimeofday]}) },
17 handles => [qw/ accept traverse /],
23 default => sub { [ shift->tree ] }
29 return unless $self->enable;
33 $params{comment} = shift || "";
36 die "profile() requires a single comment parameter or a list of name-value pairs; found "
37 . (scalar @_) . " values: " . join(", ", @_);
41 $params{comment} ||= "";
46 my $t = [ gettimeofday ];
47 my $stack = $self->stack;
50 # parent is on stack; search for matching block and splice out
51 for (my $i = $#{$stack}; $i > 0; $i--) {
52 if ($stack->[$i]->getNodeValue->{action} eq $params{end}) {
53 my ($node) = splice(@{$stack}, $i, 1);
54 # Adjust elapsed on partner node
55 my $v = $node->getNodeValue;
56 $v->{elapsed} = tv_interval($v->{t}, $t);
60 # if partner not found, fall through to treat as non-closing call
62 if ($params{parent}) {
63 # parent is explicitly defined
64 $prev = $parent = $self->_get_uid($params{parent});
67 # Find previous node, which is either previous sibling or parent, for ref time.
68 $prev = $parent = $stack->[-1] or return undef;
69 my $n = $parent->getChildCount;
70 $prev = $parent->getChild($n - 1) if $n > 0;
73 my $node = Tree::Simple->new({
74 action => $params{begin} || "",
76 elapsed => tv_interval($prev->getNodeValue->{t}, $t),
77 comment => $params{comment},
79 $node->setUID($params{uid}) if $params{uid};
81 $parent->addChild($node);
82 push(@{$stack}, $node) if $params{begin};
88 return @{ shift->{tree}->getNodeValue->{t} };
92 return tv_interval(shift->{tree}->getNodeValue->{t});
102 $t = Text::SimpleTable->new(
103 [ Catalyst::Utils::term_width() - 9 - 13, 'Action' ],
108 $self->traverse(sub {
110 my $stat = $action->getNodeValue;
111 my @r = ( $action->getDepth,
112 ($stat->{action} || "") .
113 ($stat->{action} && $stat->{comment} ? " " : "") . ($stat->{comment} ? '- ' . $stat->{comment} : ""),
115 $stat->{action} ? 1 : 0,
117 # Trim down any times >= 10 to avoid ugly Text::Simple line wrapping
118 my $elapsed = substr(sprintf("%f", $stat->{elapsed}), 0, 8) . "s";
120 $t->row( ( q{ } x $r[0] ) . $r[1],
121 defined $r[2] ? $elapsed : '??');
127 return wantarray ? @results : $t->draw;
131 my ($self, $uid) = @_;
133 my $visitor = Tree::Simple::Visitor::FindByUID->new;
134 $visitor->searchForUID($uid);
135 $self->accept($visitor);
136 return $visitor->getResult;
143 my $stat = $node->getNodeValue;
145 # do we need to fake $stat->{ t } ?
146 if( $stat->{ elapsed } ) {
147 # remove the "s" from elapsed time
148 $stat->{ elapsed } =~ s{s$}{};
151 $self->tree->addChild( @_ );
158 # do we need to fake $stat->{ t } ?
159 if( $stat->{ elapsed } ) {
160 # remove the "s" from elapsed time
161 $stat->{ elapsed } =~ s{s$}{};
164 $self->tree->setNodeValue( @_ );
169 $self->tree->getNodeValue( @_ )->{ t };
172 __PACKAGE__->meta->make_immutable();
178 =for stopwords addChild getNodeValue mysub rollup setNodeValue
182 Catalyst::Stats - Catalyst Timing Statistics Class
188 $stats->profile($comment);
189 $stats->profile(begin => $block_name, comment =>$comment);
190 $stats->profile(end => $block_name);
191 $elapsed = $stats->elapsed;
192 $report = $stats->report;
198 This module provides the default, simple timing stats collection functionality for Catalyst.
199 If you want something different set C<< MyApp->stats_class >> in your application module,
202 __PACKAGE__->stats_class( "My::Stats" );
204 If you write your own, your stats object is expected to provide the interface described here.
206 Catalyst uses this class to report timings of component actions. You can add
207 profiling points into your own code to get deeper insight. Typical usage might
212 $c->stats->profile(begin => "mysub");
215 $c->stats->profile("starting critical bit");
218 $c->stats->profile("completed first part of critical bit");
221 $c->stats->profile("completed second part of critical bit");
224 $c->stats->profile(end => "mysub");
227 Supposing mysub was called from the action "process" inside a Catalyst
228 Controller called "service", then the reported timings for the above example
229 might look something like this:
231 .----------------------------------------------------------------+-----------.
233 +----------------------------------------------------------------+-----------+
234 | /service/process | 1.327702s |
235 | mysub | 0.555555s |
236 | - starting critical bit | 0.111111s |
237 | - completed first part of critical bit | 0.333333s |
238 | - completed second part of critical bit | 0.111000s |
240 '----------------------------------------------------------------+-----------'
242 which means mysub took 0.555555s overall, it took 0.111111s to reach the
243 critical bit, the first part of the critical bit took 0.333333s, and the second
253 $stats = Catalyst::Stats->new;
260 Enable or disable stats collection. By default, stats are enabled after object creation.
264 $stats->profile($comment);
265 $stats->profile(begin => $block_name, comment =>$comment);
266 $stats->profile(end => $block_name);
268 Marks a profiling point. These can appear in pairs, to time the block of code
269 between the begin/end pairs, or by themselves, in which case the time of
270 execution to the previous profiling point will be reported.
272 The argument may be either a single comment string or a list of name-value
273 pairs. Thus the following are equivalent:
275 $stats->profile($comment);
276 $stats->profile(comment => $comment);
278 The following key names/values may be used:
282 =item * begin => ACTION
284 Marks the beginning of a block. The value is used in the description in the
287 =item * end => ACTION
289 Marks the end of the block. The name given must match a previous 'begin'.
290 Correct nesting is recommended, although this module is tolerant of blocks that
291 are not correctly nested, and the reported timings should accurately reflect the
292 time taken to execute the block whether properly nested or not.
294 =item * comment => COMMENT
296 Comment string; use this to describe the profiling point. It is combined with
297 the block action (if any) in the timing report description field.
301 Assign a predefined unique ID. This is useful if, for whatever reason, you wish
302 to relate a profiling point to a different parent than in the natural execution
305 =item * parent => UID
307 Explicitly relate the profiling point back to the parent with the specified UID.
308 The profiling point will be ignored if the UID has not been previously defined.
312 Returns the UID of the current point in the profile tree. The UID is
313 automatically assigned if not explicitly given.
317 ($seconds, $microseconds) = $stats->created;
319 Returns the time the object was created, in C<gettimeofday> format, with
320 Unix epoch seconds followed by microseconds.
324 $elapsed = $stats->elapsed
326 Get the total elapsed time (in seconds) since the object was created.
330 print $stats->report ."\n";
331 $report = $stats->report;
332 @report = $stats->report;
334 In scalar context, generates a textual report. In array context, returns the
335 array of results where each row comprises:
337 [ depth, description, time, rollup ]
339 The depth is the calling stack level of the profiling point.
341 The description is a combination of the block name and comment.
343 The time reported for each block is the total execution time for the block, and
344 the time associated with each intermediate profiling point is the elapsed time
345 from the previous profiling point.
347 The 'rollup' flag indicates whether the reported time is the rolled up time for
348 the block, or the elapsed time from the previous profiling point.
350 =head1 COMPATIBILITY METHODS
352 Some components might expect the stats object to be a regular Tree::Simple object.
353 We've added some compatibility methods to handle this scenario:
371 Catalyst Contributors, see Catalyst.pm
375 This library is free software. You can redistribute it and/or modify
376 it under the same terms as Perl itself.
380 __PACKAGE__->meta->make_immutable;