X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=e22ff8167d90d72308021c7f0e2f2e21e77d93e3;hp=809d2a4e08b9758d4c323e268b5ebd9b5343e40e;hb=f3414019f472b55682ef3af53f761b6db7955887;hpb=3b6a1db18241beccccb477ffd5f3abeaaff35418 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 809d2a4..e22ff81 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1,7 +1,8 @@ package Catalyst; -use strict; -use base 'Catalyst::Component'; +use Class::C3; +use Moose; +extends 'Catalyst::Component'; use bytes; use Catalyst::Exception; use Catalyst::Log; @@ -13,7 +14,6 @@ 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 (); @@ -30,21 +30,34 @@ use Carp qw/croak carp/; BEGIN { require 5.008001; } -__PACKAGE__->mk_accessors( - qw/counter request response state action stack namespace stats/ -); +has stack => (is => 'rw', default => sub { [] }); +has stash => (is => 'rw', default => sub { {} }); +has state => (is => 'rw', default => 0); +has stats => (is => 'rw'); +has action => (is => 'rw'); +has counter => (is => 'rw', default => sub { {} }); +has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1); +has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1); +has namespace => (is => 'rw'); + +no Moose; attributes->import( __PACKAGE__, \&namespace, 'lvalue' ); sub depth { scalar @{ shift->stack || [] }; } +sub comp { shift->component(@_) } -# Laziness++ -*comp = \&component; -*req = \&request; -*res = \&response; +sub req { + # carp "the use of req() is deprecated in favour of request()"; + my $self = shift; return $self->request(@_); +} +sub res { + # carp "the use of res() is deprecated in favour of response()"; + my $self = shift; return $self->response(@_); +} # For backwards compatibility -*finalize_output = \&finalize_body; +sub finalize_output { shift->finalize_body(@_) }; # For statistics our $COUNT = 1; @@ -52,18 +65,22 @@ our $START = time; our $RECURSION = 1000; our $DETACH = "catalyst_detach\n"; +#I imagine that very few of these really need to be class variables. if any. +#maybe we should just make them attributes with a default? __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.7008'; +our $VERSION = '5.7013'; sub import { my ( $class, @arguments ) = @_; @@ -74,9 +91,19 @@ sub import { my $caller = caller(0); + #why does called have to ISA Catalyst and ISA Controller ? + #Convert test suite to not use the behavior where Myapp ISA Controller + # after that is done we can eliminate that little mess. unless ( $caller->isa('Catalyst') ) { no strict 'refs'; - push @{"$caller\::ISA"}, $class, 'Catalyst::Controller'; + if( $caller->can('meta') ){ + my @superclasses = ($caller->meta->superclasses, $class, 'Catalyst::Controller'); + #my @superclasses = ($caller->meta->superclasses, $class); + $caller->meta->superclasses(@superclasses); + } else { + push @{"$caller\::ISA"}, $class, 'Catalyst::Controller'; + #push @{"$caller\::ISA"}, $class; + } } $caller->arguments( [@arguments] ); @@ -111,7 +138,7 @@ documentation and tutorials. ### in lib/MyApp.pm use Catalyst qw/-Debug/; # include plugins here as well - ### In lib/MyApp/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 @@ -240,6 +267,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 @@ -299,7 +337,7 @@ your code like this: =cut -sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) } +sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) } =head2 $c->detach( $action [, \@arguments ] ) @@ -345,14 +383,17 @@ sub stash { my $c = shift; if (@_) { my $stash = @_ > 1 ? {@_} : $_[0]; - croak('stash takes a hash or hashref') unless ref $stash; + croak('stash takes a hash or hashref') unless ref $stash; foreach my $key ( keys %$stash ) { - $c->{stash}->{$key} = $stash->{$key}; + #shouldn't we hold this in a var and save ourselves the subcall? + $c->next::method->{$key} = $stash->{$key}; } } - return $c->{stash}; + + return $c->next::method; } + =head2 $c->error =head2 $c->error($error, ...) @@ -669,7 +710,7 @@ sub config { $c->log->warn("Setting config after setup has been run is not a good idea.") if ( @_ and $c->setup_finished ); - $c->NEXT::config(@_); + $c->next::method(@_); } =head2 $c->log @@ -813,6 +854,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 +948,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 @@ -931,6 +976,7 @@ sub uri_for { my $params = ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); + carp "uri_for called with undef argument" if grep { ! defined $_ } @args; s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; unshift(@args, $path); @@ -963,7 +1009,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; @@ -992,8 +1038,8 @@ sub welcome_message { "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> - - + + $name on Catalyst $VERSION