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

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

minor doc fixes
updated version number
set actual number of tests

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