X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=7cc3184455d51d81d01656a7566ed749929bea4a;hp=96b44a43c2ec792e4376d46006492b8ec90897ea;hb=a5d07d293f196ce3be5efa8eeead2231bbfb6304;hpb=47a6ff618d05d50762b9e653d6a7acb05b82525c diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 96b44a4..7cc3184 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -3,6 +3,7 @@ package Catalyst; use Moose; extends 'Catalyst::Component'; use bytes; +use Scope::Upper (); use Catalyst::Exception; use Catalyst::Log; use Catalyst::Request; @@ -20,16 +21,16 @@ use Time::HiRes qw/gettimeofday tv_interval/; use URI (); use URI::http; use URI::https; -use Scalar::Util qw/weaken blessed/; +use Scalar::Util qw/weaken/; use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use attributes; use utf8; -use Carp qw/croak carp/; +use Carp qw/croak carp shortmess/; BEGIN { require 5.008001; } -has stack => (is => 'rw', default => sub { [] }); +has stack => (is => 'ro', default => sub { [] }); has stash => (is => 'rw', default => sub { {} }); has state => (is => 'rw', default => 0); has stats => (is => 'rw'); @@ -76,7 +77,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.8000_02'; +our $VERSION = '5.8000_05'; sub import { my ( $class, @arguments ) = @_; @@ -257,7 +258,9 @@ MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used. =head2 -Log -Specifies log level. + use Catalyst '-Log=warn,fatal,error'; + +Specifies a comma-delimited list of log levels. =head2 -Stats @@ -503,9 +506,24 @@ sub _comp_search_prefixes { # don't warn if we didn't find any results, it just might not exist if( @result ) { - $c->log->warn( qq(Found results for "${name}" using regexp fallback.) ); - $c->log->warn( 'Relying on the regexp fallback behavior for component resolution is unreliable and unsafe.' ); - $c->log->warn( 'If you really want to search, pass in a regexp as the argument.' ); + my $msg = "Used regexp fallback for \$c->model('${name}'), which found '" . + (join '", "', @result) . "'. Relying on regexp fallback behavior for " . + "component resolution is unreliable and unsafe."; + my $short = $result[0]; + $short =~ s/.*?Model:://; + my $shortmess = Carp::shortmess(''); + if ($shortmess =~ m#Catalyst/Plugin#) { + $msg .= " You probably need to set '$short' instead of '${name}' in this " . + "plugin's config"; + } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) { + $msg .= " You probably need to set '$short' instead of '${name}' in this " . + "component's config"; + } else { + $msg .= " You probably meant \$c->model('$short') instead of \$c->model{'${name}'}, " . + "but if you really wanted to search, pass in a regexp as the argument " . + "like so: \$c->model(qr/${name}/)"; + } + $c->log->warn( "${msg}$shortmess" ); } return @result; @@ -526,7 +544,7 @@ sub _comp_names { sub _filter_component { my ( $c, $comp, @args ) = @_; - if ( Scalar::Util::blessed($c) && eval { $comp->can('ACCEPT_CONTEXT'); } ) { + if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) { return $comp->ACCEPT_CONTEXT( $c, @args ); } @@ -606,11 +624,11 @@ sub model { my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/); if( $rest ) { - $c->log->warn( 'Calling $c->model() will return a random model unless you specify one of:' ); + $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') ); $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' ); $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' ); $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' ); - $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' ); + $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); } return $c->_filter_component( $comp ); @@ -663,7 +681,7 @@ sub view { $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' ); $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' ); $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' ); - $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' ); + $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); } return $c->_filter_component( $comp ); @@ -745,7 +763,7 @@ sub component { return map { $c->_filter_component( $_, @args ) } @result if ref $name; if( $result[ 0 ] ) { - $c->log->warn( qq(Found results for "${name}" using regexp fallback.) ); + $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) ); $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' ); $c->log->warn( 'is unreliable and unsafe. You have been warned' ); return $c->_filter_component( $result[ 0 ], @args ); @@ -854,11 +872,19 @@ loads and instantiates the given class. MyApp->plugin( 'prototype', 'HTML::Prototype' ); $c->prototype->define_javascript_functions; + +B This method of adding plugins is deprecated. The ability +to add plugins like this B in a Catalyst 5.9. +Please do not use this functionality in new code. =cut sub plugin { my ( $class, $name, $plugin, @args ) = @_; + + # See block comment in t/unit_core_plugin.t + $class->log->debug(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.9/); + $class->_register_plugin( $plugin, 1 ); eval { $plugin->import }; @@ -965,8 +991,8 @@ EOF my $engine = $class->engine; my $home = $class->config->{home}; - $class->log->debug(qq/Loaded dispatcher "$dispatcher"/); - $class->log->debug(qq/Loaded engine "$engine"/); + $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher))); + $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine))); $home ? ( -d $home ) @@ -975,7 +1001,7 @@ EOF : $class->log->debug(q/Couldn't find home/); } - # Call plugins setup + # Call plugins setup, this is stupid and evil. { no warnings qw/redefine/; local *setup = sub { }; @@ -1010,26 +1036,38 @@ EOF } $class->log->_flush() if $class->log->can('_flush'); + # Make sure that the application class becomes immutable at this point, + # which ensures that it gets an inlined constructor. This means that it + # works even if the user has added a plugin which contains a new method. + # Note however that we have to do the work on scope end, so that method + # modifiers work correctly in MyApp (as you have to call setup _before_ + # applying modifiers). + Scope::Upper::reap(sub { + my $meta = Class::MOP::get_metaclass_by_name($class); + $meta->make_immutable unless $meta->is_immutable; + }, Scope::Upper::SCOPE(1)); + + $class->setup_finalize; +} + +sub setup_finalize { + my ($class) = @_; $class->setup_finished(1); } +=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? ) + =head2 $c->uri_for( $path, @args?, \%query_values? ) -Merges path with C<< $c->request->base >> for absolute URIs and with -C<< $c->namespace >> for relative URIs, then returns a normalized L -object. If any args are passed, they are added at the end of the path. -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. +=over -Note that uri_for is destructive to the passed hashref. Subsequent calls -with the same hashref may have unintended results. +=item $action -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 -C<@args> is an arrayref it is treated as a list of captures to be passed -to C. +A Catalyst::Action object representing the Catalyst action you want to +create a URI for. To get one for an action in the current controller, +use C<< $c->action('someactionname') >>. To get one from different +controller, fetch the controller using C<< $c->controller() >>, then +call C on it. You can maintain the arguments captured by an action (e.g.: Regex, Chained) using C<< $c->req->captures >>. @@ -1040,6 +1078,8 @@ using C<< $c->req->captures >>. # For the Foo action in the Bar controller $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures); +=back + =cut sub uri_for { @@ -1075,7 +1115,7 @@ sub uri_for { # join args with '/', or a blank string my $args = join('/', grep { defined($_) } @args); $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE - $args =~ s!^/!!; + $args =~ s!^/+!!; my $base = $c->req->base; my $class = ref($base); $base =~ s{(?Wiki
  • - Mailing-List + Mailing-List
  • IRC channel #catalyst on irc.perl.org @@ -1534,8 +1574,7 @@ sub finalize_headers { $c->log->debug(qq/Redirecting to "$location"/) if $c->debug; $response->header( Location => $location ); - #Moose TODO: we should probably be using a predicate method here ? - if ( !$response->body ) { + if ( !$response->has_body ) { # Add a default body if none is already present $response->body( qq{

    This item has moved here.

    } @@ -1731,9 +1770,7 @@ Prepares message body. sub prepare_body { my $c = shift; - #Moose TODO: what is _body ?? - # Do we run for the first time? - return if defined $c->request->{_body}; + return if $c->request->_has_body; # Initialize on-demand data $c->engine->prepare_body( $c, @_ ); @@ -2080,9 +2117,10 @@ sub setup_engine { } if ( $ENV{MOD_PERL} ) { - + my $meta = Class::MOP::get_metaclass_by_name($class); + # create the apache method - $class->meta->add_method('apache' => sub { shift->engine->apache }); + $meta->add_method('apache' => sub { shift->engine->apache }); my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; @@ -2140,9 +2178,6 @@ sub setup_engine { } Class::MOP::load_class($engine); - #unless (Class::Inspector->loaded($engine)) { - # require Class::Inspector->filename($engine); - #} # check for old engines that are no longer compatible my $old_engine; @@ -2204,20 +2239,35 @@ sub setup_home { =head2 $c->setup_log -Sets up log. +Sets up log by instantiating a L object and +passing it to C. Pass in a comma-delimited list of levels to set the +log to. + +This method also installs a C method that returns a true value into the +catalyst subclass if the "debug" level is passed in the comma-delimited list, +or if the C<$CATALYST_DEBUG> environment variable is set to a true value. + +Note that if the log has already been setup, by either a previous call to +C or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>, +that this method won't actually set up the log object. =cut sub setup_log { - my ( $class, $debug ) = @_; + my ( $class, $levels ) = @_; + $levels ||= ''; + $levels =~ s/^\s+//; + $levels =~ s/\s+$//; + my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || ''; + unless ( $class->log ) { - $class->log( Catalyst::Log->new ); + $class->log( Catalyst::Log->new(keys %levels) ); } my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' ); - if ( defined($env_debug) ? $env_debug : $debug ) { - $class->meta->add_method('debug' => sub { 1 }); + if ( defined($env_debug) or $levels{debug} ) { + Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 }); $class->log->debug('Debug messages enabled'); } } @@ -2241,7 +2291,7 @@ sub setup_stats { my $env = Catalyst::Utils::env_value( $class, 'STATS' ); if ( defined($env) ? $env : ($stats || $class->debug ) ) { - $class->meta->add_method('use_stats' => sub { 1 }); + Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 }); $class->log->debug('Statistics enabled'); } } @@ -2284,9 +2334,9 @@ the plugin name does not begin with C. $proto->_plugins->{$plugin} = 1; unless ($instant) { no strict 'refs'; - if( $class->can('meta') ){ - my @superclasses = ($plugin, $class->meta->superclasses ); - $class->meta->superclasses(@superclasses); + if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) { + my @superclasses = ($plugin, $meta->superclasses ); + $meta->superclasses(@superclasses); } else { unshift @{"$class\::ISA"}, $plugin; } @@ -2435,8 +2485,8 @@ IRC: Mailing Lists: - http://lists.rawmode.org/mailman/listinfo/catalyst - http://lists.rawmode.org/mailman/listinfo/catalyst-dev + http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst + http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev Web: @@ -2486,10 +2536,14 @@ audreyt: Audrey Tang bricas: Brian Cassidy +Caelum: Rafael Kitover + chansen: Christian Hansen chicks: Christopher Hicks +David E. Wheeler + dkubb: Dan Kubb Drew Taylor @@ -2508,6 +2562,8 @@ ilmari: Dagfinn Ilmari Mannsåker jcamacho: Juan Camacho +jhannah: Jay Hannah + Jody Belka Johan Lindstrom @@ -2542,6 +2598,8 @@ sky: Arthur Bergman the_jester: Jesse Sheidlower +t0m: Tomas Doran + Ulf Edvinsson willert: Sebastian Willert