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

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

added a !head directive for section headers in forms
removed generated Parser.pm file from version control
File size: 6.3 KB
Line 
1package Text::FormBuilder;
2
3use strict;
4use warnings;
5
6our $VERSION = '0.02';
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                DELIMITERS => [ qw(<% %>) ],
95            },
96            data => {
97                headings => $self->{form_spec}{headings},
98                author   => $self->{form_spec}{author},
99            },
100        },
101        %options,
102    );
103    $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} };
104   
105    return $self;
106}
107
108sub write {
109    my ($self, $outfile) = @_;
110    if ($outfile) {
111        open FORM, "> $outfile";
112        print FORM $self->form->render;
113        close FORM;
114    } else {
115        print $self->form->render;
116    }
117}
118
119sub form { shift->{form} }
120
121sub _template {
122q[
123<html>
124<head>
125  <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title>
126  <style type="text/css">
127    #author, #footer { font-style: italic; }
128    th { text-align: left; }
129    th h2 { padding: .125em .5em; background: #eee; }
130    th.label { font-weight: normal; text-align: right; vertical-align: top; }
131  </style>
132</head>
133<body>
134
135<h1><% $title %></h1>
136<% $author ? qq[<p id="author">Created by $author</p>] : '' %>
137<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p>
138<% $start %>
139<table>
140<% my $i; foreach(@fields) {
141    $OUT .= qq[  <tr><th colspan="2"><h2>$headings[$i]</h2></th></tr>\n] if $headings[$i];
142    $OUT .= qq[  <tr>];
143    $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>';
144    $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n];
145    $i++;
146} %>
147  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr>
148</table>
149<% $end %>
150<hr />
151<div id="footer">
152  <p id="creator">Made with <a href="http://formbuilder.org/">CGI::FormBuilder</a> version <% $CGI::FormBuilder::VERSION %>.</p>
153</div>
154</body>
155</html>
156];
157}
158
159sub dump { 
160    eval "use YAML;";
161    unless ($@) {
162        print YAML::Dump(shift->{form_spec});
163    } else {
164        warn "Can't dump form spec structure: $@";
165    }
166}
167
168
169# module return
1701;
171
172=head1 NAME
173
174Text::FormBuilder - Parser for a minilanguage describing web forms
175
176=head1 SYNOPSIS
177
178    my $parser = Text::FormBuilder->new;
179    $parser->parse($src_file);
180   
181    # returns a new CGI::FormBuilder object with the fields
182    # from the input form spec
183    my $form = $parser->form;
184
185=head1 DESCRIPTION
186
187=head2 new
188
189=head2 parse
190
191    $parser->parse($src_file);
192   
193    # or as a class method
194    my $parser = Txt::FormBuilder->parse($src_file);
195
196=head2 parse_text
197
198=head2 build
199
200Options passed to build are passed on verbatim to the L<CGI::FormBuilder>
201constructor. Any options given here override the defaults that this module
202uses.
203
204=head2 form
205
206    my $form = $parser->form;
207
208Returns the L<CGI::FormBuilder> object.
209
210=head2 write
211
212    $parser->write($out_file);
213    # or just print to STDOUT
214    $parser->write;
215
216Calls C<render> on the FormBuilder form, and either writes the resulting HTML
217to a file, or to STDOUT if no filename is given.
218
219=head2 dump
220
221Uses L<YAML> to print out a human-readable representaiton of the parsed
222form spec.
223
224=head1 LANGUAGE
225
226    name[size]|descriptive label[hint]:type=default{option1[display string],option2[display string],...}//validate
227   
228    !title ...
229   
230    !pattern name /regular expression/
231    !list name {
232        option1[display string],
233        option2[display string],
234        ...
235    }
236
237=head2 Directives
238
239=over
240
241=item C<!pattern>
242
243=item C<!list>
244
245=item C<!title>
246
247=item C<!author>
248
249=back
250
251=head2 Fields
252
253Form fields are each described on a single line.
254
255If you have a list of options that is too long to fit comfortably on one line,
256consider using the C<!list> directive.
257
258=head2 Comments
259
260    # comment ...
261
262Any line beginning with a C<#> is considered a comment.
263
264=head1 TODO
265
266=head2 Langauge
267
268Directive for a descriptive or explanatory paragraph about the form
269
270Subsection headers?
271
272=head1 SEE ALSO
273
274L<CGI::FormBuilder>
275
276=cut
Note: See TracBrowser for help on using the repository browser.