X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=537cae1bff92d8a73447444d5835e18729af0f8f;hp=21c04d8e18ae6e03604873557f0773fe44691bfc;hb=e260802a2794d499f6faf2619dbbf943541829ab;hpb=29817f46bdaaa28fb0c1471fc74084482ce6f3ee
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 21c04d8..537cae1 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -2,6 +2,7 @@ package Catalyst;
use Moose;
extends 'Catalyst::Component';
+use Moose::Util qw/find_meta/;
use bytes;
use Scope::Upper ();
use Catalyst::Exception;
@@ -17,13 +18,12 @@ use Module::Pluggable::Object ();
use Text::SimpleTable ();
use Path::Class::Dir ();
use Path::Class::File ();
-use Time::HiRes qw/gettimeofday tv_interval/;
use URI ();
use URI::http;
use URI::https;
-use Scalar::Util qw/weaken/;
use Tree::Simple qw/use_weak_refs/;
use Tree::Simple::Visitor::FindByUID;
+use Class::C3::Adopt::NEXT;
use attributes;
use utf8;
use Carp qw/croak carp shortmess/;
@@ -44,11 +44,9 @@ sub depth { scalar @{ shift->stack || [] }; }
sub comp { shift->component(@_) }
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(@_);
}
@@ -77,7 +75,14 @@ __PACKAGE__->stats_class('Catalyst::Stats');
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.8000_05';
+our $VERSION = '5.80002';
+
+{
+ my $dev_version = $VERSION =~ /_\d{2}$/;
+ *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
+}
+
+$VERSION = eval $VERSION;
sub import {
my ( $class, @arguments ) = @_;
@@ -88,6 +93,12 @@ sub import {
my $caller = caller();
return if $caller eq 'main';
+
+ # Kill Adopt::NEXT warnings if we're a non-RC version
+ unless (_IS_DEVELOPMENT_VERSION()) {
+ Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
+ }
+
my $meta = Moose::Meta::Class->initialize($caller);
#Moose->import({ into => $caller }); #do we want to do this?
@@ -349,9 +360,9 @@ When called with no arguments it escapes the processing chain entirely.
sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
-=head2 $c->visit( $action [, \@arguments ] )
+=head2 $c->visit( $action [, \@captures, \@arguments ] )
-=head2 $c->visit( $class, $method, [, \@arguments ] )
+=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
Almost the same as C
script/${prefix}_create.pl -help
Also, be sure to check out the vast and growing - collection of plugins for Catalyst on CPAN; + collection of plugins for Catalyst on CPAN; you are likely to find what you need there.
@@ -1399,6 +1482,7 @@ sub execute { push( @{ $c->stack }, $code ); + no warnings 'recursion'; eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) }; $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info; @@ -1806,10 +1890,15 @@ sub prepare_body { $c->prepare_parameters; $c->prepare_uploads; - if ( $c->debug ) { - $c->log_parameters( - 'Body Parameters are', $c->request->body_parameters - ); + if ( $c->debug && keys %{ $c->req->body_parameters } ) { + 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 : ''; + $t->row( $key, + ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); + } + $c->log->debug( "Body Parameters are:\n" . $t->draw ); } } @@ -1895,65 +1984,15 @@ sub prepare_query_parameters { $c->engine->prepare_query_parameters( $c, @_ ); - if ( $c->debug ) { - $c->log_parameters( - 'Query Parameters are', $c->request->query_parameters - ); - } -} - -=head2 $c->log_parameters($name, $parameters) - -Logs a hash reference of key value pairs, with a caption above the table. - -Looks like: - - [debug] Query Parameters are: - .-------------------------------------+--------------------------------------. - | Parameter | Value | - +-------------------------------------+--------------------------------------+ - | search | Moose | - | searchtype | modules | - '-------------------------------------+--------------------------------------' - -If there are query parameters you don't want to display in this output, such -as passwords or other sensitive input, you can configure your application to -redact those parameters: - - C<< MyApp->config->{Debug}->{redact_parameters} = [ 'password' ] >> - -In that case, the output will look like: - - [debug] Query Parameters are: - .-------------------------------------+--------------------------------------. - | Parameter | Value | - +-------------------------------------+--------------------------------------+ - | password | (redacted by config) | - | username | some_user | - '-------------------------------------+--------------------------------------' - -=cut - -sub log_parameters { - my ( $c, $name, $parameters ) = @_; - - my $skip = $c->config->{Debug}->{redact_parameters}; - if ( - ( not defined $skip or ref $skip eq 'ARRAY' ) - && keys %{ $parameters } - ) { - my $t = Text::SimpleTable->new( - [ 35, 'Parameter' ], [ 36, 'Value' ] ); - my %skip_params = map { $_ => $_ } @{ $skip || [] }; - for my $key ( sort keys %$parameters ) { - my $param = $parameters->{$key}; + if ( $c->debug && keys %{ $c->request->query_parameters } ) { + 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 : ''; - $value = '(redacted by config)' if exists $skip_params{$key}; - $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); } - $c->log->debug( "$name:\n" . $t->draw ); + $c->log->debug( "Query Parameters are:\n" . $t->draw ); } } @@ -2089,7 +2128,12 @@ sub setup_components { my @comps = sort { length $a <=> length $b } $locator->plugins; my %comps = map { $_ => 1 } @comps; - + + my $deprecated_component_names = grep { /::[CMV]::/ } @comps; + $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}. + qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n} + ) if $deprecated_component_names; + for my $component ( @comps ) { # We pass ignore_loaded here so that overlay files for (e.g.) @@ -2119,6 +2163,14 @@ sub setup_components { =cut +sub _controller_init_base_classes { + my ($class, $component) = @_; + foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) { + Moose->init_meta( for_class => $class ) + unless find_meta($class); + } +} + sub setup_component { my( $class, $component ) = @_; @@ -2126,6 +2178,14 @@ sub setup_component { return $component; } + # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes + # nearest to Catalyst::Controller first, no matter what order stuff happens + # to be loaded. There are TODO tests in Moose for this, see + # f2391d17574eff81d911b97be15ea51080500003 + if ($component->isa('Catalyst::Controller')) { + $class->_controller_init_base_classes($component); + } + my $suffix = Catalyst::Utils::class2classsuffix( $component ); my $config = $class->config->{ $suffix } || {}; @@ -2138,11 +2198,16 @@ sub setup_component { ); } - Catalyst::Exception->throw( - message => - qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/ - ) unless blessed($instance); - + unless (blessed $instance) { + my $metaclass = Moose::Util::find_meta($component); + my $method_meta = $metaclass->find_method_by_name('COMPONENT'); + my $component_method_from = $method_meta->associated_metaclass->name; + my $value = defined($instance) ? $instance : 'undef'; + Catalyst::Exception->throw( + message => + qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./ + ); + } return $instance; } @@ -2333,14 +2398,19 @@ sub setup_log { $levels ||= ''; $levels =~ s/^\s+//; $levels =~ s/\s+$//; - my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || ''; - + my %levels = map { $_ => 1 } split /\s*,\s*/, $levels; + + my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' ); + if ( defined $env_debug ) { + $levels{debug} = 1 if $env_debug; # Ugly! + delete($levels{debug}) unless $env_debug; + } + unless ( $class->log ) { $class->log( Catalyst::Log->new(keys %levels) ); } - my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' ); - if ( defined($env_debug) or $levels{debug} ) { + if ( $levels{debug} ) { Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 }); $class->log->debug('Debug messages enabled'); } @@ -2610,8 +2680,6 @@ audreyt: Audrey Tang bricas: Brian Cassidy