File Coverage

blib/lib/Catalyst/ComponentRole/PathFrom.pm
Criterion Covered Total %
statement 54 55 98.1
branch 19 24 79.1
condition 6 9 66.6
subroutine 12 12 100.0
pod 1 1 100.0
total 92 101 91.0


line stmt bran cond sub pod time code
1             package Catalyst::ComponentRole::PathFrom;
2              
3             our $VERSION = '0.001';
4              
5 1     1   2178969 use File::Spec;
  1         3  
  1         42  
6 1     1   8 use Moose::Role;
  1         2  
  1         11  
7              
8             with 'Catalyst::Component::ApplicationAttribute';
9              
10             has extension => (
11             is=>'ro',
12             predicate=>'has_extension');
13              
14             has stash_key => (
15             is=>'ro',
16             required=>1,
17             lazy=>1,
18             builder=>'_build_stash_key');
19              
20 1     1   29 sub _build_stash_key { return 'path_from' }
21              
22             has action_attribute => (
23             is=>'ro',
24             required=>1,
25             lazy=>1,
26             builder=>'_build_action_attribute');
27              
28 1     1   30 sub _build_action_attribute { return 'PathFrom' }
29              
30             has path_base => (
31             is=>'ro',
32             required=>1,
33             lazy=>1,
34             builder=>'_build_path_base');
35              
36             sub _build_path_base {
37 1     1   2 my $self = shift;
38 1         60 my $app = $self->_application;
39 1         13 return $app->config->{root};
40             }
41              
42             sub _normalized_extension {
43 10     10   214 my $self = shift;
44             # Because some people think the '.' is always needed...
45 10         301 my $ext = $self->extension;
46 10         40 $ext =~s/^\.?(.+)$/$1/;
47              
48 10         18 return $ext;
49             }
50              
51             sub _path_from_proto {
52 10     10   25 my ($self, @proto) = @_;
53 10 100       333 my $filepath = $proto[0] eq '' ?
54             File::Spec->catfile(@proto) :
55             $self->path_base->file(@proto);
56              
57 10 50       1246 if($self->has_extension) {
58 10         34 $filepath = $filepath .'.'. $self->_normalized_extension;
59             }
60              
61 10         109 return $filepath;
62             }
63              
64             sub path_from {
65 10     10 1 113602 my $self = shift;
66 10         14 my $proto = shift;
67              
68 10         15 my ($c, $action) = ();
69 10 50       78 if($proto->isa('Catalyst::Action')) {
70 0         0 $action = $proto;
71             } else {
72 10         14 $c = $proto;
73 10         13 my $proto2 = shift;
74 10 100 100     38 if(defined $proto2 && (ref(\$proto2) eq 'SCALAR')) {
75 1         33 my @string_path = $self->_expand_template($c->action, $proto2);
76 1         4 return $self->_path_from_proto(@string_path);
77             }
78             else {
79 9         13 $action = $proto2;
80             }
81             }
82            
83 9 100       19 if(defined $action) {
84             # If an action was submitted, create path ONLY from that.
85 1   33     5 return $self->_path_from_action_attribute($action)||
86             $self->_path_from_action($action);
87             } else {
88 8         163 $action = $c->action;
89             }
90            
91 8   66     49 return $self->_path_from_stash($c) ||
92             $self->_path_from_action_attribute($action) ||
93             $self->_path_from_action($action);
94             }
95              
96             sub _expand_template {
97 8     8   33 my ($self, $action, $pattern) = @_;
98 8         184 my %template_args = (
99             ':namespace' => $action->namespace,
100             ':reverse' => $action->reverse,
101             ':actionname' => $action->name,
102             );
103              
104 13 50       45 return my @parts =
105 13 100       38 map { ref $_ ? @$_ : $_ }
106 8         437 map { defined($template_args{$_}) ? $template_args{$_} : $_ }
107             split('/', $pattern);
108             }
109              
110             sub _path_from_stash {
111 8     8   10 my ($self, $c) = @_;
112 8         17 my $proto = $c->stash->{$self->stash_key};
113 8 100       37 return unless defined $proto;
114              
115 5         95 my @expanded_proto = $self->_expand_template($c->action, $proto);
116 5         12 return $self->_path_from_proto(@expanded_proto);
117             }
118              
119             sub _path_from_action_attribute {
120 4     4   7 my ($self, $action) = @_;
121 4 100       56 my ($proto, @more) = @{$action->attributes->{$self->action_attribute} || []};
  4         106  
122 4 100       23 return unless defined $proto;
123              
124 2 50       6 die "Too many action attributes for $action" if @more;
125              
126 2         9 my @expanded_proto = $self->_expand_template($action, $proto);
127 2         7 return $self->_path_from_proto(@expanded_proto);
128             }
129              
130             sub _path_from_action {
131 2     2   5 my ($self, $action) = @_;
132 2 50       5 return unless defined $action;
133 2         9 return $self->_path_from_proto("$action");
134             }
135              
136             1;
137              
138             =head1 NAME
139              
140             Catalyst::ComponentRole::PathFrom - Derive a path using common Catalyst patterns
141              
142             =head1 SYNOPSIS
143              
144             package MyApp::Model::Path;
145              
146             use Moose;
147              
148             extends 'Catalyst::Component';
149             with 'Catalyst::ComponentRole::PathFrom',
150             'Catalyst::Component::InstancePerContext';
151              
152             has ctx => (is=>'rw', weak_ref=>1);
153              
154             sub build_per_context_instance {
155             my ($self, $c) = @_;
156             $self->ctx($c);
157             return $self;
158             }
159              
160             around 'path_from', sub {
161             my ($orig, $self, @args) = @_;
162             return $self->$orig($self->ctx, @args);
163             };
164              
165             __PACKAGE__->meta->make_immutable;
166              
167             package MyApp::Controller::Example;
168             use base 'Catalyst::Controller';
169              
170             sub test_a :Local {
171             my ($self, $c) = @_;
172             }
173              
174             sub test_b :Local PathFrom('ffffff') {
175             my ($self, $c) = @_;
176             }
177              
178             sub test_c :Local {
179             my ($self, $c) = @_;
180             $c->stash(path_from=>'foo/bar');
181             }
182              
183             =head1 DESCRIPTION
184              
185             Common L<Catalyst> views set a template path using a standard process,
186             typically one based on the action or from a stash key. This component
187             role trys to encapsulate that common pattern, with the hope that it makes
188             it easier for people to make new Views in a consistent way. For example
189             if you make your own custom Views this could save you some time in getting
190             a common and expected setup.
191              
192             =head1 ATTRIBUTES
193              
194             This role exposes the following attributes for configuration
195              
196             =head2 extension
197              
198             Optional. This is a file extension added to the end of your generated file
199             path. For example 'html', 'tt2'. You don't need to include the '.' separator.
200              
201             =head2 stash_key
202              
203             Has default, 'path_from'. Used to set the stash key you wish to use to
204             programmatically set the file path pattern in your action body.
205              
206             =head2 action_attribute
207              
208             Has default, 'PathFrom'. Used to set the action attribute we use to get a file
209             path pattern.
210              
211             =head2 path_base
212              
213             Has default "$app->config->{root}". Used to set the base path for relative
214             paths. Usually you leave this one alone :)
215              
216             =head1 METHODS
217              
218             This role exposes the following public methods
219              
220             =head2 path_from ( $action | $c | $c, $action | $c, $string_path )
221              
222             Builds a full path to a file on the filesystem using common L<Catalyst> conventions.
223              
224             Given an $action, will return $base_path + $action->reverse + $extension OR if
225             the $action has an attribute value for $action_attribute, return $base_path +
226             $action_attribute + $extension.
227              
228             Given $c, will do all the above (using $c->action for $action), but also check if
229             the stash contains $stash_key and if so use that path instead.
230              
231             Given $c, $action, does as above but uses the given $action instead of $c->action
232              
233             Given $c, $string_path, uses $string_path instead of $action->reverse.
234              
235             When using a $string_path, a $stash_key value or a value in $action_attribute you
236             may use the following placeholders in the string (for example ':namespace/foo')
237              
238             =over4
239              
240             =item :namespace
241              
242             The action namespace ($action->namespace), which is typically the controller
243             namespace
244              
245             =item :reverse
246              
247             "$action->reverse" (which is basically the default
248              
249             =item :actionname
250              
251             "action->name" (the subroutine method name, typically).
252              
253             =back
254              
255             B<NOTE>: if you use a $string_path, a $stash_key value or a value in
256             $action_attribute and that value starts with '/', that is a signal you wish to
257             use an absolute path, and we don't prepend $self->base_path. You probably
258             won't need this...
259              
260             =head1 SEE ALSO
261              
262             L<Catalyst>, L<Catalyst::Component>, L<File::Spec>, L<Moose::Role>.
263              
264             =head1 AUTHOR
265            
266             John Napiorkowski L<email:jjnapiork@cpan.org>
267            
268             =head1 COPYRIGHT & LICENSE
269            
270             Copyright 2015, John Napiorkowski L<email:jjnapiork@cpan.org>
271            
272             This library is free software; you can redistribute it and/or modify it under
273             the same terms as Perl itself.
274              
275             =cut