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__ |