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

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

initial import
File size: 5.1 KB
Line 
1package Text::FormBuilder;
2
3use strict;
4use warnings;
5
6our $VERSION = '0.01';
7
8use Text::FormBuilder::Parser;
9use CGI::FormBuilder;
10use YAML;
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    # so it can be called as a class method
38    $self = $self->new unless ref $self;
39    $self->{form_spec} = $self->{parser}->form_spec($src);
40    return $self;
41}
42
43sub build {
44    my ($self, %options) = @_;
45   
46    # substitute in custom pattern definitions for field validation
47    if (my %patterns = %{ $self->{form_spec}{patterns} }) {
48        foreach (@{ $self->{form_spec}{fields} }) {
49            if ($$_{validate} and exists $patterns{$$_{validate}}) {
50                $$_{validate} = $patterns{$$_{validate}};
51            }
52        }
53    }
54   
55    # so we don't get all fields required
56    foreach (@{ $self->{form_spec}{fields} }) {
57        delete $$_{validate} unless $$_{validate};
58    }
59   
60    # substitute in list names
61    if (my %lists = %{ $self->{form_spec}{lists} }) {
62        foreach (@{ $self->{form_spec}{fields} }) {
63            next unless $$_{list};
64           
65            $$_{list} =~ s/^\@//;   # strip leading @ from list var name
66           
67            # a hack so we don't get screwy reference errors
68            if (exists $lists{$$_{list}}) {
69                my @list;
70                push @list, { %$_ } foreach @{ $lists{$$_{list}} };
71                $$_{options} = \@list;
72            }
73        } continue {
74            delete $$_{list};
75        }
76    }
77
78##     #TODO: option switch for this
79##     #TODO: goes with CGI::FormBuilder 2.13
80##     foreach (@{ $self->{form_spec}{fields} }) {
81##         $$_{ulist} = 1 if $$_{type} and $$_{type} =~ /checkbox|radio/ and @{ $$_{options} } >= 3;
82##     }
83   
84    $self->{form} = CGI::FormBuilder->new(
85        method => 'GET',
86        javascript => 0,
87        keepextras => 1,
88        title => $self->{form_spec}{title},
89        fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ],
90        template => {
91            type => 'Text',
92            engine => {
93                TYPE       => 'STRING',
94                SOURCE     => $self->_template,
95                DELIMETERS => [ qw(<% %>) ],
96            },
97            data => {
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 { font-weight: normal; text-align: right; vertical-align: top; }
129  </style>
130</head>
131<body>
132
133<h1><% $title %></h1>
134<% $author ? qq[<p id="author">Created by $author</p>] : '' %>
135<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p>
136<% $start %>
137<table>
138<% foreach (@fields) {
139    $OUT .= qq[  <tr>];
140    $OUT .= '<th>' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>';
141    $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n]
142} %>
143  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr>
144</table>
145<% $end %>
146<hr />
147<div id="footer">
148  <p id="creator">Made with <a href="http://formbuilder.org/">CGI::FormBuilder</a> version <% $CGI::FormBuilder::VERSION %>.</p>
149</div>
150</body>
151</html>
152];
153}
154
155sub _dump { print YAML::Dump(shift->{form_spec}); }
156
157
158# module return
1591;
160
161=head1 NAME
162
163Text::FormBuilder - Parser for a minilanguage describing web forms
164
165=head1 SYNOPSIS
166
167    my $parser = Text::FormBuilder->new;
168    $parser->parse($src_file);
169   
170    # returns a new CGI::FormBuilder object with the fields
171    # from the input form spec
172    my $form = $parser->build_form;
173
174=head1 DESCRIPTION
175
176=head2 new
177
178=head2 parse
179
180=head2 build
181
182=head2 write
183
184=head1 LANGUAGE
185
186    name[size]|descriptive label[hint]:type=default{option1(display string),option2(display string),...}//validate
187   
188    !title ...
189   
190    !pattern name /regular expression/
191    !list name {
192        option1(display string),
193        option2(display string),
194        ...
195    }
196
197=head2 Directives
198
199=over
200
201=item C<!pattern>
202
203=item C<!list>
204
205=item C<!title>
206
207=back
208
209=head2 Fields
210
211Form fields are each described on a single line.
212
213If you have a list of options that is too long to fit comfortably on one line,
214consider using the C<!list> directive.
215
216=head2 Comments
217
218    # comment ...
219
220Any line beginning with a C<#> is considered a comment.
221
222=head1 SEE ALSO
223
224L<CGI::FormBuilder>
225
226=cut
Note: See TracBrowser for help on using the repository browser.