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]}) }
19 default => sub { [ shift->tree ] }
25 return unless $self->enable;
29 $params{comment} = shift || "";
32 die "profile() requires a single comment parameter or a list of name-value pairs; found "
33 . (scalar @_) . " values: " . join(", ", @_);
37 $params{comment} ||= "";
42 my $t = [ gettimeofday ];
43 my $stack = $self->stack;
46 # parent is on stack; search for matching block and splice out
47 for (my $i = $#{$stack}; $i > 0; $i--) {
48 if ($stack->[$i]->getNodeValue->{action} eq $params{end}) {
49 my ($node) = splice(@{$stack}, $i, 1);
50 # Adjust elapsed on partner node
51 my $v = $node->getNodeValue;
52 $v->{elapsed} = tv_interval($v->{t}, $t);
56 # if partner not found, fall through to treat as non-closing call
58 if ($params{parent}) {
59 # parent is explicitly defined
60 $prev = $parent = $self->_get_uid($params{parent});
63 # Find previous node, which is either previous sibling or parent, for ref time.
64 $prev = $parent = $stack->[-1] or return undef;
65 my $n = $parent->getChildCount;
66 $prev = $parent->getChild($n - 1) if $n > 0;
69 my $node = Tree::Simple->new({
70 action => $params{begin} || "",
72 elapsed => tv_interval($prev->getNodeValue->{t}, $t),
73 comment => $params{comment},
75 $node->setUID($params{uid}) if $params{uid};
77 $parent->addChild($node);
78 push(@{$stack}, $node) if $params{begin};
84 return tv_interval(shift->{tree}->getNodeValue->{t});
90 # close any remaining open nodes
91 map { $self->profile(end => $_->getNodeValue->{action}) }
92 (reverse @{ $self->stack })[1 .. $#{$self->stack}];
94 my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
96 $self->tree->traverse(
99 my $stat = $action->getNodeValue;
100 my @r = ( $action->getDepth,
101 ($stat->{action} || "") .
102 ($stat->{action} && $stat->{comment} ? " " : "") . ($stat->{comment} ? '- ' . $stat->{comment} : ""),
104 $stat->{action} ? 1 : 0,
106 $t->row( ( q{ } x $r[0] ) . $r[1],
107 defined $r[2] ? sprintf("%fs", $r[2]) : '??');
111 return wantarray ? @results : $t->draw;
115 my ($self, $uid) = @_;
117 my $visitor = Tree::Simple::Visitor::FindByUID->new;
118 $visitor->searchForUID($uid);
119 $self->tree->accept($visitor);
120 return $visitor->getResult;
124 __PACKAGE__->meta->make_immutable();
132 Catalyst::Stats - Catalyst Timing Statistics Class
138 $stats->profile($comment);
139 $stats->profile(begin => $block_name, comment =>$comment);
140 $stats->profile(end => $block_name);
141 $elapsed = $stats->elapsed;
142 $report = $stats->report;
148 This module provides the default, simple timing stats collection functionality for Catalyst.
149 If you want something different set C<< MyApp->stats_class >> in your application module,
152 __PACKAGE__->stats_class( "My::Stats" );
154 If you write your own, your stats object is expected to provide the interface described here.
156 Catalyst uses this class to report timings of component actions. You can add
157 profiling points into your own code to get deeper insight. Typical usage might
162 $c->stats->profile(begin => "mysub");
165 $c->stats->profile("starting critical bit");
168 $c->stats->profile("completed first part of critical bit");
171 $c->stats->profile("completed second part of critical bit");
174 $c->stats->profile(end => "mysub");
177 Supposing mysub was called from the action "process" inside a Catalyst
178 Controller called "service", then the reported timings for the above example
179 might look something like this:
181 .----------------------------------------------------------------+-----------.
183 +----------------------------------------------------------------+-----------+
184 | /service/process | 1.327702s |
185 | mysub | 0.555555s |
186 | - starting critical bit | 0.111111s |
187 | - completed first part of critical bit | 0.333333s |
188 | - completed second part of critical bit | 0.111000s |
190 '----------------------------------------------------------------+-----------'
192 which means mysub took 0.555555s overall, it took 0.111111s to reach the
193 critical bit, the first part of the critical bit took 0.333333s, and the second
203 $stats = Catalyst::Stats->new;
210 Enable or disable stats collection. By default, stats are enabled after object creation.
214 $stats->profile($comment);
215 $stats->profile(begin => $block_name, comment =>$comment);
216 $stats->profile(end => $block_name);
218 Marks a profiling point. These can appear in pairs, to time the block of code
219 between the begin/end pairs, or by themselves, in which case the time of
220 execution to the previous profiling point will be reported.
222 The argument may be either a single comment string or a list of name-value
223 pairs. Thus the following are equivalent:
225 $stats->profile($comment);
226 $stats->profile(comment => $comment);
228 The following key names/values may be used:
232 =item * begin => ACTION
234 Marks the beginning of a block. The value is used in the description in the
237 =item * end => ACTION
239 Marks the end of the block. The name given must match a previous 'begin'.
240 Correct nesting is recommended, although this module is tolerant of blocks that
241 are not correctly nested, and the reported timings should accurately reflect the
242 time taken to execute the block whether properly nested or not.
244 =item * comment => COMMENT
246 Comment string; use this to describe the profiling point. It is combined with
247 the block action (if any) in the timing report description field.
251 Assign a predefined unique ID. This is useful if, for whatever reason, you wish
252 to relate a profiling point to a different parent than in the natural execution
255 =item * parent => UID
257 Explicitly relate the profiling point back to the parent with the specified UID.
258 The profiling point will be ignored if the UID has not been previously defined.
262 Returns the UID of the current point in the profile tree. The UID is
263 automatically assigned if not explicitly given.
267 $elapsed = $stats->elapsed
269 Get the total elapsed time (in seconds) since the object was created.
273 print $stats->report ."\n";
274 $report = $stats->report;
275 @report = $stats->report;
277 In scalar context, generates a textual report. In array context, returns the
278 array of results where each row comprises:
280 [ depth, description, time, rollup ]
282 The depth is the calling stack level of the profiling point.
284 The description is a combination of the block name and comment.
286 The time reported for each block is the total execution time for the block, and
287 the time associated with each intermediate profiling point is the elapsed time
288 from the previous profiling point.
290 The 'rollup' flag indicates whether the reported time is the rolled up time for
291 the block, or the elapsed time from the previous profiling point.
304 This program is free software, you can redistribute it and/or modify
305 it under the same terms as Perl itself.
309 __PACKAGE__->meta->make_immutable;