X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=9183864fe422500e4214e96695e67bbce3fb9576;hp=0e9ebc29341b8e36bebb77b838b3b0218a8a7636;hb=059c085bfcead450e70ace9ef193aa99ac2ab37d;hpb=9c71d51daf53bfd6f77d7e252b594392bd4be3de diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 0e9ebc2..9183864 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -54,16 +54,18 @@ our $DETACH = "catalyst_detach\n"; __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log dispatcher_class - engine_class context_class request_class response_class setup_finished/; + engine_class context_class request_class response_class stats_class + setup_finished/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); __PACKAGE__->engine_class('Catalyst::Engine::CGI'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); +__PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.7011'; +our $VERSION = '5.7013'; sub import { my ( $class, @arguments ) = @_; @@ -240,6 +242,17 @@ MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used. Specifies log level. +=head2 -Stats + +Enables statistics collection and reporting. You can also force this setting +from the system environment with CATALYST_STATS or _STATS. The +environment settings override the application, with _STATS having the +highest priority. + +e.g. + + use Catalyst qw/-Stats=1/ + =head1 METHODS =head2 INFORMATION ABOUT THE CURRENT REQUEST @@ -813,6 +826,7 @@ sub setup { $class->setup_plugins( delete $flags->{plugins} ); $class->setup_dispatcher( delete $flags->{dispatcher} ); $class->setup_engine( delete $flags->{engine} ); + $class->setup_stats( delete $flags->{stats} ); for my $flag ( sort keys %{$flags} ) { @@ -906,6 +920,9 @@ If the last argument to C is a hash reference, it is assumed to contain GET parameter key/value pairs, which will be appended to the URI in standard fashion. +Note that uri_for is destructive to the passed hashref. Subsequent calls +with the same hashref may have unintended results. + Instead of C<$path>, you can also optionally pass a C<$action> object which will be resolved to a path using C<< $c->dispatcher->uri_for_action >>; if the first element of @@ -964,7 +981,7 @@ sub uri_for { $val = '' unless defined $val; (map { $_ = "$_"; - utf8::encode( $_ ); + utf8::encode( $_ ) if utf8::is_utf8($_); # using the URI::Escape pattern here so utf8 chars survive s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; s/ /+/g; @@ -1198,13 +1215,13 @@ sub execute { return $c->state; } - my $stats_info = $c->_stats_start_execute( $code ) if $c->debug; + my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats; push( @{ $c->stack }, $code ); eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }; - $c->_stats_finish_execute( $stats_info ) if $c->debug and $stats_info; + $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info; my $last = pop( @{ $c->stack } ); @@ -1252,51 +1269,43 @@ sub _stats_start_execute { } } - my $node = Tree::Simple->new( - { - action => $action, - elapsed => undef, # to be filled in later - comment => "", - } - ); - $node->setUID( "$code" . $c->counter->{"$code"} ); + my $uid = "$code" . $c->counter->{"$code"}; # is this a root-level call or a forwarded call? if ( $callsub =~ /forward$/ ) { # forward, locate the caller if ( my $parent = $c->stack->[-1] ) { - my $visitor = Tree::Simple::Visitor::FindByUID->new; - $visitor->searchForUID( - "$parent" . $c->counter->{"$parent"} ); - $c->stats->accept($visitor); - if ( my $result = $visitor->getResult ) { - $result->addChild($node); - } + $c->stats->profile( + begin => $action, + parent => "$parent" . $c->counter->{"$parent"}, + uid => $uid, + ); } else { # forward with no caller may come from a plugin - $c->stats->addChild($node); + $c->stats->profile( + begin => $action, + uid => $uid, + ); } } else { - + # root-level call - $c->stats->addChild($node); + $c->stats->profile( + begin => $action, + uid => $uid, + ); } + return $action; - return { - start => [gettimeofday], - node => $node, - }; } sub _stats_finish_execute { my ( $c, $info ) = @_; - my $elapsed = tv_interval $info->{start}; - my $value = $info->{node}->getNodeValue; - $value->{elapsed} = sprintf( '%fs', $elapsed ); + $c->stats->profile( end => $info ); } =head2 $c->_localize_fields( sub { }, \%keys ); @@ -1352,22 +1361,11 @@ sub finalize { $c->finalize_body; } - if ($c->debug) { - my $elapsed = sprintf '%f', tv_interval($c->stats->getNodeValue); + if ($c->use_stats) { + my $elapsed = sprintf '%f', $c->stats->elapsed; my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; - - my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] ); - $c->stats->traverse( - sub { - my $action = shift; - my $stat = $action->getNodeValue; - $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment}, - $stat->{elapsed} || '??' ); - } - ); - $c->log->info( - "Request took ${elapsed}s ($av/s)\n" . $t->draw . "\n" ); + "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); } return $c->response->status; @@ -1437,6 +1435,7 @@ sub finalize_headers { } } else { + # everything should be bytes at this point, but just in case $c->response->content_length( bytes::length( $c->response->body ) ); } } @@ -1567,16 +1566,14 @@ sub prepare { } ); + $c->stats($class->stats_class->new)->enable($c->use_stats); if ( $c->debug ) { - $c->stats(Tree::Simple->new([gettimeofday])); $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } # For on-demand data - $c->request->{_context} = $c; - $c->response->{_context} = $c; - weaken( $c->request->{_context} ); - weaken( $c->response->{_context} ); + $c->request->_context($c); + $c->response->_context($c); # Allow engine to direct the prepare flow (for POE) if ( $c->engine->can('prepare') ) { @@ -2125,6 +2122,26 @@ Sets up plugins. =cut +=head2 $c->setup_stats + +Sets up timing statistics class. + +=cut + +sub setup_stats { + my ( $class, $stats ) = @_; + + Catalyst::Utils::ensure_class_loaded($class->stats_class); + + my $env = Catalyst::Utils::env_value( $class, 'STATS' ); + if ( defined($env) ? $env : ($stats || $class->debug ) ) { + no strict 'refs'; + *{"$class\::use_stats"} = sub { 1 }; + $class->log->debug('Statistics enabled'); + } +} + + =head2 $c->registered_plugins Returns a sorted list of the plugins which have either been stated in the @@ -2188,6 +2205,24 @@ the plugin name does not begin with C. Returns an arrayref of the internal execution stack (actions that are currently executing). +=head2 $c->stats_class + +Returns or sets the stats (timing statistics) class. + +=head2 $c->use_stats + +Returns 1 when stats collection is enabled. Stats collection is enabled +when the -Stats options is set, debug is on or when the _STATS +environment variable is set. + +Note that this is a static method, not an accessor and should be overloaded +by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1). + +=cut + +sub use_stats { 0 } + + =head2 $c->write( $data ) Writes $data to the output stream. When using this method directly, you