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

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

abstracted out the form options code; revisions to the code generation code

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