line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Form::Factory::Processor::Role; |
2
|
|
|
|
|
|
|
$Form::Factory::Processor::Role::VERSION = '0.022'; |
3
|
1
|
|
|
1
|
|
2828
|
use Moose; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
6
|
|
4
|
1
|
|
|
1
|
|
4527
|
use Moose::Exporter; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
37
|
use Carp (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
11
|
|
7
|
1
|
|
|
1
|
|
355
|
use Form::Factory::Action::Role; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
327
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
Moose::Exporter->setup_import_methods( |
10
|
|
|
|
|
|
|
as_is => [ qw( deferred_value ) ], |
11
|
|
|
|
|
|
|
with_meta => [ qw( |
12
|
|
|
|
|
|
|
has_control use_feature |
13
|
|
|
|
|
|
|
has_cleaner has_checker has_pre_processor has_post_processor |
14
|
|
|
|
|
|
|
) ], |
15
|
|
|
|
|
|
|
also => 'Moose::Role', |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# ABSTRACT: Moos-ish helper for action roles |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub init_meta { |
22
|
2
|
|
|
2
|
1
|
685
|
my $package = shift; |
23
|
2
|
|
|
|
|
8
|
my %options = @_; |
24
|
|
|
|
|
|
|
|
25
|
2
|
|
|
|
|
7
|
Moose::Role->init_meta(%options); |
26
|
|
|
|
|
|
|
|
27
|
2
|
|
|
|
|
4464
|
my $meta = Moose::Util::MetaRole::apply_metaroles( |
28
|
|
|
|
|
|
|
for => $options{for_class}, |
29
|
|
|
|
|
|
|
role_metaroles => { |
30
|
|
|
|
|
|
|
role => [ 'Form::Factory::Action::Meta::Role' ], |
31
|
|
|
|
|
|
|
}, |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
2
|
|
|
|
|
1659
|
Moose::Util::apply_all_roles( |
35
|
|
|
|
|
|
|
$options{for_class}, 'Form::Factory::Action::Role', |
36
|
|
|
|
|
|
|
); |
37
|
|
|
|
|
|
|
|
38
|
2
|
|
|
|
|
1546
|
return $meta; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub has_control { |
43
|
2
|
|
|
2
|
1
|
3879
|
my ($meta, $name, $args) = Form::Factory::Processor::_setup_control_defaults(@_); |
44
|
2
|
|
|
|
|
17
|
$meta->add_attribute( $name => %$args ); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub use_feature { |
49
|
0
|
|
|
0
|
1
|
0
|
my $meta = shift; |
50
|
0
|
|
|
|
|
0
|
my $name = shift; |
51
|
0
|
0
|
|
|
|
0
|
my $args = @_ == 1 ? shift : { @_ }; |
52
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
0
|
$meta->features->{$name} = $args; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub deferred_value(&) { |
58
|
0
|
|
|
0
|
1
|
0
|
my $code = shift; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
0
|
return Form::Factory::Processor::DeferredValue->new( |
61
|
|
|
|
|
|
|
code => $code, |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub _add_function { |
67
|
2
|
|
|
2
|
|
3
|
my ($type, $meta, $name, $code) = @_; |
68
|
2
|
50
|
|
|
|
5
|
Carp::croak("bad code given for $type $name") unless defined $code; |
69
|
2
|
|
|
|
|
75
|
$meta->features->{functional}{$type . '_code'}{$name} = $code; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
2
|
|
|
2
|
1
|
159
|
sub has_cleaner { _add_function('cleaner', @_) } |
73
|
0
|
|
|
0
|
1
|
|
sub has_checker { _add_function('checker', @_) } |
74
|
0
|
|
|
0
|
1
|
|
sub has_pre_processor { _add_function('pre_processor', @_) } |
75
|
0
|
|
|
0
|
1
|
|
sub has_post_processor { _add_function('post_processor', @_) } |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
__END__ |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=pod |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=encoding UTF-8 |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 NAME |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Form::Factory::Processor::Role - Moos-ish helper for action roles |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head1 VERSION |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
version 0.022 |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 SYNOPSIS |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
package MyApp::Action::Role::HasAuthor; |
97
|
|
|
|
|
|
|
use Form::Factory::Processor::Role; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
has_control author => ( |
100
|
|
|
|
|
|
|
control => 'text', |
101
|
|
|
|
|
|
|
features => { |
102
|
|
|
|
|
|
|
trim => 1, |
103
|
|
|
|
|
|
|
required => 1, |
104
|
|
|
|
|
|
|
}, |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
has_checker authors_should_be_proper_names => ( |
108
|
|
|
|
|
|
|
my $self = shift; |
109
|
|
|
|
|
|
|
my $value = $self->controls->{author}->current_value; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# We want two words, but only a warning since I have a friend with only |
112
|
|
|
|
|
|
|
# one name... we wouldn't want to discriminate. |
113
|
|
|
|
|
|
|
$self->warning('you really should use a full name') |
114
|
|
|
|
|
|
|
if $value !~ /\w\s+\w/; |
115
|
|
|
|
|
|
|
$self->result->is_valid(1); |
116
|
|
|
|
|
|
|
); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
package MyApp::Action::Post; |
119
|
|
|
|
|
|
|
use Form::Factory::Processor; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
with qw( MyApp::Action::Role::HasAuthor ); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
has_control title => ( |
124
|
|
|
|
|
|
|
control => 'text', |
125
|
|
|
|
|
|
|
features => { |
126
|
|
|
|
|
|
|
trim => 1, |
127
|
|
|
|
|
|
|
required => 1, |
128
|
|
|
|
|
|
|
}, |
129
|
|
|
|
|
|
|
); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
has_control body => ( |
132
|
|
|
|
|
|
|
control => 'full_text', |
133
|
|
|
|
|
|
|
features => { |
134
|
|
|
|
|
|
|
trim => 1, |
135
|
|
|
|
|
|
|
required => 1, |
136
|
|
|
|
|
|
|
}, |
137
|
|
|
|
|
|
|
); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub run { |
140
|
|
|
|
|
|
|
my $self = shift; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my $filename = $self->title . '.txt'; |
143
|
|
|
|
|
|
|
$filename =~ s/\W+/-/g; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
open my $fh, '>', $filename or die "cannot open $filename: $!"; |
146
|
|
|
|
|
|
|
print $fh "Title: ", $self->title, "\n"; |
147
|
|
|
|
|
|
|
print $fh "Author: ", $self->author, "\n"; |
148
|
|
|
|
|
|
|
print $fh "Body: ", $self->body, "\n"; |
149
|
|
|
|
|
|
|
close $fh; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=head1 DESCRIPTION |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
This is a helper class used to define action roles. This class automatically imports the subroutiens described in this documentation as well as any defined in L<Moose::Role>. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
You may compose roles defined this way to build a complete action. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head1 METHODS |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 init_meta |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Sets up the roles and meta-class information for your action role. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head2 has_control |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
has_control $name => ( |
167
|
|
|
|
|
|
|
%usual_has_options, |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
control => $control_short_name, |
170
|
|
|
|
|
|
|
options => \%control_options, |
171
|
|
|
|
|
|
|
features => \%control_features, |
172
|
|
|
|
|
|
|
); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
This works very similar to L<Moose::Role/has>. This applies the L<Form::Factory::Action::Meta::Attribute::Control> trait to the attribute and sets up other defaults. These defaults match those shown in L<Form::Factory::Processor/has_control>. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head2 use_feature |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
This function is used to make an action role use a particular form feature. You use it like this: |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
use_feature $name => \%options; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
The C<%options> are optional. So, this is also acceptable: |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
use_feature $name; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
The C<$name> is a short name for the feature class. For example, the name "require_none_or_all" will load teh feature defined in L<Form::Factory::Features::RequireNoneOrAll>. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head2 deferred_value |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
has_control publish_on => ( |
191
|
|
|
|
|
|
|
control => 'text', |
192
|
|
|
|
|
|
|
options => { |
193
|
|
|
|
|
|
|
default_value => deferred_value { |
194
|
|
|
|
|
|
|
my ($action, $control_name) = @_; |
195
|
|
|
|
|
|
|
DateTime->now->iso8601, |
196
|
|
|
|
|
|
|
}, |
197
|
|
|
|
|
|
|
}, |
198
|
|
|
|
|
|
|
); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
This is a helper for deferring the calculation of a value. This works similar to L<Scalar::Defer> to defer the calculation, but with an important difference. The subroutine is passed the action object (such as it exists while the controls are being constructed) and the control's name. The control itself doesn't exist yet when the subroutine is called. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head2 has_cleaner |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
has_cleaner $name => sub { ... } |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
Adds some code called during the clean phase. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head2 has_checker |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
has_checker $name => sub { ... } |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Adds some code called during the check phase. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head2 has_pre_processor |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
has_pre_processor $name => sub { ... } |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Adds some code called during the pre-process phase. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head2 has_post_processor |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
has_post_processor $name => sub { ... } |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Adds some code called during the post-process phase. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head1 SEE ALSO |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
L<Form::Factory::Action::Role> |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 AUTHOR |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Andrew Sterling Hanenkamp <hanenkamp@cpan.org> |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
This software is copyright (c) 2015 by Qubling Software LLC. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
239
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=cut |