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

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

removed dependecies on YAML and Parse::RecDescent
renamed _dump to dump; now only tries to load YAML if it is called; non-fatal error if YAML cannot be loaded
modified bin/fb-cgi.pl
expanded docs
File size: 6.0 KB
RevLine 
[1]1package Text::FormBuilder;
2
3use strict;
4use warnings;
5
[7]6our $VERSION = '0.02';
[1]7
8use Text::FormBuilder::Parser;
9use CGI::FormBuilder;
10
11sub new {
12    my $invocant = shift;
13    my $class = ref $invocant || $invocant;
14    my $self = {
15        parser => Text::FormBuilder::Parser->new,
16    };
17    return bless $self, $class;
18}
19
20sub parse {
21    my ($self, $filename) = @_;
22   
23    # so it can be called as a class method
24    $self = $self->new unless ref $self;
25   
26    local $/ = undef;
27    open SRC, "< $filename";
28    my $src = <SRC>;
29    close SRC;
30   
31    return $self->parse_text($src);
32}
33
34sub parse_text {
35    my ($self, $src) = @_;
36    # so it can be called as a class method
37    $self = $self->new unless ref $self;
38    $self->{form_spec} = $self->{parser}->form_spec($src);
39    return $self;
40}
41
42sub build {
43    my ($self, %options) = @_;
44   
45    # substitute in custom pattern definitions for field validation
46    if (my %patterns = %{ $self->{form_spec}{patterns} }) {
47        foreach (@{ $self->{form_spec}{fields} }) {
48            if ($$_{validate} and exists $patterns{$$_{validate}}) {
49                $$_{validate} = $patterns{$$_{validate}};
50            }
51        }
52    }
53   
54    # so we don't get all fields required
55    foreach (@{ $self->{form_spec}{fields} }) {
56        delete $$_{validate} unless $$_{validate};
57    }
58   
59    # substitute in list names
60    if (my %lists = %{ $self->{form_spec}{lists} }) {
61        foreach (@{ $self->{form_spec}{fields} }) {
62            next unless $$_{list};
63           
64            $$_{list} =~ s/^\@//;   # strip leading @ from list var name
65           
66            # a hack so we don't get screwy reference errors
67            if (exists $lists{$$_{list}}) {
68                my @list;
69                push @list, { %$_ } foreach @{ $lists{$$_{list}} };
70                $$_{options} = \@list;
71            }
72        } continue {
73            delete $$_{list};
74        }
75    }
76
77##     #TODO: option switch for this
78##     #TODO: goes with CGI::FormBuilder 2.13
79##     foreach (@{ $self->{form_spec}{fields} }) {
80##         $$_{ulist} = 1 if $$_{type} and $$_{type} =~ /checkbox|radio/ and @{ $$_{options} } >= 3;
81##     }
82   
83    $self->{form} = CGI::FormBuilder->new(
84        method => 'GET',
85        javascript => 0,
86        keepextras => 1,
87        title => $self->{form_spec}{title},
88        fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ],
89        template => {
90            type => 'Text',
91            engine => {
92                TYPE       => 'STRING',
93                SOURCE     => $self->_template,
94                DELIMETERS => [ qw(<% %>) ],
95            },
96            data => {
97                author => $self->{form_spec}{author},
98            },
99        },
100        %options,
101    );
102    $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} };
103   
104    return $self;
105}
106
107sub write {
108    my ($self, $outfile) = @_;
109    if ($outfile) {
110        open FORM, "> $outfile";
111        print FORM $self->form->render;
112        close FORM;
113    } else {
114        print $self->form->render;
115    }
116}
117
118sub form { shift->{form} }
119
120sub _template {
121q[
122<html>
123<head>
124  <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title>
125  <style type="text/css">
126    #author, #footer { font-style: italic; }
127    th { font-weight: normal; text-align: right; vertical-align: top; }
128  </style>
129</head>
130<body>
131
132<h1><% $title %></h1>
133<% $author ? qq[<p id="author">Created by $author</p>] : '' %>
134<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p>
135<% $start %>
136<table>
137<% foreach (@fields) {
138    $OUT .= qq[  <tr>];
139    $OUT .= '<th>' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>';
140    $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n]
141} %>
142  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr>
143</table>
144<% $end %>
145<hr />
146<div id="footer">
147  <p id="creator">Made with <a href="http://formbuilder.org/">CGI::FormBuilder</a> version <% $CGI::FormBuilder::VERSION %>.</p>
148</div>
149</body>
150</html>
151];
152}
153
[7]154sub dump { 
155    eval "use YAML;";
156    unless ($@) {
157        print YAML::Dump(shift->{form_spec});
158    } else {
159        warn "Can't dump form spec structure: $@";
160    }
161}
[1]162
163
164# module return
1651;
166
167=head1 NAME
168
169Text::FormBuilder - Parser for a minilanguage describing web forms
170
171=head1 SYNOPSIS
172
173    my $parser = Text::FormBuilder->new;
174    $parser->parse($src_file);
175   
176    # returns a new CGI::FormBuilder object with the fields
177    # from the input form spec
[7]178    my $form = $parser->form;
[1]179
180=head1 DESCRIPTION
181
182=head2 new
183
184=head2 parse
185
[7]186    $parser->parse($src_file);
187   
188    # or as a class method
189    my $parser = Txt::FormBuilder->parse($src_file);
190
191=head2 parse_text
192
[1]193=head2 build
194
[7]195Options passed to build are passed on verbatim to the L<CGI::FormBuilder>
196constructor. Any options given here override the defaults that this module
197uses.
198
199=head2 form
200
201    my $form = $parser->form;
202
203Returns the L<CGI::FormBuilder> object.
204
[1]205=head2 write
206
[7]207    $parser->write($out_file);
208    # or just print to STDOUT
209    $parser->write;
210
211Calls C<render> on the FormBuilder form, and either writes the resulting HTML
212to a file, or to STDOUT if no filename is given.
213
214=head2 dump
215
216Uses L<YAML> to print out a human-readable representaiton of the parsed
217form spec.
218
[1]219=head1 LANGUAGE
220
[7]221    name[size]|descriptive label[hint]:type=default{option1[display string],option2[display string],...}//validate
[1]222   
223    !title ...
224   
225    !pattern name /regular expression/
226    !list name {
[7]227        option1[display string],
228        option2[display string],
[1]229        ...
230    }
231
232=head2 Directives
233
234=over
235
236=item C<!pattern>
237
238=item C<!list>
239
240=item C<!title>
241
[7]242=item C<!author>
243
[1]244=back
245
246=head2 Fields
247
248Form fields are each described on a single line.
249
250If you have a list of options that is too long to fit comfortably on one line,
251consider using the C<!list> directive.
252
253=head2 Comments
254
255    # comment ...
256
257Any line beginning with a C<#> is considered a comment.
258
[7]259=head1 TODO
260
261=head2 Langauge
262
263Directive for a descriptive or explanatory paragraph about the form
264
265Subsection headers?
266
[1]267=head1 SEE ALSO
268
269L<CGI::FormBuilder>
270
271=cut
Note: See TracBrowser for help on using the repository browser.