Merge branch 'pr/135' into release-candidates/rc-5.90116

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Stats.pm

diff --git a/lib/Catalyst/Stats.pm b/lib/Catalyst/Stats.pm
index 5fadca6..1987205 100644 (file)
--- a/lib/Catalyst/Stats.pm
+++ b/lib/Catalyst/Stats.pm
@@ -3,14 +3,18 @@ package Catalyst::Stats;
 use Moose;
 use Time::HiRes qw/gettimeofday tv_interval/;
 use Text::SimpleTable ();
+use Catalyst::Utils;
 use Tree::Simple qw/use_weak_refs/;
 use Tree::Simple::Visitor::FindByUID;
 
+use namespace::clean -except => 'meta';
+
 has enable => (is => 'rw', required => 1, default => sub{ 1 });
 has tree => (
              is => 'ro',
              required => 1,
-             default => sub{ Tree::Simple->new({t => [gettimeofday]}) }
+             default => sub{ Tree::Simple->new({t => [gettimeofday]}) },
+             handles => [qw/ accept traverse /],
             );
 has stack => (
               is => 'ro',
@@ -80,6 +84,10 @@ sub profile {
     return $node->getUID;
 }
 
+sub created {
+    return @{ shift->{tree}->getNodeValue->{t} };
+}
+
 sub elapsed {
     return tv_interval(shift->{tree}->getNodeValue->{t});
 }
@@ -87,13 +95,10 @@ sub elapsed {
 sub report {
     my $self = shift;
 
-    # close any remaining open nodes
-    map { $self->profile(end => $_->getNodeValue->{action}) }
-      (reverse @{ $self->stack })[1 .. $#{$self->stack}];
-
-    my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
+    my $column_width = Catalyst::Utils::term_width() - 9 - 13;
+    my $t = Text::SimpleTable->new( [ $column_width, 'Action' ], [ 9, 'Time' ] );
     my @results;
-    $self->tree->traverse(
+    $self->traverse(
                 sub {
                 my $action = shift;
                 my $stat   = $action->getNodeValue;
@@ -103,8 +108,10 @@ sub report {
                       $stat->{elapsed},
                       $stat->{action} ? 1 : 0,
                       );
+                # Trim down any times >= 10 to avoid ugly Text::Simple line wrapping
+                my $elapsed = substr(sprintf("%f", $stat->{elapsed}), 0, 8) . "s";
                 $t->row( ( q{ } x $r[0] ) . $r[1],
-                     defined $r[2] ? sprintf("%fs", $r[2]) : '??');
+                     defined $r[2] ? $elapsed : '??');
                 push(@results, \@r);
                 }
             );
@@ -116,14 +123,51 @@ sub _get_uid {
 
     my $visitor = Tree::Simple::Visitor::FindByUID->new;
     $visitor->searchForUID($uid);
-    $self->tree->accept($visitor);
+    $self->accept($visitor);
     return $visitor->getResult;
 }
 
+sub addChild {
+    my $self = shift;
+    my $node = $_[ 0 ];
+
+    my $stat = $node->getNodeValue;
+
+    # do we need to fake $stat->{ t } ?
+    if( $stat->{ elapsed } ) {
+        # remove the "s" from elapsed time
+        $stat->{ elapsed } =~ s{s$}{};
+    }
+
+    $self->tree->addChild( @_ );
+}
+
+sub setNodeValue {
+    my $self = shift;
+    my $stat = $_[ 0 ];
+
+    # do we need to fake $stat->{ t } ?
+    if( $stat->{ elapsed } ) {
+        # remove the "s" from elapsed time
+        $stat->{ elapsed } =~ s{s$}{};
+    }
+
+    $self->tree->setNodeValue( @_ );
+}
+
+sub getNodeValue {
+    my $self = shift;
+    $self->tree->getNodeValue( @_ )->{ t };
+}
+
+__PACKAGE__->meta->make_immutable();
+
 1;
 
 __END__
 
+=for stopwords addChild getNodeValue mysub rollup setNodeValue
+
 =head1 NAME
 
 Catalyst::Stats - Catalyst Timing Statistics Class
@@ -259,6 +303,13 @@ The profiling point will be ignored if the UID has not been previously defined.
 Returns the UID of the current point in the profile tree.  The UID is
 automatically assigned if not explicitly given.
 
+=head2 created
+
+    ($seconds, $microseconds) = $stats->created;
+
+Returns the time the object was created, in C<gettimeofday> format, with
+Unix epoch seconds followed by microseconds.
+
 =head2 elapsed
 
     $elapsed = $stats->elapsed
@@ -287,18 +338,32 @@ from the previous profiling point.
 The 'rollup' flag indicates whether the reported time is the rolled up time for
 the block, or the elapsed time from the previous profiling point.
 
+=head1 COMPATIBILITY METHODS
+
+Some components might expect the stats object to be a regular Tree::Simple object.
+We've added some compatibility methods to handle this scenario:
+
+=head2 accept
+
+=head2 addChild
+
+=head2 setNodeValue
+
+=head2 getNodeValue
+
+=head2 traverse
 
 =head1 SEE ALSO
 
-L<Catalyst>.
+L<Catalyst>
 
-=head1 AUTHOR
+=head1 AUTHORS
 
-Jon Schutz
+Catalyst Contributors, see Catalyst.pm
 
 =head1 COPYRIGHT
 
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
 it under the same terms as Perl itself.
 
 =cut