1 package Catalyst::Stats;
5 use Time::HiRes qw/gettimeofday tv_interval/;
6 use Text::SimpleTable ();
7 use Tree::Simple qw/use_weak_refs/;
8 use Tree::Simple::Visitor::FindByUID;
13 my $root = Tree::Simple->new({t => [gettimeofday]});
18 }, ref $class || $class;
22 my ($self, $enable) = @_;
24 $self->{enabled} = $enable;
30 return unless $self->{enabled};
34 $params{comment} = shift || "";
37 die "profile() requires a single comment parameter or a list of name-value pairs; found "
38 . (scalar @_) . " values: " . join(", ", @_);
42 $params{comment} ||= "";
47 my $t = [ gettimeofday ];
50 # parent is on stack; search for matching block and splice out
51 for (my $i = $#{$self->{stack}}; $i > 0; $i--) {
52 if ($self->{stack}->[$i]->getNodeValue->{action} eq $params{end}) {
53 my $node = $self->{stack}->[$i];
54 splice(@{$self->{stack}}, $i, 1);
55 # Adjust elapsed on partner node
56 my $v = $node->getNodeValue;
57 $v->{elapsed} = tv_interval($v->{t}, $t);
61 # if partner not found, fall through to treat as non-closing call
63 if ($params{parent}) {
64 # parent is explicitly defined
65 $prev = $parent = $self->_get_uid($params{parent});
68 # Find previous node, which is either previous sibling or parent, for ref time.
69 $prev = $parent = $self->{stack}->[-1] or return undef;
70 my $n = $parent->getChildCount;
71 $prev = $parent->getChild($n - 1) if $n > 0;
74 my $node = Tree::Simple->new({
75 action => $params{begin} || "",
77 elapsed => tv_interval($prev->getNodeValue->{t}, $t),
78 comment => $params{comment},
80 $node->setUID($params{uid}) if $params{uid};
82 $parent->addChild($node);
83 push(@{$self->{stack}}, $node) if $params{begin};
89 return tv_interval(shift->{tree}->getNodeValue->{t});
95 # close any remaining open nodes
96 for (my $i = $#{$self->{stack}}; $i > 0; $i--) {
97 $self->profile(end => $self->{stack}->[$i]->getNodeValue->{action});
100 my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
102 $self->{tree}->traverse(
105 my $stat = $action->getNodeValue;
106 my @r = ( $action->getDepth,
107 ($stat->{action} || "") .
108 ($stat->{action} && $stat->{comment} ? " " : "") . ($stat->{comment} ? '- ' . $stat->{comment} : ""),
110 $stat->{action} ? 1 : 0,
112 $t->row( ( q{ } x $r[0] ) . $r[1],
113 defined $r[2] ? sprintf("%fs", $r[2]) : '??');
117 return wantarray ? @results : $t->draw;
121 my ($self, $uid) = @_;
123 my $visitor = Tree::Simple::Visitor::FindByUID->new;
124 $visitor->searchForUID($uid);
125 $self->{tree}->accept($visitor);
126 return $visitor->getResult;
135 Catalyst::Stats - Catalyst Timing Statistics Class
141 $stats->profile($comment);
142 $stats->profile(begin => $block_name, comment =>$comment);
143 $stats->profile(end => $block_name);
144 $elapsed = $stats->elapsed;
145 $report = $stats->report;
151 This module provides the default, simple timing stats collection functionality for Catalyst.
152 If you want something different set C<< MyApp->stats_class >> in your application module,
155 __PACKAGE__->stats_class( "My::Stats" );
157 If you write your own, your stats object is expected to provide the interface described here.
159 Catalyst uses this class to report timings of component actions. You can add
160 profiling points into your own code to get deeper insight. Typical usage might
165 $c->stats->profile(begin => "mysub");
168 $c->stats->profile("starting critical bit");
171 $c->stats->profile("completed first part of critical bit");
174 $c->stats->profile("completed second part of critical bit");
177 $c->stats->profile(end => "mysub");
180 Supposing mysub was called from the action "process" inside a Catalyst
181 Controller called "service", then the reported timings for the above example
182 might look something like this:
184 .----------------------------------------------------------------+-----------.
186 +----------------------------------------------------------------+-----------+
187 | /service/process | 1.327702s |
188 | mysub | 0.555555s |
189 | - starting critical bit | 0.111111s |
190 | - completed first part of critical bit | 0.333333s |
191 | - completed second part of critical bit | 0.111000s |
193 '----------------------------------------------------------------+-----------'
195 which means mysub took 0.555555s overall, it took 0.111111s to reach the
196 critical bit, the first part of the critical bit took 0.333333s, and the second
206 $stats = Catalyst::Stats->new;
213 Enable or disable stats collection. By default, stats are enabled after object creation.
217 $stats->profile($comment);
218 $stats->profile(begin => $block_name, comment =>$comment);
219 $stats->profile(end => $block_name);
221 Marks a profiling point. These can appear in pairs, to time the block of code
222 between the begin/end pairs, or by themselves, in which case the time of
223 execution to the previous profiling point will be reported.
225 The argument may be either a single comment string or a list of name-value
226 pairs. Thus the following are equivalent:
228 $stats->profile($comment);
229 $stats->profile(comment => $comment);
231 The following key names/values may be used:
235 =item * begin => ACTION
237 Marks the beginning of a block. The value is used in the description in the
240 =item * end => ACTION
242 Marks the end of the block. The name given must match a previous 'begin'.
243 Correct nesting is recommended, although this module is tolerant of blocks that
244 are not correctly nested, and the reported timings should accurately reflect the
245 time taken to execute the block whether properly nested or not.
247 =item * comment => COMMENT
249 Comment string; use this to describe the profiling point. It is combined with
250 the block action (if any) in the timing report description field.
254 Assign a predefined unique ID. This is useful if, for whatever reason, you wish
255 to relate a profiling point to a different parent than in the natural execution
258 =item * parent => UID
260 Explicitly relate the profiling point back to the parent with the specified UID.
261 The profiling point will be ignored if the UID has not been previously defined.
265 Returns the UID of the current point in the profile tree. The UID is
266 automatically assigned if not explicitly given.
270 $elapsed = $stats->elapsed
272 Get the total elapsed time (in seconds) since the object was created.
276 print $stats->report ."\n";
277 $report = $stats->report;
278 @report = $stats->report;
280 In scalar context, generates a textual report. In array context, returns the
281 array of results where each row comprises:
283 [ depth, description, time, rollup ]
285 The depth is the calling stack level of the profiling point.
287 The description is a combination of the block name and comment.
289 The time reported for each block is the total execution time for the block, and
290 the time associated with each intermediate profiling point is the elapsed time
291 from the previous profiling point.
293 The 'rollup' flag indicates whether the reported time is the rolled up time for
294 the block, or the elapsed time from the previous profiling point.
307 This program is free software, you can redistribute it and/or modify
308 it under the same terms as Perl itself.