X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=26b5b75ff70b1b7b1189db97904553d7f7f2e9ca;hp=45036a65e96785de55cbb9e6867b5323f3e622f3;hb=8a440eba91ace539964b76901ad0e9274ece4ec6;hpb=55424863eb3c285a31f47e0acedab864ccb1f335 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 45036a6..26b5b75 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1,6 +1,11 @@ package Catalyst; +# we don't need really need this, but if we load it before MRO::Compat gets +# loaded (via Moose and Class::MOP), we can avoid some nasty warnings +use Class::C3; + use Moose; +use Class::MOP::Object (); extends 'Catalyst::Component'; use bytes; use Catalyst::Exception; @@ -29,7 +34,8 @@ use Carp qw/croak carp/; BEGIN { require 5.008001; } -has stack => (is => 'rw', default => sub { [] }); +# FIXME lazy => 1 here makes C::P::Auth tests pass?!? +has stack => (is => 'ro', default => sub { [] }); has stash => (is => 'rw', default => sub { {} }); has state => (is => 'rw', default => 0); has stats => (is => 'rw'); @@ -76,7 +82,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.8000_02'; +our $VERSION = '5.8000_04'; sub import { my ( $class, @arguments ) = @_; @@ -257,7 +263,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 @@ -526,7 +534,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 ); } @@ -1036,6 +1044,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 { @@ -1071,7 +1081,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 @@ -1530,8 +1540,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.

} @@ -2076,9 +2085,10 @@ sub setup_engine { } if ( $ENV{MOD_PERL} ) { - + my $meta = $class->Class::MOP::Object::meta(); + # 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+)+)/; @@ -2136,9 +2146,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; @@ -2200,20 +2207,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. =cut sub setup_log { - my ( $class, $debug ) = @_; + my ( $class, $levels ) = @_; + my %levels; unless ( $class->log ) { - $class->log( Catalyst::Log->new ); + $levels ||= ''; + $levels =~ s/^\s+//; + $levels =~ s/\s+$//; + %levels = map { $_ => 1 } split /\s*,\s*/, $levels || ''; + $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->Class::MOP::Object::meta()->add_method('debug' => sub { 1 }); $class->log->debug('Debug messages enabled'); } } @@ -2237,7 +2259,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->Class::MOP::Object::meta()->add_method('use_stats' => sub { 1 }); $class->log->debug('Statistics enabled'); } } @@ -2280,9 +2302,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->Class::MOP::Object::meta() ) { + my @superclasses = ($plugin, $meta->superclasses ); + $meta->superclasses(@superclasses); } else { unshift @{"$class\::ISA"}, $plugin; } @@ -2431,8 +2453,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: @@ -2482,10 +2504,14 @@ audreyt: Audrey Tang bricas: Brian Cassidy +Caelum: Rafael Kitover + chansen: Christian Hansen chicks: Christopher Hicks +David E. Wheeler + dkubb: Dan Kubb Drew Taylor