File: Multi.pm

package info (click to toggle)
libcgi-formbuilder-perl 3.08-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,204 kB
  • sloc: perl: 7,201; makefile: 13
file content (376 lines) | stat: -rw-r--r-- 11,136 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376

###########################################################################
# Copyright (c) Nate Wiger http://nateware.com. All Rights Reserved.
# Please visit http://formbuilder.org for tutorials, support, and examples.
###########################################################################

package CGI::FormBuilder::Multi;

=head1 NAME

CGI::FormBuilder::Multi - Create multi-page FormBuilder forms 

=head1 SYNOPSIS

    use CGI::FormBuilder::Multi;
    use CGI::Session;   # or something similar

    # Top-level "meta-form"
    my $multi = CGI::FormBuilder::Multi->new(

        # form 1 options
        { fields   => [qw(name email daytime_phone evening_phone)],
          title    => 'Basic Info',
          template => 'page1.tmpl',
          validate => { name => 'NAME', email => 'EMAIL' },
          required => [qw(name email daytime_phone)],
        },

        # form 2 options
        { fields   => [qw(billing_name billing_card billing_exp
                          billing_address billing_city billing_state
                          billing_zip billing_phone)],
          title    => 'Billing',
          template => 'page2.tmpl',
          required => 'ALL',
        },

        # form 3 options
        { fields   => [qw(same_as_billing shipping_address
                          shipping_city shipping_state shipping_zip)],
          title    => 'Shipping',
          template => 'page3.tmpl',
          required => 'ALL',
        },

        # a couple options specific to this module
        navbar => 1,

        # remaining options (not in hashrefs) apply to all forms
        header => 1,
        method => 'POST',
        submit => 'Continue',
        values => $dbi_hashref_query,
    );

    # Get current page's form
    my $form = $multi->form;

    if ($form->submitted && $form->validate) {

        # Retrieve session id
        my $sid = $form->sessionid;

        # Initialize session
        my $session = CGI::Session->new("driver:File", $sid, {Directory=>'/tmp'});

        # Automatically store updated data in session
        $session->save_param($form);

        # last page?
        if ($multi->page == $multi->pages) {
            print $form->confirm;
            exit;
        }

        # Still here, goto next page
        $multi->page++;

        # And re-get form (no "my" on $form!)
        $form = $multi->form;

        # Make sure it has the right sessionid
        $form->sessionid($session->id);

        # on page 3 we have special field handling
        if ($multi->page == 3) {
            $form->field(name    => 'same_as_billing',
                         type    => 'checkbox',
                         options => 'Yes',
                         jsclick => 'this.form.submit()');
        }
    }

    # Fall through and print next page's form
    print $form->render;

=cut

use strict;
use warnings;
no  warnings 'uninitialized';

use CGI::FormBuilder;
use CGI::FormBuilder::Util;

our $VERSION = '3.08';

our %DEFAULT = (
    pagename => '_page',
    navbar   => 0,
);

sub new {
    my $mod = shift;
    my $class = ref($mod) || $mod;

    # Arg parsing is a little more complex than FormBuilder proper,
    # since we keep going thru our options until we don't see hashrefs
    my @forms = ();
    while (ref $_[0]) {
        push @forms, shift;
    }

    # Remaining options are form opts
    my %opt  = arghash(@_);

    # If no forms, and specified number of pages, use that instead
    if ($opt{pages}) {
        puke "Can't specify pages and form hashrefs" if @forms;
        my $p = 0;
        push @forms, {} while $p++ < $opt{pages};
    }
    puke "Must specify at least one form or 'pages' option for ::Multi" unless @forms;

    # Check for CGI params
    # This is duplicated code straight out of FormBuilder.pm,
    # but it's needed here as well so we can get our _page
    unless ($opt{params} && ref $opt{params} ne 'HASH') {
        require CGI;
        $CGI::USE_PARAM_SEMICOLONS = 0;     # fuck ; in urls
        $opt{params} = CGI->new($opt{params});
    }               

    # Options for me
    my %me;
    while (my($k,$v) = each %DEFAULT) {
        $me{$k} = exists $opt{$k} ? delete $opt{$k} : $v;
    }
    $me{forms} = \@forms;

    # Plop in our defaults per-form unless it's an object
    @forms = map { ref $_ eq 'HASH' ? { %opt, %$_ } : $_ } @forms;

    # Top-level multi
    my $self = bless \%me, $class;

    # Copy CGI object into self, and get page
    $self->{params} = $opt{params};
    $self->{keepextras} = $opt{keepextras};
    $self->{page}   = $self->{params}->param($self->{pagename}) || 1;

    return $self;
}

# return an lvalue to allow $multi->page++ and $multi->page--;
sub page : lvalue {
    my $self = shift;
    $self->{page} = shift if @_;    # rvalue
    $self->{page};                  # lvalue
}

*forms = \&pages;
sub pages {
    my $self = shift;
    puke "No arguments allowed to \$multi->pages or \$multi->forms" if @_;
    return @{$self->{forms}};
}

# return the form from this page, as a new object
sub form {
    my $self = shift;
    puke "No arguments allowed to \$multi->form" if @_;
    my $page = $self->page;
    my $idx  = $page - 1;

    return $self->{_cache}{forms}[$idx] if $self->{_cache}{forms}[$idx];
    puke "Invalid page $page, no form present"
        unless my $form = $self->{forms}[$idx];

    if (ref $form eq 'CGI::FormBuilder') {
        # already constructed
    } else {
        $form = CGI::FormBuilder->new(%$form);
    }

    # hooks
    $form->page($self->page);
    $form->text(scalar $self->navbar) if $self->{navbar}; # cheat

    # create new $form and cache for re-get
    $self->{_cache}{forms}[$idx] = $form;
}

