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

Last change on this file since 39 was 39, checked in by peter, 19 years ago

added write_script function to write a complete CGI script using the form
abstracted some of the internal code generating and writing code to be easily reused by write_* functions
started work on allowing validation coderefs in the formspec

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