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

Last change on this file since 35 was 35, checked in by peter, 20 years ago

updated version number

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