X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FController.pm;h=c5e6249be3b014bd7a24f2b547ac2de8caf59fac;hb=74c89dead3cfd8e95cbe853adbc6fe9eed539f4e;hp=a76337e11523d64e2433ffcf0e3bb93a79b9b3ff;hpb=84ff88cf89ff12ce25b7a9e9748a077427a10c9a;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index a76337e..c5e6249 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -1,14 +1,13 @@ package Catalyst::Controller; #switch to BEGIN { extends qw/ ... /; } ? -use Class::C3; use base qw/Catalyst::Component Catalyst::AttrContainer/; use Moose; +use Class::MOP::Object (); use Scalar::Util qw/blessed/; use Catalyst::Exception; use Catalyst::Utils; -use Class::Inspector; has path_prefix => ( @@ -108,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 ); } @@ -123,13 +122,14 @@ sub _END : Private { return !@{ $c->error }; } -sub new { +around new => sub { + my $orig = shift; my $self = shift; my $app = $_[0]; - my $new = $self->next::method(@_); + my $new = $self->$orig(@_); $new->_application( $app ); return $new; -} +}; sub action_for { my ( $self, $name ) = @_; @@ -139,24 +139,17 @@ sub action_for { #my opinion is that this whole sub really should be a builder method, not #something that happens on every call. Anyone else disagree?? -- groditi - -#we are wrapping the accessor, so just uyse a modifier since a normal sub would -#just be overridden by the generated moose method +## -- apparently this is all just waiting for app/ctx split around action_namespace => sub { my $orig = shift; my ( $self, $c ) = @_; if( ref($self) ){ return $self->$orig if $self->has_action_namespace; - } else { - warn "action_namespace called as class method"; - # if the following won't change at runtime it should be lazy_building thing + } else { 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 sensitivity settings -- groditi my $case_s; if( $c ){ $case_s = $c->config->{case_sensitive}; @@ -197,11 +190,10 @@ sub register_actions { my $class = ref $self || $self; #this is still not correct for some reason. my $namespace = $self->action_namespace($c); - my $meta = $self->meta; - my %methods = map{ $_->{code}->body => $_->{name} } - grep {$_->{class} ne 'Moose::Object'} #ignore Moose::Object methods - $meta->compute_all_applicable_methods; - + my $meta = $self->Class::MOP::Object::meta(); + my %methods = map { $_->body => $_->name } + grep { $_->package_name ne 'Moose::Object' } #ignore Moose::Object methods + $meta->get_all_methods; # Advanced inheritance support for plugins and the like #moose todo: migrate to eliminate CDI compat @@ -322,7 +314,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 ); } @@ -344,11 +336,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/^\+// ) { @@ -368,6 +401,8 @@ sub _parse_MyAction_attr { no Moose; +__PACKAGE__->meta->make_immutable; + 1; __END__ @@ -418,8 +453,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) @@ -435,10 +470,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