File Coverage

blib/lib/HTML/FormHandler/Wizard.pm
Criterion Covered Total %
statement 36 37 97.3
branch 4 6 66.6
condition 6 8 75.0
subroutine 9 9 100.0
pod 1 7 14.2
total 56 67 83.5


line stmt bran cond sub pod time code
1             package HTML::FormHandler::Wizard;
2             # ABSTRACT: create a multi-page form
3             $HTML::FormHandler::Wizard::VERSION = '0.40067';
4 1     1   624 use HTML::FormHandler::Moose;
  1         1  
  1         6  
5             extends 'HTML::FormHandler';
6             with ('HTML::FormHandler::BuildPages', 'HTML::FormHandler::Pages' );
7              
8              
9 2     2 0 16 sub is_wizard {1}
10              
11             has_field 'page_num' => ( type => 'Hidden', default => 1 );
12              
13             has 'on_last_page' => ( is => 'rw', isa => 'Bool', default => 0 );
14             has 'stash' => ( is => 'rw', isa => 'HashRef' );
15             has 'save_to' => ( is => 'rw', isa => 'Str' ); # 'item', 'stash', 'temp_table'
16              
17             # temp_table: DBIC row or other object with three columns:
18             # form, field, value
19             #
20             has 'temp_table' => ( is => 'rw' );
21              
22             sub validated {
23 16     16 1 13 my $self = shift;
24 16   66     36 return $self->next::method && $self->on_last_page;
25             }
26              
27             sub page_validated {
28 3     3 0 5 my $self = shift;
29 3         12 return $self->SUPER::validated;
30             }
31              
32             sub build_active {
33 2     2 0 3 my $self = shift;
34              
35 2         3 my @page_fields;
36 2         62 foreach my $page ( $self->all_pages ) {
37 6         175 push @page_fields, $page->all_fields;
38             }
39 2         6 foreach my $field_name ( @page_fields ) {
40 6         27 $self->field($field_name)->inactive(1);
41             }
42             }
43              
44              
45             sub set_active {
46 6     6 0 12 my ( $self, $current_page ) = @_;;
47              
48 6   100     135 $current_page ||= $self->get_param('page_num') || 1;
      66        
49 6 50       180 return if $current_page > $self->num_pages;
50 6 100       169 $self->on_last_page(1) if $current_page == $self->num_pages;
51 6         181 my $page = $self->get_page( $current_page - 1 );
52              
53 6         192 foreach my $fname ( $page->all_fields ) {
54 6         19 my $field = $self->field($fname);
55 6 50       16 if ( $field ) {
56 6         140 $field->_active(1);
57             }
58             else {
59 0         0 warn "field $fname not found for page " . $page->name;
60             }
61             }
62             }
63              
64             after 'validate_form' => sub {
65             my $self = shift;
66             if( $self->page_validated ) {
67             $self->save_page;
68             if( $self->field('page_num')->value < $self->num_pages ) {
69             my $new_page_num = $self->field('page_num')->value + 1;
70             $self->clear_page;
71             $self->set_active( $new_page_num );
72             $self->_result_from_fields( $self->result );
73             $self->field('page_num')->value($new_page_num);
74             $self->on_last_page(1) if $new_page_num == $self->num_pages;
75             }
76             elsif( $self->field('page_num')->value == $self->num_pages ) {
77             $self->_set_value( $self->stash );
78             }
79             }
80             };
81              
82             sub clear_page {
83 2     2 0 3 my $self = shift;
84 2         8 $self->clear_data;
85 2         59 $self->clear_params;
86 2         47 $self->processed(0);
87             # $self->did_init_obj(0);
88 2         50 $self->clear_result;
89             }
90              
91             sub save_page {
92 3     3 0 4 my $self = shift;
93              
94 3         78 my $stash = $self->stash;
95 3         4 while ( my ($key, $value) = each %{$self->value}) {
  9         26  
96 6         15 $stash->{$key} = $value;
97             }
98             }
99              
100             __PACKAGE__->meta->make_immutable;
101 1     1   2191 use namespace::autoclean;
  1         1  
  1         8  
102             1;
103              
104             __END__
105              
106             =pod
107              
108             =encoding UTF-8
109              
110             =head1 NAME
111              
112             HTML::FormHandler::Wizard - create a multi-page form
113              
114             =head1 VERSION
115              
116             version 0.40067
117              
118             =head1 SYNOPSIS
119              
120             This feature is EXPERIMENTAL. That means that the interface may change,
121             and that it hasn't been fully implemented.
122             We are actively looking for input, so if you are interested in this
123             feature, please show up on the FormHandler mailing list or irc channel
124             (#formhandler on irc.perl.org) to discuss.
125              
126             package Test::Wizard;
127             use HTML::FormHandler::Moose;
128             extends 'HTML::FormHandler::Wizard';
129              
130             has_field 'foo';
131             has_field 'bar';
132             has_field 'zed';
133              
134             has_page 'one' => ( fields => ['foo'] );
135             has_page 'two' => ( fields => ['bar'] );
136             has_page 'three' => ( fields => ['zed'] );
137              
138             ...
139              
140             my $stash = {};
141             my $wizard = Test::Wizard->new( stash => $stash );
142             $wizard->process( params => $params );
143              
144             =head1 AUTHOR
145              
146             FormHandler Contributors - see HTML::FormHandler
147              
148             =head1 COPYRIGHT AND LICENSE
149              
150             This software is copyright (c) 2016 by Gerda Shank.
151              
152             This is free software; you can redistribute it and/or modify it under
153             the same terms as the Perl 5 programming language system itself.
154              
155             =cut