source: text-formbuilder/trunk/lib/Text/FormBuilder.pm @ 83

Last change on this file since 83 was 83, checked in by peichman, 19 years ago

BUGFIX: typo in write_module where params were not getting passed in
reverted to FB style required field marking

File size: 40.5 KB
Line 
1package Text::FormBuilder;
2
3use strict;
4use warnings;
5
6use base qw(Exporter Class::ParseText::Base);
7use vars qw($VERSION @EXPORT);
8
9$VERSION = '0.11_01';
10@EXPORT = qw(create_form);
11
12#$::RD_TRACE = 1;
13
14use Carp;
15use Text::FormBuilder::Parser;
16use CGI::FormBuilder;
17
18use Data::Dumper;
19$Data::Dumper::Terse = 1;           # don't dump $VARn names
20$Data::Dumper::Quotekeys = 0;       # don't quote simple string keys
21
22# the static default options passed to CGI::FormBuilder->new
23my %DEFAULT_OPTIONS = (
24    method => 'GET',
25    keepextras => 1,
26);
27
28# the built in CSS for the template
29my $DEFAULT_CSS = <<END;
30table { padding: 1em; }
31td table { padding: 0; } /* exclude the inner checkbox tables */
32#author, #footer { font-style: italic; }
33caption h2 { padding: .125em .5em; background: #ccc; text-align: left; }
34fieldset { margin: 1em 0; border: none; border-top: 2px solid #999; }
35legend { font-size: 1.25em; font-weight: bold; background: #ccc; padding: .125em .25em; border: 1px solid #666; }
36th { text-align: left; }
37th h2 { padding: .125em .5em; background: #eee; font-size: 1.25em; }
38.label { font-weight: normal; text-align: right; vertical-align: top; }
39td ul { list-style: none; padding-left: 0; margin-left: 0; }
40.note { background: #eee; padding: .5em 1em; }
41.sublabel { color: #999; }
42.invalid { background: red; }
43END
44
45# default messages that can be localized
46my %DEFAULT_MESSAGES = (
47    text_author   => 'Created by %s',
48    text_madewith => 'Made with %s version %s',
49    text_required => 'Fields that are <strong>highlighted</strong> are required.',
50    text_invalid  => 'Missing or invalid value.',
51);
52
53my $DEFAULT_CHARSET = 'iso-8859-1';
54
55# options to clean up the code with Perl::Tidy
56my $TIDY_OPTIONS = '-nolq -ci=4 -ce';
57
58my $HTML_EXTS   = qr/\.html?$/;
59my $MODULE_EXTS = qr/\.pm$/;
60my $SCRIPT_EXTS = qr/\.(pl|cgi)$/;
61
62# superautomagical exported function
63sub create_form {
64    my ($source, $options, $destination) = @_;
65    my $parser = __PACKAGE__->parse($source);
66    $parser->build(%{ $options || {} });
67    if ($destination) {
68        if (ref $destination) {
69            croak '[' . (caller(0))[3] . "] Don't know what to do with a ref for $destination";
70            #TODO: what DO ref dests mean?
71        } else {
72            # write webpage, script, or module
73            if ($destination =~ $MODULE_EXTS) {
74                $parser->write_module($destination, 1);
75            } elsif ($destination =~ $SCRIPT_EXTS) {
76                $parser->write_script($destination, 1);
77            } else {
78                $parser->write($destination);
79            }
80        }
81    } else {
82        defined wantarray ? return $parser->form : $parser->write;
83    }
84}
85
86# subclass of Class::ParseText::Base
87sub init {
88    my $self = shift;
89    $self->{parser}         = Text::FormBuilder::Parser->new;
90    $self->{start_rule}     = 'form_spec';
91    $self->{ensure_newline} = 1;
92    return $self;
93}
94
95# this is where a lot of the magic happens
96sub build {
97    my ($self, %options) = @_;
98   
99    # our custom %options:
100    # form_only: use only the form part of the template
101    my $form_only = $options{form_only};
102   
103    # css, extra_css: allow for custom inline stylesheets
104    #   neat trick: css => '@import(my_external_stylesheet.css);'
105    #   will let you use an external stylesheet
106    #   CSS Hint: to get multiple sections to all line up their fields,
107    #   set a standard width for th.label
108    # external_css: scalar for a single external stylesheet; array for
109    #   multiple sheets; prepended to the beginning of the CSS as @import
110    #   statetments
111    my $css;
112    $css = $options{css} || $DEFAULT_CSS;
113    if ($options{external_css}) {
114        my $ref = ref $options{external_css};
115        if ($ref eq 'ARRAY') {
116            # loop over the list of external sheets
117            my $external_sheets = join("\n", map { "\@import url($_);" } @{ $options{external_css} });
118            $css = "$external_sheets\n$css";
119        } elsif ($ref) {
120            croak '[' . (caller(0))[3] . "] Don't know how to handle $ref reference as an argument to external_css";
121        } else {
122            $css = "\@import url($options{external_css});\n$css";
123        }
124    }
125    $css .= $options{extra_css} if $options{extra_css};
126   
127    # messages
128    # code pulled (with modifications) from CGI::FormBuilder
129    if ($options{messages}) {
130        # if its a hashref, we'll just pass it on to CGI::FormBuilder
131       
132        if (my $ref = ref $options{messages}) {
133            # hashref pass on to CGI::FormBuilder
134            croak "[Text::FormBuilder] Argument to 'messages' option must be a filename or hashref" unless $ref eq 'HASH';
135            while (my ($key,$value) = each %DEFAULT_MESSAGES) {
136                $options{messages}{$key} ||= $DEFAULT_MESSAGES{$key};
137            }
138        } else {
139            # filename, just *warn* on missing, and use defaults
140            if (-f $options{messages} && -r _ && open(MESSAGES, "< $options{messages}")) {
141                $options{messages} = { %DEFAULT_MESSAGES };
142                while(<MESSAGES>) {
143                    next if /^\s*#/ || /^\s*$/;
144                    chomp;
145                    my($key,$value) = split ' ', $_, 2;
146                    ($options{messages}{$key} = $value) =~ s/\s+$//;
147                }
148                close MESSAGES;
149            } else {
150                carp '[' . (caller(0))[3] . "] Could not read messages file $options{messages}: $!";
151            }
152        }
153    } else {
154        $options{messages} = { %DEFAULT_MESSAGES };
155    }
156   
157    # character set
158    my $charset = $options{charset};
159   
160    # save the build options so they can be used from write_module
161    $self->{build_options} = { %options };
162   
163    # remove our custom options before we hand off to CGI::FormBuilder
164    delete $options{$_} foreach qw(form_only css extra_css charset);
165   
166    # expand groups
167    if (my %groups = %{ $self->{form_spec}{groups} || {} }) {       
168        for my $section (@{ $self->{form_spec}{sections} || [] }) {
169            foreach (grep { $$_[0] eq 'group' } @{ $$section{lines} }) {
170                $$_[1]{group} =~ s/^\%//;       # strip leading % from group var name
171               
172                if (exists $groups{$$_[1]{group}}) {
173                    my @fields; # fields in the group
174                    push @fields, { %$_ } foreach @{ $groups{$$_[1]{group}} };
175                    for my $field (@fields) {
176                        $$field{label} ||= ucfirst $$field{name};
177                        $$field{name} = "$$_[1]{name}_$$field{name}";               
178                    }
179                    $_ = [
180                        'group',
181                        {
182                            label => $$_[1]{label} || ucfirst(join(' ',split('_',$$_[1]{name}))),
183                            comment => $$_[1]{comment},
184                            group => \@fields,
185                        },
186                    ];
187                }
188            }
189        }
190    }
191   
192    # the actual fields that are given to CGI::FormBuilder
193    # make copies so that when we trim down the sections
194    # we don't lose the form field information
195    $self->{form_spec}{fields} = [];
196   
197    for my $section (@{ $self->{form_spec}{sections} || [] }) {
198        for my $line (@{ $$section{lines} }) {
199            if ($$line[0] eq 'group') {
200                push @{ $self->{form_spec}{fields} }, { %{$_} } foreach @{ $$line[1]{group} };
201            } elsif ($$line[0] eq 'field') {
202                push @{ $self->{form_spec}{fields} }, { %{$$line[1]} };
203            }
204        }
205    }
206   
207    # substitute in custom validation subs and pattern definitions for field validation
208    my %patterns = %{ $self->{form_spec}{patterns} || {} };
209    my %subs = %{ $self->{form_spec}{subs} || {} };
210   
211    foreach (@{ $self->{form_spec}{fields} }) {
212        if ($$_{validate}) {
213            if (exists $patterns{$$_{validate}}) {
214                $$_{validate} = $patterns{$$_{validate}};
215            # TODO: need the Data::Dumper code to work for this
216            # for now, we just warn that it doesn't work
217            } elsif (exists $subs{$$_{validate}}) {
218                warn '[' . (caller(0))[3] . "] validate coderefs don't work yet";
219                delete $$_{validate};
220##                 $$_{validate} = $subs{$$_{validate}};
221            }
222        }
223    }
224   
225    # get user-defined lists; can't make this conditional because
226    # we need to be able to fall back to CGI::FormBuilder's lists
227    # even if the user didn't define any
228    my %lists = %{ $self->{form_spec}{lists} || {} };
229   
230    # substitute in list names
231    foreach (@{ $self->{form_spec}{fields} }) {
232        next unless $$_{list};
233       
234        $$_{list} =~ s/^\@//;   # strip leading @ from list var name
235       
236        # a hack so we don't get screwy reference errors
237        if (exists $lists{$$_{list}}) {
238            my @list;
239            push @list, { %$_ } foreach @{ $lists{$$_{list}} };
240            $$_{options} = \@list;
241        } else {
242            # assume that the list name is a builtin
243            # and let it fall through to CGI::FormBuilder
244            $$_{options} = $$_{list};
245        }
246    } continue {
247        delete $$_{list};
248    }
249   
250    # special case single-value checkboxes
251    foreach (grep { $$_{type} && $$_{type} eq 'checkbox' } @{ $self->{form_spec}{fields} }) {
252        unless ($$_{options}) {
253            $$_{options} = [ { $$_{name} => $$_{label} || ucfirst join(' ',split(/_/,$$_{name})) } ];
254        }
255    }
256   
257    # use columns for displaying checkbox fields larger than 2 items
258    foreach (@{ $self->{form_spec}{fields} }) {
259        if (ref $$_{options} and @{ $$_{options} } >= 3) {
260            $$_{columns} = int(@{ $$_{options} } / 8) + 1;
261        }
262    }
263   
264    # remove extraneous undefined values
265    # also check for approriate version of CGI::FormBuilder
266    # for some advanced options
267    my $FB_version = CGI::FormBuilder->VERSION;
268    for my $field (@{ $self->{form_spec}{fields} }) {
269        defined $$field{$_} or delete $$field{$_} foreach keys %{ $field };
270       
271        unless ($FB_version >= '3.02') {
272            for (qw(growable other)) {
273                if ($$field{$_}) {
274                    warn '[' . (caller(0))[3] . "] '$_' fields not supported by FB $FB_version (requires 3.02)";
275                    delete $$field{$_};
276                }
277            }
278        }
279    }
280   
281    # assign the field names to the sections
282    foreach (@{ $self->{form_spec}{sections} }) {
283        for my $line (@{ $$_{lines} }) {
284            if ($$line[0] eq 'field') {
285                $$line[1] = $$line[1]{name};
286            }
287        }
288    }
289   
290    # gather together all of the form options
291    $self->{form_options} = {
292        %DEFAULT_OPTIONS,
293        # need to explicity set the fields so that simple text fields get picked up
294        fields   => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ],
295        required => [ map { $$_{name} } grep { $$_{required} } @{ $self->{form_spec}{fields} } ],
296        title => $self->{form_spec}{title},
297        text  => $self->{form_spec}{description},
298        # use 'defined' so we are able to differentiate between 'submit = 0' (no submit button)
299        # and 'submit = undef' (use default submit button)
300        ( defined $self->{form_spec}{submit} ? (submit => $self->{form_spec}{submit}) : () ),
301        reset => $self->{form_spec}{reset},
302        template => {
303            type => 'Text',
304            engine => {
305                TYPE       => 'STRING',
306                SOURCE     => $form_only ? $self->_form_template : $self->_template($css, $charset),
307                DELIMITERS => [ qw(<% %>) ],
308            },
309            data => {
310                #TODO: make FB aware of sections
311                sections    => $self->{form_spec}{sections},
312                author      => $self->{form_spec}{author},
313                description => $self->{form_spec}{description},
314            },
315        },
316        %options,
317    };
318   
319    # create the form object
320    $self->{form} = CGI::FormBuilder->new(%{ $self->{form_options} });
321   
322    # ...and set up its fields
323    $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} };
324   
325    # mark structures as built
326    $self->{built} = 1;
327   
328    return $self;
329}
330
331sub write {
332    my ($self, $outfile) = @_;
333   
334    # automatically call build if needed to
335    # allow the new->parse->write shortcut
336    $self->build unless $self->{built};
337   
338    if ($outfile) {
339        open FORM, "> $outfile";
340        print FORM $self->form->render;
341        close FORM;
342    } else {
343        print $self->form->render;
344    }
345}
346
347# dump the form options as eval-able code
348sub _form_options_code {
349    my $self = shift;
350    my $d = Data::Dumper->new([ $self->{form_options} ], [ '*options' ]);
351    return keys %{ $self->{form_options} } > 0 ? $d->Dump : '';   
352}
353# dump the field setup subs as eval-able code
354# pass in the variable name of the form object
355# (defaults to '$form')
356# TODO: revise this code to use the new 'fieldopts'
357# option to the FB constructor (requires FB 3.02)
358sub _field_setup_code {
359    my $self = shift;
360    my $object_name = shift || '$form';
361    return join(
362        "\n", 
363        map { $object_name . '->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} }
364    );
365}
366
367sub as_module {
368    my ($self, $package, $use_tidy) = @_;
369
370    croak '[' . (caller(0))[3] . '] Expecting a package name' unless $package;
371   
372    # remove a trailing .pm
373    $package =~ s/\.pm$//;
374
375    # auto-build
376    $self->build unless $self->{built};
377
378    my $form_options = $self->_form_options_code;
379    my $field_setup = $self->_field_setup_code('$self');
380   
381    # old style of module
382    # TODO: how to keep this (as deprecated method)
383    my $old_module = <<END;
384package $package;
385use strict;
386use warnings;
387
388use CGI::FormBuilder;
389
390sub get_form {
391    my \$q = shift;
392
393    my \$self = CGI::FormBuilder->new(
394        $form_options,
395        \@_,
396    );
397   
398    $field_setup
399   
400    return \$self;
401}
402
403# module return
4041;
405END
406
407    # new style of module
408    my $module = <<END;
409package $package;
410use strict;
411use warnings;
412
413use base qw(CGI::FormBuilder);
414
415sub new {
416    my \$invocant = shift;
417    my \$class = ref \$invocant || \$invocant;
418   
419    my \$self = CGI::FormBuilder->new(
420        $form_options,
421        \@_,
422    );
423   
424    $field_setup
425   
426    # re-bless into this class
427    bless \$self, \$class;
428}
429
430# module return
4311;
432END
433
434    $module = _tidy_code($module, $use_tidy) if $use_tidy;
435   
436    return $module;
437}
438
439sub write_module {
440    my ($self, $package, $use_tidy) = @_;
441   
442    my $module = $self->as_module($package, $use_tidy);
443   
444    my $outfile = (split(/::/, $package))[-1];
445    $outfile .= '.pm' unless $outfile =~ /\.pm$/;
446    _write_output_file($module, $outfile);
447    return $self;
448}
449
450sub as_script {
451    my ($self, $use_tidy) = @_;
452   
453    # auto-build
454    $self->build unless $self->{built};
455   
456    my $form_options = $self->_form_options_code;
457    my $field_setup = $self->_field_setup_code('$form');
458
459    my $script = <<END;
460#!/usr/bin/perl
461use strict;
462use warnings;
463
464use CGI::FormBuilder;
465
466my \$form = CGI::FormBuilder->new(
467    $form_options
468);
469
470$field_setup
471   
472unless (\$form->submitted && \$form->validate) {
473    print \$form->render;
474} else {
475    # do something with the entered data
476}
477END
478    $script = _tidy_code($script, $use_tidy) if $use_tidy;
479   
480    return $script;
481}
482   
483sub write_script {
484    my ($self, $script_name, $use_tidy) = @_;
485
486    croak '[' . (caller(0))[3] . '] Expecting a script name' unless $script_name;
487
488    my $script = $self->as_script($use_tidy);
489   
490    _write_output_file($script, $script_name);   
491    return $self;
492}
493
494sub _tidy_code {
495    my ($source_code, $use_tidy) = @_;
496    eval 'use Perl::Tidy';
497    carp '[' . (caller(0))[3] . "] Can't tidy the code: $@" and return $source_code if $@;
498   
499    # use the options string only if it begins with '_'
500    my $options = ($use_tidy =~ /^-/) ? $use_tidy : undef;
501   
502    my $tidy_code;
503    Perl::Tidy::perltidy(source => \$source_code, destination => \$tidy_code, argv => $options || $TIDY_OPTIONS);
504   
505    return $tidy_code;
506}
507
508
509sub _write_output_file {
510    my ($source_code, $outfile) = @_;   
511    open OUT, "> $outfile" or croak '[' . (caller(1))[3] . "] Can't open $outfile for writing: $!";
512    print OUT $source_code;
513    close OUT;
514}
515
516
517sub form {
518    my $self = shift;
519   
520    # automatically call build if needed to
521    # allow the new->parse->write shortcut
522    $self->build unless $self->{built};
523
524    return $self->{form};
525}
526
527sub _form_template {
528    my $self = shift;
529    my $msg_required = $self->{build_options}{messages}{text_required};
530    my $msg_invalid = $self->{build_options}{messages}{text_invalid};
531    return q{<% $description ? qq[<p id="description">$description</p>] : '' %>
532<% (grep { $_->{required} } @fields) ? qq[<p id="instructions">} . $msg_required . q{</p>] : '' %>
533<% $start %>
534<%
535    # drop in the hidden fields here
536    $OUT = join("\n", map { $$_{field} } grep { $$_{type} eq 'hidden' } @fields);
537%>} .
538q[
539<%
540    SECTION: while (my $section = shift @sections) {
541        $OUT .= qq[<fieldset>\n];
542        $OUT .= qq[  <legend>$$section{head}</legend>] if $$section{head};
543        $OUT .= qq[<table id="] . ($$section{id} || '_default') . qq[">\n];
544        #$OUT .= qq[  <caption><h2 class="sectionhead">$$section{head}</h2></caption>] if $$section{head};
545        TABLE_LINE: for my $line (@{ $$section{lines} }) {
546            if ($$line[0] eq 'head') {
547                $OUT .= qq[  <tr><th class="subhead" colspan="2"><h2>$$line[1]</h2></th></tr>\n]
548            } elsif ($$line[0] eq 'note') {
549                $OUT .= qq[  <tr><td class="note" colspan="2">$$line[1]</td></tr>\n]
550            } elsif ($$line[0] eq 'field') {
551                local $_ = $field{$$line[1]};
552               
553                # skip hidden fields in the table
554                next TABLE_LINE if $$_{type} eq 'hidden';
555               
556                $OUT .= $$_{invalid} ? qq[  <tr class="invalid">] : qq[  <tr>];
557               
558                # special case single value checkboxes
559                if ($$_{type} eq 'checkbox' && @{ $$_{options} } == 1) {
560                    $OUT .= qq[<td></td>];
561                } else {
562                    $OUT .= '<td class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}</strong>] : "$$_{label}") . '</td>';
563                }
564               
565                # mark invalid fields
566                if ($$_{invalid}) {
567                    $OUT .= qq[<td>$$_{field} <span class="comment">$$_{comment}</span> $$_{error}</td>];
568                } else {
569                    $OUT .= qq[<td>$$_{field} <span class="comment">$$_{comment}</span></td>];
570                }
571               
572                $OUT .= qq[</tr>\n];
573               
574            } elsif ($$line[0] eq 'group') {
575                my @group_fields = map { $field{$_} } map { $$_{name} } @{ $$line[1]{group} };
576                $OUT .= (grep { $$_{invalid} } @group_fields) ? qq[  <tr class="invalid">\n] : qq[  <tr>\n];
577               
578                $OUT .= '    <td class="label">';
579                $OUT .= (grep { $$_{required} } @group_fields) ? qq[<strong class="required">$$line[1]{label}</strong>] : "$$line[1]{label}";
580                $OUT .= qq[</td>\n];
581               
582                $OUT .= qq[    <td><span class="fieldgroup">];
583                $OUT .= join(' ', map { qq[<small class="sublabel">$$_{label}</small> $$_{field} $$_{comment}] } @group_fields);
584                if (my @invalid = grep { $$_{invalid} } @group_fields) {
585                    $OUT .= ' ' . join('; ', map { $$_{error} } @invalid);
586                }               
587                $OUT .= qq[ <span class="comment">$$line[1]{comment}</span></span></td>\n];
588                $OUT .= qq[  </tr>\n];
589            }   
590        }
591        # close the table if there are sections remaining
592        # but leave the last one open for the submit button
593        if (@sections) {
594            $OUT .= qq[</table>\n];
595            $OUT .= qq[</fieldset>\n];
596        }
597    }
598%>
599  <tr><th></th><td style="padding-top: 1em;"><% $submit %> <% $reset %></td></tr>
600</table>
601</fieldset>
602<% $end %>
603];
604}
605
606# usage: $self->_pre_template($css, $charset)
607sub _pre_template {
608    my $self = shift;
609    my $css = shift || $DEFAULT_CSS;
610    my $charset = shift || $DEFAULT_CHARSET;
611    my $msg_author = 'sprintf("' . quotemeta($self->{build_options}{messages}{text_author}) . '", $author)';
612    return 
613q[<html>
614<head>
615  <meta http-equiv="Content-Type" content="text/html; charset=] . $charset . q[" />
616  <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title>
617  <style type="text/css">
618] . $css . q[  </style>
619  <% $jshead %>
620</head>
621<body>
622
623<h1><% $title %></h1>
624<% $author ? qq[<p id="author">] . ] . $msg_author . q{ . q[</p>] : '' %>
625};
626}
627
628sub _post_template {
629    my $self = shift;
630    my $msg_madewith = 'sprintf("' . quotemeta($self->{build_options}{messages}{text_madewith}) .
631        '", q[<a href="http://formbuilder.org/">CGI::FormBuilder</a>], CGI::FormBuilder->VERSION)';
632   
633    return qq[<hr />
634<div id="footer">
635  <p id="creator"><% $msg_madewith %></p>
636</div>
637</body>
638</html>
639];
640}
641
642# usage: $self->_template($css, $charset)
643sub _template {
644    my $self = shift;
645    return $self->_pre_template(@_) . $self->_form_template . $self->_post_template;
646}
647
648sub dump { 
649    eval "use YAML;";
650    unless ($@) {
651        print YAML::Dump(shift->{form_spec});
652    } else {
653        warn '[' . (caller(0))[3] . "] Can't dump form spec structure using YAML: $@";
654    }
655}
656
657
658# module return
6591;
660
661=head1 NAME
662
663Text::FormBuilder - Create CGI::FormBuilder objects from simple text descriptions
664
665=head1 SYNOPSIS
666
667    use Text::FormBuilder;
668   
669    my $parser = Text::FormBuilder->new;
670    $parser->parse($src_file);
671   
672    # returns a new CGI::FormBuilder object with
673    # the fields from the input form spec
674    my $form = $parser->form;
675   
676    # write a My::Form module to Form.pm
677    $parser->write_module('My::Form');
678
679=head1 REQUIRES
680
681L<Parse::RecDescent>,
682L<CGI::FormBuilder>,
683L<Text::Template>,
684L<Class::Base>
685
686=head1 DESCRIPTION
687
688This module is intended to extend the idea of making it easy to create
689web forms by allowing you to describe them with a simple langauge. These
690I<formspecs> are then passed through this module's parser and converted
691into L<CGI::FormBuilder> objects that you can easily use in your CGI
692scripts. In addition, this module can generate code for standalone modules
693which allow you to separate your form design from your script code.
694
695A simple formspec looks like this:
696
697    name//VALUE
698    email//EMAIL
699    langauge:select{English,Spanish,French,German}
700    moreinfo|Send me more information:checkbox
701    interests:checkbox{Perl,karate,bass guitar}
702
703This will produce a required C<name> test field, a required C<email> text
704field that must look like an email address, an optional select dropdown
705field C<langauge> with the choices English, Spanish, French, and German,
706an optional C<moreinfo> checkbox labeled ``Send me more information'', and
707finally a set of checkboxes named C<interests> with the choices Perl,
708karate, and bass guitar.
709
710=head1 METHODS
711
712=head2 new
713
714    my $parser = Text::FormBuilder->new;
715
716=head2 parse
717
718    # parse a file (regular scalar)
719    $parser->parse($filename);
720   
721    # or pass a scalar ref for parse a literal string
722    $parser->parse(\$string);
723   
724    # or an array ref to parse lines
725    $parser->parse(\@lines);
726
727Parse the file or string. Returns the parser object. This method,
728along with all of its C<parse_*> siblings, may be called as a class
729method to construct a new object.
730
731=head2 parse_file
732
733    $parser->parse_file($src_file);
734   
735    # or as a class method
736    my $parser = Text::FormBuilder->parse($src_file);
737
738=head2 parse_text
739
740    $parser->parse_text($src);
741
742Parse the given C<$src> text. Returns the parser object.
743
744=head2 parse_array
745
746    $parser->parse_array(@lines);
747
748Concatenates and parses C<@lines>. Returns the parser object.
749
750=head2 build
751
752    $parser->build(%options);
753
754Builds the CGI::FormBuilder object. Options directly used by C<build> are:
755
756=over
757
758=item C<form_only>
759
760Only uses the form portion of the template, and omits the surrounding html,
761title, author, and the standard footer. This does, however, include the
762description as specified with the C<!description> directive.
763
764=item C<css>, C<extra_css>
765
766These options allow you to tell Text::FormBuilder to use different
767CSS styles for the built in template. A value given a C<css> will
768replace the existing CSS, and a value given as C<extra_css> will be
769appended to the CSS. If both options are given, then the CSS that is
770used will be C<css> concatenated with C<extra_css>.
771
772If you want to use an external stylesheet, a quick way to get this is
773to set the C<css> parameter to import your file:
774
775    css => '@import(my_external_stylesheet.css);'
776
777=item C<external_css>
778
779If you want to use multiple external stylesheets, or an external stylesheet
780in conojunction with the default styles, use the C<external_css> option:
781
782    # single external sheet
783    external_css => 'my_styles.css'
784   
785    # mutliple sheets
786    external_css => [
787        'my_style_A.css',
788        'my_style_B.css',
789    ]
790
791=item C<messages>
792
793This works the same way as the C<messages> parameter to
794C<< CGI::FormBuilder->new >>; you can provide either a hashref of messages
795or a filename.
796
797The default messages used by Text::FormBuilder are:
798
799    text_author       Created by %s
800    text_madewith     Made with %s version %s
801    text_required     (Required fields are marked in <strong>bold</strong>.)
802    text_invalid      Missing or invalid value.
803
804Any messages you set here get passed on to CGI::FormBuilder, which means
805that you should be able to put all of your customization messages in one
806big file.
807
808=item C<charset>
809
810Sets the character encoding for the generated page. The default is ISO-8859-1.
811
812=back
813
814All other options given to C<build> are passed on verbatim to the
815L<CGI::FormBuilder> constructor. Any options given here override the
816defaults that this module uses.
817
818The C<form>, C<write>, and C<write_module> methods will all call
819C<build> with no options for you if you do not do so explicitly.
820This allows you to say things like this:
821
822    my $form = Text::FormBuilder->new->parse('formspec.txt')->form;
823
824However, if you need to specify options to C<build>, you must call it
825explictly after C<parse>.
826
827=head2 form
828
829    my $form = $parser->form;
830
831Returns the L<CGI::FormBuilder> object. Remember that you can modify
832this object directly, in order to (for example) dynamically populate
833dropdown lists or change input types at runtime.
834
835=head2 write
836
837    $parser->write($out_file);
838    # or just print to STDOUT
839    $parser->write;
840
841Calls C<render> on the FormBuilder form, and either writes the resulting
842HTML to a file, or to STDOUT if no filename is given.
843
844=head2 as_module
845
846    my $module_code = $parser->as_module($package, $use_tidy);
847
848=head2 write_module
849
850I<B<Note:> The code output from the C<write_*> methods may be in flux for
851the next few versions, as I coordinate with the B<FormBuilder> project.>
852
853    $parser->write_module($package, $use_tidy);
854
855Takes a package name, and writes out a new module that can be used by your
856CGI script to render the form. This way, you only need CGI::FormBuilder on
857your server, and you don't have to parse the form spec each time you want
858to display your form. The generated module is a subclass of L<CGI::FormBuilder>,
859that will pass along any constructor arguments to FormBuilder, and set up
860the fields for you.
861
862First, you parse the formspec and write the module, which you can do as a one-liner:
863
864    $ perl -MText::FormBuilder -e"Text::FormBuilder->parse('formspec.txt')->write_module('My::Form')"
865
866And then, in your CGI script, use the new module:
867
868    #!/usr/bin/perl -w
869    use strict;
870   
871    use CGI;
872    use My::Form;
873   
874    my $q = CGI->new;
875    my $form = My::Form->new;
876   
877    # do the standard CGI::FormBuilder stuff
878    if ($form->submitted && $form->validate) {
879        # process results
880    } else {
881        print $q->header;
882        print $form->render;
883    }
884
885If you pass a true value as the second argument to C<write_module>, the parser
886will run L<Perl::Tidy> on the generated code before writing the module file.
887
888    # write tidier code
889    $parser->write_module('My::Form', 1);
890
891If you set C<$use_tidy> to a string beginning with `-' C<write_module> will
892interpret C<$use_tidy> as the formatting option switches to pass to Perl::Tidy.
893
894=head2 as_script
895
896    my $script_code = $parser->as_script($use_tidy);
897
898=head2 write_script
899
900    $parser->write_script($filename, $use_tidy);
901
902If you don't need the reuseability of a separate module, you can have
903Text::FormBuilder write the form object to a script for you, along with
904the simplest framework for using it, to which you can add your actual
905form processing code.
906
907The generated script looks like this:
908
909    #!/usr/bin/perl
910    use strict;
911    use warnings;
912   
913    use CGI::FormBuilder;
914   
915    my $form = CGI::FormBuilder->new(
916        # lots of stuff here...
917    );
918   
919    # ...and your field setup subs are here
920    $form->field(name => '...');
921       
922    unless ($form->submitted && $form->validate) {
923        print $form->render;
924    } else {
925        # do something with the entered data
926    }
927
928Like C<write_module>, you can optionally pass a true value as the second
929argument to have Perl::Tidy make the generated code look nicer.
930
931=head2 dump
932
933Uses L<YAML> to print out a human-readable representation of the parsed
934form spec.
935
936=head1 EXPORTS
937
938There is one exported function, C<create_form>, that is intended to ``do the
939right thing'' in simple cases.
940
941=head2 create_form
942
943    # get a CGI::FormBuilder object
944    my $form = create_form($source, $options, $destination);
945   
946    # or just write the form immediately
947    create_form($source, $options, $destination);
948
949C<$source> accepts any of the types of arguments that C<parse> does. C<$options>
950is a hashref of options that should be passed to C<build>. Finally, C<$destination>
951is a simple scalar that determines where and what type of output C<create_form>
952should generate.
953
954    /\.pm$/             ->write_module($destination)
955    /\.(cgi|pl)$/       ->write_script($destination)
956    everything else     ->write($destination)
957
958For anything more than simple, one-off cases, you are usually better off using the
959object-oriented interface, since that gives you more control over things.
960
961=head1 DEFAULTS
962
963These are the default settings that are passed to C<< CGI::FormBuilder->new >>:
964
965    method => 'GET'
966    keepextras => 1
967
968Any of these can be overriden by the C<build> method:
969
970    # use POST instead
971    $parser->build(method => 'POST')->write;
972
973=head1 LANGUAGE
974
975    # name field_size growable label hint type other default option_list validate
976   
977    field_name[size]|descriptive label[hint]:type=default{option1[display string],...}//validate
978   
979    !title ...
980   
981    !author ...
982   
983    !description {
984        ...
985    }
986   
987    !pattern NAME /regular expression/
988   
989    !list NAME {
990        option1[display string],
991        option2[display string],
992        ...
993    }
994   
995    !group NAME {
996        field1
997        field2
998        ...
999    }
1000   
1001    !section id heading
1002   
1003    !head ...
1004   
1005    !note {
1006        ...
1007    }
1008   
1009    !submit label, label 2, ...
1010   
1011    !reset label
1012
1013=head2 Directives
1014
1015=over
1016
1017=item C<!pattern>
1018
1019Defines a validation pattern.
1020
1021=item C<!list>
1022
1023Defines a list for use in a C<radio>, C<checkbox>, or C<select> field.
1024
1025=item C<!group>
1026
1027Define a named group of fields that are displayed all on one line. Use with
1028the C<!field> directive.
1029
1030=item C<!field>
1031
1032B<DEPRECATED> Include a named instance of a group defined with C<!group>.
1033
1034=item C<!title>
1035
1036Title of the form.
1037
1038=item C<!author>
1039
1040Author of the form.
1041
1042=item C<!description>
1043
1044A brief description of the form. Suitable for special instructions on how to
1045fill out the form.
1046
1047=item C<!section>
1048
1049Starts a new section. Each section has its own heading and id, which are
1050written by default into spearate tables.
1051
1052=item C<!head>
1053
1054Inserts a heading between two fields. There can only be one heading between
1055any two fields; the parser will warn you if you try to put two headings right
1056next to each other.
1057
1058=item C<!note>
1059
1060A text note that can be inserted as a row in the form. This is useful for
1061special instructions at specific points in a long form.
1062
1063=item C<!submit>
1064
1065A list of one or more submit button labels in a comma-separated list. Each label
1066is a L<string|/Strings>. Multiple instances of this directive may be used; later
1067lists are simply appended to the earlier lists. All the submit buttons are
1068rendered together at the bottom of the form. See L<CGI::FormBuilder> for an
1069explanation of how the multiple submit buttons work together in a form.
1070
1071To disable the display of any submit button, use C<!submit 0>
1072
1073=item C<!reset>
1074
1075The label for the a reset button at the end of the form. No reset button will be
1076rendered unless you use this directive.
1077
1078=back
1079
1080=head2 Strings
1081
1082First, a note about multiword strings in the fields. Anywhere where it says
1083that you may use a multiword string, this means that you can do one of two
1084things. For strings that consist solely of alphanumeric characters (i.e.
1085C<\w+>) and spaces, the string will be recognized as is:
1086
1087    field_1|A longer label
1088
1089If you want to include non-alphanumerics (e.g. punctuation), you must
1090single-quote the string:
1091
1092    field_2|'Dept./Org.'
1093
1094To include a literal single-quote in a single-quoted string, escape it with
1095a backslash:
1096
1097    field_3|'\'Official\' title'
1098
1099Quoted strings are also how you can set the label for a field to be blank:
1100
1101    unlabeled_field|''
1102
1103=head2 Fields
1104
1105Form fields are each described on a single line. The simplest field is
1106just a name (which cannot contain any whitespace):
1107
1108    color
1109
1110This yields a form with one text input field of the default size named `color'.
1111The generated label for this field would be ``Color''. To add a longer or more
1112descriptive label, use:
1113
1114    color|Favorite color
1115
1116The descriptive label can be a multiword string, as described above. So if you
1117want punctuation in the label, you should single quote it:
1118
1119    color|'Fav. color'
1120
1121To use a different input type:
1122
1123    color|Favorite color:select{red,blue,green}
1124
1125Recognized input types are the same as those used by CGI::FormBuilder:
1126
1127    text        # the default
1128    textarea
1129    password
1130    file
1131    checkbox
1132    radio
1133    select
1134    hidden
1135    static
1136
1137To change the size of the input field, add a bracketed subscript after the
1138field name (but before the descriptive label):
1139
1140    # for a single line field, sets size="40"
1141    title[40]:text
1142   
1143    # for a multiline field, sets rows="4" and cols="30"
1144    description[4,30]:textarea
1145
1146To also set the C<maxlength> attribute for text fields, add a C<!> after
1147the size:
1148
1149    # ensure that all titles entered are 40 characters or less
1150    title[40!]:text
1151
1152This currently only works for single line text fields.
1153
1154To create a growable field, add a C<*> after the name (and size, if
1155given). Growable fields have a button that allows the user to add a
1156copy of the field input. Currently, this only works for C<text> and
1157C<file> fields, and you must have L<CGI::FormBuilder> 3.02 or higher.
1158Growable fields also require JavaScript to function correctly.
1159
1160    # you can have as many people as you like
1161    person*:text
1162
1163To set a limit to the maximum number of inputs a field can grow to, add
1164a number after the C<*>:
1165
1166    # allow up to 5 musicians
1167    musician*5:text
1168
1169To create a C<radio> or C<select> field that includes an "other" option,
1170append the string C<+other> to the field type:
1171
1172    position:select+other
1173
1174Or, to let FormBuilder decide whether to use radio buttons or a dropdown:
1175
1176    position+other
1177
1178Like growable fields, 'other' fields require FormBuilder 3.02 or higher.
1179
1180For the input types that can have options (C<select>, C<radio>, and
1181C<checkbox>), here's how you do it:
1182
1183    color|Favorite color:select{red,blue,green}
1184
1185Values are in a comma-separated list of single words or multiword strings
1186inside curly braces. Whitespace between values is irrelevant.
1187
1188To add more descriptive display text to a value in a list, add a square-bracketed
1189``subscript,'' as in:
1190
1191    ...:select{red[Scarlet],blue[Azure],green[Olive Drab]}
1192
1193If you have a list of options that is too long to fit comfortably on one line,
1194you should use the C<!list> directive:
1195
1196    !list MONTHS {
1197        1[January],
1198        2[February],
1199        3[March],
1200        # and so on...
1201    }
1202   
1203    month:select@MONTHS
1204
1205If you want to have a single checkbox (e.g. for a field that says ``I want to
1206recieve more information''), you can just specify the type as checkbox without
1207supplying any options:
1208
1209    moreinfo|I want to recieve more information:checkbox
1210
1211In this case, the label ``I want to recieve more information'' will be
1212printed to the right of the checkbox.
1213
1214You can also supply a default value to the field. To get a default value of
1215C<green> for the color field:
1216
1217    color|Favorite color:select=green{red,blue,green}
1218
1219Default values can also be either single words or multiword strings.
1220
1221To validate a field, include a validation type at the end of the field line:
1222
1223    email|Email address//EMAIL
1224
1225Valid validation types include any of the builtin defaults from L<CGI::FormBuilder>,
1226or the name of a pattern that you define with the C<!pattern> directive elsewhere
1227in your form spec:
1228
1229    !pattern DAY /^([1-3][0-9])|[1-9]$/
1230   
1231    last_day//DAY
1232
1233If you just want a required value, use the builtin validation type C<VALUE>:
1234
1235    title//VALUE
1236
1237By default, adding a validation type to a field makes that field required. To
1238change this, add a C<?> to the end of the validation type:
1239
1240    contact//EMAIL?
1241
1242In this case, you would get a C<contact> field that was optional, but if it
1243were filled in, would have to validate as an C<EMAIL>.
1244
1245=head2 Field Groups
1246
1247You can define groups of fields using the C<!group> directive:
1248
1249    !group DATE {
1250        month:select@MONTHS//INT
1251        day[2]//INT
1252        year[4]//INT
1253    }
1254
1255You can then include instances of this group using the C<!field> directive:
1256
1257    !field %DATE birthday
1258
1259This will create a line in the form labeled ``Birthday'' which contains
1260a month dropdown, and day and year text entry fields. The actual input field
1261names are formed by concatenating the C<!field> name (e.g. C<birthday>) with
1262the name of the subfield defined in the group (e.g. C<month>, C<day>, C<year>).
1263Thus in this example, you would end up with the form fields C<birthday_month>,
1264C<birthday_day>, and C<birthday_year>.
1265
1266You can also use groups in normal field lines:
1267
1268    birthday|Your birthday:DATE
1269
1270The only (currently) supported pieces of a fieldspec that may be used with a
1271group in this notation are name, label, and hint.
1272
1273=head2 Comments
1274
1275    # comment ...
1276
1277Any line beginning with a C<#> is considered a comment. Comments can also appear
1278after any field line. They I<cannot> appear between items in a C<!list>, or on
1279the same line as any of the directives.
1280
1281=head1 TODO
1282
1283=head2 Documentation/Tests
1284
1285Document use of the parser as a standalone module
1286
1287Make sure that the docs match the generated code.
1288
1289Better tests!
1290
1291=head2 Language/Parser
1292
1293Support the C<multiple> attribute for a field.
1294
1295Make sure that multiple runs of the parser don't share data.
1296
1297Warn/suggest using the C<!submit> directive if some uses C<foo:submit>?
1298
1299Set FB constructor options directly in the formspec (via a C<!fb> or similar
1300directive). The major issue here would be what format to use to allow for
1301array/hash refs.
1302
1303Pieces that wouldn't make sense in a group field: size, row/col, options,
1304validate. These should cause C<build> to emit a warning before ignoring them.
1305
1306C<!include> directive to include external formspec files
1307
1308=head2 Code generation/Templates
1309
1310Revise the generated form constructing code to use the C<fieldopts>
1311option to C<< FB->new >>; will require FB 3.02 to run.
1312
1313Better integration with L<CGI::FormBuilder>'s templating system; rely on the
1314FB messages instead of trying to make our own.
1315
1316Allow for custom wrappers around the C<form_template>
1317
1318Maybe use HTML::Template instead of Text::Template for the built in template
1319(since CGI::FormBuilder users may be more likely to already have HTML::Template)
1320
1321=head1 BUGS
1322
1323Creating two $parsers in the same script causes the second one to get the data
1324from the first one.
1325
1326I'm sure there are more in there, I just haven't tripped over any new ones lately. :-)
1327
1328Suggestions on how to improve the (currently tiny) test suite would be appreciated.
1329
1330=head1 SEE ALSO
1331
1332L<http://textformbuilder.berlios.de>
1333
1334L<CGI::FormBuilder>, L<http://formbuilder.org>
1335
1336=head1 THANKS
1337
1338Thanks to eszpee for pointing out some bugs in the default value parsing,
1339as well as some suggestions for i18n/l10n and splitting up long forms into
1340sections.
1341
1342And of course, to Nathan Wiger, for giving use CGI::FormBuilder in the
1343first place. Thanks Nate!
1344
1345=head1 AUTHOR
1346
1347Peter Eichman C<< <peichman@cpan.org> >>
1348
1349=head1 COPYRIGHT AND LICENSE
1350
1351Copyright E<copy>2004-2005 by Peter Eichman.
1352
1353This program is free software; you can redistribute it and/or
1354modify it under the same terms as Perl itself.
1355
1356=cut
Note: See TracBrowser for help on using the repository browser.