Changeset 39 in text-formbuilder for trunk/lib/Text

Timestamp:

12/07/04 16:18:02 (20 years ago)

Author:

peter

Message:

added write_script function to write a complete CGI script using the form
abstracted some of the internal code generating and writing code to be easily reused by write_* functions
started work on allowing validation coderefs in the formspec

Location:

trunk/lib/Text

Files:

• FormBuilder.pm (modified) (8 diffs)
• FormBuilder/grammar (modified) (4 diffs)

trunk/lib/Text/FormBuilder.pm

@@ -41 +41 @@
 
 my $DEFAULT_CHARSET = 'iso-8859-1';
+
+# options to clean up the code with Perl::Tidy
+my $TIDY_OPTIONS = '-nolq -ci=4 -ce';
 
 sub new {
@@ -177 +180 @@
     }
     
-    # substitute in custom pattern definitions for field validation
-    if (my %patterns = %{ $self->{form_spec}{patterns} || {} }) {
-        foreach (@{ $self->{form_spec}{fields} }) {
-            if ($$_{validate} and exists $patterns{$$_{validate}}) {
+    # substitute in custom validation subs and pattern definitions for field validation
+    my %patterns = %{ $self->{form_spec}{patterns} || {} };
+    my %subs = %{ $self->{form_spec}{subs} || {} };
+    
+    foreach (@{ $self->{form_spec}{fields} }) {
+        if ($$_{validate}) {
+            if (exists $patterns{$$_{validate}}) {
                 $$_{validate} = $patterns{$$_{validate}};
+            # TODO: need the Data::Dumper code to work for this
+            # for now, we just warn that it doesn't work
+            } elsif (exists $subs{$$_{validate}}) {
+                warn "[Text::FormBuilder] validate coderefs don't work yet";
+                delete $$_{validate};
+##                 $$_{validate} = eval "sub $subs{$$_{validate}}";
             }
         }
@@ -229 +241 @@
     $$_{required} or delete $$_{required} foreach @{ $self->{form_spec}{fields} };
 
+    foreach (@{ $self->{form_spec}{sections} }) {
+        for my $line (grep { $$_[0] eq 'field' } @{ $$_{lines} }) {
+            $_ eq 'name' or delete $$line[1]{$_} foreach keys %{ $$line[1] };
+        }
+    }
+    
     $self->{form} = CGI::FormBuilder->new(
         %DEFAULT_OPTIONS,
@@ -275 +293 @@
 }
 
-sub write_module {
-    my ($self, $package, $use_tidy) = @_;
-
-    croak '[Text::FormBuilder::write_module] Expecting a package name' unless $package;
-    
+sub _form_code {
+    my $self = shift;
     # automatically call build if needed to
     # allow the new->parse->write shortcut
@@ -322 +337 @@
     delete $options{$_} foreach qw(form_only css extra_css);
     
-    my $form_options = keys %options > 0 ? Data::Dumper->Dump([\%options],['*options']) : '';
+    my %module_subs;
+    my $d = Data::Dumper->new([ \%options ], [ '*options' ]);
+    
+    #TODO: need a workaround/better solution since Data::Dumper doesn't like dumping coderefs
+##     foreach (@{ $self->{form_spec}{fields} }) {
+##         if (ref $$_{validate} eq 'CODE') {
+##             $d->Seen({ "*_validate_$$_{name}" => $$_{validate} });
+##             $module_subs{$$_{name}} = "sub _validate_$$_{name} $$_{validate}";
+##         }
+##     }
+##     
+##     my $sub_code = join("\n", each %module_subs);
+    my $form_options = keys %options > 0 ? $d->Dump : '';
     
     my $field_setup = join(
         "\n", 
-        map { '$cgi_form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} }
+        map { '$form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} }
     );
+    
+    return <<END;
+my \$form = CGI::FormBuilder->new(
+    params => \$q,
+    $form_options
+);
+
+$field_setup
+END
+}
+
+sub write_module {
+    my ($self, $package, $use_tidy) = @_;
+
+    croak '[Text::FormBuilder::write_module] Expecting a package name' unless $package;
+    
+    my $form_code = $self->_form_code;
     
     my $module = <<END;
@@ -337 +381 @@
 
 sub get_form {
-    my \$cgi = shift;
-    my \$cgi_form = CGI::FormBuilder->new(
-        params => \$cgi,
-        $form_options
-    );
-    
-    $field_setup
-    
-    return \$cgi_form;
+    my \$q = shift;
+
+    $form_code
+    
+    return \$form;
 }
 
@@ -354 +394 @@
     my $outfile = (split(/::/, $package))[-1] . '.pm';
     
+    _write_output_file($module, $outfile, $use_tidy);
+    return $self;
+}
+
+sub write_script {
+    my ($self, $script_name, $use_tidy) = @_;
+
+    croak '[Text::FormBuilder::write_script] Expecting a script name' unless $script_name;
+    
+    my $form_code = $self->_form_code;
+    
+    my $script = <<END;
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use CGI;
+use CGI::FormBuilder;
+
+my \$q = CGI->new;
+
+$form_code
+    
+unless (\$form->submitted && \$form->validate) {
+    print \$form->render;
+} else {
+    # do something with the entered data
+}
+END
+    
+    _write_output_file($script, $script_name, $use_tidy);   
+    return $self;
+}
+
+sub _write_output_file {
+    my ($source_code, $outfile, $use_tidy) = @_;
     if ($use_tidy) {
         # clean up the generated code, if asked
         eval 'use Perl::Tidy';
         die "Can't tidy the code: $@" if $@;
-        Perl::Tidy::perltidy(source => \$module, destination => $outfile, argv => '-nolq -ci=4');
+        Perl::Tidy::perltidy(source => \$source_code, destination => $outfile, argv => $TIDY_OPTIONS);
     } else {
         # otherwise, just print as is
-        open FORM, "> $outfile";
-        print FORM $module;
-        close FORM;
-    }
-}
+        open OUT, "> $outfile" or die $!;
+        print OUT $source_code;
+        close OUT;
+    }
+}
+
 
 sub form {
@@ -696 +773 @@
     $parser->write_module('My::Form', 1);
 
+=head2 write_script
+
+    $parser->write_script($filename, $use_tidy);
+
+If you don't need the reuseability of a separate module, you can have
+Text::FormBuilder write the form object to a script for you, along with
+the simplest framework for using it, to which you can add your actual
+form processing code.
+
+The generated script looks like this:
+
+    #!/usr/bin/perl
+    use strict;
+    use warnings;
+    
+    use CGI;
+    use CGI::FormBuilder;
+    
+    my $q = CGI->new;
+    
+    my $form = CGI::FormBuilder->new(
+        params => $q,
+        # ... lots of other stuff to set up the form ...
+    );
+    
+    $form->field( name => 'month' );
+    $form->field( name => 'day' );
+    
+    unless ( $form->submitted && $form->validate ) {
+        print $form->render;
+    } else {
+        # do something with the entered data ...
+        # this is where your form processing code should go
+    }
+
+Like C<write_module>, you can optionally pass a true value as the second
+argument to have Perl::Tidy make the generated code look nicer.
+
 =head2 dump
 

trunk/lib/Text/FormBuilder/grammar

@@ -11 +11 @@
         %lists,
         %patterns,
+        %subs,         # validation subs
         @group,        # current group
         %groups,       # stored groups of fields
@@ -24 +25 @@
 }
 
-form_spec: (list_def | description_def | group_def | line)(s)
+form_spec: (list_def | description_def | validate_def | group_def | line)(s)
     {
         # grab the last section, if there is any
@@ -45 +46 @@
             lists    => \%lists,
             patterns => \%patterns,
+            subs     => \%subs,
             groups   => \%groups,
             sections => \@sections,
@@ -71 +73 @@
     $description =~ s/^{\s*|\s*}$//g;
     }
+
+validate_def: '!validate' var_name <perl_codeblock>
+    { $subs{$item{var_name}} = $item[3] }
 
 group_def: '!group' { $context = 'group' } var_name '{' field_line(s) '}' { $context = 'line' }