X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=dd0d1ed8e827f5710399feba9e917364c396d33c;hb=596aaffea2f27d13f0725b72a5b9f79a826d285b;hp=f1bfec475518d35d3b73a3c57c55c570ccad453f;hpb=0e8ab4caab000235ca4dcd614d0b69e593fbc02c;p=catagits%2FCatalyst-Runtime.git
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index f1bfec4..dd0d1ed 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -3,7 +3,6 @@ package Catalyst;
use strict;
use base 'Catalyst::Component';
use bytes;
-use UNIVERSAL::require;
use Catalyst::Exception;
use Catalyst::Log;
use Catalyst::Request;
@@ -11,13 +10,15 @@ use Catalyst::Request::Upload;
use Catalyst::Response;
use Catalyst::Utils;
use Catalyst::Controller;
+use Devel::InnerPackage ();
use File::stat;
+use Module::Pluggable::Object ();
use NEXT;
-use Text::SimpleTable;
-use Path::Class::Dir;
-use Path::Class::File;
+use Text::SimpleTable ();
+use Path::Class::Dir ();
+use Path::Class::File ();
use Time::HiRes qw/gettimeofday tv_interval/;
-use URI;
+use URI ();
use Scalar::Util qw/weaken blessed/;
use Tree::Simple qw/use_weak_refs/;
use Tree::Simple::Visitor::FindByUID;
@@ -25,6 +26,8 @@ use attributes;
use utf8;
use Carp qw/croak/;
+BEGIN { require 5.008001; }
+
__PACKAGE__->mk_accessors(
qw/counter request response state action stack namespace stats/
);
@@ -47,11 +50,6 @@ our $START = time;
our $RECURSION = 1000;
our $DETACH = "catalyst_detach\n";
-require Module::Pluggable::Fast;
-
-# Helper script generation
-our $CATALYST_SCRIPT_GEN = 27;
-
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
engine_class context_class request_class response_class setup_finished/;
@@ -61,7 +59,9 @@ __PACKAGE__->engine_class('Catalyst::Engine::CGI');
__PACKAGE__->request_class('Catalyst::Request');
__PACKAGE__->response_class('Catalyst::Response');
-our $VERSION = '5.67';
+# Remember to update this in Catalyst::Runtime as well!
+
+our $VERSION = '5.7006';
sub import {
my ( $class, @arguments ) = @_;
@@ -87,11 +87,12 @@ Catalyst - The Elegant MVC Web Application Framework
=head1 SYNOPSIS
+ # Install Catalyst::Devel for helpers and other development tools
# use the helper to create a new application
catalyst.pl MyApp
# add models, views, controllers
- script/myapp_create.pl model Database DBIC dbi:SQLite:/path/to/db
+ script/myapp_create.pl model Database DBIC::SchemaLoader dbi:SQLite:/path/to/db
script/myapp_create.pl view TT TT
script/myapp_create.pl controller Search
@@ -104,7 +105,7 @@ Catalyst - The Elegant MVC Web Application Framework
### in lib/MyApp.pm
use Catalyst qw/-Debug/; # include plugins here as well
- ### In libMyApp/Controller/Root.pm (autocreated)
+ ### In lib/MyApp/Controller/Root.pm (autocreated)
sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
$c->stash->{template} = 'foo.tt'; # set the template
@@ -164,14 +165,17 @@ Catalyst - The Elegant MVC Web Application Framework
sub details : Regex('^product/(\w+)/details$') {
my ( $self, $c ) = @_;
# extract the (\w+) from the URI
- my $product = $c->req->snippets->[0];
+ my $product = $c->req->captures->[0];
}
See L
Welcome to the wonderful world of Catalyst.
+ Welcome to the world of Catalyst.
This MVC
framework will make web development something you had
never expected it to be: Fun, rewarding, and quick. That really depends on what you want to do.
We do, however, provide you with a few starting points. If you want to jump right into web development with Catalyst
- you might want to check out the documentation.perldoc Catalyst::Manual::Intro
-perldoc Catalyst::Manual::Tutorial
+ you might want want to start with a tutorial.
perldoc Catalyst::Manual::Tutorial ++
Afterwards you can go on to check out a more complete look at our features.
+
+perldoc Catalyst::Manual::Intro
+
perldoc Catalyst::Manual
Next it's time to write an actual application. Use the
@@ -1082,7 +1133,10 @@ that will be dumped on the error page in debug mode.
sub dump_these {
my $c = shift;
- [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
+ [ Request => $c->req ],
+ [ Response => $c->res ],
+ [ Stash => $c->stash ],
+ [ Config => $c->config ];
}
=head2 $c->engine_class
@@ -1103,7 +1157,7 @@ sub execute {
if ( $c->depth >= $RECURSION ) {
my $action = "$code";
- $action = "/$action" unless $action =~ /\-\>/;
+ $action = "/$action" unless $action =~ /->/;
my $error = qq/Deep recursion detected calling "$action"/;
$c->log->error($error);
$c->error($error);
@@ -1111,21 +1165,21 @@ sub execute {
return $c->state;
}
- my $stats_info = $c->_stats_start_execute( $code );
+ my $stats_info = $c->_stats_start_execute( $code ) if $c->debug;
push( @{ $c->stack }, $code );
eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
- $c->_stats_finish_execute( $stats_info );
+ $c->_stats_finish_execute( $stats_info ) if $c->debug and $stats_info;
- my $last = ${ $c->stack }[-1];
- pop( @{ $c->stack } );
+ my $last = pop( @{ $c->stack } );
if ( my $error = $@ ) {
- if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
+ if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
else {
unless ( ref $error ) {
+ no warnings 'uninitialized';
chomp $error;
my $class = $last->class;
my $name = $last->name;
@@ -1141,13 +1195,14 @@ sub execute {
sub _stats_start_execute {
my ( $c, $code ) = @_;
- return unless $c->debug;
+ return if ( ( $code->name =~ /^_.*/ )
+ && ( !$c->config->{show_internal_actions} ) );
- my $action = "$code";
-
- $action = "/$action" unless $action =~ /\-\>/;
$c->counter->{"$code"}++;
+ my $action = "$code";
+ $action = "/$action" unless $action =~ /->/;
+
# determine if the call was the result of a forward
# this is done by walking up the call stack and looking for a calling
# sub of Catalyst::forward before the eval
@@ -1173,73 +1228,42 @@ sub _stats_start_execute {
);
$node->setUID( "$code" . $c->counter->{"$code"} );
- unless ( ( $code->name =~ /^_.*/ )
- && ( !$c->config->{show_internal_actions} ) )
- {
- # 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);
- }
- }
- else {
-
- # forward with no caller may come from a plugin
- $c->stats->addChild($node);
+ # 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);
}
}
else {
- # root-level call
+ # forward with no caller may come from a plugin
$c->stats->addChild($node);
}
}
+ else {
- my $start = [gettimeofday];
- my $elapsed = tv_interval($start);
+ # root-level call
+ $c->stats->addChild($node);
+ }
return {
- code => $code,
- elapsed => $elapsed,
- start => $start,
+ start => [gettimeofday],
node => $node,
- }
+ };
}
sub _stats_finish_execute {
my ( $c, $info ) = @_;
-
- return unless $c->debug;
-
- my ( $code, $start, $elapsed ) = @{ $info }{qw/code start elapsed/};
-
- unless ( ( $code->name =~ /^_.*/ )
- && ( !$c->config->{show_internal_actions} ) )
- {
-
- # FindByUID uses an internal die, so we save the existing error
- my $error = $@;
-
- # locate the node in the tree and update the elapsed time
- my $visitor = Tree::Simple::Visitor::FindByUID->new;
- $visitor->searchForUID( "$code" . $c->counter->{"$code"} );
- $c->stats->accept($visitor);
- if ( my $result = $visitor->getResult ) {
- my $value = $result->getNodeValue;
- $value->{elapsed} = sprintf( '%fs', $elapsed );
- $result->setNodeValue($value);
- }
-
- # restore error
- $@ = $error || undef;
- }
+ my $elapsed = tv_interval $info->{start};
+ my $value = $info->{node}->getNodeValue;
+ $value->{elapsed} = sprintf( '%fs', $elapsed );
}
=head2 $c->_localize_fields( sub { }, \%keys );
@@ -1274,7 +1298,7 @@ sub finalize {
# Allow engine to handle finalize flow (for POE)
if ( $c->engine->can('finalize') ) {
- $c->engine->finalize( $c );
+ $c->engine->finalize($c);
}
else {
@@ -1294,6 +1318,24 @@ sub finalize {
$c->finalize_body;
}
+
+ if ($c->debug) {
+ my $elapsed = sprintf '%f', tv_interval($c->stats->getNodeValue);
+ my $av = sprintf '%.3f', ( $elapsed == 0 ? '??' : ( 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" );
+ }
return $c->response->status;
}
@@ -1421,38 +1463,16 @@ sub handle_request {
# Always expect worst case!
my $status = -1;
eval {
- my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
-
- my $handler = sub {
- my $c = $class->prepare(@arguments);
- $c->stats($stats);
- $c->dispatch;
- return $c->finalize;
- };
-
- if ( $class->debug ) {
- my $start = [gettimeofday];
- $status = &$handler;
- my $elapsed = tv_interval $start;
- $elapsed = sprintf '%f', $elapsed;
- my $av = sprintf '%.3f',
- ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
- my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
-
- $stats->traverse(
- sub {
- my $action = shift;
- my $stat = $action->getNodeValue;
- $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment},
- $stat->{elapsed} || '??' );
- }
- );
-
- $class->log->info(
- "Request took ${elapsed}s ($av/s)\n" . $t->draw );
+ if ($class->debug) {
+ my $secs = time - $START || 1;
+ my $av = sprintf '%.3f', $COUNT / $secs;
+ my $time = localtime time;
+ $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
}
- else { $status = &$handler }
+ my $c = $class->prepare(@arguments);
+ $c->dispatch;
+ $status = $c->finalize;
};
if ( my $error = $@ ) {
@@ -1489,7 +1509,7 @@ sub prepare {
parameters => {},
query_parameters => {},
secure => 0,
- snippets => [],
+ captures => [],
uploads => {}
}
),
@@ -1506,21 +1526,17 @@ sub prepare {
}
);
+ 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} );
- if ( $c->debug ) {
- my $secs = time - $START || 1;
- my $av = sprintf '%.3f', $COUNT / $secs;
- $c->log->debug('**********************************');
- $c->log->debug("* Request $COUNT ($av/s) [$$]");
- $c->log->debug('**********************************');
- $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
- }
-
# Allow engine to direct the prepare flow (for POE)
if ( $c->engine->can('prepare') ) {
$c->engine->prepare( $c, @arguments );
@@ -1538,7 +1554,7 @@ sub prepare {
}
my $method = $c->req->method || '';
- my $path = $c->req->path || '';
+ my $path = $c->req->path || '/';
my $address = $c->req->address || '';
$c->log->debug(qq/"$method" request for "$path" from "$address"/)
@@ -1575,7 +1591,7 @@ sub prepare_body {
$c->prepare_uploads;
if ( $c->debug && keys %{ $c->req->body_parameters } ) {
- my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
+ my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
for my $key ( sort keys %{ $c->req->body_parameters } ) {
my $param = $c->req->body_parameters->{$key};
my $value = defined($param) ? $param : '';
@@ -1669,7 +1685,7 @@ sub prepare_query_parameters {
$c->engine->prepare_query_parameters( $c, @_ );
if ( $c->debug && keys %{ $c->request->query_parameters } ) {
- my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
+ my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
for my $key ( sort keys %{ $c->req->query_parameters } ) {
my $param = $c->req->query_parameters->{$key};
my $value = defined($param) ? $param : '';
@@ -1709,8 +1725,8 @@ sub prepare_uploads {
if ( $c->debug && keys %{ $c->request->uploads } ) {
my $t = Text::SimpleTable->new(
- [ 12, 'Key' ],
- [ 28, 'Filename' ],
+ [ 12, 'Parameter' ],
+ [ 26, 'Filename' ],
[ 18, 'Type' ],
[ 9, 'Size' ]
);
@@ -1779,64 +1795,74 @@ sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
=head2 $c->setup_components
-Sets up components.
+Sets up components. Specify a C