X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=37425b1ecc507d1fa286f091f7b68e1518c56868;hp=809d2a4e08b9758d4c323e268b5ebd9b5343e40e;hb=8e061fef6ed2e38808032cbb722098c5c183ec03;hpb=3b6a1db18241beccccb477ffd5f3abeaaff35418 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 809d2a4..37425b1 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1,7 +1,7 @@ package Catalyst; -use strict; -use base 'Catalyst::Component'; +use Moose; +extends 'Catalyst::Component'; use bytes; use Catalyst::Exception; use Catalyst::Log; @@ -13,7 +13,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,9 +29,16 @@ 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'); + attributes->import( __PACKAGE__, \&namespace, 'lvalue' ); @@ -40,8 +46,15 @@ sub depth { scalar @{ shift->stack || [] }; } # 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; @@ -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 ] ) @@ -341,17 +379,20 @@ Catalyst). =cut -sub stash { +around stash => sub { + my $orig = shift; my $c = shift; + + my $orig_stash = $c->$orig(); 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}; + $orig_stash->{$key} = $stash->{$key}; } } - return $c->{stash}; -} + return $orig_stash; +}; =head2 $c->error @@ -663,14 +704,15 @@ L. =cut -sub config { +around config => sub { + my $orig = shift; my $c = shift; $c->log->warn("Setting config after setup has been run is not a good idea.") if ( @_ and $c->setup_finished ); - $c->NEXT::config(@_); -} + $c->$orig(@_); +}; =head2 $c->log @@ -813,6 +855,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 +949,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 +977,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 +1010,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 +1039,8 @@ sub welcome_message { "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> - - + + $name on Catalyst $VERSION