X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=0226a1c6b93d4048fd385ccda5c726c0984d8bbb;hp=a3c022b14db86870d2bf129e1d0d3eff7694acf8;hb=39fc6508fb05c3bfdf07166a3c77071ff29fb7c1;hpb=3c9b6867515767b70b7771dd0c32a532f23e876b diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index a3c022b..0226a1c 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -7,6 +7,8 @@ use Moose::Util qw/find_meta/; use bytes; use B::Hooks::EndOfScope (); use Catalyst::Exception; +use Catalyst::Exception::Detach; +use Catalyst::Exception::Go; use Catalyst::Log; use Catalyst::Request; use Catalyst::Request::Upload; @@ -58,8 +60,8 @@ sub finalize_output { shift->finalize_body(@_) }; our $COUNT = 1; our $START = time; our $RECURSION = 1000; -our $DETACH = "catalyst_detach\n"; -our $GO = "catalyst_go\n"; +our $DETACH = Catalyst::Exception::Detach->new; +our $GO = Catalyst::Exception::Go->new; #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? @@ -76,7 +78,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80005'; +our $VERSION = '5.80007'; { my $dev_version = $VERSION =~ /_\d{2}$/; @@ -101,12 +103,13 @@ sub import { } my $meta = Moose::Meta::Class->initialize($caller); - #Moose->import({ into => $caller }); #do we want to do this? - unless ( $caller->isa('Catalyst') ) { my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); $meta->superclasses(@superclasses); } + # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp + $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses); + unless( $meta->has_method('meta') ){ $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } ); } @@ -115,6 +118,8 @@ sub import { $caller->setup_home; } +sub _application { $_[0] } + =head1 NAME Catalyst - The Elegant MVC Web Application Framework @@ -493,8 +498,13 @@ sub clear_errors { $c->error(0); } -# search components given a name and some prefixes sub _comp_search_prefixes { + my $c = shift; + return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_); +} + +# search components given a name and some prefixes +sub _comp_names_search_prefixes { my ( $c, $name, @prefixes ) = @_; my $appclass = ref $c || $c; my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; @@ -510,18 +520,18 @@ sub _comp_search_prefixes { my $query = ref $name ? $name : qr/^$name$/i; my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible; - return map { $c->components->{ $_ } } @result if @result; + return @result if @result; # if we were given a regexp to search against, we're done. return if ref $name; # regexp fallback $query = qr/$name/i; - @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible; + @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible; # no results? try against full names if( !@result ) { - @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible; + @result = grep { m{$query} } keys %eligible; } # don't warn if we didn't find any results, it just might not exist @@ -558,7 +568,9 @@ sub _comp_names { my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; - my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes ); + my @names = map { s{$filter}{}; $_; } + $c->_comp_names_search_prefixes( undef, @prefixes ); + return @names; } @@ -1192,7 +1204,7 @@ sub uri_for { ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); carp "uri_for called with undef argument" if grep { ! defined $_ } @args; - s/([^A-Za-z0-9\-_.!~*'()+])/$URI::Escape::escapes{$1}/go for @args; + s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; unshift(@args, $path); @@ -1223,12 +1235,12 @@ sub uri_for { my $key = $_; $val = '' unless defined $val; (map { - $_ = "$_"; - utf8::encode( $_ ) if utf8::is_utf8($_); + my $param = "$_"; + utf8::encode( $param ) if utf8::is_utf8($param); # using the URI::Escape pattern here so utf8 chars survive - s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; - s/ /+/g; - "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val )); + $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; + $param =~ s/ /+/g; + "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } @@ -1502,11 +1514,11 @@ sub execute { my $last = pop( @{ $c->stack } ); if ( my $error = $@ ) { - if ( !ref($error) and $error eq $DETACH ) { - die $DETACH if($c->depth > 1); + if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) { + $error->rethrow if $c->depth > 1; } - elsif ( !ref($error) and $error eq $GO ) { - die $GO if($c->depth > 0); + elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) { + $error->rethrow if $c->depth > 0; } else { unless ( ref $error ) { @@ -2503,8 +2515,8 @@ the plugin name does not begin with C. $class->_plugins( {} ) unless $class->_plugins; $plugins ||= []; - my @plugins = map { s/\A\+// ? $_ : "Catalyst::Plugin::$_" } @$plugins; - + my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins); + for my $plugin ( reverse @plugins ) { Class::MOP::load_class($plugin); my $meta = find_meta($plugin); @@ -2518,7 +2530,7 @@ the plugin name does not begin with C. grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') } map { find_meta($_) } @plugins; - + Moose::Util::apply_all_roles( $class => @roles ) if @roles; @@ -2777,7 +2789,7 @@ willert: Sebastian Willert =head1 LICENSE -This library is free software, you can redistribute it and/or modify it under +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut