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