Index: /tags/0.07_03/Changes =================================================================== --- /tags/0.07_03/Changes (revision 49) +++ /tags/0.07_03/Changes (revision 49) @@ -0,0 +1,30 @@ +Release history for Text::FormBuilder. + +0.07 + * added a create_form exported method to "do the right + thing" in simple cases + * added parse_array method to parse an array of lines making + up a formspec + * inline field groups via the !group and !field directives + * added write_script method to write a skeleton CGI + script around the FormBuilder object + * added external documentation of usage examples + +0.06 - 19 Nov 2004 + * marked Parse::RecDescent as an explicit dependency + * added a single-quoted string to the grammar that + can be used in the labels and default values to include + characters not in [\w\t ] + * generated code leaves out overwrriten options + * allow option lists to have simple multiword and quoted + string values + * allow for validated but not required fields + * added a !section directive that splits up a form into + sub-tables with their own ids and captions + * fall through to CGI::FormBuilder builtin option lists + if @LIST does not match a list directive + * customizable messages similar to CGI::FormBuilder + * customizable charset for the generated HTML page + +0.05 - 9 Nov 2004 + * First CPAN release Index: /tags/0.07_03/MANIFEST =================================================================== --- /tags/0.07_03/MANIFEST (revision 49) +++ /tags/0.07_03/MANIFEST (revision 49) @@ -0,0 +1,10 @@ +Changes +Makefile.PL +MANIFEST +README +t/Text-FormBuilder.t +lib/Text/FormBuilder.pm +lib/Text/FormBuilder/Examples.pod +lib/Text/FormBuilder/Parser.pm +lib/Text/FormBuilder/grammar +META.yml Module meta-data (added by MakeMaker) Index: /tags/0.07_03/Makefile.PL =================================================================== --- /tags/0.07_03/Makefile.PL (revision 49) +++ /tags/0.07_03/Makefile.PL (revision 49) @@ -0,0 +1,16 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'Text::FormBuilder', + VERSION_FROM => 'lib/Text/FormBuilder.pm', # finds $VERSION +## EXE_FILES => [ 'bin/fb.pl' ], + PREREQ_PM => { + CGI::FormBuilder => 2.13, + Parse::RecDescent => 1.94, + Text::Template => 1.44, + }, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/Text/FormBuilder.pm', # retrieve abstract from module + AUTHOR => 'Peter Eichman ') : ()), +); Index: /tags/0.07_03/README =================================================================== --- /tags/0.07_03/README (revision 49) +++ /tags/0.07_03/README (revision 49) @@ -0,0 +1,32 @@ +Text-FormBuilder version 0.07_03 +================================ + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + CGI::FormBuilder 2.13 + Text::Template 1.44 + Parse::RecDescent + +Optional: + + Perl::Tidy + YAML + +COPYRIGHT AND LICENCE + +Copyright (C) 2004 by Peter Eichman + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + Index: /tags/0.07_03/bin/fb-cgi.pl =================================================================== --- /tags/0.07_03/bin/fb-cgi.pl (revision 49) +++ /tags/0.07_03/bin/fb-cgi.pl (revision 49) @@ -0,0 +1,42 @@ +use strict; +use warnings; + +use Text::FormBuilder; +use CGI; + +my $q = CGI->new; + +my $form_id = $q->param('form_id'); +my $src_file = get_src_file($form_id); + +my $parser = Text::FormBuilder->new; +my $form = $parser->parse($src_file)->build(method => 'POST', params => $q)->form; + +if (1 or $form->submitted && $form->validate) { + + # call storage function + + my $plugin = 'StoreSQLite'; + + eval "use $plugin;"; + die "Can't use $plugin; $@" if $@; + die "Plugin $plugin doesn't know how to process" unless $plugin->can('process'); + + # plugin process method should return a true value + if ($plugin->process($q, $form, $form_id)) { + # show thank you page + } else { + # there was an error processing the results + die "There was an error processing the submission: " . $plugin->error; + } + +} else { + print $q->header; + print $form->render; +} + +sub get_src_file { + my $form_id = shift; + my $form_spec_path = 'F:/Projects/SurveyMaker/form_specs'; + return "$form_spec_path/$form_id.txt"; +} Index: /tags/0.07_03/bin/fb.pl =================================================================== --- /tags/0.07_03/bin/fb.pl (revision 49) +++ /tags/0.07_03/bin/fb.pl (revision 49) @@ -0,0 +1,37 @@ +use strict; +use warnings; + +use Getopt::Long; +use Text::FormBuilder; + +GetOptions( + 'o=s' => \my $outfile, + 'D=s' => \my %fb_options, +); +my $src_file = shift; + +Text::FormBuilder->parse($src_file)->build(%fb_options)->write($outfile); + +=head1 NAME + +fb - Frontend script for Text::FormBuilder + +=head1 SYNOPSIS + + $ fb my_form.txt -o form.html + + $ fb my_form.txt -o my_form.html -D action=/cgi-bin/my-script.pl + +=head1 OPTIONS + +=over + +=item -D = + +Define options that are passed to the CGI::FormBuilder object. For example, +to create a form on a static html page, and have it submitted to an external +CGI script, you would want to define the C parameter: + + $ fb ... -D action=/cgi-bin/some_script.pl + +=item -o Index: /tags/0.07_03/lib/Text/FormBuilder.pm =================================================================== --- /tags/0.07_03/lib/Text/FormBuilder.pm (revision 49) +++ /tags/0.07_03/lib/Text/FormBuilder.pm (revision 49) @@ -0,0 +1,1215 @@ +package Text::FormBuilder; + +use strict; +use warnings; + +use base qw(Exporter); +use vars qw($VERSION @EXPORT); + +$VERSION = '0.07_03'; +@EXPORT = qw(create_form); + +use Carp; +use Text::FormBuilder::Parser; +use CGI::FormBuilder; + +# the static default options passed to CGI::FormBuilder->new +my %DEFAULT_OPTIONS = ( + method => 'GET', + javascript => 0, + keepextras => 1, +); + +# the built in CSS for the template +my $DEFAULT_CSS = < 'Created by %s', + text_madewith => 'Made with %s version %s', + text_required => '(Required fields are marked in bold.)', + text_invalid => 'Missing or invalid value.', +); + +my $DEFAULT_CHARSET = 'iso-8859-1'; + +# options to clean up the code with Perl::Tidy +my $TIDY_OPTIONS = '-nolq -ci=4 -ce'; + +my $HTML_EXTS = qr/\.html?$/; +my $MODULE_EXTS = qr/\.pm$/; +my $SCRIPT_EXTS = qr/\.(pl|cgi)$/; + +# superautomagical exported function +sub create_form { + my ($source, $options, $destination) = @_; + my $parser = __PACKAGE__->parse($source); + $parser->build(%{ $options || {} }); + if ($destination) { + if (ref $destination) { + croak "[Text::FormBuilder::create_form] Don't know what to do with a ref for $destination"; + #TODO: what do ref dests mean? + } else { + # write webpage, script, or module + if ($destination =~ $MODULE_EXTS) { + $parser->write_module($destination); + } elsif ($destination =~ $SCRIPT_EXTS) { + $parser->write_script($destination); + } else { + $parser->write($destination); + } + } + } else { + defined wantarray ? return $parser->form : $parser->write; + } +} + + +sub new { + my $invocant = shift; + my $class = ref $invocant || $invocant; + my $self = { + parser => Text::FormBuilder::Parser->new, + }; + return bless $self, $class; +} + +sub parse { + my ($self, $source) = @_; + if (my $type = ref $source) { + if ($type eq 'SCALAR') { + $self->parse_text($$source); + } elsif ($type eq 'ARRAY') { + $self->parse_array(@$source); + } else { + croak "[Text::FormBuilder::parse] Unknown ref type $type passed as source"; + } + } else { + $self->parse_file($source); + } +} + +sub parse_array { + my ($self, @lines) = @_; + # so it can be called as a class method + $self = $self->new unless ref $self; + $self->parse_text(join("\n", @lines)); + return $self; +} + +sub parse_file { + my ($self, $filename) = @_; + + # so it can be called as a class method + $self = $self->new unless ref $self; + + local $/ = undef; + open SRC, "< $filename" or croak "[Text::FormBuilder::parse_file] Can't open $filename: $!" and return; + my $src = ; + close SRC; + + return $self->parse_text($src); +} + +sub parse_text { + my ($self, $src) = @_; + + # so it can be called as a class method + $self = $self->new unless ref $self; + + # append a newline so that it can be called on a single field easily + $src .= "\n"; + + $self->{form_spec} = $self->{parser}->form_spec($src); + + # mark structures as not built (newly parsed text) + $self->{built} = 0; + + return $self; +} + +# this is where a lot of the magic happens +sub build { + my ($self, %options) = @_; + + # our custom %options: + # form_only: use only the form part of the template + my $form_only = $options{form_only}; + + # css, extra_css: allow for custom inline stylesheets + # neat trick: css => '@import(my_external_stylesheet.css);' + # will let you use an external stylesheet + # CSS Hint: to get multiple sections to all line up their fields, + # set a standard width for th.label + my $css; + $css = $options{css} || $DEFAULT_CSS; + $css .= $options{extra_css} if $options{extra_css}; + + # messages + # code pulled (with modifications) from CGI::FormBuilder + if ($options{messages}) { + # if its a hashref, we'll just pass it on to CGI::FormBuilder + + if (my $ref = ref $options{messages}) { + # hashref pass on to CGI::FormBuilder + croak "[Text::FormBuilder] Argument to 'messages' option must be a filename or hashref" unless $ref eq 'HASH'; + while (my ($key,$value) = each %DEFAULT_MESSAGES) { + $options{messages}{$key} ||= $DEFAULT_MESSAGES{$key}; + } + } else { + # filename, just *warn* on missing, and use defaults + if (-f $options{messages} && -r _ && open(MESSAGES, "< $options{messages}")) { + $options{messages} = { %DEFAULT_MESSAGES }; + while() { + next if /^\s*#/ || /^\s*$/; + chomp; + my($key,$value) = split ' ', $_, 2; + ($options{messages}{$key} = $value) =~ s/\s+$//; + } + close MESSAGES; + } else { + carp "[Text::FormBuilder] Could not read messages file $options{messages}: $!"; + } + } + } else { + $options{messages} = { %DEFAULT_MESSAGES }; + } + + my $charset = $options{charset}; + + # save the build options so they can be used from write_module + $self->{build_options} = { %options }; + + # remove our custom options before we hand off to CGI::FormBuilder + delete $options{$_} foreach qw(form_only css extra_css charset); + + # expand groups + if (my %groups = %{ $self->{form_spec}{groups} || {} }) { + for my $section (@{ $self->{form_spec}{sections} || [] }) { + foreach (grep { $$_[0] eq 'group' } @{ $$section{lines} }) { + $$_[1]{group} =~ s/^\%//; # strip leading % from group var name + + if (exists $groups{$$_[1]{group}}) { + my @fields; # fields in the group + push @fields, { %$_ } foreach @{ $groups{$$_[1]{group}} }; + for my $field (@fields) { + $$field{label} ||= ucfirst $$field{name}; + $$field{name} = "$$_[1]{name}_$$field{name}"; + } + $_ = [ 'group', { label => $$_[1]{label} || ucfirst(join(' ',split('_',$$_[1]{name}))), group => \@fields } ]; + } + } + } + } + + # the actual fields that are given to CGI::FormBuilder + # make copies so that when we trim down the sections + # we don't lose the form field information + $self->{form_spec}{fields} = []; + + for my $section (@{ $self->{form_spec}{sections} || [] }) { + for my $line (@{ $$section{lines} }) { + if ($$line[0] eq 'group') { + push @{ $self->{form_spec}{fields} }, { %{$_} } foreach @{ $$line[1]{group} }; + } elsif ($$line[0] eq 'field') { + push @{ $self->{form_spec}{fields} }, { %{$$line[1]} }; + } + } + } + + # 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} = $subs{$$_{validate}}; + } + } + } + + # substitute in list names + if (my %lists = %{ $self->{form_spec}{lists} || {} }) { + foreach (@{ $self->{form_spec}{fields} }) { + next unless $$_{list}; + + $$_{list} =~ s/^\@//; # strip leading @ from list var name + + # a hack so we don't get screwy reference errors + if (exists $lists{$$_{list}}) { + my @list; + push @list, { %$_ } foreach @{ $lists{$$_{list}} }; + $$_{options} = \@list; + } else { + # assume that the list name is a builtin + # and let it fall through to CGI::FormBuilder + $$_{options} = $$_{list}; + } + } continue { + delete $$_{list}; + } + } + + # special case single-value checkboxes + foreach (grep { $$_{type} && $$_{type} eq 'checkbox' } @{ $self->{form_spec}{fields} }) { + unless ($$_{options}) { + $$_{options} = [ { $$_{name} => $$_{label} || ucfirst join(' ',split(/_/,$$_{name})) } ]; + } + } + + # use the list for displaying checkbox groups + foreach (@{ $self->{form_spec}{fields} }) { + $$_{ulist} = 1 if ref $$_{options} and @{ $$_{options} } >= 3; + } + + # remove extraneous undefined values + for my $field (@{ $self->{form_spec}{fields} }) { + defined $$field{$_} or delete $$field{$_} foreach keys %{ $field }; + } + + # remove false $$_{required} params because this messes up things at + # the CGI::FormBuilder::field level; it seems to be marking required + # based on the existance of a 'required' param, not whether it is + # true or defined + $$_{required} or delete $$_{required} foreach @{ $self->{form_spec}{fields} }; + + foreach (@{ $self->{form_spec}{sections} }) { + #for my $line (grep { $$_[0] eq 'field' } @{ $$_{lines} }) { + for my $line (@{ $$_{lines} }) { + if ($$line[0] eq 'field') { + $$line[1] = $$line[1]{name}; +## $_ eq 'name' or delete $$line[1]{$_} foreach keys %{ $$line[1] }; +## } elsif ($$line[0] eq 'group') { +## $$line[1] = [ map { $$_{name} } @{ $$line[1]{group} } ]; + } + } + } + + $self->{form} = CGI::FormBuilder->new( + %DEFAULT_OPTIONS, + # need to explicity set the fields so that simple text fields get picked up + fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], + required => [ map { $$_{name} } grep { $$_{required} } @{ $self->{form_spec}{fields} } ], + title => $self->{form_spec}{title}, + text => $self->{form_spec}{description}, + template => { + type => 'Text', + engine => { + TYPE => 'STRING', + SOURCE => $form_only ? $self->_form_template : $self->_template($css, $charset), + DELIMITERS => [ qw(<% %>) ], + }, + data => { + sections => $self->{form_spec}{sections}, + author => $self->{form_spec}{author}, + description => $self->{form_spec}{description}, + }, + }, + %options, + ); + $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} }; + + # mark structures as built + $self->{built} = 1; + + return $self; +} + +sub write { + my ($self, $outfile) = @_; + + # automatically call build if needed to + # allow the new->parse->write shortcut + $self->build unless $self->{built}; + + if ($outfile) { + open FORM, "> $outfile"; + print FORM $self->form->render; + close FORM; + } else { + print $self->form->render; + } +} + +# generates the core code to create the $form object +# the generated code assumes that you have a CGI.pm +# object named $q +sub _form_code { + my $self = shift; + + # automatically call build if needed to + # allow the new->parse->write shortcut + $self->build unless $self->{built}; + + # conditionally use Data::Dumper + eval 'use Data::Dumper;'; + die "Can't write module; need Data::Dumper. $@" if $@; + + $Data::Dumper::Terse = 1; # don't dump $VARn names + $Data::Dumper::Quotekeys = 0; # don't quote simple string keys + + my $css; + $css = $self->{build_options}{css} || $DEFAULT_CSS; + $css .= $self->{build_options}{extra_css} if $self->{build_options}{extra_css}; + + my %options = ( + %DEFAULT_OPTIONS, + title => $self->{form_spec}{title}, + text => $self->{form_spec}{description}, + fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], + required => [ map { $$_{name} } grep { $$_{required} } @{ $self->{form_spec}{fields} } ], + template => { + type => 'Text', + engine => { + TYPE => 'STRING', + SOURCE => $self->{build_options}{form_only} ? + $self->_form_template : + $self->_template($css, $self->{build_options}{charset}), + DELIMITERS => [ qw(<% %>) ], + }, + data => { + sections => $self->{form_spec}{sections}, + author => $self->{form_spec}{author}, + description => $self->{form_spec}{description}, + }, + }, + %{ $self->{build_options} }, + ); + + # remove our custom options + delete $options{$_} foreach qw(form_only css extra_css); + + my %module_subs; + my $d = Data::Dumper->new([ \%options ], [ '*options' ]); + + use B::Deparse; + my $deparse = B::Deparse->new; +## +## #TODO: need a workaround/better solution since Data::Dumper doesn't like dumping coderefs +## foreach (@{ $self->{form_spec}{fields} }) { +## if (ref $$_{validate} eq 'CODE') { +## my $body = $deparse->coderef2text($$_{validate}); +## #$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 { '$form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} } + ); + + return <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 = <_form_code; + + my $script = <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 => \$source_code, destination => $outfile, argv => $TIDY_OPTIONS); + } else { + # otherwise, just print as is + open OUT, "> $outfile" or die $!; + print OUT $source_code; + close OUT; + } +} + + +sub form { + my $self = shift; + + # automatically call build if needed to + # allow the new->parse->write shortcut + $self->build unless $self->{built}; + + return $self->{form}; +} + +sub _form_template { + my $self = shift; + my $msg_required = $self->{build_options}{messages}{text_required}; + my $msg_invalid = $self->{build_options}{messages}{text_invalid}; + return q{<% $description ? qq[

