File Coverage

lib/CGI/FormBuilder/Multi.pm
Criterion Covered Total %
statement 56 80 70.0
branch 16 40 40.0
condition 3 11 27.2
subroutine 9 10 90.0
pod 5 5 100.0
total 89 146 60.9


line stmt bran cond sub pod time code
1              
2             ###########################################################################
3             # Copyright (c) Nate Wiger http://nateware.com. All Rights Reserved.
4             # Please visit http://formbuilder.org for tutorials, support, and examples.
5             ###########################################################################
6              
7             package CGI::FormBuilder::Multi;
8              
9             =head1 NAME
10              
11             CGI::FormBuilder::Multi - Create multi-page FormBuilder forms
12              
13             =head1 SYNOPSIS
14              
15             use CGI::FormBuilder::Multi;
16             use CGI::Session; # or something similar
17              
18             # Top-level "meta-form"
19             my $multi = CGI::FormBuilder::Multi->new(
20              
21             # form 1 options
22             { fields => [qw(name email daytime_phone evening_phone)],
23             title => 'Basic Info',
24             template => 'page1.tmpl',
25             validate => { name => 'NAME', email => 'EMAIL' },
26             required => [qw(name email daytime_phone)],
27             },
28              
29             # form 2 options
30             { fields => [qw(billing_name billing_card billing_exp
31             billing_address billing_city billing_state
32             billing_zip billing_phone)],
33             title => 'Billing',
34             template => 'page2.tmpl',
35             required => 'ALL',
36             },
37              
38             # form 3 options
39             { fields => [qw(same_as_billing shipping_address
40             shipping_city shipping_state shipping_zip)],
41             title => 'Shipping',
42             template => 'page3.tmpl',
43             required => 'ALL',
44             },
45              
46             # a couple options specific to this module
47             navbar => 1,
48              
49             # remaining options (not in hashrefs) apply to all forms
50             header => 1,
51             method => 'POST',
52             submit => 'Continue',
53             values => $dbi_hashref_query,
54             );
55              
56             # Get current page's form
57             my $form = $multi->form;
58              
59             if ($form->submitted && $form->validate) {
60              
61             # Retrieve session id
62             my $sid = $form->sessionid;
63              
64             # Initialize session
65             my $session = CGI::Session->new("driver:File", $sid, {Directory=>'/tmp'});
66              
67             # Automatically store updated data in session
68             $session->save_param($form);
69              
70             # last page?
71             if ($multi->page == $multi->pages) {
72             print $form->confirm;
73             exit;
74             }
75              
76             # Still here, goto next page
77             $multi->page++;
78              
79             # And re-get form (no "my" on $form!)
80             $form = $multi->form;
81              
82             # Make sure it has the right sessionid
83             $form->sessionid($session->id);
84              
85             # on page 3 we have special field handling
86             if ($multi->page == 3) {
87             $form->field(name => 'same_as_billing',
88             type => 'checkbox',
89             options => 'Yes',
90             jsclick => 'this.form.submit()');
91             }
92             }
93              
94             # Fall through and print next page's form
95             print $form->render;
96              
97             =cut
98              
99 1     1   1322 use strict;
  1         3  
  1         275  
100 1     1   7 use warnings;
  1         3  
  1         40  
101 1     1   128 no warnings 'uninitialized';
  1         3  
  1         52  
102              
103 1     1   5 use CGI::FormBuilder;
  1         2  
  1         65  
104 1     1   5 use CGI::FormBuilder::Util;
  1         2  
  1         1912  
