File Coverage

blib/lib/Catalyst/ActionSignatures.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Catalyst::ActionSignatures;
2              
3 3     3   2845460 use Moose;
  3         7  
  3         52  
4 3     3   21731 use B::Hooks::Parser;
  3         6945  
  3         91  
5 3     3   22 use Carp;
  3         9  
  3         3086  
6             extends 'signatures';
7              
8             our $VERSION = '0.008';
9              
10             around 'callback', sub {
11             my ($orig, $self, $offset, $inject) = @_;
12              
13             my @parts = map { ($_ =~ /([\$\%\@]\w+)/g) } split ',', $inject;
14             my $signature = join(',', ('$self', @parts));
15              
16             $self->$orig($offset, $signature);
17              
18             #Is this an action? Sadly we have to guess using a hueristic...
19              
20             my $linestr = B::Hooks::Parser::get_linestr();
21             my ($attribute_area) = ($linestr =~m/\)(.*){/s);
22              
23             # If there's anything in the attribute area, we assume a catalyst action...
24             # Sorry thats th best I can do for now, patches to make it smarter very
25             # welcomed.
26              
27             if($attribute_area =~m/\S/) {
28             $linestr =~s/\{/:Does(MethodSignatureDependencyInjection) :ExecuteArgsTemplate($inject) \{/;
29              
30             # How many numbered or unnumberd args?
31             my $count_args = scalar(my @countargs = $inject=~m/(Arg)[\d+\s\>]/ig);
32             if($count_args and $attribute_area!~m/Args\(.+?\)/i) {
33            
34             my @constraints = ($inject=~m/Arg[\d+\s+][\$\%\@]\w+\s+isa\s+([\w"']+)/gi);
35             if(@constraints) {
36             if(scalar(@constraints) != $count_args) {
37             confess "If you use constraints in a method signature, all args must have constraints";
38             }
39             my $constraint = join ',',@constraints;
40             $linestr =~s/\{/ :Args($constraint) \{/;
41             } else {
42             $linestr =~s/\{/ :Args($count_args) \{/;
43             }
44             }
45              
46             my $count_capture = scalar(my @countcaps = $inject=~m/(capture)[\d+\s\>]/ig);
47             if($count_capture and $attribute_area!~m/CaptureArgs\(.+?\)/i) {
48              
49             my @constraints = ($inject=~m/Capture[\d+\s+][\$\%\@]\w+\s+isa\s+([\w"']+)/gi);
50             if(@constraints) {
51             if(scalar(@constraints) != $count_capture) {
52             confess "If you use constraints in a method signature, all args must have constraints";
53             }
54             my $constraint = join ',',@constraints;
55             $linestr =~s/\{/ :CaptureArgs($constraint) \{/;
56             } else {
57             $linestr =~s/\{/ :CaptureArgs($count_capture) \{/;
58             }
59             }
60              
61             # Check for Args
62             if(($inject=~m/Args/i) and ($attribute_area!~m/Args\s/)) {
63             $linestr =~s/\{/ :Args \{/;
64             }
65              
66             # If there's Chained($target/) thats the convention for last
67             # action in chain with Args(0). So if we detect that and there
68             # is no Args present, add Args(0).
69             ($attribute_area) = ($linestr =~m/\)(.*){/s);
70            
71             if($attribute_area =~m/Chained\(['"]?\w+?\/['"]?\)/) {
72             if($attribute_area!~m/[\s\:]Args/i) {
73             $linestr =~s/Chained\(["']?(\w+?)\/["']?\)/Chained\($1\)/;
74             $linestr =~s/\{/ :Args(0) \{/;
75             } else {
76             # Ok so... someone used .../ BUT already declared Args. Probably
77             # a very common type of error to make. For now lets fix it.
78             $linestr =~s/Chained\(["']?(\w+?)\/["']?\)/Chained\($1\)/;
79             }
80             }
81              
82             # If this is chained but no Args, Args($n) or Captures($n), then add
83             # a CaptureArgs(0). Gotta rebuild the attribute area since we might
84             # have modified it above.
85             ($attribute_area) = ($linestr =~m/\)(.*){/s);
86              
87             if(
88             $attribute_area =~m/Chained/i &&
89             $attribute_area!~m/[\s\:]Args/i &&
90             $attribute_area!~m/CaptureArgs/i
91             ) {
92             $linestr =~s/\{/ :CaptureArgs(0) \{/;
93             }
94              
95             B::Hooks::Parser::set_linestr($linestr);
96              
97             print "\n $linestr \n" if $ENV{CATALYST_METHODSIGNATURES_DEBUG};
98             }
99             };
100              
101             1;
102              
103             =head1 NAME
104              
105             Catalyst::ActionSignatures - so you can stop looking at @_
106              
107             =head1 SYNOPSIS
108              
109             package MyApp::Controller::Example;
110              
111             use Moose;
112             use MooseX::MethodAttributes;
113             use Catalyst::ActionSignatures;
114              
115             extends 'Catalyst::Controller';
116              
117             sub test($Req, $Res, Model::A $A, Model::Z $Z) :Local {
118             # has $self implicitly
119             $Res->body('Look ma, no @_!')
120             }
121              
122             sub regular_method ($arg1, $arg1) {
123             # has $self implicitly
124             }
125              
126             __PACKAGE__->meta->make_immutable;
127              
128             =head1 DESCRIPTION
129              
130             Lets you declare required action dependencies via the method signature.
131              
132             This subclasses L<signatures> to allow you a more concise approach to
133             creating your controllers. This injects your method signature into the
134             code so you don't need to use @_. You should read L<signatures> to be
135             aware of any limitations.
136              
137             For actions and regular controller methods, "$self" is implicitly injected,
138             but '$c' is not. You should add that to the method signature if you need it
139             although you are encouraged to name your dependencies rather than hang it all
140             after $c.
141              
142             You should review L<Catalyst::ActionRole::MethodSignatureDependencyInjection>
143             for more on how to construct signatures.
144              
145             Also L<Catalyst::ActionSignatures::Rationale> may be useful.
146              
147             =head1 Args and Captures
148              
149             If you specify args and captures in your method signature, you can leave off the
150             associated method attributes (Args($n) and CaptureArgs($n)) IF the method
151             signature is the full specification. In other works instead of:
152              
153             sub chain(Model::A $a, Capture $id, $res) :Chained(/) CaptureArgs(1) {
154             Test::Most::is $id, 100;
155             Test::Most::ok $res->isa('Catalyst::Response');
156             }
157              
158             sub endchain($res, Arg0 $name) :Chained(chain) Args(1) {
159             $res->body($name);
160             }
161            
162             sub endchain2($res, Arg $first, Arg $last) :Chained(chain) PathPart(endchain) Args(2) {
163             $res->body("$first $last");
164             }
165              
166             You can do:
167              
168             sub chain(Model::A $a, Capture $id, $res) :Chained(/) {
169             Test::Most::is $id, 100;
170             Test::Most::ok $res->isa('Catalyst::Response');
171             }
172              
173             sub endchain($res, Arg0 $name) :Chained(chain) {
174             $res->body($name);
175             }
176            
177             sub endchain2($res, Arg $first, Arg $last) :Chained(chain) PathPart(endchain) {
178             $res->body("$first $last");
179             }
180              
181             =head1 Type Constraints
182              
183             If you are using a newer L<Catalyst> (greater that 5.90090) you may declare your
184             Args and CaptureArgs typeconstraints via the method signature.
185              
186             use Types::Standard qw/Int Str/;
187              
188             sub chain(Model::A $a, Capture $id isa Int, $res) :Chained(/) {
189             Test::Most::is $id, 100;
190             Test::Most::ok $res->isa('Catalyst::Response');
191             }
192              
193             sub typed0($res, Arg $id) :Chained(chain) PathPart(typed) {
194             $res->body('any');
195             }
196              
197             sub typed1($res, Arg $pid isa Int) :Chained(chain) PathPart(typed) {
198             $res->body('int');
199             }
200              
201             B<NOTE> If you declare any type constraints on args or captures, all declared
202             args or captures must have them.
203              
204             =head1 Implicit 'CaptureArgs(0)' and 'Args(0)' in chained actions
205              
206             If you fail to use an Args or CaptureArgs attributes and you do not declare
207             any captures or args in your chained action method signatures, we automatically
208             add a CaptureArgs(0) attribute. However, since we cannot properly detect the
209             end of a chain, you must still use Args(0) to terminate chains when the
210             last action has no arguments. You may instead use "Chained(link/)" and
211             note the terminal '/' in the chained attribute value to declare a terminal
212             Chain with an implicit Args(0).
213              
214             sub another_chain() :Chained(/) { }
215              
216             sub another_end($res) :Chained(another_chain/) {
217             $res->body('another_end');
218             }
219              
220             =head1 Models and Views
221              
222             As in the documentation in L<Catalyst::ActionRole::MethodSignatureDependencyInjection>
223             you may declare the required models and views for you action via the method
224             prototype:
225              
226             sub myaction(Model::User $user) :Local { ... }
227              
228             You can also access the default/current model and view:
229              
230             sub myaction(Model $current_model) :Local { ... }
231              
232             You can declare models to be required and conform to a type constraint
233              
234             use MyApp::MyTypes 'User';
235              
236             sub find_user(Model::User $u isa User requires
237              
238             =head1 Model and View parameters
239              
240             If your Model or View is a factory that takes parameters, you may supply those
241             from other existing dependencies:
242              
243             # like $c->model('ReturnsArg', $id);
244             sub from_arg($res, Model::ReturnsArg<Arg $id isa '"Int"'> $model) :Local {
245             $res->body("model $model");
246             # $id is also available.
247             }
248              
249             =head1 ENVIRONMENT VARIABLES.
250              
251             Set C<CATALYST_METHODSIGNATURES_DEBUG> to true to get initial debugging output
252             of the generated method signatures and attribute changes. Useful if you are
253             having trouble and want some help to offer a patch!
254              
255             =head1 SEE ALSO
256              
257             L<Catalyst::Action>, L<Catalyst>, L<signatures>,
258             L<Catalyst::ActionRole::MethodSignatureDependencyInjection>
259              
260             =head1 AUTHOR
261            
262             John Napiorkowski L<email:jjnapiork@cpan.org>
263            
264             =head1 COPYRIGHT & LICENSE
265            
266             Copyright 2015, John Napiorkowski L<email:jjnapiork@cpan.org>
267            
268             This library is free software; you can redistribute it and/or modify it under
269             the same terms as Perl itself.
270              
271             =cut