$description

] : '' %> +<% (grep { $_->{required} } @fields) ? qq[

} . $msg_required . q{

] : '' %> +<% $start %> +<% + # drop in the hidden fields here + $OUT = join("\n", map { $$_{field} } grep { $$_{type} eq 'hidden' } @fields); +%>} . +q[ +<% + SECTION: while (my $section = shift @sections) { + $OUT .= qq[\n]; + $OUT .= qq[ ] if $$section{head}; + TABLE_LINE: for my $line (@{ $$section{lines} }) { + if ($$line[0] eq 'head') { + $OUT .= qq[ \n] + } elsif ($$line[0] eq 'field') { + local $_ = $field{$$line[1]}; + + # skip hidden fields in the table + next TABLE_LINE if $$_{type} eq 'hidden'; + + $OUT .= $$_{invalid} ? qq[ ] : qq[ ]; + + # special case single value checkboxes + if ($$_{type} eq 'checkbox' && @{ $$_{options} } == 1) { + $OUT .= qq[]; + } else { + $OUT .= ''; + } + + # mark invalid fields + if ($$_{invalid}) { + $OUT .= ""; + } else { + $OUT .= qq[]; + } + + $OUT .= qq[\n]; + + } elsif ($$line[0] eq 'group') { + my @group_fields = map { $field{$_} } map { $$_{name} } @{ $$line[1]{group} }; + $OUT .= (grep { $$_{invalid} } @group_fields) ? qq[ \n] : qq[ \n]; + + $OUT .= ' \n]; + + $OUT .= qq[ \n]; + $OUT .= qq[ \n]; + } + } + # close the table if there are sections remaining + # but leave the last one open for the submit button + $OUT .= qq[