# allow jumps between pages
sub navbar {
    my $self = shift;
    $self->{navbar} = shift if @_;
    my $base = basename; 
    my $pnam = $self->{pagename};
    return '' unless $self->pages > 1;

    # Look for extra params to keep
    # Algorithm here is a bit different
    my @keep;
    if ($self->{keepextras}) {
        unless (ref $self->{keepextras}) {
            $self->{keepextras} = [ $self->{params}->param ];
        }
        for my $k (@{$self->{keepextras}}) {
            next if $k eq $pnam;
            for my $v ($self->{params}->param($k)) {
                push @keep, { name => $k, value => $v };
            }
        }
    }

    my @html = ();
    for (my $p=1; $p <= $self->pages; $p++) {
        my $cl = $self->page == $p ? 'fb_multi_page' : 'fb_multi_link';
         
        # this looks like gibberish
        my $purl = basename . '?' . join '&',
            map { "$_->{name}=$_->{value}" } @keep,
                     { name => $pnam, value => $p };
 
        push @html, htmltag('a', href => $purl, class => $cl)
                    . ($self->{forms}[$p-1]{title} || "Page $p") . '</a>';
    }

    return wantarray ? @html : '<p>'. join(' | ', @html) . '<p>';
}

1;
__END__

=head1 DESCRIPTION

This module works with C<CGI::FormBuilder> to create multi-page forms.
Each form is specified using the same options you would pass directly
into B<FormBuilder>. See L<CGI::FormBuilder> for a list of these options.

The multi-page "meta-form" is a composite of the individual forms you
specify, tied together via the special C<_page> CGI param. The current
form is available via the C<form()> method, and the current page is
available via C<page()>. It's up to you to navigate appropriately:

    my $multi = CGI::FormBuilder::Multi->new(...);

    # current form
    my $form  = $multi->form;

    $multi->page++;         # page forward
    $multi->page--;         # and back
    $multi->page = $multi->pages;   # goto last page

    # current form
    $form = $multi->form;

To make things are fluid as possible, you should title each of your
forms, even if you're using a template. This will allow C<::Multi>
to create cross-links by-name instead of just "Page 2".

=head1 METHODS

The following methods are provided:

=head2 new(\%form1, \%form2, opt => val)

This creates a new C<CGI::FormBuilder::Multi> object. Forms are
specified as hashrefs of options, in sequential order, similar to
how fields are specified. The order the forms are in is the order
that the pages will cycle through.

In addition to a hashref, forms can be directly specified as a
C<$form> object that has already been created. For existing objects,
the below does not apply.

When the first non-ref argument is seen, then all remaining args
are taken as common options that apply to all forms. In this way,
you can specify global settings for things like C<method> or
C<header> (which will likely be the same), and then override
individual settings like C<fields> and C<validate> on a per-form
basis.

If you do not wish to specify any options for your forms, you
can instead just specify the C<pages> option, for example:

    my $multi = CGI::FormBuilder::Multi->new(pages => 3);

With this approach, you will have to dynamically assemble each
page as you come to them. The mailing list can help.

The L</"SYNOPSIS"> above is very representative of typical usage.

=head2 form()

This returns the current page's form, as an object created
directly by C<< CGI::FormBuilder->new >>. All valid B<FormBuilder>
methods and options work on the form. To change which form is
returned, us C<page()>.

=head2 page($num)

This sets and returns the current page. It can accept a page number
either as an argument, or directly as an assignment:

    $multi->page(1);    # page 1
    $multi->page = 1;   # same thing

    $multi->page++;     # next page
    $multi->page--;     # back one

    if ($multi->page == $multi->pages) {
        # last page
    }

Hint: Usually, you should only change pages once you have validated
the current page's form appropriately.

=head2 pages()

This returns the total number of pages. Actually, what it returns
is an array of all forms (and hence it has the alias C<forms()>),
which just so happens to become the length in a scalar context,
just like anywhere else in Perl.

=head2 navbar($onoff)

This returns a navigation bar that allows the user to jump between
pages of the form. This is useful if you want to let a person fill
out different pages out of order. In most cases, you do I<not>
want this, so it's off by default.

To use it, the best way is setting C<< navbar => 1 >> in C<new()>.
However, you can also get it yourself to render your own HTML:

    my $html = $multi->navbar;      # scalar HTML
    my @link = $multi->navbar;      # array of links

This is useful in something like this:

    my $nav = $multi->navbar;
    $form = $multi->form;
    $form->tmpl_param(navbar => $navbar);

The navbar will have two style classes: C<fb_multi_page> for the
current page's link, and C<fb_multi_link> for the others.

=head1 SEE ALSO

L<CGI::FormBuilder>

=head1 REVISION

$Id: Multi.pm 100 2007-03-02 18:13:13Z nwiger $

=head1 AUTHOR

Copyright (c) L<Nate Wiger|http://nateware.com>. All Rights Reserved.

This module is free software; you may copy this under the terms of
the GNU General Public License, or the Artistic License, copies of
which should have accompanied your Perl kit.

=cut