Changeset 12 in text-formbuilder for trunk/lib


Ignore:
Timestamp:
10/22/04 15:37:34 (20 years ago)
Author:
peter
Message:

added a method to write a "pre-compiled" module that encapsulates setting up a form
updated docs
updated version number

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/lib/Text/FormBuilder.pm

    r11 r12  
    44use warnings; 
    55 
    6 our $VERSION = '0.02'; 
     6our $VERSION = '0.03'; 
    77 
    88use Text::FormBuilder::Parser; 
    … …  
    4343    my ($self, %options) = @_; 
    4444     
     45    $self->{build_options} = { %options }; 
     46     
     47    # our custom %options: 
     48    # form_only: use only the form part of the template 
     49    my $form_only = $options{form_only}; 
     50    delete $options{form_only}; 
     51     
    4552    # substitute in custom pattern definitions for field validation 
    4653    if (my %patterns = %{ $self->{form_spec}{patterns} }) { 
    … …  
    5057            } 
    5158        } 
     59    } 
     60     
     61    # remove extraneous undefined values 
     62    for my $field (@{ $self->{form_spec}{fields} }) { 
     63        defined $$field{$_} or delete $$field{$_} foreach keys %{ $field }; 
    5264    } 
    5365     
    … …  
    91103            engine => { 
    92104                TYPE       => 'STRING', 
    93                 SOURCE     => $self->_template, 
     105                SOURCE     => $form_only ? $self->_form_template : $self->_template, 
    94106                DELIMITERS => [ qw(<% %>) ], 
    95107            }, 
    … …  
    117129} 
    118130 
     131sub write_module { 
     132    my ($self, $package) = @_; 
     133 
     134    use Data::Dumper; 
     135    # don't dump $VARn names 
     136    $Data::Dumper::Terse = 1; 
     137     
     138    my $title = $self->{form_spec}{title} || ''; 
     139    my $author = $self->{form_spec}{author} || ''; 
     140    my $headings = Data::Dumper->Dump([$self->{form_spec}{headings}],['headings']); 
     141    my $fields = Data::Dumper->Dump([ [ map { $$_{name} } @{ $self->{form_spec}{fields} } ] ],['fields']); 
     142     
     143    my $source = $self->{build_options}{form_only} ? $self->_form_template : $self->_template; 
     144     
     145    my $options = keys %{ $self->{build_options} } > 0 ? Data::Dumper->Dump([$self->{build_options}],['*options']) : ''; 
     146     
     147    my $field_setup = join( 
     148        "\n",  
     149        map { '$cgi_form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} } 
     150    ); 
     151     
     152    my $module = <<END; 
     153package $package; 
     154use strict; 
     155use warnings; 
     156 
     157use CGI::FormBuilder; 
     158 
     159sub form { 
     160    my \$cgi = shift; 
     161    my \$cgi_form = CGI::FormBuilder->new( 
     162        method => 'GET', 
     163        params => \$cgi, 
     164        javascript => 0, 
     165        keepextras => 1, 
     166        title => q[$title], 
     167        fields => $fields, 
     168        template => { 
     169            type => 'Text', 
     170            engine => { 
     171                TYPE       => 'STRING', 
     172                SOURCE     => q[$source], 
     173                DELIMITERS => [ qw(<% %>) ], 
     174            }, 
     175            data => { 
     176                headings => $headings, 
     177                author   => q[$author], 
     178            }, 
     179        }, 
     180        $options 
     181    ); 
     182     
     183    $field_setup 
     184     
     185    return \$cgi_form; 
     186} 
     187 
     188# module return 
     1891; 
     190END 
     191    my $outfile = (split(/::/, $package))[-1] . '.pm'; 
     192     
     193    if ($outfile) { 
     194        open FORM, "> $outfile"; 
     195        print FORM $module; 
     196        close FORM; 
     197    } else { 
     198        print $module; 
     199    } 
     200} 
     201 
    119202sub form { shift->{form} } 
    120203 
     204sub _form_template { 
     205q[<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p> 
     206<% $start %> 
     207<table> 
     208<% my $i; foreach(@fields) { 
     209    $OUT .= qq[  <tr><th class="sectionhead" colspan="2"><h2>$headings[$i]</h2></th></tr>\n] if $headings[$i]; 
     210    $OUT .= qq[  <tr>]; 
     211    $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>'; 
     212    $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n]; 
     213    $i++; 
     214} %> 
     215  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr> 
     216</table> 
     217<% $end %> 
     218]; 
     219} 
     220 
    121221sub _template { 
    122 q[ 
    123 <html> 
     222    my $self = shift; 
     223q[<html> 
    124224<head> 
    125225  <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title> 
    … …  
    135235<h1><% $title %></h1> 
    136236<% $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 %> 
     237] . $self->_form_template . q[ 
    150238<hr /> 
    151239<div id="footer"> 
    … …  
    198286=head2 build 
    199287 
    200 Options passed to build are passed on verbatim to the L<CGI::FormBuilder> 
    201 constructor. Any options given here override the defaults that this module 
    202 uses. 
     288    $parser->build(%options); 
     289 
     290Builds the CGI::FormBuilder object. Options directly used by C<build> are: 
     291 
     292=over 
     293 
     294=item form_only 
     295 
     296Only uses the form portion of the template, and omits the surrounding html, 
     297title, author, and the standard footer. 
     298 
     299=back 
     300 
     301All other options given to C<build> are passed on verbatim to the 
     302L<CGI::FormBuilder> constructor. Any options given here override the 
     303defaults that this module uses. 
    203304 
    204305=head2 form 
    … …  
    217318to a file, or to STDOUT if no filename is given. 
    218319 
     320=head2 write_module 
     321 
     322    $parser->write_module($package); 
     323 
     324Takes a package name, and writes out a new module that can be used by your 
     325CGI script to render the form. This way, you only need CGI::FormBuilder on 
     326your server, and you don't have to parse the form spec each time you want  
     327to display your form. 
     328 
     329    #!/usr/bin/perl -w 
     330    use strict; 
     331     
     332    # your CGI script 
     333     
     334    use CGI; 
     335    use MyForm; 
     336     
     337    my $q = CGI->new; 
     338    my $form = MyForm::form($q); 
     339     
     340    # do the standard CGI::FormBuilder stuff 
     341    if ($form->submitted && $form->validate) { 
     342        # process results 
     343    } else { 
     344        print $q->header; 
     345        print $form->render; 
     346    } 
     347     
     348 
    219349=head2 dump 
    220350 
    … …  
    224354=head1 LANGUAGE 
    225355 
    226     name[size]|descriptive label[hint]:type=default{option1[display string],option2[display string],...}//validate 
     356    field_name[size]|descriptive label[hint]:type=default{option1[display string],option2[display string],...}//validate 
    227357     
    228358    !title ... 
     359     
     360    !author ... 
    229361     
    230362    !pattern name /regular expression/ 
    … …  
    234366        ... 
    235367    } 
     368     
     369    !list name &{ CODE } 
     370     
     371    !head ... 
    236372 
    237373=head2 Directives 
    … …  
    241377=item C<!pattern> 
    242378 
     379Defines a validation pattern. 
     380 
    243381=item C<!list> 
    244382 
     383Defines a list for use in a C<radio>, C<checkbox>, or C<select> field. 
     384 
    245385=item C<!title> 
    246386 
    247387=item C<!author> 
     388 
     389=item C<!head> 
     390 
     391Inserts a heading between two fields. There can only be one heading between 
     392any two fields; the parser will warn you if you try to put two headings right 
     393next to each other. 
    248394 
    249395=back 
    … …  
    268414Directive for a descriptive or explanatory paragraph about the form 
    269415 
    270 Subsection headers? 
    271  
    272416=head1 SEE ALSO 
    273417 
Note: See TracChangeset for help on using the changeset viewer.