File Coverage

blib/lib/Catalyst/Plugin/Digress.pm
Criterion Covered Total %
statement 27 34 79.4
branch 5 12 41.6
condition 3 9 33.3
subroutine 6 6 100.0
pod 1 1 100.0
total 42 62 67.7


line stmt bran cond sub pod time code
1 1     1   2806 use strict; use warnings;
  1     1   2  
  1         21  
  1         3  
  1         2  
  1         25  
2              
3              
4             use Scalar::Util ();
5 1     1   3 use Carp ();
  1         2  
  1         8  
6 1     1   3  
  1         2  
  1         342  
7             our $VERSION = '1.101';
8              
9             my $c = shift;
10             my $action = shift;
11 4     4 1 263799  
12 4         6 unless ( Scalar::Util::blessed( $action ) && $action->isa( 'Catalyst::Action' ) ) {
13             $action = $c->stack->[-1]->namespace . '/' . $action if $action !~ m!/!;
14 4 50 33     14 $action = $c->dispatcher->get_action_by_path( $action )
15 4 100       24 || Carp::croak "Cannot digress to nonexistant action '$action'";
16 4   66     33 }
17              
18             my $scope_guard = bless [ $c ], 'Catalyst::Plugin::Digress::_ScopeGuard';
19             if ( $c->use_stats ) { # basically Catalyst::_stats_start_execute with less nonsense
20 3         158 my $counter = $c->counter;
21 3 50       7 my $action_name = $action->reverse;
22 0         0 my $uid = $action_name . ++$counter->{ $action_name };
23 0         0 my $stats_info = '-> ' . ( $action_name =~ /->/ ? '' : '/' ) . $action_name;
24 0         0 my $p = $c->stack->[-1];
25 0 0       0 $c->stats->profile(
26 0         0 begin => $stats_info,
27             uid => $uid,
28             parent => ( $p && exists $counter->{ $p = $p->reverse } ? $p . $counter->{ $p } : undef ),
29             );
30 0 0 0     0 push @$scope_guard, $stats_info;
31             }
32 0         0 push @{ $c->stack }, $action;
33              
34 3         8 # using a scope guard to unwind the Catalyst stack allows this call to
  3         55  
35             # happen as the last thing in the function, which avoids the need to
36             # explicitly recreate caller context with wantarray
37             $action->execute( $c->components->{ $action->class }, $c, @_ );
38             }
39 3         19  
40             my ( $c, $stats_info ) = @{ $_[0] };
41             $c->stats->profile( end => $stats_info ) if $stats_info;
42             pop @{ $c->stack };
43 3     3   366 }
  3         8  
44 3 50       7  
45 3         3 1;
  3         45  
46              
47              
48             =pod
49              
50             =encoding UTF-8
51              
52             =head1 NAME
53              
54             Catalyst::Plugin::Digress - A cleaner, simpler, action-only $c->forward
55              
56             =head1 SYNOPSIS
57              
58             $c->digress( 'some/other/action' );
59             $c->digress( 'action_in_same_controller' );
60             $c->digress( $self->action_for( 'action_in_same_controller' ) );
61            
62             my %form = $c->digress( 'validate_params', {
63             name => { required => 1 },
64             email => { type => 'Str' },
65             } );
66              
67             $c->digress( $c->view ); # FAIL: cannot digress to components
68              
69             =head1 DESCRIPTION
70              
71             This plugin gives you the useful part of the Catalyst C<forward> method without
72             the weirdness (or the madness).
73              
74             =head1 METHODS
75              
76             =head2 C<digress>
77              
78             This is akin to C<forward>, with the following differences:
79              
80             =over 2
81              
82             =item * It does not catch exceptions (the most important benefit).
83              
84             =item * It passes parameters like in a normal Perl method call.
85              
86             =item * It does not mess with C<< $c->request->arguments >>.
87              
88             =item * It preserves list vs scalar context for the call.
89              
90             =item *
91              
92             It does not walk the Perl call stack every time (or ever, even once)
93             to figure out what its own name was (or for any other purpose).
94              
95             =item *
96              
97             It cannot forward to components, only actions
98             (because don’t ask how forwarding to components works).
99              
100             =back
101              
102             In other words, is almost identical to a straight method call:
103              
104             package MyApp::Controller::Some;
105             sub other_action : Private { ... }
106              
107             package MyApp::Controller::Root;
108             sub index : Path {
109             my ( $c, @some_args ) = ( shift, @_ );
110             # ...
111             my @some_return = $c->digress( '/some/other_action', @any_old_args );
112             # this is nearly identical to the following line:
113             my @some_return = $c->controller( 'Some' )->other_action( $c, @any_old_args );
114             # ...
115             }
116              
117             Except, of course, that it takes an action path instead of a plain method name,
118             and it maintains the Catalyst action stack for you just like C<forward> would,
119             which keeps various Catalyst mechanisms working, such as calling C<forward> and
120             friends from C<other_action> with a local action name.
121              
122             =head1 AUTHOR
123              
124             Aristotle Pagaltzis <pagaltzis@gmx.de>
125              
126             =head1 COPYRIGHT AND LICENSE
127              
128             This software is copyright (c) 2022 by Aristotle Pagaltzis.
129              
130             This is free software; you can redistribute it and/or modify it under
131             the same terms as the Perl 5 programming language system itself.
132              
133             =cut