X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FController.pm;h=18c825968deb622fdadddf5e6f947652658e80ca;hp=78a60a61de4b7c80e6a1bb404db958b1d0774998;hb=ae29b412955743885e80350085167b54b69672da;hpb=9287719bfa7656dd651d04cb624dd1b586af7178 diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 78a60a6..18c8259 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -1,12 +1,48 @@ package Catalyst::Controller; -use strict; -use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/; +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 Catalyst::Exception; use Catalyst::Utils; -use Class::Inspector; -use NEXT; + +with 'Catalyst::Component::ApplicationAttribute'; + +has path_prefix => + ( + is => 'rw', + isa => 'Str', + init_arg => 'path', + predicate => 'has_path_prefix', + ); + +has action_namespace => + ( + is => 'rw', + isa => 'Str', + init_arg => 'namespace', + predicate => 'has_action_namespace', + ); + +has actions => + ( + is => 'rw', + isa => 'HashRef', + init_arg => undef, + ); + +sub BUILD { + my ($self, $args) = @_; + my $action = delete $args->{action} || {}; + my $actions = delete $args->{actions} || {}; + my $attr_value = $self->merge_config_hashes($actions, $action); + $self->actions($attr_value); +} =head1 NAME @@ -15,31 +51,29 @@ Catalyst::Controller - Catalyst Controller base class =head1 SYNOPSIS package MyApp::Controller::Search - use base qw/Catalyst::Controller; + use base qw/Catalyst::Controller/; sub foo : Local { - my ($self,$c,@args) = @_; - ... + my ($self,$c,@args) = @_; + ... } # Dispatches to /search/foo =head1 DESCRIPTION -Controllers are where the actions in the Catalyst framework reside. each -action is represented by a function with an attribute to identify what kind -of action it is. See the L for more info about how -Catalyst dispatches to actions. +Controllers are where the actions in the Catalyst framework +reside. Each action is represented by a function with an attribute to +identify what kind of action it is. See the L +for more info about how Catalyst dispatches to actions. =cut +#I think both of these could be attributes. doesn't really seem like they need +#to ble class data. i think that attributes +default would work just fine __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/; __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] ); __PACKAGE__->_action_class('Catalyst::Action'); -__PACKAGE__->mk_accessors( qw/_application/ ); - -### _app as alias -*_app = *_application; sub _DISPATCH : Private { my ( $self, $c ) = @_; @@ -73,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 ); } @@ -88,59 +122,75 @@ sub _END : Private { return !@{ $c->error }; } -sub new { - my $self = shift; - my $app = $_[0]; - my $new = $self->NEXT::new(@_); - $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); } -sub 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 = shift; my ( $self, $c ) = @_; - unless ( $c ) { - $c = ($self->isa('Catalyst') ? $self : $self->_application); + + if( ref($self) ){ + return $self->$orig if $self->has_action_namespace; + } else { + return $self->config->{namespace} if exists $self->config->{namespace}; } - my $hash = (ref $self ? $self : $self->config); # hate app-is-class - return $hash->{namespace} if exists $hash->{namespace}; - return Catalyst::Utils::class2prefix( ref($self) || $self, - $c->config->{case_sensitive} ) - || ''; -} -sub path_prefix { - my ( $self, $c ) = @_; - unless ( $c ) { - $c = ($self->isa('Catalyst') ? $self : $self->_application); + my $case_s; + if( $c ){ + $case_s = $c->config->{case_sensitive}; + } else { + if ($self->isa('Catalyst')) { + $case_s = $self->config->{case_sensitive}; + } else { + if (ref $self) { + $case_s = $self->_application->config->{case_sensitive}; + } else { + confess("Can't figure out case_sensitive setting"); + } + } } - my $hash = (ref $self ? $self : $self->config); # hate app-is-class - return $hash->{path} if exists $hash->{path}; - return shift->action_namespace(@_); -} + + 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; + if( ref($self) ){ + return $self->$orig if $self->has_path_prefix; + } else { + return $self->config->{path} if exists $self->config->{path}; + } + my $namespace = $self->action_namespace(@_); + $self->$orig($namespace) if ref($self); + return $namespace; +}; sub register_actions { my ( $self, $c ) = @_; my $class = ref $self || $self; + #this is still not correct for some reason. my $namespace = $self->action_namespace($c); - my %methods; - $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 + #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 }); } } @@ -156,7 +206,7 @@ sub register_actions { if $c->debug; next; } - my $reverse = $namespace ? "$namespace/$method" : $method; + my $reverse = $namespace ? "${namespace}/${method}" : $method; my $action = $self->create_action( name => $method, code => $code, @@ -178,10 +228,7 @@ sub create_action { ? $args{attributes}{ActionClass}[0] : $self->_action_class); - unless ( Class::Inspector->loaded($class) ) { - require Class::Inspector->filename($class); - } - + Class::MOP::load_class($class); return $class->new( \%args ); } @@ -204,15 +251,24 @@ sub _parse_attrs { } } - my $hash = (ref $self ? $self : $self->config); # hate app-is-class - - if (exists $hash->{actions} || exists $hash->{action}) { - my $a = $hash->{actions} || $hash->{action}; - %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()), - %raw_attributes, - (exists $a->{$name} ? %{$a->{$name}} : ())); + #I know that the original behavior was to ignore action if actions was set + # but i actually think this may be a little more sane? we can always remove + # the merge behavior quite easily and go back to having actions have + # presedence over action by modifying the keys. i honestly think this is + # superior while mantaining really high degree of compat + my $actions; + if( ref($self) ) { + $actions = $self->actions; + } else { + my $cfg = $self->config; + $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action}); } + %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()), + %raw_attributes, + (exists $actions->{$name} ? %{$actions->{$name}} : ())); + + my %final_attributes; foreach my $key (keys %raw_attributes) { @@ -222,8 +278,8 @@ sub _parse_attrs { foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) { my $meth = "_parse_${key}_attr"; - if ( $self->can($meth) ) { - ( $key, $value ) = $self->$meth( $c, $name, $value ); + if ( my $code = $self->can($meth) ) { + ( $key, $value ) = $self->$code( $c, $name, $value ); } push( @{ $final_attributes{$key} }, $value ); } @@ -248,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 ); } @@ -270,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/^\+// ) { @@ -292,24 +389,27 @@ sub _parse_MyAction_attr { return ( 'ActionClass', $value ); } +__PACKAGE__->meta->make_immutable; + 1; __END__ =head1 CONFIGURATION -As any other L, controllers have a config -hash, accessable through $self->config from the controller actions. -Some settings are in use by the Catalyst framework: +Like any other L, controllers have a config hash, +accessible through $self->config from the controller actions. Some +settings are in use by the Catalyst framework: =head2 namespace -This spesifies the internal namespace the controller should be bound to. By default -the controller is bound to the uri version of the 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 ''. +This specifies the internal namespace the controller should be bound +to. By default the controller is bound to the URI version of the +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 prefix +=head2 path Sets 'path_prefix', as described below. @@ -322,49 +422,49 @@ $self->_application. =head2 $self->action_for('name') -Returns the Catalyst::Action object (if any) for a given method name in -this component. +Returns the Catalyst::Action object (if any) for a given method name +in this component. =head2 $self->register_actions($c) -Finds all applicable actions for this component, creates Catalyst::Action -objects (using $self->create_action) for them and registers them with -$c->dispatcher. +Finds all applicable actions for this component, creates +Catalyst::Action objects (using $self->create_action) for them and +registers them with $c->dispatcher. =head2 $self->action_namespace($c) -Returns the private namespace for actions in this component. Defaults to a value -from the controller name (for e.g. MyApp::Controller::Foo::Bar becomes -"foo/bar") or can be overriden from the "namespace" config key. +Returns the private namespace for actions in this component. Defaults +to a value from the controller name (for +e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be +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 can be -overriden from the "path" config key. +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) -Called with a hash of data to be use for construction of a new Catalyst::Action -(or appropriate sub/alternative class) object. +Called with a hash of data to be use for construction of a new +Catalyst::Action (or appropriate sub/alternative class) object. Primarily designed for the use of register_actions. -=head2 $self->_application +=head2 $self->_application =head2 $self->_app Returns the application instance stored by C -=head1 AUTHOR +=head1 AUTHORS -Sebastian Riedel, C -Marcus Ramberg C +Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify it under -the same terms as Perl itself. +This program is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. =cut