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

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

more documentation
added automagic parse method; moved old parse($file) method to parse_file

File size: 16.1 KB
Line 
1package Text::FormBuilder;
2
3use strict;
4use warnings;
5
6use vars qw($VERSION);
7
8$VERSION = '0.05';
9
10use Carp;
11use Text::FormBuilder::Parser;
12use CGI::FormBuilder;
13
14sub new {
15    my $invocant = shift;
16    my $class = ref $invocant || $invocant;
17    my $self = {
18        parser => Text::FormBuilder::Parser->new,
19    };
20    return bless $self, $class;
21}
22
23sub parse {
24    my ($self, $source) = @_;
25    if (ref $source && ref $source eq 'SCALAR') {
26        $self->parse_text($$source);
27    } else {
28        $self->parse_file($source);
29    }
30}
31
32sub parse_file {
33    my ($self, $filename) = @_;
34   
35    # so it can be called as a class method
36    $self = $self->new unless ref $self;
37   
38    local $/ = undef;
39    open SRC, "< $filename";
40    my $src = <SRC>;
41    close SRC;
42   
43    return $self->parse_text($src);
44}
45
46sub parse_text {
47    my ($self, $src) = @_;
48   
49    # so it can be called as a class method
50    $self = $self->new unless ref $self;
51   
52    $self->{form_spec} = $self->{parser}->form_spec($src);
53   
54    # mark structures as not built (newly parsed text)
55    $self->{built} = 0;
56   
57    return $self;
58}
59
60sub build {
61    my ($self, %options) = @_;
62
63    # save the build options so they can be used from write_module
64    $self->{build_options} = { %options };
65   
66    # our custom %options:
67    # form_only: use only the form part of the template
68    my $form_only = $options{form_only};
69    delete $options{form_only};
70   
71    # substitute in custom pattern definitions for field validation
72    if (my %patterns = %{ $self->{form_spec}{patterns} || {} }) {
73        foreach (@{ $self->{form_spec}{fields} }) {
74            if ($$_{validate} and exists $patterns{$$_{validate}}) {
75                $$_{validate} = $patterns{$$_{validate}};
76            }
77        }
78    }
79   
80    # remove extraneous undefined values
81    for my $field (@{ $self->{form_spec}{fields} }) {
82        defined $$field{$_} or delete $$field{$_} foreach keys %{ $field };
83    }
84   
85    # so we don't get all fields required
86    foreach (@{ $self->{form_spec}{fields} }) {
87        delete $$_{validate} unless $$_{validate};
88    }
89   
90    # substitute in list names
91    if (my %lists = %{ $self->{form_spec}{lists} || {} }) {
92        foreach (@{ $self->{form_spec}{fields} }) {
93            next unless $$_{list};
94           
95            $$_{list} =~ s/^\@//;   # strip leading @ from list var name
96           
97            # a hack so we don't get screwy reference errors
98            if (exists $lists{$$_{list}}) {
99                my @list;
100                push @list, { %$_ } foreach @{ $lists{$$_{list}} };
101                $$_{options} = \@list;
102            }
103        } continue {
104            delete $$_{list};
105        }
106    }
107
108    # TODO: configurable threshold for this
109    foreach (@{ $self->{form_spec}{fields} }) {
110        $$_{ulist} = 1 if defined $$_{options} and @{ $$_{options} } >= 3;
111    }
112   
113    $self->{form} = CGI::FormBuilder->new(
114        method => 'GET',
115        javascript => 0,
116        keepextras => 1,
117        title => $self->{form_spec}{title},
118        fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ],
119        template => {
120            type => 'Text',
121            engine => {
122                TYPE       => 'STRING',
123                SOURCE     => $form_only ? $self->_form_template : $self->_template,
124                DELIMITERS => [ qw(<% %>) ],
125            },
126            data => {
127                headings    => $self->{form_spec}{headings},
128                author      => $self->{form_spec}{author},
129                description => $self->{form_spec}{description},
130            },
131        },
132        %options,
133    );
134    $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} };
135   
136    # mark structures as built
137    $self->{built} = 1;
138   
139    return $self;
140}
141
142sub write {
143    my ($self, $outfile) = @_;
144   
145    # automatically call build if needed to
146    # allow the new->parse->write shortcut
147    $self->build unless $self->{built};
148   
149    if ($outfile) {
150        open FORM, "> $outfile";
151        print FORM $self->form->render;
152        close FORM;
153    } else {
154        print $self->form->render;
155    }
156}
157
158sub write_module {
159    my ($self, $package, $use_tidy) = @_;
160
161    croak 'Expecting a package name' unless $package;
162   
163    # automatically call build if needed to
164    # allow the new->parse->write shortcut
165    $self->build unless $self->{built};
166   
167    # conditionally use Data::Dumper
168    eval 'use Data::Dumper;';
169    die "Can't write module; need Data::Dumper. $@" if $@;
170   
171    # don't dump $VARn names
172    $Data::Dumper::Terse = 1;
173   
174    my $title       = $self->{form_spec}{title} || '';
175    my $author      = $self->{form_spec}{author} || '';
176    my $description = $self->{form_spec}{description} || '';
177   
178    my $headings    = Data::Dumper->Dump([$self->{form_spec}{headings}],['headings']);
179    my $fields      = Data::Dumper->Dump([ [ map { $$_{name} } @{ $self->{form_spec}{fields} } ] ],['fields']);
180   
181    my %options = %{ $self->{build_options} };
182    my $source = $options{form_only} ? $self->_form_template : $self->_template;
183   
184    delete $options{fomr_only};
185   
186    my $form_options = keys %options > 0 ? Data::Dumper->Dump([$self->{build_options}],['*options']) : '';
187   
188    my $field_setup = join(
189        "\n", 
190        map { '$cgi_form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} }
191    );
192   
193    my $module = <<END;
194package $package;
195use strict;
196use warnings;
197
198use CGI::FormBuilder;
199
200sub get_form {
201    my \$cgi = shift;
202    my \$cgi_form = CGI::FormBuilder->new(
203        method => 'GET',
204        params => \$cgi,
205        javascript => 0,
206        keepextras => 1,
207        title => q[$title],
208        fields => $fields,
209        template => {
210            type => 'Text',
211            engine => {
212                TYPE       => 'STRING',
213                SOURCE     => q[$source],
214                DELIMITERS => [ qw(<% %>) ],
215            },
216            data => {
217                headings => $headings,
218                author   => q[$author],
219                description => q[$description],
220            },
221        },
222        $form_options
223    );
224   
225    $field_setup
226   
227    return \$cgi_form;
228}
229
230# module return
2311;
232END
233   
234    my $outfile = (split(/::/, $package))[-1] . '.pm';
235   
236    if ($use_tidy) {
237        # clean up the generated code, if asked
238        eval 'use Perl::Tidy';
239        die "Can't tidy the code: $@" if $@;
240        Perl::Tidy::perltidy(source => \$module, destination => $outfile);
241    } else {
242        # otherwise, just print as is
243        open FORM, "> $outfile";
244        print FORM $module;
245        close FORM;
246    }
247}
248
249sub form {
250    my $self = shift;
251   
252    # automatically call build if needed to
253    # allow the new->parse->write shortcut
254    $self->build unless $self->{built};
255
256    return $self->{form};
257}
258
259sub _form_template {
260q[<% $description ? qq[<p id="description">$description</p>] : '' %>
261<% (grep { $_->{required} } @fields) ? qq[<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p>] : '' %>
262<% $start %>
263<table>
264<% my $i; foreach(@fields) {
265    $OUT .= qq[  <tr><th class="sectionhead" colspan="2"><h2>$headings[$i]</h2></th></tr>\n] if $headings[$i];
266    $OUT .= $$_{invalid} ? qq[  <tr class="invalid">] : qq[  <tr>];
267    $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>';
268    if ($$_{invalid}) {
269        $OUT .= qq[<td>$$_{field} $$_{comment} Missing or invalid value.</td></tr>\n];
270    } else {
271        $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n];
272    }
273    $i++;
274} %>
275  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr>
276</table>
277<% $end %>
278];
279}
280
281sub _template {
282    my $self = shift;
283q[<html>
284<head>
285  <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title>
286  <style type="text/css">
287    #author, #footer { font-style: italic; }
288    th { text-align: left; }
289    th h2 { padding: .125em .5em; background: #eee; }
290    th.label { font-weight: normal; text-align: right; vertical-align: top; }
291    td ul { list-style: none; padding-left: 0; margin-left: 0; }
292  </style>
293</head>
294<body>
295
296<h1><% $title %></h1>
297<% $author ? qq[<p id="author">Created by $author</p>] : '' %>
298] . $self->_form_template . q[
299<hr />
300<div id="footer">
301  <p id="creator">Made with <a href="http://formbuilder.org/">CGI::FormBuilder</a> version <% CGI::FormBuilder->VERSION %>.</p>
302</div>
303</body>
304</html>
305];
306}
307
308sub dump { 
309    eval "use YAML;";
310    unless ($@) {
311        print YAML::Dump(shift->{form_spec});
312    } else {
313        warn "Can't dump form spec structure: $@";
314    }
315}
316
317
318# module return
3191;
320
321=head1 NAME
322
323Text::FormBuilder - Parser for a minilanguage for generating web forms
324
325=head1 SYNOPSIS
326
327    use Text::FormBuilder;
328   
329    my $parser = Text::FormBuilder->new;
330    $parser->parse($src_file);
331   
332    # returns a new CGI::FormBuilder object with
333    # the fields from the input form spec
334    my $form = $parser->form;
335   
336    # write a My::Form module to Form.pm
337    $parser->write_module('My::Form');
338
339=head1 DESCRIPTION
340
341=head2 new
342
343=head2 parse
344
345    # parse a file
346    $parser->parse($filename);
347   
348    # or pass a scalar ref for parse a literal string
349    $parser->parse(\$string);
350
351Parse the file or string. Returns the parser object.
352
353=head2 parse_file
354
355    $parser->parse_file($src_file);
356   
357    # or as a class method
358    my $parser = Text::FormBuilder->parse($src_file);
359
360=head2 parse_text
361
362    $parser->parse_text($src);
363
364Parse the given C<$src> text. Returns the parser object.
365
366=head2 build
367
368    $parser->build(%options);
369
370Builds the CGI::FormBuilder object. Options directly used by C<build> are:
371
372=over
373
374=item C<form_only>
375
376Only uses the form portion of the template, and omits the surrounding html,
377title, author, and the standard footer. This does, however, include the
378description as specified with the C<!description> directive.
379
380=back
381
382All other options given to C<build> are passed on verbatim to the
383L<CGI::FormBuilder> constructor. Any options given here override the
384defaults that this module uses.
385
386The C<form>, C<write>, and C<write_module> methods will all call
387C<build> with no options for you if you do not do so explicitly.
388This allows you to say things like this:
389
390    my $form = Text::FormBuilder->new->parse('formspec.txt')->form;
391
392However, if you need to specify options to C<build>, you must call it
393explictly after C<parse>.
394
395=head2 form
396
397    my $form = $parser->form;
398
399Returns the L<CGI::FormBuilder> object. Remember that you can modify
400this object directly, in order to (for example) dynamically populate
401dropdown lists or change input types at runtime.
402
403=head2 write
404
405    $parser->write($out_file);
406    # or just print to STDOUT
407    $parser->write;
408
409Calls C<render> on the FormBuilder form, and either writes the resulting HTML
410to a file, or to STDOUT if no filename is given.
411
412=head2 write_module
413
414    $parser->write_module($package, $use_tidy);
415
416Takes a package name, and writes out a new module that can be used by your
417CGI script to render the form. This way, you only need CGI::FormBuilder on
418your server, and you don't have to parse the form spec each time you want
419to display your form. The generated module has one function (not exported)
420called C<get_form>, that takes a CGI object as its only argument, and returns
421a CGI::FormBuilder object.
422
423First, you parse the formspec and write the module, which you can do as a one-liner:
424
425    $ perl -MText::FormBuilder -e"Text::FormBuilder->parse('formspec.txt')->write_module('My::Form')"
426
427And then, in your CGI script, use the new module:
428
429    #!/usr/bin/perl -w
430    use strict;
431   
432    use CGI;
433    use My::Form;
434   
435    my $q = CGI->new;
436    my $form = My::Form::get_form($q);
437   
438    # do the standard CGI::FormBuilder stuff
439    if ($form->submitted && $form->validate) {
440        # process results
441    } else {
442        print $q->header;
443        print $form->render;
444    }
445
446If you pass a true value as the second argument to C<write_module>, the parser
447will run L<Perl::Tidy> on the generated code before writing the module file.
448
449    # write tidier code
450    $parser->write_module('My::Form', 1);
451
452=head2 dump
453
454Uses L<YAML> to print out a human-readable representation of the parsed
455form spec.
456
457=head1 LANGUAGE
458
459    field_name[size]|descriptive label[hint]:type=default{option1[display string],...}//validate
460   
461    !title ...
462   
463    !author ...
464   
465    !description {
466        ...
467    }
468   
469    !pattern name /regular expression/
470   
471    !list name {
472        option1[display string],
473        option2[display string],
474        ...
475    }
476   
477    !list name &{ CODE }
478   
479    !head ...
480
481=head2 Directives
482
483=over
484
485=item C<!pattern>
486
487Defines a validation pattern.
488
489=item C<!list>
490
491Defines a list for use in a C<radio>, C<checkbox>, or C<select> field.
492
493=item C<!title>
494
495=item C<!author>
496
497=item C<!description>
498
499A brief description of the form. Suitable for special instructions on how to
500fill out the form.
501
502=item C<!head>
503
504Inserts a heading between two fields. There can only be one heading between
505any two fields; the parser will warn you if you try to put two headings right
506next to each other.
507
508=back
509
510=head2 Fields
511
512Form fields are each described on a single line. The simplest field is just a
513name:
514
515    color
516
517This yields a form with one text input field of the default size named `color'.
518The label for this field as generated by CGI::FormBuilder would be ``Color''.
519To add a longer or more descriptive label, use:
520
521    color|Favorite color
522
523Field names cannot contain whitespace, but the descriptive label can.
524
525To use a different input type:
526
527    color|Favorite color:select{red,blue,green}
528
529Recognized input types are the same as those used by CGI::FormBuilder:
530
531    text        # the default
532    textarea
533    select
534    radio
535    checkbox
536    static
537
538This example also shows how you can list multiple values for the input types
539that take multiple values (C<select>, C<radio>, and C<checkbox>). Values are
540in a comma-separated list inside curly braces. Whitespace between values is
541irrelevant, although there cannot be any whitespace within a value.
542
543To add more descriptive display text to a vlaue in a list, add a square-bracketed
544``subscript,'' as in:
545
546    ...:select{red[Scarlet],blue[Azure],green[Olive Drab]}
547
548As you can see, spaces I<are> allowed within the display text for a value.
549
550If you have a list of options that is too long to fit comfortably on one line,
551consider using the C<!list> directive:
552
553    !list MONTHS {
554        1[January],
555        2[February],
556        3[March],
557        # and so on...
558    }
559   
560    month:select@MONTHS
561
562There is another form of the C<!list> directive: the dynamic list:
563
564    !list RANDOM &{ map { rand } (0..5) }
565
566The code inside the C<&{ ... }> is C<eval>ed by C<build>, and the results
567are stuffed into the list. The C<eval>ed code can either return a simple
568list, as the example does, or the fancier C<( { value1 => 'Description 1'},
569{ value2 => 'Description 2}, ...)> form.
570
571B<NOTE:> This feature of the language may go away unless I find a compelling
572reason for it in the next few versions. What I really wanted was lists that
573were filled in at run-time (e.g. from a database), and that can be done easily
574enough with the CGI::FormBuilder object directly.
575
576You can also supply a default value to the field. To get a default value of
577C<green> for the color field:
578
579    color|Favorite color:select=green{red,blue,green}
580
581To validate a field, include a validation type at the end of the field line:
582
583    email|Email address//EMAIL
584
585Valid validation types include any of the builtin defaults from CGI::FormBuilder,
586or the name of a pattern that you define with the C<!pattern> directive elsewhere
587in your form spec:
588
589    !pattern DAY /^([1-3][0-9])|[1-9]$/
590   
591    last_day//DAY
592
593If you just want a required value, use the builtin validation type C<VALUE>:
594
595    title//VALUE
596
597=head2 Comments
598
599    # comment ...
600
601Any line beginning with a C<#> is considered a comment.
602
603=head1 TODO
604
605C<!include> directive to include external formspec files
606
607Field groups all on one line in the generated form
608
609Better tests!
610
611=head1 SEE ALSO
612
613L<CGI::FormBuilder>
614
615=head1 AUTHOR
616
617Peter Eichman <peichman@cpan.org>
618
619=head1 COPYRIGHT AND LICENSE
620
621Copyright E<copy>2004 by Peter Eichman.
622
623This program is free software; you can redistribute it and/or
624modify it under the same terms as Perl itself.
625
626=cut
Note: See TracBrowser for help on using the repository browser.