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 |