X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FController.pm;h=18c825968deb622fdadddf5e6f947652658e80ca;hb=b354201608d428db344c63dd35de096a62a7a9d3;hp=64fa368f284253875724c3cf03118d5efb1a2eee;hpb=0bc4c3ab80525051843dd85cb18f5d3762b0414c;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 64fa368..18c8259 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -1,17 +1,21 @@ package Catalyst::Controller; -#switch to BEGIN { extends qw/ ... /; } ? -use base qw/Catalyst::Component Catalyst::AttrContainer/; use Moose; +use Moose::Util qw/find_meta/; + +use namespace::clean -except => 'meta'; + +# Note - Must be done at compile time due to attributes (::AttrContainer) +BEGIN { extends qw/Catalyst::Component Catalyst::AttrContainer/; } -use Scalar::Util qw/blessed/; use Catalyst::Exception; use Catalyst::Utils; -use Class::Inspector; + +with 'Catalyst::Component::ApplicationAttribute'; has path_prefix => ( - is => 'ro', + is => 'rw', isa => 'Str', init_arg => 'path', predicate => 'has_path_prefix', @@ -19,7 +23,7 @@ has path_prefix => has action_namespace => ( - is => 'ro', + is => 'rw', isa => 'Str', init_arg => 'namespace', predicate => 'has_action_namespace', @@ -32,10 +36,6 @@ has actions => init_arg => undef, ); -# isa => 'ClassName|Catalyst' ? -has _application => (is => 'rw'); -sub _app{ shift->_application(@_) } # eww - sub BUILD { my ($self, $args) = @_; my $action = delete $args->{action} || {}; @@ -53,9 +53,9 @@ Catalyst::Controller - Catalyst Controller base class package MyApp::Controller::Search use base qw/Catalyst::Controller/; - sub foo : Local { + sub foo : Local { my ($self,$c,@args) = @_; - ... + ... } # Dispatches to /search/foo =head1 DESCRIPTION @@ -107,7 +107,7 @@ sub _ACTION : Private { my ( $self, $c ) = @_; if ( ref $c->action && $c->action->can('execute') - && $c->req->action ) + && defined $c->req->action ) { $c->action->dispatch( $c ); } @@ -122,23 +122,18 @@ sub _END : Private { return !@{ $c->error }; } -around new => sub { - my $orig = shift; - my $self = shift; - my $app = $_[0]; - my $new = $self->$orig(@_); - $new->_application( $app ); - return $new; -}; - sub action_for { my ( $self, $name ) = @_; my $app = ($self->isa('Catalyst') ? $self : $self->_application); return $app->dispatcher->get_action($name, $self->action_namespace); } +#my opinion is that this whole sub really should be a builder method, not +#something that happens on every call. Anyone else disagree?? -- groditi +## -- apparently this is all just waiting for app/ctx split around action_namespace => sub { - my ( $orig, $self, $c ) = @_; + my $orig = shift; + my ( $self, $c ) = @_; if( ref($self) ){ return $self->$orig if $self->has_action_namespace; @@ -146,9 +141,6 @@ around action_namespace => sub { return $self->config->{namespace} if exists $self->config->{namespace}; } - #the following looks like a possible target for a default setting. i am not - #making the below the builder because i don't know if $c will vary from - #call to call, which would affect case sensitivitysettings -- groditi my $case_s; if( $c ){ $case_s = $c->config->{case_sensitive}; @@ -164,10 +156,12 @@ around action_namespace => sub { } } - return Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || ''; + my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || ''; + $self->$orig($namespace) if ref($self); + return $namespace; }; - +#Once again, this is probably better written as a builder method around path_prefix => sub { my $orig = shift; my $self = shift; @@ -176,7 +170,9 @@ around path_prefix => sub { } else { return $self->config->{path} if exists $self->config->{path}; } - return $self->action_namespace(@_); + my $namespace = $self->action_namespace(@_); + $self->$orig($namespace) if ref($self); + return $namespace; }; @@ -185,26 +181,16 @@ sub register_actions { my $class = ref $self || $self; #this is still not correct for some reason. my $namespace = $self->action_namespace($c); - my %methods; - if( $self->can('meta') ){ - my $meta = $self->meta; - %methods = map{ $_->{code}->body => $_->{name} } - grep {$_->{class} ne 'Moose::Object'} #ignore Moose::Object methods - $meta->compute_all_applicable_methods; - } else { #until we are sure there's no moose stuff left... - $methods{ $self->can($_) } = $_ - for @{ Class::Inspector->methods($class) || [] }; - } + my $meta = find_meta($self); + my %methods = map { $_->body => $_->name } + $meta->get_all_methods; # Advanced inheritance support for plugins and the like - #to be modified to use meta->superclasses #moose todo: migrate to eliminate CDI compat my @action_cache; - { - no strict 'refs'; - for my $isa ( @{"$class\::ISA"}, $class ) { - push @action_cache, @{ $isa->_action_cache } - if $isa->can('_action_cache'); + for my $isa ( $meta->superclasses, $class ) { + if(my $coderef = $isa->can('_action_cache')){ + push(@action_cache, @{ $isa->$coderef }); } } @@ -318,7 +304,7 @@ sub _parse_Relative_attr { shift->_parse_Local_attr(@_); } sub _parse_Path_attr { my ( $self, $c, $name, $value ) = @_; - $value ||= ''; + $value = '' if !defined $value; if ( $value =~ m!^/! ) { return ( 'Path', $value ); } @@ -340,11 +326,52 @@ sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); } sub _parse_LocalRegex_attr { my ( $self, $c, $name, $value ) = @_; unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; } - return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" ); + + my $prefix = $self->path_prefix( $c ); + $prefix .= '/' if length( $prefix ); + + return ( 'Regex', "^${prefix}${value}" ); } sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); } +sub _parse_Chained_attr { + my ($self, $c, $name, $value) = @_; + + if (defined($value) && length($value)) { + if ($value eq '.') { + $value = '/'.$self->action_namespace($c); + } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) { + my @parts = split '/', $self->action_namespace($c); + my @levels = split '/', $rel; + + $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest); + } elsif ($value !~ m/^\//) { + my $action_ns = $self->action_namespace($c); + + if ($action_ns) { + $value = '/'.join('/', $action_ns, $value); + } else { + $value = '/'.$value; # special case namespace '' (root) + } + } + } else { + $value = '/' + } + + return Chained => $value; +} + +sub _parse_ChainedParent_attr { + my ($self, $c, $name, $value) = @_; + return $self->_parse_Chained_attr($c, $name, '../'.$name); +} + +sub _parse_PathPrefix_attr { + my $self = shift; + return PathPart => $self->path_prefix; +} + sub _parse_ActionClass_attr { my ( $self, $c, $name, $value ) = @_; unless ( $value =~ s/^\+// ) { @@ -362,6 +389,8 @@ sub _parse_MyAction_attr { return ( 'ActionClass', $value ); } +__PACKAGE__->meta->make_immutable; + 1; __END__ @@ -380,7 +409,7 @@ controller name. For instance controller 'MyApp::Controller::Foo::Bar' will be bound to 'foo/bar'. The default Root controller is an example of setting namespace to '' (the null string). -=head2 path +=head2 path Sets 'path_prefix', as described below. @@ -412,8 +441,8 @@ overridden from the "namespace" config key. =head2 $self->path_prefix($c) -Returns the default path prefix for :Local, :LocalRegex and relative -:Path actions in this component. Defaults to the action_namespace or +Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and +relative :Path actions in this component. Defaults to the action_namespace or can be overridden from the "path" config key. =head2 $self->create_action(%args) @@ -429,10 +458,9 @@ Primarily designed for the use of register_actions. Returns the application instance stored by C -=head1 AUTHOR +=head1 AUTHORS -Sebastian Riedel, C -Marcus Ramberg C +Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT