File Coverage

blib/lib/Catalyst/Controller/HTML/FormFu.pm
Criterion Covered Total %
statement 77 95 81.0
branch 22 40 55.0
condition n/a
subroutine 15 16 93.7
pod 1 2 50.0
total 115 153 75.1


line stmt bran cond sub pod time code
1             package Catalyst::Controller::HTML::FormFu;
2              
3 9     9   18626853 use strict;
  9         23  
  9         353  
4              
5             our $VERSION = '2.02'; # VERSION
6              
7 9     9   49 use Moose;
  9         18  
  9         64  
8              
9 9     9   59534 use HTML::FormFu;
  9         4332836  
  9         382  
10 9     9   79 use Config::Any;
  9         23  
  9         185  
11 9     9   7466 use Regexp::Assemble;
  9         101072  
  9         321  
12 9     9   132 use Scalar::Util qw/ isweak weaken /;
  9         29  
  9         523  
13 9     9   55 use Carp qw/ croak /;
  9         21  
  9         324  
14              
15 9     9   52 use namespace::autoclean;
  9         19  
  9         109  
16              
17             # see https://rt.cpan.org/Ticket/Display.html?id=55780
18             BEGIN {
19 9     9   750 extends 'Catalyst::Controller';
20             }
21              
22             with 'Catalyst::Component::InstancePerContext';
23              
24             has _html_formfu_config => ( is => 'rw' );
25              
26             sub build_per_context_instance {
27 112     112 0 2287464 my ( $self, $c ) = @_;
28 112 100       507 return $self unless(ref $c);
29 106         423 $self->{c} = $c;
30              
31             weaken( $self->{c} )
32 106 50       790 if !isweak( $self->{c} );
33              
34 106         464 return $self;
35             }
36              
37             sub BUILD {}
38              
39             after BUILD => sub {
40             my ( $self ) = @_;
41              
42             my $app = $self->_app;
43             my $self_config = $self->config->{'Controller::HTML::FormFu'} || {};
44             my $parent_config = $app->config->{'Controller::HTML::FormFu'} || {};
45              
46             my %defaults = (
47             request_token_enable => 0,
48             request_token_field_name => '_token',
49             request_token_session_key => '__token',
50             request_token_expiration_time => 3600,
51             form_method => 'form',
52             form_stash => 'form',
53             form_attr => 'Form',
54             config_attr => 'FormConfig',
55             method_attr => 'FormMethod',
56             form_action => "Catalyst::Controller::HTML::FormFu::Action::Form",
57             config_action =>
58             "Catalyst::Controller::HTML::FormFu::Action::FormConfig",
59             method_action =>
60             "Catalyst::Controller::HTML::FormFu::Action::FormMethod",
61              
62             multiform_method => 'multiform',
63             multiform_stash => 'multiform',
64             multiform_attr => 'MultiForm',
65             multiform_config_attr => 'MultiFormConfig',
66             multiform_method_attr => 'MultiFormMethod',
67             multiform_action =>
68             "Catalyst::Controller::HTML::FormFu::Action::MultiForm",
69             multiform_config_action =>
70             "Catalyst::Controller::HTML::FormFu::Action::MultiFormConfig",
71             multiform_method_action =>
72             "Catalyst::Controller::HTML::FormFu::Action::MultiFormMethod",
73              
74             context_stash => 'context',
75              
76             model_stash => {},
77              
78             constructor => {},
79             multiform_constructor => {},
80              
81             config_callback => 1,
82             );
83              
84             my %args = ( %defaults, %$parent_config, %$self_config );
85              
86             my $local_path = $app->path_to( 'root', 'formfu' );
87              
88             if ( !exists $args{constructor}{tt_args}
89             || !exists $args{constructor}{tt_args}{INCLUDE_PATH} && -d $local_path )
90             {
91             $args{constructor}{tt_args}{INCLUDE_PATH} = [$local_path];
92             }
93              
94             $args{constructor}{query_type} ||= 'Catalyst';
95              
96             if ( !exists $args{constructor}{config_file_path} ) {
97             $args{constructor}{config_file_path} = $app->path_to( 'root', 'forms' );
98             }
99              
100             # build regexp of file extensions
101             my $regex_builder = Regexp::Assemble->new;
102              
103             map { $regex_builder->add($_) } Config::Any->extensions;
104              
105             $args{_file_ext_regex} = $regex_builder->re;
106              
107             # save config for use by action classes
108             $self->_html_formfu_config( \%args );
109              
110             # add controller methods
111 9     9   59988 no strict 'refs'; ## no critic (ProhibitNoStrict);
  9         21  
  9         7817  
112             *{"$args{form_method}"} = \&_form;
113             *{"$args{multiform_method}"} = \&_multiform;
114             };
115              
116             sub _form {
117 34     34   97 my $self = shift;
118 34         1045 my $config = $self->_html_formfu_config;
119             my $form = HTML::FormFu->new( {
120 34         984 %{ $self->_html_formfu_config->{constructor} },
121 34 50       98 ( @_ ? %{ $_[0] } : () ),
  0         0  
122             } );
123              
124 34         28077 $self->_common_construction($form);
125              
126 34 100       146 if ( $config->{request_token_enable} ) {
127             $form->plugins( {
128             type => 'RequestToken',
129             context => $config->{context_stash},
130             field_name => $config->{request_token_field_name},
131             session_key => $config->{request_token_session_key},
132 26         304 expiration_time => $config->{request_token_expiration_time} } );
133             }
134              
135 34         2866 return $form;
136             }
137              
138             sub _multiform {
139 0     0   0 my $self = shift;
140              
141 0         0 require HTML::FormFu::MultiForm;
142              
143             my $multi = HTML::FormFu::MultiForm->new( {
144 0         0 %{ $self->_html_formfu_config->{constructor} },
145 0         0 %{ $self->_html_formfu_config->{multiform_constructor} },
146 0 0       0 ( @_ ? %{ $_[0] } : () ),
  0         0  
147             } );
148              
149 0         0 $self->_common_construction($multi);
150              
151 0         0 return $multi;
152             }
153              
154             sub _common_construction {
155 34     34   128 my ( $self, $form ) = @_;
156              
157 34 50       150 croak "form or multi arg required" if !defined $form;
158              
159 34         691 $form->query( $self->{c}->request );
160              
161 34         1983 my $config = $self->_html_formfu_config;
162              
163 34 50       143 if ( $config->{config_callback} ) {
164             $form->config_callback( {
165             plain_value => sub {
166 58 50   58   80237 return if !defined $_;
167 58 100       196 s{__uri_for\((.+?)\)__}
168 5         69 { $self->{c}->uri_for( split( '\s*,\s*', $1 ) ) }eg
169             if /__uri_for\(/;
170              
171 58 50       1211 s{__path_to\(\s*(.+?)\s*\)__}
172 0         0 { $self->{c}->path_to( split( '\s*,\s*', $1 ) ) }eg
173             if /__path_to\(/;
174              
175 58 50       193 s{__config\((.+?)\)__}
176 0         0 { $self->{c}->config->{$1} }eg
177             if /__config\(/;
178             }
179 34         382 } );
180              
181             weaken( $self->{c} )
182 34 50       404 if !isweak( $self->{c} );
183             }
184              
185 34 50       161 if ( $config->{languages_from_context} ) {
186 0         0 $form->languages( $self->{c}->languages );
187             }
188              
189 34 50       210 if ( $config->{localize_from_context} ) {
190 0         0 $form->add_localize_object( $self->{c} );
191             }
192              
193 34 50       196 if ( $config->{default_action_use_name} ) {
    50          
194 0         0 my $action = $self->{c}->uri_for( $self->{c}->{action}->name );
195              
196             $self->{c}
197             ->log->debug( "FormFu - Setting default action by name: $action" )
198 0 0       0 if $self->{c}->debug;
199              
200 0         0 $form->action($action);
201             }
202             elsif ( $config->{default_action_use_path} ) {
203 34         815 my $action = $self->{c}->{request}->base . $self->{c}->{request}->path;
204              
205             $self->{c}
206             ->log->debug( "FormFu - Setting default action by path: $action" )
207 34 50       2372 if $self->{c}->debug;
208              
209 34         250 $form->action($action);
210             }
211              
212 34         498 my $context_stash = $config->{context_stash};
213 34         197 $form->stash->{$context_stash} = $self->{c};
214 34         427 weaken( $form->stash->{$context_stash} );
215              
216 34         271 my $model_stash = $config->{model_stash};
217              
218 34         126 for my $model ( keys %$model_stash ) {
219 0         0 $form->stash->{$model} = $self->{c}->model( $model_stash->{$model} );
220             }
221              
222 34         93 return;
223             }
224              
225             sub create_action {
226 459     459 1 2142585 my $self = shift;
227 459         2186 my %args = @_;
228              
229 459         14659 my $config = $self->_html_formfu_config;
230              
231 459         1119 for my $type (
232             qw/
233             form
234             config
235             method
236             multiform
237             multiform_config
238             multiform_method /
239             )
240             {
241 2484         4933 my $attr = $config->{"${type}_attr"};
242              
243 2484 100       6416 if ( exists $args{attributes}{$attr} ) {
    50          
244 99         324 $args{_attr_params} = delete $args{attributes}{$attr};
245             }
246             elsif ( exists $args{attributes}{"$attr()"} ) {
247 0         0 $args{_attr_params} = delete $args{attributes}{"$attr()"};
248             }
249             else {
250 2385         4171 next;
251             }
252              
253 99         230 push @{ $args{attributes}{ActionClass} }, $config->{"${type}_action"};
  99         764  
254 99         221 last;
255             }
256              
257 459         1996 $self->SUPER::create_action(%args);
258             }
259              
260             1;
261              
262             __END__
263              
264             =head1 NAME
265              
266             Catalyst::Controller::HTML::FormFu - Catalyst integration for HTML::FormFu
267              
268             =head1 VERSION
269              
270             version 2.02
271              
272             =head1 SYNOPSIS
273              
274             package MyApp::Controller::My::Controller;
275              
276             use Moose;
277             use namespace::autoclean;
278              
279             BEGIN { extends 'Catalyst::Controller::HTML::FormFu'; }
280              
281             sub index : Local {
282             my ( $self, $c ) = @_;
283              
284             # doesn't use an Attribute to make a form
285             # can get an empty form from $self->form()
286              
287             my $form = $self->form();
288             }
289              
290             sub foo : Local : Form {
291             my ( $self, $c ) = @_;
292              
293             # using the Form attribute is equivalent to:
294             #
295             # my $form = $self->form;
296             #
297             # $form->process;
298             #
299             # $c->stash->{form} = $form;
300             }
301              
302             sub bar : Local : FormConfig {
303             my ( $self, $c ) = @_;
304              
305             # using the FormConfig attribute is equivalent to:
306             #
307             # my $form = $self->form;
308             #
309             # $form->load_config_filestem('root/forms/my/controller/bar');
310             #
311             # $form->process;
312             #
313             # $c->stash->{form} = $form;
314             #
315             # so you only need to do the following...
316              
317             my $form = $c->stash->{form};
318              
319             if ( $form->submitted_and_valid ) {
320             do_something();
321             }
322             }
323              
324             sub baz : Local : FormConfig('my_config') {
325             my ( $self, $c ) = @_;
326              
327             # using the FormConfig attribute with an argument is equivalent to:
328             #
329             # my $form = $self->form;
330             #
331             # $form->load_config_filestem('root/forms/my_config');
332             #
333             # $form->process;
334             #
335             # $c->stash->{form} = $form;
336             #
337             # so you only need to do the following...
338              
339             my $form = $c->stash->{form};
340              
341             if ( $form->submitted_and_valid ) {
342             do_something();
343             }
344             }
345              
346             sub quux : Local : FormMethod('load_form') {
347             my ( $self, $c ) = @_;
348              
349             # using the FormMethod attribute with an argument is equivalent to:
350             #
351             # my $form = $self->form;
352             #
353             # $form->populate( $c->load_form );
354             #
355             # $form->process;
356             #
357             # $c->stash->{form} = $form;
358             #
359             # so you only need to do the following...
360              
361             my $form = $c->stash->{form};
362              
363             if ( $form->submitted_and_valid ) {
364             do_something();
365             }
366             }
367              
368             sub load_form {
369             my ( $self, $c ) = @_;
370              
371             # Automatically called by the above FormMethod('load_form') action.
372             # Called as a method on the controller object, with the context
373             # object as an argument.
374              
375             # Must return a hash-ref suitable to be fed to $form->populate()
376             }
377              
378             You can also use specially-named actions that will only be called under
379             certain circumstances.
380              
381             sub edit : Chained('group') : PathPart : Args(0) : FormConfig { }
382              
383             sub edit_FORM_VALID {
384             my ( $self, $c ) = @_;
385              
386             my $form = $c->stash->{form};
387             my $group = $c->stash->{group};
388              
389             $form->model->update( $group );
390              
391             $c->response->redirect( $c->uri_for( '/group', $group->id ) );
392             }
393              
394             sub edit_FORM_NOT_SUBMITTED {
395             my ( $self, $c ) = @_;
396              
397             my $form = $c->stash->{form};
398             my $group = $c->stash->{group};
399              
400             $form->model->default_values( $group );
401             }
402              
403             =head1 METHODS
404              
405             =head2 form
406              
407             This creates a new L<HTML::FormFu> object, passing as it's argument the
408             contents of the L</constructor> config value.
409              
410             This is useful when using the ConfigForm() or MethodForm() action attributes,
411             to create a 2nd form which isn't populated using a config-file or method
412             return value.
413              
414             sub foo : Local {
415             my ( $self, $c ) = @_;
416              
417             my $form = $self->form;
418             }
419              
420             Note that when using this method, the form's L<query|HTML::FormFu/query>
421             method is not populated with the Catalyst request object.
422              
423             =head1 SPECIAL ACTION NAMES
424              
425             An example showing how a complicated action method can be broken down into
426             smaller sections, making it clearer which code will be run, and when.
427              
428             sub edit : Local : FormConfig {
429             my ( $self, $c ) = @_;
430              
431             my $form = $c->stash->{form};
432             my $group = $c->stash->{group};
433              
434             $c->detach('/unauthorised') unless $c->user->can_edit( $group );
435              
436             if ( $form->submitted_and_valid ) {
437             $form->model->update( $group );
438              
439             $c->response->redirect( $c->uri_for('/group', $group->id ) );
440             return;
441             }
442             elsif ( !$form->submitted ) {
443             $form->model->default_values( $group );
444             }
445              
446             $self->_add_breadcrumbs_nav( $c, $group );
447             }
448              
449             Instead becomes...
450              
451             sub edit : Local : FormConfig {
452             my ( $self, $c ) = @_;
453              
454             $c->detach('/unauthorised') unless $c->user->can_edit(
455             $c->stash->{group}
456             );
457             }
458              
459             sub edit_FORM_VALID {
460             my ( $self, $c ) = @_;
461              
462             my $group = $c->stash->{group};
463              
464             $c->stash->{form}->model->update( $group );
465              
466             $c->response->redirect( $c->uri_for('/group', $group->id ) );
467             }
468              
469             sub edit_FORM_NOT_SUBMITTED {
470             my ( $self, $c ) = @_;
471              
472             $c->stash->{form}->model->default_values(
473             $c->stash->{group}
474             );
475             }
476              
477             sub edit_FORM_RENDER {
478             my ( $self, $c ) = @_;
479              
480             $self->_add_breadcrumbs_nav( $c, $c->stash->{group} );
481             }
482              
483             For any action method that uses a C<Form>, C<FormConfig> or C<FormMethod>
484             attribute, you can add extra methods that use the naming conventions below.
485              
486             These methods will be called after the original, plainly named action method.
487              
488             =head2 _FORM_VALID
489              
490             Run when the form has been submitted and has no errors.
491              
492             =head2 _FORM_SUBMITTED
493              
494             Run when the form has been submitted, regardless of whether or not there was
495             errors.
496              
497             =head2 _FORM_COMPLETE
498              
499             For MultiForms, is run if the MultiForm is completed.
500              
501             =head2 _FORM_NOT_VALID
502              
503             Run when the form has been submitted and there were errors.
504              
505             =head2 _FORM_NOT_SUBMITTED
506              
507             Run when the form has not been submitted.
508              
509             =head2 _FORM_NOT_COMPLETE
510              
511             For MultiForms, is run if the MultiForm is not completed.
512              
513             =head2 _FORM_RENDER
514              
515             For normal C<Form> base classes, this subroutine is run after any of the
516             other special methods, unless C<< $form->submitted_and_valid >> is true.
517              
518             For C<MultiForm> base classes, this subroutine is run after any of the other
519             special methods, unless C<< $multi->complete >> is true.
520              
521             =head1 CUSTOMIZATION
522              
523             You can set your own config settings, using either your controller config
524             or your application config.
525              
526             $c->config( 'Controller::HTML::FormFu' => \%my_values );
527              
528             # or
529              
530             MyApp->config( 'Controller::HTML::FormFu' => \%my_values );
531              
532             # or, in myapp.conf
533              
534             <Controller::HTML::FormFu>
535             default_action_use_path 1
536             </Controller::HTML::FormFu>
537              
538             =head2 form_method
539              
540             Override the method-name used to create a new form object.
541              
542             See L</form>.
543              
544             Default value: C<form>.
545              
546             =head2 form_stash
547              
548             Sets the stash key name used to store the form object.
549              
550             Default value: C<form>.
551              
552             =head2 form_attr
553              
554             Sets the attribute name used to load the
555             L<Catalyst::Controller::HTML::FormFu::Action::Form> action.
556              
557             Default value: C<Form>.
558              
559             =head2 config_attr
560              
561             Sets the attribute name used to load the
562             L<Catalyst::Controller::HTML::FormFu::Action::Config> action.
563              
564             Default value: C<FormConfig>.
565              
566             =head2 method_attr
567              
568             Sets the attribute name used to load the
569             L<Catalyst::Controller::HTML::FormFu::Action::Method> action.
570              
571             Default value: C<FormMethod>.
572              
573             =head2 form_action
574              
575             Sets which package will be used by the Form() action.
576              
577             Probably only useful if you want to create a sub-class which provides custom
578             behaviour.
579              
580             Default value: C<Catalyst::Controller::HTML::FormFu::Action::Form>.
581              
582             =head2 config_action
583              
584             Sets which package will be used by the Config() action.
585              
586             Probably only useful if you want to create a sub-class which provides custom
587             behaviour.
588              
589             Default value: C<Catalyst::Controller::HTML::FormFu::Action::Config>.
590              
591             =head2 method_action
592              
593             Sets which package will be used by the Method() action.
594              
595             Probably only useful if you want to create a sub-class which provides custom
596             behaviour.
597              
598             Default value: C<Catalyst::Controller::HTML::FormFu::Action::Method>.
599              
600             =head2 constructor
601              
602             Pass common defaults to the L<HTML::FormFu constructor|HTML::FormFu/new>.
603              
604             These values are used by all of the action attributes, and by the
605             C<< $self->form >> method.
606              
607             Default value: C<{}>.
608              
609             =head2 config_callback
610              
611             Arguments: bool
612              
613             If true, a coderef is passed to C<< $form->config_callback->{plain_value} >>
614             which replaces any instance of C<__uri_for(URI)__> found in form config files
615             with the result of passing the C<URI> argument to L<Catalyst/uri_for>.
616              
617             The form C<< __uri_for(URI, PATH, PARTS)__ >> is also supported, which is
618             equivalent to C<< $c->uri_for( 'URI', \@ARGS ) >>. At this time, there is no
619             way to pass query values equivalent to
620             C<< $c->uri_for( 'URI', \@ARGS, \%QUERY_VALUES ) >>.
621              
622             The second codeword that is being replaced is C<__path_to( @DIRS )__>. Any
623             instance is replaced with the result of passing the C<DIRS> arguments to
624             L<Catalyst/path_to>.
625             Don't use qoutationmarks as they would become part of the path.
626              
627             Default value: 1
628              
629             =head2 default_action_use_name
630              
631             If set to a true value the action for the form will be set to the currently
632             called action name.
633              
634             Default value: C<false>.
635              
636             =head2 default_action_use_path
637              
638             If set to a true value the action for the form will be set to the currently
639             called action path.
640             The action path includes concurrent to action name additioal parameters which
641             were code inside the path.
642              
643             Default value: C<false>.
644              
645             Example:
646              
647             action: /foo/bar
648             called uri contains: /foo/bar/1
649              
650             # default_action_use_name => 1 leads to:
651             $form->action = /foo/bar
652              
653             # default_action_use_path => 1 leads to:
654             $form->action = /foo/bar/1
655              
656             =head2 model_stash
657              
658             Arguments: \%stash_keys_to_model_names
659              
660             Used to place Catalyst models on the form stash.
661              
662             If it's being used to make a L<DBIx::Class> schema available for
663             L<HTML::FormFu::Model::DBIC/options_from_model>, for C<Select> and other
664             Group-type elements - then the hash-key must be C<schema>. For example, if
665             your schema model class is C<MyApp::Model::MySchema>, you would set
666             C<model_stash> like so:
667              
668             <Controller::HTML::FormFu>
669             <model_stash>
670             schema MySchema
671             </model_stash>
672             </Controller::HTML::FormFu>
673              
674             =head2 context_stash
675              
676             To allow your form validation packages, etc, access to the catalyst context,
677             a weakened reference of the context is copied into the form's stash.
678              
679             $form->stash->{context};
680              
681             This setting allows you to change the key name used in the form stash.
682              
683             Default value: C<context>
684              
685             =head2 languages_from_context
686              
687             If you're using a L10N / I18N plugin such as L<Catalyst::Plugin::I18N> which
688             provides a C<languages> method that returns a list of valid languages to use
689             for the currect request - and you want to use formfu's built-in I18N packages,
690             then setting L</languages_from_context>
691              
692             =head2 localize_from_context
693              
694             If you're using a L10N / I18N plugin such as L<Catalyst::Plugin::I18N> which
695             provides it's own C<localize> method, you can set L<localize_from_context> to
696             use that method for formfu's localization.
697              
698             =head2 request_token_enable
699              
700             If true, adds an instance of L<HTML::FormFu::Plugin::RequestToken> to every
701             form, to stop accidental double-submissions of data and to prevent CSRF attacks.
702              
703             =head2 request_token_field_name
704              
705             Defaults to C<_token>.
706              
707             =head2 request_token_session_key
708              
709             Defaults to C<__token>.
710              
711             =head2 request_token_expiration_time
712              
713             Defaults to C<3600>.
714              
715             =head1 DISCONTINUED CONFIG SETTINGS
716              
717             =head2 config_file_ext
718              
719             Support for this has now been removed. Config files are now searched
720             for, with any file extension supported by Config::Any.
721              
722             =head2 config_file_path
723              
724             Support for this has now been removed.
725             Use C<< {constructor}{config_file_path} >> instead.
726              
727             =head1 CAVEATS
728              
729             When using the C<Form> action attribute to create an empty form, you must
730             call L<< $form->process|HTML::FormFu/process >> after populating the form.
731             However, you don't need to pass any arguments to C<process>, as the
732             Catalyst request object will have automatically been set in
733             L<< $form->query|HTML::FormFu/query >>.
734              
735             When using the C<FormConfig> and C<FormMethod> action attributes, if you
736             make any modifications to the form, such as adding or changing it's
737             elements, you must call L<< $form->process|HTML::FormFu/process >> before
738             rendering the form.
739              
740             =head1 GITHUB REPOSITORY
741              
742             This module's sourcecode is maintained in a git repository at
743             L<git://github.com/fireartist/Catalyst-Controller-HTML-FormFu.git>
744              
745             The project page is L<https://github.com/fireartist/Catalyst-Controller-HTML-FormFu>
746              
747             =head1 SEE ALSO
748              
749             L<HTML::FormFu>, L<Catalyst::Helper::HTML::FormFu>
750              
751             =head1 AUTHOR
752              
753             Carl Franks, C<cfranks@cpan.org>
754              
755             =head1 COPYRIGHT AND LICENSE
756              
757             Copyright (C) 2007 by Carl Franks
758              
759             This library is free software; you can redistribute it and/or modify
760             it under the same terms as Perl itself, either Perl version 5.8.8 or,
761             at your option, any later version of Perl 5 you may have available.
762              
763             =cut