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

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