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

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

catch, warn about, and skip unknown directives (lines beginning with !)
optionally use PerlTidy to clean up generated module code
updated version number and docs
write, write_module, and form automatically call build if necessary

File size: 12.8 KB
Line 
1package Text::FormBuilder;
2
3use strict;
4use warnings;
5
6our $VERSION = '0.04';
7
8use Carp;
9use Text::FormBuilder::Parser;
10use CGI::FormBuilder;
11
12sub new {
13    my $invocant = shift;
14    my $class = ref $invocant || $invocant;
15    my $self = {
16        parser => Text::FormBuilder::Parser->new,
17    };
18    return bless $self, $class;
19}
20
21sub parse {
22    my ($self, $filename) = @_;
23   
24    # so it can be called as a class method
25    $self = $self->new unless ref $self;
26   
27    local $/ = undef;
28    open SRC, "< $filename";
29    my $src = <SRC>;
30    close SRC;
31   
32    return $self->parse_text($src);
33}
34
35sub parse_text {
36    my ($self, $src) = @_;
37   
38    # so it can be called as a class method
39    $self = $self->new unless ref $self;
40   
41    $self->{form_spec} = $self->{parser}->form_spec($src);
42   
43    # mark structures as not built (newly parsed text)
44    $self->{built} = 0;
45   
46    return $self;
47}
48
49sub build {
50    my ($self, %options) = @_;
51
52    # save the build options so they can be used from write_module
53    $self->{build_options} = { %options };
54   
55    # our custom %options:
56    # form_only: use only the form part of the template
57    my $form_only = $options{form_only};
58    delete $options{form_only};
59   
60    # substitute in custom pattern definitions for field validation
61    if (my %patterns = %{ $self->{form_spec}{patterns} }) {
62        foreach (@{ $self->{form_spec}{fields} }) {
63            if ($$_{validate} and exists $patterns{$$_{validate}}) {
64                $$_{validate} = $patterns{$$_{validate}};
65            }
66        }
67    }
68   
69    # remove extraneous undefined values
70    for my $field (@{ $self->{form_spec}{fields} }) {
71        defined $$field{$_} or delete $$field{$_} foreach keys %{ $field };
72    }
73   
74    # so we don't get all fields required
75    foreach (@{ $self->{form_spec}{fields} }) {
76        delete $$_{validate} unless $$_{validate};
77    }
78   
79    # substitute in list names
80    if (my %lists = %{ $self->{form_spec}{lists} }) {
81        foreach (@{ $self->{form_spec}{fields} }) {
82            next unless $$_{list};
83           
84            $$_{list} =~ s/^\@//;   # strip leading @ from list var name
85           
86            # a hack so we don't get screwy reference errors
87            if (exists $lists{$$_{list}}) {
88                my @list;
89                push @list, { %$_ } foreach @{ $lists{$$_{list}} };
90                $$_{options} = \@list;
91            }
92        } continue {
93            delete $$_{list};
94        }
95    }
96
97    # TODO: configurable threshold for this
98    foreach (@{ $self->{form_spec}{fields} }) {
99        $$_{ulist} = 1 if defined $$_{options} and @{ $$_{options} } >= 3;
100    }
101   
102    $self->{form} = CGI::FormBuilder->new(
103        method => 'GET',
104        javascript => 0,
105        keepextras => 1,
106        title => $self->{form_spec}{title},
107        fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ],
108        template => {
109            type => 'Text',
110            engine => {
111                TYPE       => 'STRING',
112                SOURCE     => $form_only ? $self->_form_template : $self->_template,
113                DELIMITERS => [ qw(<% %>) ],
114            },
115            data => {
116                headings    => $self->{form_spec}{headings},
117                author      => $self->{form_spec}{author},
118                description => $self->{form_spec}{description},
119            },
120        },
121        %options,
122    );
123    $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} };
124   
125    # mark structures as built
126    $self->{built} = 1;
127   
128    return $self;
129}
130
131sub write {
132    my ($self, $outfile) = @_;
133   
134    # automatically call build if needed to
135    # allow the new->parse->write shortcut
136    $self->build unless $self->{built};
137   
138    if ($outfile) {
139        open FORM, "> $outfile";
140        print FORM $self->form->render;
141        close FORM;
142    } else {
143        print $self->form->render;
144    }
145}
146
147sub write_module {
148    my ($self, $package, $use_tidy) = @_;
149
150    croak 'Expecting a package name' unless $package;
151   
152    # automatically call build if needed to
153    # allow the new->parse->write shortcut
154    $self->build unless $self->{built};
155   
156    # conditionally use Data::Dumper
157    eval 'use Data::Dumper;';
158    die "Can't write module; need Data::Dumper. $@" if $@;
159   
160    # don't dump $VARn names
161    $Data::Dumper::Terse = 1;
162   
163    my $title       = $self->{form_spec}{title} || '';
164    my $author      = $self->{form_spec}{author} || '';
165    my $description = $self->{form_spec}{description} || '';
166   
167    my $headings    = Data::Dumper->Dump([$self->{form_spec}{headings}],['headings']);
168    my $fields      = Data::Dumper->Dump([ [ map { $$_{name} } @{ $self->{form_spec}{fields} } ] ],['fields']);
169   
170    my %options = %{ $self->{build_options} };
171    my $source = $options{form_only} ? $self->_form_template : $self->_template;
172   
173    delete $options{fomr_only};
174   
175    my $form_options = keys %options > 0 ? Data::Dumper->Dump([$self->{build_options}],['*options']) : '';
176   
177    my $field_setup = join(
178        "\n", 
179        map { '$cgi_form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} }
180    );
181   
182    my $module = <<END;
183package $package;
184use strict;
185use warnings;
186
187use CGI::FormBuilder;
188
189sub get_form {
190    my \$cgi = shift;
191    my \$cgi_form = CGI::FormBuilder->new(
192        method => 'GET',
193        params => \$cgi,
194        javascript => 0,
195        keepextras => 1,
196        title => q[$title],
197        fields => $fields,
198        template => {
199            type => 'Text',
200            engine => {
201                TYPE       => 'STRING',
202                SOURCE     => q[$source],
203                DELIMITERS => [ qw(<% %>) ],
204            },
205            data => {
206                headings => $headings,
207                author   => q[$author],
208                description => q[$description],
209            },
210        },
211        $form_options
212    );
213   
214    $field_setup
215   
216    return \$cgi_form;
217}
218
219# module return
2201;
221END
222   
223    my $outfile = (split(/::/, $package))[-1] . '.pm';
224   
225    if ($use_tidy) {
226        # clean up the generated code, if asked
227        eval 'use Perl::Tidy';
228        die "Can't tidy the code: $@" if $@;
229        Perl::Tidy::perltidy(source => \$module, destination => $outfile);
230    } else {
231        # otherwise, just print as is
232        open FORM, "> $outfile";
233        print FORM $module;
234        close FORM;
235    }
236}
237
238sub form {
239    my $self = shift;
240   
241    # automatically call build if needed to
242    # allow the new->parse->write shortcut
243    $self->build unless $self->{built};
244
245    return $self->{form};
246}
247
248sub _form_template {
249q[<% $description ? qq[<p id="description">$description</p>] : '' %>
250<% (grep { $_->{required} } @fields) ? qq[<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p>] : '' %>
251<% $start %>
252<table>
253<% my $i; foreach(@fields) {
254    $OUT .= qq[  <tr><th class="sectionhead" colspan="2"><h2>$headings[$i]</h2></th></tr>\n] if $headings[$i];
255    $OUT .= $$_{invalid} ? qq[  <tr class="invalid">] : qq[  <tr>];
256    $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>';
257    if ($$_{invalid}) {
258        $OUT .= qq[<td>$$_{field} $$_{comment} Missing or invalid value.</td></tr>\n];
259    } else {
260        $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n];
261    }
262    $i++;
263} %>
264  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr>
265</table>
266<% $end %>
267];
268}
269
270sub _template {
271    my $self = shift;
272q[<html>
273<head>
274  <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title>
275  <style type="text/css">
276    #author, #footer { font-style: italic; }
277    th { text-align: left; }
278    th h2 { padding: .125em .5em; background: #eee; }
279    th.label { font-weight: normal; text-align: right; vertical-align: top; }
280    td ul { list-style: none; padding-left: 0; margin-left: 0; }
281  </style>
282</head>
283<body>
284
285<h1><% $title %></h1>
286<% $author ? qq[<p id="author">Created by $author</p>] : '' %>
287] . $self->_form_template . q[
288<hr />
289<div id="footer">
290  <p id="creator">Made with <a href="http://formbuilder.org/">CGI::FormBuilder</a> version <% CGI::FormBuilder->VERSION %>.</p>
291</div>
292</body>
293</html>
294];
295}
296
297sub dump { 
298    eval "use YAML;";
299    unless ($@) {
300        print YAML::Dump(shift->{form_spec});
301    } else {
302        warn "Can't dump form spec structure: $@";
303    }
304}
305
306
307# module return
3081;
309
310=head1 NAME
311
312Text::FormBuilder - Parser for a minilanguage for generating web forms
313
314=head1 SYNOPSIS
315
316    use Text::FormBuilder;
317   
318    my $parser = Text::FormBuilder->new;
319    $parser->parse($src_file);
320   
321    # returns a new CGI::FormBuilder object with
322    # the fields from the input form spec
323    my $form = $parser->form;
324
325=head1 DESCRIPTION
326
327=head2 new
328
329=head2 parse
330
331    $parser->parse($src_file);
332   
333    # or as a class method
334    my $parser = Text::FormBuilder->parse($src_file);
335
336=head2 parse_text
337
338    $parser->parse_text($src);
339
340Parse the given C<$src> text. Returns the parse object.
341
342=head2 build
343
344    $parser->build(%options);
345
346Builds the CGI::FormBuilder object. Options directly used by C<build> are:
347
348=over
349
350=item form_only
351
352Only uses the form portion of the template, and omits the surrounding html,
353title, author, and the standard footer.
354
355=back
356
357All other options given to C<build> are passed on verbatim to the
358L<CGI::FormBuilder> constructor. Any options given here override the
359defaults that this module uses.
360
361The C<form>, C<write>, and C<write_module> methods will all call
362C<build> with no options for you if you do not do so explicitly.
363This allows you to say things like this:
364
365    my $form = Text::FormBuilder->new->parse('formspec.txt')->form;
366
367However, if you need to specify options to C<build>, you must call it
368explictly after C<parse>.
369
370=head2 form
371
372    my $form = $parser->form;
373
374Returns the L<CGI::FormBuilder> object. Remember that you can modify
375this object directly, in order to (for example) dynamically populate
376dropdown lists or change input types at runtime.
377
378=head2 write
379
380    $parser->write($out_file);
381    # or just print to STDOUT
382    $parser->write;
383
384Calls C<render> on the FormBuilder form, and either writes the resulting HTML
385to a file, or to STDOUT if no filename is given.
386
387=head2 write_module
388
389    $parser->write_module($package, $use_tidy);
390
391Takes a package name, and writes out a new module that can be used by your
392CGI script to render the form. This way, you only need CGI::FormBuilder on
393your server, and you don't have to parse the form spec each time you want
394to display your form. The generated module has one function (not exported)
395called C<get_form>, that takes a CGI object as its only argument, and returns
396a CGI::FormBuilder object.
397
398First, you parse the formspec and write the module, which you can do as a one-liner:
399
400    $ perl -MText::FormBuilder -e"Text::FormBuilder->parse('formspec.txt')->write_module('MyForm')"
401
402And then, in your CGI script, use the new module:
403
404    #!/usr/bin/perl -w
405    use strict;
406   
407    use CGI;
408    use MyForm;
409   
410    my $q = CGI->new;
411    my $form = MyForm::get_form($q);
412   
413    # do the standard CGI::FormBuilder stuff
414    if ($form->submitted && $form->validate) {
415        # process results
416    } else {
417        print $q->header;
418        print $form->render;
419    }
420
421If you pass a true value as the second argument to C<write_module>, the parser
422will run L<Perl::Tidy> on the generated code before writing the module file.
423
424=head2 dump
425
426Uses L<YAML> to print out a human-readable representation of the parsed
427form spec.
428
429=head1 LANGUAGE
430
431    field_name[size]|descriptive label[hint]:type=default{option1[display string],option2[display string],...}//validate
432   
433    !title ...
434   
435    !author ...
436   
437    !description {
438        ...
439    }
440   
441    !pattern name /regular expression/
442   
443    !list name {
444        option1[display string],
445        option2[display string],
446        ...
447    }
448   
449    !list name &{ CODE }
450   
451    !head ...
452
453=head2 Directives
454
455=over
456
457=item C<!pattern>
458
459Defines a validation pattern.
460
461=item C<!list>
462
463Defines a list for use in a C<radio>, C<checkbox>, or C<select> field.
464
465=item C<!title>
466
467=item C<!author>
468
469=item C<!description>
470
471=item C<!head>
472
473Inserts a heading between two fields. There can only be one heading between
474any two fields; the parser will warn you if you try to put two headings right
475next to each other.
476
477=back
478
479=head2 Fields
480
481Form fields are each described on a single line.
482
483If you have a list of options that is too long to fit comfortably on one line,
484consider using the C<!list> directive.
485
486=head2 Comments
487
488    # comment ...
489
490Any line beginning with a C<#> is considered a comment.
491
492=head1 TODO
493
494C<!include> directive to include external formspec files
495
496Field groups all on one line in the generated form
497
498Tests!
499
500=head1 SEE ALSO
501
502L<CGI::FormBuilder>
503
504=head1 AUTHOR
505
506Peter Eichman <peichman@cpan.org>
507
508=head1 COPYRIGHT AND LICENSE
509
510Copyright E<copy>2004 by Peter Eichman.
511
512This program is free software; you can redistribute it and/or
513modify it under the same terms as Perl itself.
514
515=cut
Note: See TracBrowser for help on using the repository browser.