lib/Catalyst/Stats.pm

   1 package Catalyst::Stats;
   2
   3 use Moose;
   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;
   8
   9 has enable => (is => 'rw', required => 1, default => sub{ 1 });
  10 has tree => (
  11              is => 'ro',
  12              required => 1,
  13              default => sub{ Tree::Simple->new({t => [gettimeofday]}) }
  14             );
  15 has stack => (
  16               is => 'ro',
  17               required => 1,
  18               lazy => 1,
  19               default => sub { [ shift->tree ] }
  20              );
  21
  22 sub profile {
  23     my $self = shift;
  24
  25     return unless $self->enable;
  26
  27     my %params;
  28     if (@_ <= 1) {
  29         $params{comment} = shift || "";
  30     }
  31     elsif (@_ % 2 != 0) {
  32         die "profile() requires a single comment parameter or a list of name-value pairs; found "
  33             . (scalar @_) . " values: " . join(", ", @_);
  34     }
  35     else {
  36         (%params) = @_;
  37         $params{comment} ||= "";
  38     }
  39
  40     my $parent;
  41     my $prev;
  42     my $t = [ gettimeofday ];
  43     my $stack = $self->stack;
  44
  45     if ($params{end}) {
  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);
  53                 return $node->getUID;
  54             }
  55         }
  56     # if partner not found, fall through to treat as non-closing call
  57     }
  58     if ($params{parent}) {
  59         # parent is explicitly defined
  60         $prev = $parent = $self->_get_uid($params{parent});
  61     }
  62     if (!$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;
  67     }
  68
  69     my $node = Tree::Simple->new({
  70         action  => $params{begin} || "",
  71         t => $t,
  72         elapsed => tv_interval($prev->getNodeValue->{t}, $t),
  73         comment => $params{comment},
  74     });
  75     $node->setUID($params{uid}) if $params{uid};
  76
  77     $parent->addChild($node);
  78     push(@{$stack}, $node) if $params{begin};
  79
  80     return $node->getUID;
  81 }
  82
  83 sub elapsed {
  84     return tv_interval(shift->{tree}->getNodeValue->{t});
  85 }
  86
  87 sub report {
  88     my $self = shift;
  89
  90     # close any remaining open nodes
  91     map { $self->profile(end => $_->getNodeValue->{action}) }
  92       (reverse @{ $self->stack })[1 .. $#{$self->stack}];
  93
  94     my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
  95     my @results;
  96     $self->tree->traverse(
  97                 sub {
  98                 my $action = shift;
  99                 my $stat   = $action->getNodeValue;
 100                 my @r = ( $action->getDepth,
 101                       ($stat->{action} || "") .
 102                       ($stat->{action} && $stat->{comment} ? " " : "") . ($stat->{comment} ? '- ' . $stat->{comment} : ""),
 103                       $stat->{elapsed},
 104                       $stat->{action} ? 1 : 0,
 105                       );
 106                 $t->row( ( q{ } x $r[0] ) . $r[1],
 107                      defined $r[2] ? sprintf("%fs", $r[2]) : '??');
 108                 push(@results, \@r);
 109                 }
 110             );
 111     return wantarray ? @results : $t->draw;
 112 }
 113
 114 sub _get_uid {
 115     my ($self, $uid) = @_;
 116
 117     my $visitor = Tree::Simple::Visitor::FindByUID->new;
 118     $visitor->searchForUID($uid);
 119     $self->tree->accept($visitor);
 120     return $visitor->getResult;
 121 }
 122
 123 no Moose;
 124 __PACKAGE__->meta->make_immutable();
 125
 126 1;
 127
 128 __END__
 129
 130 =head1 NAME
 131
 132 Catalyst::Stats - Catalyst Timing Statistics Class
 133
 134 =head1 SYNOPSIS
 135
 136     $stats = $c->stats;
 137     $stats->enable(1);
 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;
 143
 144 See L<Catalyst>.
 145
 146 =head1 DESCRIPTION
 147
 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,
 150 e.g.:
 151
 152     __PACKAGE__->stats_class( "My::Stats" );
 153
 154 If you write your own, your stats object is expected to provide the interface described here.
 155
 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
 158 be like this:
 159
 160   sub mysub {
 161     my ($c, ...) = @_;
 162     $c->stats->profile(begin => "mysub");
 163     # code goes here
 164     ...
 165     $c->stats->profile("starting critical bit");
 166     # code here too
 167     ...
 168     $c->stats->profile("completed first part of critical bit");
 169     # more code
 170     ...
 171     $c->stats->profile("completed second part of critical bit");
 172     # more code
 173     ...
 174     $c->stats->profile(end => "mysub");
 175   }
 176
 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:
 180
 181   .----------------------------------------------------------------+-----------.
 182   | Action                                                         | Time      |
 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 |
 189   | /end                                                           | 0.000160s |
 190   '----------------------------------------------------------------+-----------'
 191
 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
 194 part 0.111s.
 195
 196
 197 =head1 METHODS
 198
 199 =head2 new
 200
 201 Constructor.
 202
 203     $stats = Catalyst::Stats->new;
 204
 205 =head2 enable
 206
 207     $stats->enable(0);
 208     $stats->enable(1);
 209
 210 Enable or disable stats collection.  By default, stats are enabled after object creation.
 211
 212 =head2 profile
 213
 214     $stats->profile($comment);
 215     $stats->profile(begin => $block_name, comment =>$comment);
 216     $stats->profile(end => $block_name);
 217
 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.
 221
 222 The argument may be either a single comment string or a list of name-value
 223 pairs.  Thus the following are equivalent:
 224
 225     $stats->profile($comment);
 226     $stats->profile(comment => $comment);
 227
 228 The following key names/values may be used:
 229
 230 =over 4
 231
 232 =item * begin => ACTION
 233
 234 Marks the beginning of a block.  The value is used in the description in the
 235 timing report.
 236
 237 =item * end => ACTION
 238
 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.
 243
 244 =item * comment => COMMENT
 245
 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.
 248
 249 =item * uid => UID
 250
 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
 253 sequence.
 254
 255 =item * parent => UID
 256
 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.
 259
 260 =back
 261
 262 Returns the UID of the current point in the profile tree.  The UID is
 263 automatically assigned if not explicitly given.
 264
 265 =head2 elapsed
 266
 267     $elapsed = $stats->elapsed
 268
 269 Get the total elapsed time (in seconds) since the object was created.
 270
 271 =head2 report
 272
 273     print $stats->report ."\n";
 274     $report = $stats->report;
 275     @report = $stats->report;
 276
 277 In scalar context, generates a textual report.  In array context, returns the
 278 array of results where each row comprises:
 279
 280     [ depth, description, time, rollup ]
 281
 282 The depth is the calling stack level of the profiling point.
 283
 284 The description is a combination of the block name and comment.
 285
 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.
 289
 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.
 292
 293
 294 =head1 SEE ALSO
 295
 296 L<Catalyst>.
 297
 298 =head1 AUTHOR
 299
 300 Jon Schutz
 301
 302 =head1 COPYRIGHT
 303
 304 This program is free software, you can redistribute it and/or modify
 305 it under the same terms as Perl itself.
 306
 307 =cut
 308
 309 __PACKAGE__->meta->make_immutable;
 310
 311 1;