X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=8480fca3450b072bbcd3c819277b1c21f2f3af49;hp=4fd4da2e793981ee5b0dfe75ae0388239c2c9233;hb=3fb903fd7b2a932d4a124dbb3c364275b665858d;hpb=8a27f8606cae3ecb2c064accf2ce0f1138a5ab7b
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 4fd4da2..8480fca 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;
@@ -59,6 +64,7 @@ our $COUNT = 1;
our $START = time;
our $RECURSION = 1000;
our $DETACH = "catalyst_detach\n";
+our $GO = "catalyst_go\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?
@@ -75,7 +81,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 ) = @_;
@@ -525,7 +531,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 );
}
@@ -1035,6 +1041,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 {
@@ -1070,7 +1078,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
@@ -1335,6 +1343,9 @@ sub execute {
if ( !ref($error) and $error eq $DETACH ) {
die $DETACH if($c->depth > 1);
}
+ elsif ( !ref($error) and $error eq $GO ) {
+ die $GO if($c->depth > 0);
+ }
else {
unless ( ref $error ) {
no warnings 'uninitialized';
@@ -1526,8 +1537,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.
}
@@ -2072,9 +2082,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+)+)/;
@@ -2132,9 +2143,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;
@@ -2209,7 +2217,7 @@ sub setup_log {
my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
if ( defined($env_debug) ? $env_debug : $debug ) {
- $class->meta->add_method('debug' => sub { 1 });
+ $class->Class::MOP::Object::meta()->add_method('debug' => sub { 1 });
$class->log->debug('Debug messages enabled');
}
}
@@ -2233,7 +2241,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');
}
}
@@ -2276,9 +2284,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;
}
@@ -2427,8 +2435,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:
@@ -2478,6 +2486,8 @@ audreyt: Audrey Tang
bricas: Brian Cassidy
+Caelum: Rafael Kitover
+
chansen: Christian Hansen
chicks: Christopher Hicks