105              
106             our $VERSION = '3.09';
107              
108             our %DEFAULT = (
109             pagename => '_page',
110             navbar => 0,
111             );
112              
113             sub new {
114 1     1 1 72 my $mod = shift;
115 1   33     8 my $class = ref($mod) || $mod;
116              
117             # Arg parsing is a little more complex than FormBuilder proper,
118             # since we keep going thru our options until we don't see hashrefs
119 1         3 my @forms = ();
120 1         5 while (ref $_[0]) {
121 3         9 push @forms, shift;
122             }
123              
124             # Remaining options are form opts
125 1         8 my %opt = arghash(@_);
126              
127             # If no forms, and specified number of pages, use that instead
128 1 50       5 if ($opt{pages}) {
129 0 0       0 puke "Can't specify pages and form hashrefs" if @forms;
130 0         0 my $p = 0;
131 0         0 push @forms, {} while $p++ < $opt{pages};
132             }
133 1 50       4 puke "Must specify at least one form or 'pages' option for ::Multi" unless @forms;
134              
135             # Check for CGI params
136             # This is duplicated code straight out of FormBuilder.pm,
137             # but it's needed here as well so we can get our _page
138 1 50 33     14 unless ($opt{params} && ref $opt{params} ne 'HASH') {
139 1         2545 require CGI;
140 1         17683 $CGI::USE_PARAM_SEMICOLONS = 0; # fuck ; in urls
141 1         12 $opt{params} = CGI->new($opt{params});
142             }
143              
144             # Options for me
145 1         5313 my %me;
146 1         10 while (my($k,$v) = each %DEFAULT) {
147 2 100       19 $me{$k} = exists $opt{$k} ? delete $opt{$k} : $v;
148             }
149 1         4 $me{forms} = \@forms;
150              
151             # Plop in our defaults per-form unless it's an object
152 1 50       5 @forms = map { ref $_ eq 'HASH' ? { %opt, %$_ } : $_ } @forms;
  3         40  
153              
154             # Top-level multi
155 1         7 my $self = bless \%me, $class;
156              
157             # Copy CGI object into self, and get page
158 1         7 $self->{params} = $opt{params};
159 1         4 $self->{keepextras} = $opt{keepextras};
160 1   50     5 $self->{page} = $self->{params}->param($self->{pagename}) || 1;
161              
162 1         30 return $self;
163             }
164              
165             # return an lvalue to allow $multi->page++ and $multi->page--;
166             sub page : lvalue {
167 22     22 1 31 my $self = shift;
168 22 100       92 $self->{page} = shift if @_; # rvalue
169 22         97 $self->{page}; # lvalue
170             }
171              
172             *forms = \&pages;
173             sub pages {
174 4     4 1 848 my $self = shift;
175 4 50       11 puke "No arguments allowed to \$multi->pages or \$multi->forms" if @_;
176 4         5 return @{$self->{forms}};
  4         19  
177             }
178              
179             # return the form from this page, as a new object
180             sub form {
181 9     9 1 21 my $self = shift;
182 9 50       23 puke "No arguments allowed to \$multi->form" if @_;
183 9         18 my $page = $self->page;
184 9         13 my $idx = $page - 1;
185              
186 9 100       53 return $self->{_cache}{forms}[$idx] if $self->{_cache}{forms}[$idx];
187 4 100       18 puke "Invalid page $page, no form present"
188             unless my $form = $self->{forms}[$idx];
189              
190 3 50       9 if (ref $form eq 'CGI::FormBuilder') {
191             # already constructed
192             } else {
193 3         26 $form = CGI::FormBuilder->new(%$form);
194             }
195              
196             # hooks
197 3         12 $form->page($self->page);
198 3 50       10 $form->text(scalar $self->navbar) if $self->{navbar}; # cheat
199              
200             # create new $form and cache for re-get
201 3         14 $self->{_cache}{forms}[$idx] = $form;
202             }
203              
204             # allow jumps between pages
205             sub navbar {
206 0     0 1   my $self = shift;
207 0 0         $self->{navbar} = shift if @_;
208 0           my $base = basename;
209 0           my $pnam = $self->{pagename};
210 0 0         return '' unless $self->pages > 1;
211              
212             # Look for extra params to keep
213             # Algorithm here is a bit different
214 0           my @keep;
215 0 0         if ($self->{keepextras}) {
216 0 0         unless (ref $self->{keepextras}) {
217 0           $self->{keepextras} = [ $self->{params}->param ];
218             }
219 0           for my $k (@{$self->{keepextras}}) {
  0            
220 0 0         next if $k eq $pnam;
221 0           for my $v ($self->{params}->param($k)) {
222 0           push @keep, { name => $k, value => $v };
223             }
224             }
225             }
226              
227 0           my @html = ();
228 0           for (my $p=1; $p <= $self->pages; $p++) {
229 0 0         my $cl = $self->page == $p ? 'fb_multi_page' : 'fb_multi_link';
230            
231             # this looks like gibberish
232 0           my $purl = basename . '?' . join '&',
233 0           map { "$_->{name}=$_->{value}" } @keep,
234             { name => $pnam, value => $p };
235            
236 0   0       push @html, htmltag('a', href => $purl, class => $cl)
237             . ($self->{forms}[$p-1]{title} || "Page $p") . '';
238             }
239              
240 0 0         return wantarray ? @html : '

'. join(' | ', @html) . '

';

241             }
242              
243             1;
244             __END__