$$section{head}

$$line[1]

' . ($$_{required} ? qq[$$_{label}:] : "$$_{label}:") . '$$_{field} $$_{comment} ] . $msg_invalid . q[$$_{field} $$_{comment}
'; + $OUT .= (grep { $$_{required} } @group_fields) ? qq[$$line[1]{label}:] : "$$line[1]{label}:"; + $OUT .= qq[]; + $OUT .= join(' ', map { qq[$$_{label} $$_{field} $$_{comment}] } @group_fields); + $OUT .= " $msg_invalid" if $$_{invalid}; + + $OUT .= qq[
\n] if @sections; + } +%> + <% $submit %> + +<% $end %> +]; +} + +# usage: $self->_pre_template($css, $charset) +sub _pre_template { + my $self = shift; + my $css = shift || $DEFAULT_CSS; + my $charset = shift || $DEFAULT_CHARSET; + my $msg_author = 'sprintf("' . quotemeta($self->{build_options}{messages}{text_author}) . '", $author)'; + return +q[ + + + <% $title %><% $author ? ' - ' . ucfirst $author : '' %> + + <% $jshead %> + + + +

<% $title %>

+<% $author ? qq[

] . ] . $msg_author . q{ . q[

] : '' %> +}; +} + +sub _post_template { + my $self = shift; + my $msg_madewith = 'sprintf("' . quotemeta($self->{build_options}{messages}{text_madewith}) . + '", q[CGI::FormBuilder], CGI::FormBuilder->VERSION)'; + + return qq[
+ + + +]; +} + +# usage: $self->_template($css, $charset) +sub _template { + my $self = shift; + return $self->_pre_template(@_) . $self->_form_template . $self->_post_template; +} + +sub dump { + eval "use YAML;"; + unless ($@) { + print YAML::Dump(shift->{form_spec}); + } else { + warn "Can't dump form spec structure: $@"; + } +} + + +# module return +1; + +=head1 NAME + +Text::FormBuilder - Create CGI::FormBuilder objects from simple text descriptions + +=head1 SYNOPSIS + + use Text::FormBuilder; + + my $parser = Text::FormBuilder->new; + $parser->parse($src_file); + + # returns a new CGI::FormBuilder object with + # the fields from the input form spec + my $form = $parser->form; + + # write a My::Form module to Form.pm + $parser->write_module('My::Form'); + +=head1 REQUIRES + +L, L, L + +=head1 DESCRIPTION + +This module is intended to extend the idea of making it easy to create +web forms by allowing you to describe them with a simple langauge. These +I are then passed through this module's parser and converted +into L objects that you can easily use in your CGI +scripts. In addition, this module can generate code for standalone modules +which allow you to separate your form design from your script code. + +A simple formspec looks like this: + + name//VALUE + email//EMAIL + langauge:select{English,Spanish,French,German} + moreinfo|Send me more information:checkbox + interests:checkbox{Perl,karate,bass guitar} + +This will produce a required C test field, a required C text +field that must look like an email address, an optional select dropdown +field C with the choices English, Spanish, French, and German, +an optional C checkbox labeled ``Send me more information'', and +finally a set of checkboxes named C with the choices Perl, +karate, and bass guitar. + +=head1 METHODS + +=head2 new + + my $parser = Text::FormBuilder->new; + +=head2 parse + + # parse a file (regular scalar) + $parser->parse($filename); + + # or pass a scalar ref for parse a literal string + $parser->parse(\$string); + + # or an array ref to parse lines + $parser->parse(\@lines); + +Parse the file or string. Returns the parser object. This method, +along with all of its C siblings, may be called as a class +method to construct a new object. + +=head2 parse_file + + $parser->parse_file($src_file); + + # or as a class method + my $parser = Text::FormBuilder->parse($src_file); + +=head2 parse_text + + $parser->parse_text($src); + +Parse the given C<$src> text. Returns the parser object. + +=head2 parse_array + + $parser->parse_array(@lines); + +Concatenates and parses C<@lines>. Returns the parser object. + +=head2 build + + $parser->build(%options); + +Builds the CGI::FormBuilder object. Options directly used by C are: + +=over + +=item C + +Only uses the form portion of the template, and omits the surrounding html, +title, author, and the standard footer. This does, however, include the +description as specified with the C directive. + +=item C, C + +These options allow you to tell Text::FormBuilder to use different +CSS styles for the built in template. A value given a C will +replace the existing CSS, and a value given as C will be +appended to the CSS. If both options are given, then the CSS that is +used will be C concatenated with C. + +If you want to use an external stylesheet, a quick way to get this is +to set the C parameter to import your file: + + css => '@import(my_external_stylesheet.css);' + +=item C + +This works the same way as the C parameter to +C<< CGI::FormBuilder->new >>; you can provide either a hashref of messages +or a filename. + +The default messages used by Text::FormBuilder are: + + text_author Created by %s + text_madewith Made with %s version %s + text_required (Required fields are marked in bold.) + text_invalid Missing or invalid value. + +Any messages you set here get passed on to CGI::FormBuilder, which means +that you should be able to put all of your customization messages in one +big file. + +=item C + +Sets the character encoding for the generated page. The default is ISO-8859-1. + +=back + +All other options given to C are passed on verbatim to the +L constructor. Any options given here override the +defaults that this module uses. + +The C
, C, and C methods will all call +C with no options for you if you do not do so explicitly. +This allows you to say things like this: + + my $form = Text::FormBuilder->new->parse('formspec.txt')->form; + +However, if you need to specify options to C, you must call it +explictly after C. + +=head2 form + + my $form = $parser->form; + +Returns the L object. Remember that you can modify +this object directly, in order to (for example) dynamically populate +dropdown lists or change input types at runtime. + +=head2 write + + $parser->write($out_file); + # or just print to STDOUT + $parser->write; + +Calls C on the FormBuilder form, and either writes the resulting +HTML to a file, or to STDOUT if no filename is given. + +=head2 write_module + + $parser->write_module($package, $use_tidy); + +Takes a package name, and writes out a new module that can be used by your +CGI script to render the form. This way, you only need CGI::FormBuilder on +your server, and you don't have to parse the form spec each time you want +to display your form. The generated module has one function (not exported) +called C, that takes a CGI object as its only argument, and returns +a CGI::FormBuilder object. + +First, you parse the formspec and write the module, which you can do as a one-liner: + + $ perl -MText::FormBuilder -e"Text::FormBuilder->parse('formspec.txt')->write_module('My::Form')" + +And then, in your CGI script, use the new module: + + #!/usr/bin/perl -w + use strict; + + use CGI; + use My::Form; + + my $q = CGI->new; + my $form = My::Form::get_form($q); + + # do the standard CGI::FormBuilder stuff + if ($form->submitted && $form->validate) { + # process results + } else { + print $q->header; + print $form->render; + } + +If you pass a true value as the second argument to C, the parser +will run L on the generated code before writing the module file. + + # write tidier code + $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, you can optionally pass a true value as the second +argument to have Perl::Tidy make the generated code look nicer. + +=head2 dump + +Uses L to print out a human-readable representation of the parsed +form spec. + +=head1 EXPORTS + +There is one exported function, C, that is intended to ``do the +right thing'' in simple cases. + +=head2 create_form + + # get a CGI::FormBuilder object + my $form = create_form($source, $options, $destination); + + # or just write the form immediately + create_form($source, $options, $destination); + +C<$source> accepts any of the types of arguments that C does. C<$options> +is a hashref of options that should be passed to C. Finally, C<$destination> +is a simple scalar that determines where and what type of output C +should generate. + + /\.pm$/ ->write_module($destination) + /\.(cgi|pl)$/ ->write_script($destination) + everything else ->write($destination) + +For anything more than simple, one-off cases, you are usually better off using the +object-oriented interface, since that gives you more control over things. + +=head1 DEFAULTS + +These are the default settings that are passed to C<< CGI::FormBuilder->new >>: + + method => 'GET' + javascript => 0 + keepextras => 1 + +Any of these can be overriden by the C method: + + # use POST instead + $parser->build(method => 'POST')->write; + +=head1 LANGUAGE + + field_name[size]|descriptive label[hint]:type=default{option1[display string],...}//validate + + !title ... + + !author ... + + !description { + ... + } + + !pattern NAME /regular expression/ + + !list NAME { + option1[display string], + option2[display string], + ... + } + + !list NAME &{ CODE } + + !group NAME { + field1 + field2 + ... + } + + !section id heading + + !head ... + +=head2 Directives + +=over + +=item C + +Defines a validation pattern. + +=item C + +Defines a list for use in a C, C, or C, C, and +C), here's how you do it: + + color|Favorite color:select{red,blue,green} + +Values are in a comma-separated list of single words or multiword strings +inside curly braces. Whitespace between values is irrelevant. + +To add more descriptive display text to a value in a list, add a square-bracketed +``subscript,'' as in: + + ...:select{red[Scarlet],blue[Azure],green[Olive Drab]} + +If you have a list of options that is too long to fit comfortably on one line, +you should use the C directive: + + !list MONTHS { + 1[January], + 2[February], + 3[March], + # and so on... + } + + month:select@MONTHS + +There is another form of the C directive: the dynamic list: + + !list RANDOM &{ map { rand } (0..5) } + +The code inside the C<&{ ... }> is Ced by C, and the results +are stuffed into the list. The Ced code can either return a simple +list, as the example does, or the fancier C<< ( { value1 => 'Description 1'}, +{ value2 => 'Description 2}, ... ) >> form. + +I This feature of the language may go away unless I find a compelling +reason for it in the next few versions. What I really wanted was lists that +were filled in at run-time (e.g. from a database), and that can be done easily +enough with the CGI::FormBuilder object directly.> + +If you want to have a single checkbox (e.g. for a field that says ``I want to +recieve more information''), you can just specify the type as checkbox without +supplying any options: + + moreinfo|I want to recieve more information:checkbox + +In this case, the label ``I want to recieve more information'' will be +printed to the right of the checkbox. + +You can also supply a default value to the field. To get a default value of +C for the color field: + + color|Favorite color:select=green{red,blue,green} + +Default values can also be either single words or multiword strings. + +To validate a field, include a validation type at the end of the field line: + + email|Email address//EMAIL + +Valid validation types include any of the builtin defaults from L, +or the name of a pattern that you define with the C directive elsewhere +in your form spec: + + !pattern DAY /^([1-3][0-9])|[1-9]$/ + + last_day//DAY + +If you just want a required value, use the builtin validation type C: + + title//VALUE + +By default, adding a validation type to a field makes that field required. To +change this, add a C to the end of the validation type: + + contact//EMAIL? + +In this case, you would get a C field that was optional, but if it +were filled in, would have to validate as an C. + +=head2 Field Groups + +You can define groups of fields using the C directive: + + !group DATE { + month:select@MONTHS//INT + day[2]//INT + year[4]//INT + } + +You can then include instances of this group using the C directive: + + !field %DATE birthday + +This will create a line in the form labeled ``Birthday'' which contains +a month dropdown, and day and year text entry fields. The actual input field +names are formed by concatenating the C name (e.g. C) with +the name of the subfield defined in the group (e.g. C, C, C). +Thus in this example, you would end up with the form fields C, +C, and C. + +=head2 Comments + + # comment ... + +Any line beginning with a C<#> is considered a comment. + +=head1 TODO + +Allow renaming of the submit button; allow renaming and inclusion of a +reset button + +Allow for custom wrappers around the C + +Maybe use HTML::Template instead of Text::Template for the built in template +(since CGI::FormBuilder users may be more likely to already have HTML::Template) + +C directive to include external formspec files + +Better tests! + +=head1 BUGS + +Creating two $parsers in the same script causes the second one to get the data +from the first one. + +I'm sure there are more in there, I just haven't tripped over any new ones lately. :-) + +Suggestions on how to improve the (currently tiny) test suite would be appreciated. + +=head1 SEE ALSO + +L + +=head1 THANKS + +Thanks to eszpee for pointing out some bugs in the default value parsing, +as well as some suggestions for i18n/l10n and splitting up long forms into +sections. + +=head1 AUTHOR + +Peter Eichman C<< >> + +=head1 COPYRIGHT AND LICENSE + +Copyright E2004 by Peter Eichman. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.07_03/lib/Text/FormBuilder/Examples.pod =================================================================== --- /tags/0.07_03/lib/Text/FormBuilder/Examples.pod (revision 49) +++ /tags/0.07_03/lib/Text/FormBuilder/Examples.pod (revision 49) @@ -0,0 +1,225 @@ +=head1 NAME + +Examples - Sample uses of Text::FormBuilder + +=head1 EXAMPLES + +=head2 Event Form + +This is the formspec for an input form for an event calendar. It exercises many +of the features of the formspec language. This is close to a real world project +that I have been developing. + + !title Add Event + !author Peter Eichman + !description { + Start and end times are not required, but are recommended. If you leave + both of them blank, the event will be considered an all day event. + } + + !pattern TIME /^\s*\d{1,2}(:\d{2})?(\s*[ap]m)?\s*$/ + !pattern DAY /^\s*(([1-3][0-9])|[1-9])\s*$/ + !pattern YEAR /^\s*\d{4}\s*$/ + + !list MONTHS { + 1[January], 2[February], 3[March], 4[April], + 5[May], 6[June], 7[July], 8[August], + 9[September], 10[October], 11[November], 12[December] + } + + !group DATE { + month@MONTHS//VALUE + day[2]//DAY + year[4]//YEAR + } + + !group TIME { + start[8]|' '//TIME? + end[8]|'–'[(hh:mm am/pm)]//TIME? + } + + !group SERIES { + old|Existing:select + new[40]|or New + } + + # input fields start here + + event_type:select//VALUE + + title[60]//VALUE + + !field %DATE date + !field %TIME time + + series_old|Existing series:select + series_new[60]|New series + + description[6,60]:textarea + contact[60] + email[40]//EMAIL? + location[60] + url[60]|Website + +Both of the fields C and C get filled in +from a database in the actual CGI script. The relevant bits of +the CGI script which uses this form go something like this: + + # the module containing the FormBuilder-building code + use Calendar::Forms::AddEvent; + my $form = Calendar::Forms::AddEvent::get_form($q); + + # now we have a CGI::FormBuilder object in $form + + # fill in dropdown lists + $form->field(name => 'event_type', values => \@event_types); + $form->field(name => 'series_old', values => \@existing_series); + + unless ($form->submitted && $form->validate) { + print $q->header; + print $form->render; + } else { + # process the data ... + } + +=head1 CGI::FormBuilder EXAMPLES + +Here are some of L's examples, translated into +Text::FormBuilder's terms. + +=head2 Ex1: order.cgi + +Formspec F: + + !title Order Info + + !list STATES { + AL, AK, AZ, AR, CA, CO, CT, DE, DC, FL, GE, HI, ID, IL, IN, IA, KS, + KY, LA, ME, MD, MA, MI, MN, MS, MO, MT, NE, NV, NH, NJ, NM, NY, NC, + ND, OH, OK, OR, PA, RI, SC, SD, TN, TX, UT, VT, VA, WA, WV, WI, WY + } + + first_name + last_name + email//EMAIL + address + state@STATES + zipcode//ZIPCODE + credit_card//CARD + details[10,50]:textarea + +Parse and create F: + + $ perl -MText::FormBuilder \ + -e'Text::FormBuilder->parse("example1")->build(method => "POST") \ + ->write_module("MyForms::Example1")' + +Script: + + #!/usr/bin/perl -w + use strict; + + use CGI; # you have to use CGI.pm explicitly + use MyForms::Example1; + + my $q = CGI->new; + + my $form = MyForms::Example1::get_form($q); + + # try to validate it first + if ($form->submitted && $form->validate) { + # ... more code goes here to do stuff ... + print $form->confirm; + } else { + print $form->render; + } + +=head2 Ex2: order_form.cgi + +You can also include the formspec in your script; the only downside to this +is that your script has to parse the spec every time it gets called, so this +method is definitely I recommended for high-traffic forms. + +Script F: + + #!/usr/bin/perl -w + use strict; + + use CGI; # you have to use CGI.pm explicitly + use Text::FormBuilder; + + my $parser = Text::FormBuilder->parse_text(q[ + first_name + last_name + email + address + state@STATE + zipcode + credit_card + details[10,50]:textarea + ]); + + my $q = CGI->new; + $parser->build(params => $q, method => 'POST', smartness => 2, debug => 2); + + my $form = $parser->form; + + # try to validate it first + if ($form->submitted && $form->validate) { + # ... more code goes here to do stuff ... + print $form->confirm; + } else { + print $form->render; + } + +=head2 Ex4: user_info.cgi + + #!/usr/bin/perl -w + use strict; + + use Text::FormBuilder; + use CGI; + use DBI; + + my $dbh = DBI->connect('dbi:Oracle:db', 'user', 'pass'); + + my $parser = Text::FormBuilder->parse_text(q[ + username + password + confirm_password + first_name + last_name + email + ]); + + + my $q = CGI->new; + my $form = $parser->build(params => $q)->form; + + # Now get the value of the username from our app + my $user = $form->cgi_param('user'); + my $sth = $dbh->prepare("select * from user_info where user = '$user'"); + $sth->execute; + my $default_hashref = $sth->fetchrow_hashref; + # Render our form with the defaults we got in our hashref + print $form->render(values => $default_hashref, + title => "User information for '$user'", + ); + +=head1 SEE ALSO + +L, +L + +=head1 AUTHOR + +Peter Eichman, C<< >> + +=head1 COPYRIGHT AND LICENSE + +Copyright E2004 by Peter Eichman. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.07_03/lib/Text/FormBuilder/Makefile =================================================================== --- /tags/0.07_03/lib/Text/FormBuilder/Makefile (revision 49) +++ /tags/0.07_03/lib/Text/FormBuilder/Makefile (revision 49) @@ -0,0 +1,3 @@ +# pre-compile the parser from the grammar +Parser.pm: grammar + perl -MParse::RecDescent - grammar Text::FormBuilder::Parser Index: /tags/0.07_03/lib/Text/FormBuilder/grammar =================================================================== --- /tags/0.07_03/lib/Text/FormBuilder/grammar (revision 49) +++ /tags/0.07_03/lib/Text/FormBuilder/grammar (revision 49) @@ -0,0 +1,224 @@ +{ + my ( + $context, # line or group + @sections, # master data structure + $section_head, + $section_id, + @lines, # lines in each section + $title, + $author, + $description, + %lists, + %patterns, + %subs, # validation subs + @group, # current group + %groups, # stored groups of fields + $type, + @options, + $required, + $list_var, + $size, + $rows, + $cols, + ); + $context = 'line'; +} + +form_spec: (list_def | description_def | validate_def | group_def | line)(s) + { + # grab the last section, if there is any + if (@lines) { + push @sections, + { + id => $section_id, + head => $section_head, + lines => [ @lines ], + }; + } + + $section_id = $item{identifier}; + $section_head = $item[3]; + @lines = (); + $return = { + title => $title, + author => $author, + description => $description, + lists => \%lists, + patterns => \%patterns, + subs => \%subs, + groups => \%groups, + sections => \@sections, + } + } + +list_def: '!list' var_name (static_list | dynamic_list) + { $lists{$item{var_name}} = [ @options ]; @options = () } + +static_list: '{' option(s /,\s*/) /,?/ '}' + +dynamic_list: '&' + { + my @results = (eval $item[2]); + if (ref $results[0] eq 'HASH') { + @options = @results; + } else { + @options = map { { $_ => $_ } } @results; + } + } + +description_def: '!description' + { warn "[Text::FormBuilder] Description redefined at input text line $thisline\n" if defined $description; + + $description = $item[2]; + $description =~ s/^{\s*|\s*}$//g; + } + +validate_def: '!validate' var_name + { $subs{$item{var_name}} = eval "sub $item[3]" } + +group_def: '!group' { $context = 'group' } var_name '{' field_line(s) '}' { $context = 'line' } + { + #warn "$item{var_name} group; context $context\n" + $groups{$item{var_name}} = [ @group ]; + @group = (); + } + +field_line: ( field | comment | blank ) "\n" +line: ( title | author | pattern_def | section_head | heading | group_field | unknown_directive | field | comment | blank ) "\n" + +title: '!title' /.*/ + { + warn "[Text::Formbuilder] Title redefined at input text line $thisline\n" if defined $title; + $title = $item[2]; + } + +author: '!author' /.*/ + { + warn "[Text::Formbuilder] Author redefined at input text line $thisline\n" if defined $author; + $author = $item[2]; + } + +pattern_def: '!pattern' var_name pattern + { $patterns{$item{var_name}} = $item{pattern} } + +pattern: /.*/ + +section_head: '!section' identifier /.*/ + { + #warn "starting section $item{identifier}\n"; + #warn " with heading $item[3]\n" if $item[3]; + + if (@lines) { + push @sections, + { + id => $section_id, + head => $section_head, + lines => [ @lines ], + }; + } + + $section_id = $item{identifier}; + $section_head = $item[3]; + @lines = (); + } + +heading: '!head' /.*/ { push @lines, [ 'head', $item[2] ] } + +group_field: '!field' group_name name label(?) + { + push @lines, [ 'group', { name => $item{name}, label => $item{'label(?)'}[0], group => $item{group_name} } ]; + } + +group_name: /%[A-Z_]+/ + +field: name field_size(?) label(?) hint(?) type(?) default(?) option_list(?) validate(?) + { + my $field = { + name => $item{name}, + label => $item{'label(?)'}[0], + comment => $item{'hint(?)'}[0], + type => $item{'type(?)'}[0], + value => $item{'default(?)'}[0], + list => $list_var, + validate => $item{'validate(?)'}[0], + required => $required || 0, + }; + + $$field{options} = [ @options ] if @options; + + $$field{rows} = $rows if defined $rows; + $$field{cols} = $cols if defined $cols; + $$field{size} = $size if defined $size; + + #warn "[$thisline] field $item{name}; context $context\n"; + if ($context eq 'group') { + push @group, $field; + } else { + push @lines, [ 'field', $field ]; + } + + $type = undef; + $required = 0; + $list_var = undef; + $size = undef; + $rows = undef; + $cols = undef; + @options = (); + + } + +name: identifier + +var_name: /[A-Z_]+/ + +field_size: '[' ( row_col | size ) ']' + +size: /\d+/ + { $size = $item[1] } + +row_col: /\d+/ /,\s*/ /\d+/ + { $rows = $item[1]; $cols = $item[3] } + +label: '|' (simple_multiword | quoted_string) { $item[2] } + +hint: '[' /[^\]]+/ ']' { $item[2] } + +type: ':' /textarea|text|password|file|checkbox|radio|select|hidden|static/ + +default: '=' (simple_multiword | quoted_string) { $item[2] } + +# for simple multiword values not involving punctuation +simple_multiword: /[\w\t ]+/ { $item[2] } + +# my attempt at a single-quoted, non-interpolating string +# where the backslash can escape literal single quotes +quoted_string: "'" /(\\'|[^'])*/ "'" + { $item[3] =~ s/\\'/'/g; $item[3] } + +option_list: options | list_var + +options: '{' option(s /,\s*/) '}' + +list_var: /@[A-Z_]+/ { $list_var = $item[1] } + +option: (simple_multiword | value | quoted_string) display_text(?) + { push @options, { $item[1] => $item{'display_text(?)'}[0] } } + +value: identifier + +display_text: '[' /[^\]]+/i ']' { $item[2] } + +validate: '//' (optional_pattern | required_pattern) { $item[2] } + +optional_pattern: /[A-Z_]+/ '?' { $required = 0; $item[1] } + +required_pattern: /[A-Z_]+/ { $required = 1; $item[1] } + +comment: '#' /.*/ +blank: + +identifier: /\w+/ + +# skip unknown directives with a warning +unknown_directive: /\!\S*/ /.*/ + { warn "[Text::Formbuilder] Skipping unknown directive '$item[1]' at input text line $thisline\n"; } Index: /tags/0.07_03/t/Text-FormBuilder.t =================================================================== --- /tags/0.07_03/t/Text-FormBuilder.t (revision 49) +++ /tags/0.07_03/t/Text-FormBuilder.t (revision 49) @@ -0,0 +1,40 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Text-FormBuilder.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test::More qw(no_plan); #tests => 6; +BEGIN { use_ok('Text::FormBuilder'); }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + +my $p = Text::FormBuilder->new; +isa_ok($p, 'Text::FormBuilder', 'new parser'); +isa_ok($p->parse_text('')->build->form, 'CGI::FormBuilder', 'generated CGI::FormBuilder object (build->form)'); +isa_ok($p->parse_text('')->form, 'CGI::FormBuilder', 'generated CGI::FormBuilder object (form)'); + +$p = Text::FormBuilder->parse_text(''); +isa_ok($p, 'Text::FormBuilder', 'new parser (from parse_text as class method)'); + +$p = Text::FormBuilder->parse(\''); +isa_ok($p, 'Text::FormBuilder', 'new parser (from parse as class method)'); + + +my $simple = <parse(\$simple)->form; +# we should have three fields +is(keys %{ $form->fields }, 3, 'correct number of fields'); + +## my $p2 = Text::FormBuilder->parse_array([qw(code title semester instructor)]); +## is(keys %{ $p2->form->fields }, 4, 'correct number of fields from parse_array'); +## $p2->write;