From 0889b4ecc65b0e0f0206733f21187722a01e45e2 Mon Sep 17 00:00:00 2001 From: John Napiorkowski Date: Thu, 29 Dec 2022 08:54:43 -0600 Subject: [PATCH] Named actions Allows you to add an additional name to action in a global namespace --- lib/Catalyst.pm | 10 ++ lib/Catalyst/Controller.pm | 121 +++++++++++++++++ lib/Catalyst/DispatchType/Chained.pm | 49 ++++--- lib/Catalyst/Dispatcher.pm | 9 ++ t/named-actions.t | 192 +++++++++++++++++++++++++++ 5 files changed, 362 insertions(+), 19 deletions(-) create mode 100644 t/named-actions.t diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 8e12a057d..baed7b88c 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -2392,8 +2392,18 @@ sub get_action { my $c = shift; $c->dispatcher->get_action(@_) } Gets all actions of a given name in a namespace and all parent namespaces. +=head2 $c->action_for( $action_private_name ) + +Returns the action which matches the full private name or nothing if there's no +matching action + =cut +sub action_for { + my ($c, $action_private_name) = @_ ; + return $c->dispatcher->get_action_by_path($action_private_name); +} + sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) } =head2 $app->handle_request( @arguments ) diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 34ad3505f..649904ebd 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -514,6 +514,8 @@ sub _parse_Chained_attr { my @levels = split '/', $rel; $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest); + } elsif ($value =~ /^\*/) { + $value = "/$value"; } elsif ($value !~ m/^\//) { my $action_ns = $self->action_namespace($c); @@ -1030,6 +1032,125 @@ like websockets. See L for more. +=head2 Name + +Allows you to give you action a globally addressable name, in addition to its private +name. Useful to decouple action referencing via Chaining and link creation from the +actions private name, which is tightly bound to the controller namespace as well as the +action subroutine name. Example: + + package MyApp::Controller::Root; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub root :Chained(/) PathPart('') CaptureArgs(0) Name(Root) { + my ($self, $c) = @_; + } + + MyApp::Controller::Root->config(namespace=>''); + + package MyApp::Controller::Home; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub home :Chained(*Root) Args(0) { + my ($self, $c) = @_; + } + +In this case the 'Home' controller's action '/home/home' is chained to the Root controllers action +'/root'. These declarations are the in practice the same: + + package MyApp::Controller::Home; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + # Reference the target prior chain link via its full private action name + sub home :Chained(/root) Args(0) { + my ($self, $c) = @_; + } + +or: + + # Reference the target prior chain link via a relative action path + sub home :Chained(../root) Args(0) { + my ($self, $c) = @_; + } + +When using a named action's name in a :Chained attribute, when using forward/detach/go/visit or +when using $c->action_for and $controller->action_for you must prefix the name with a '*' so that +we can disambiguate a named action from an action relative path: + + package MyApp::Controller::URI; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub target :Path(/target) Args(0) Name (Target) { + my ($self, $c) = @_; + } + + sub uri :Path(/uri) Args(0) { + my ($self, $c) = @_; + $c->response->body($c->uri_for( $c->action_for('*Target') )); + } + + package MyApp::Controller::Flow; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub test_forward :Path(/forward) Args(0) { + my ($self, $c) = @_; + $c->forward('*ForForward'); + } + + sub forward_target :Action Name(ForForward) { + my ($self, $c) = @_; + $c->response->body('forward'); + } + + sub test_detach :Path(/detach) Args(0) { + my ($self, $c) = @_; + $c->detach('*ForDetach'); + } + + sub detach_target :Action Name(ForDetach) { + my ($self, $c) = @_; + $c->response->body('detach'); + } + + sub test_go :Path(/go) Args(0) { + my ($self, $c) = @_; + $c->detach('*ForGo'); + } + + sub go_target :Action Name(ForGo) { + my ($self, $c) = @_; + $c->response->body('go'); + } + + sub test_visit :Path(/visit) Args(0) { + my ($self, $c) = @_; + $c->detach('*ForVisit'); + } + + sub visit_target :Action Name(ForVisit) { + my ($self, $c) = @_; + $c->response->body('visit'); + } + +B: Named actions are not a replacement for using an actions private name, but are offered +as an option for when additional clarity or action namespace decoupling improve code understanding +and maintainability. + =head1 OPTIONAL METHODS =head2 _parse_[$name]_attr diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index 34faf94e9..3e646ba4d 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -278,25 +278,31 @@ sub recurse_match { next TRY_ACTION unless $action->match_captures($c, \@captures); # try the remaining parts against children of this action - my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match( - $c, '/'.$action->reverse, \@parts - ); - # No best action currently - # OR The action has less parts - # OR The action has equal parts but less captured data (ergo more defined) - if ($actions && - (!$best_action || - $#$action_parts < $#{$best_action->{parts}} || - ($#$action_parts == $#{$best_action->{parts}} && - $#$captures < $#{$best_action->{captures}} && - $n_pathparts > $best_action->{n_pathparts}))) { - my @pathparts = split /\//, $action->attributes->{PathPart}->[0]; - $best_action = { - actions => [ $action, @$actions ], - captures=> [ @captures, @$captures ], - parts => $action_parts, - n_pathparts => scalar(@pathparts) + $n_pathparts, - }; + my @action_names = ($action->reverse); + # try Name first if that exists and then short circuit out + unshift @action_names, map { "*${_}"} @{$action->attributes->{Name}} if exists $action->attributes->{Name}; + + foreach my $action_name (@action_names) { + my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match( + $c, '/'.$action_name, \@parts + ); + # No best action currently + # OR The action has less parts + # OR The action has equal parts but less captured data (ergo more defined) + if ($actions && + (!$best_action || + $#$action_parts < $#{$best_action->{parts}} || + ($#$action_parts == $#{$best_action->{parts}} && + $#$captures < $#{$best_action->{captures}} && + $n_pathparts > $best_action->{n_pathparts}))) { + my @pathparts = split /\//, $action->attributes->{PathPart}->[0]; + $best_action = { + actions => [ $action, @$actions ], + captures=> [ @captures, @$captures ], + parts => $action_parts, + n_pathparts => scalar(@pathparts) + $n_pathparts, + }; + } } } else { @@ -399,6 +405,11 @@ sub register { $self->_actions->{'/'.$action->reverse} = $action; + if(my ($name) = @{$action->attributes->{Name}||[]}) { + die "Named action '$name' is already defined" if exists $self->_actions->{"/*$name"}; + $self->_actions->{"/*$name"} = $action; + } + if (exists $action->attributes->{Args} and exists $action->attributes->{CaptureArgs}) { Catalyst::Exception->throw( "Combining Args and CaptureArgs attributes not supported registering " . diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index 496aaa2bb..61dc89b7e 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -297,6 +297,7 @@ sub _action_rel2abs { sub _invoke_as_path { my ( $self, $c, $rel_path, $args ) = @_; + return $c->action_for($rel_path) if $rel_path =~ m/^\*/; my $path = $self->_action_rel2abs( $c, $rel_path ); my ( $tail, @extra_args ); @@ -585,6 +586,14 @@ sub register { $self->_action_hash->{"$namespace/$name"} = $action; $self->_container_hash->{$namespace} = $container; + + # Named Actions + if(my (@names) = @{$action->attributes->{Name}||[]}) { + foreach my $name (@names) { + die "Named action '$name' is already defined" if $self->_action_hash->{"/*$name"}; + $self->_action_hash->{"/*$name"} = $action; + } + } } sub _find_or_create_action_container { diff --git a/t/named-actions.t b/t/named-actions.t new file mode 100644 index 000000000..58eb86251 --- /dev/null +++ b/t/named-actions.t @@ -0,0 +1,192 @@ +{ + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub root :Chained(/) PathPart('') CaptureArgs(0) Name(Root) { + my ($self, $c) = @_; + } + + sub a :Chained(root) PathPart('a') Args(0) { + my ($self, $c) = @_; + $c->response->body('/a'); + } + + sub b :Chained(*Root) PathPart('b') Args(0) { + my ($self, $c, @a) = @_; + $c->response->body('/b'); + } + + sub c :Chained(*Root) PathPart('c') CaptureArgs(0) Name(C) { } + + MyApp::Controller::Root->config(namespace=>''); + + package MyApp::Controller::Home; + $INC{'MyApp/Controller/Home.pm'} = __FILE__; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub root_a :Chained(*Root) PathPart('home') CaptureArgs(0) { + my ($self, $c) = @_; + } + + sub a :Chained(root_a) PathPart('a') Args(0) { + my ($self, $c) = @_; + $c->response->body('/home/a'); + } + + sub root_b :Chained(../root) PathPart('home') CaptureArgs(0) { + my ($self, $c) = @_; + } + + sub b :Chained(root_b) PathPart('b') Args(0) { + my ($self, $c) = @_; + $c->response->body('/home/b'); + } + + sub d :Chained(*C) PathPart('d') Args(0) Name(D) { + my ($self, $c) = @_; + $c->response->body('/c/d'); + } + + package MyApp::Controller::URI; + $INC{'MyApp/Controller/URI.pm'} = __FILE__; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub uri1 :Path(/uri1) Args(0) { + my ($self, $c) = @_; + $c->response->body($c->uri_for( $c->controller('Root')->action_for('*D') )); + } + + sub uri2 :Path(/uri2) Args(0) { + my ($self, $c) = @_; + $c->response->body($c->uri_for( $c->action_for('*D') )); + } + + sub uri3 :Path(/uri3) Args(0) { + my ($self, $c) = @_; + $c->response->body($c->uri_for( $self->action_for('../*D') )); + } + + package MyApp::Controller::Flow; + $INC{'MyApp/Controller/Flow.pm'} = __FILE__; + + use warnings; + use strict; + use base 'Catalyst::Controller'; + + sub test_forward :Path(/forward) Args(0) { + my ($self, $c) = @_; + $c->forward('*ForForward'); + } + + sub forward_target :Action Name(ForForward) { + my ($self, $c) = @_; + $c->response->body('forward'); + } + + sub test_detach :Path(/detach) Args(0) { + my ($self, $c) = @_; + $c->detach('*ForDetach'); + } + + sub detach_target :Action Name(ForDetach) { + my ($self, $c) = @_; + $c->response->body('detach'); + } + + sub test_go :Path(/go) Args(0) { + my ($self, $c) = @_; + $c->detach('*ForGo'); + } + + sub go_target :Action Name(ForGo) { + my ($self, $c) = @_; + $c->response->body('go'); + } + + sub test_visit :Path(/visit) Args(0) { + my ($self, $c) = @_; + $c->detach('*ForVisit'); + } + + sub visit_target :Action Name(ForVisit) { + my ($self, $c) = @_; + $c->response->body('visit'); + } + + package MyApp; + use Catalyst; + + MyApp->setup; +} + +use Test::More; +use Catalyst::Test 'MyApp'; + +{ + ok my $res = request '/detach'; + is $res->content, 'detach'; +} + +{ + ok my $res = request '/forward'; + is $res->content, 'forward'; +} + +{ + ok my $res = request '/go'; + is $res->content, 'go'; +} + +{ + ok my $res = request '/visit'; + is $res->content, 'visit'; +} + +{ + ok my $res = request '/uri1'; + is $res->content, 'http://localhost/c/d'; + + ok $res = request '/uri2'; + is $res->content, 'http://localhost/c/d'; + + ok $res = request '/uri3'; + is $res->content, 'http://localhost/c/d'; + +} + +{ + ok my $res = request '/a'; + is $res->content, '/a'; +} + +{ + ok my $res = request '/b'; + is $res->content, '/b'; +} + +{ + ok my $res = request '/home/a'; + is $res->content, '/home/a'; +} + +{ + ok my $res = request '/home/b'; + is $res->content, '/home/b'; +} + +{ + ok my $res = request '/c/d'; + is $res->content, '/c/d'; +} + +done_testing;