package Text::FormBuilder; use strict; use warnings; use vars qw($VERSION); $VERSION = '0.06'; use Carp; use Text::FormBuilder::Parser; use CGI::FormBuilder; 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 (ref $source && ref $source eq 'SCALAR') { $self->parse_text($$source); } else { $self->parse_file($source); } } 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"; 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; $self->{form_spec} = $self->{parser}->form_spec($src); # mark structures as not built (newly parsed text) $self->{built} = 0; return $self; } sub build { my ($self, %options) = @_; # save the build options so they can be used from write_module $self->{build_options} = { %options }; # our custom %options: # form_only: use only the form part of the template my $form_only = $options{form_only}; delete $options{form_only}; # 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}}) { $$_{validate} = $patterns{$$_{validate}}; } } } # remove extraneous undefined values for my $field (@{ $self->{form_spec}{fields} }) { defined $$field{$_} or delete $$field{$_} foreach keys %{ $field }; } # so we don't get all fields required foreach (@{ $self->{form_spec}{fields} }) { delete $$_{validate} unless $$_{validate}; } # expand groups my %groups = %{ $self->{form_spec}{groups} }; foreach (grep { $$_[0] eq 'group' } @{ $self->{form_spec}{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 } ]; } } $self->{form_spec}{fields} = []; for my $line (@{ $self->{form_spec}{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 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; } } continue { delete $$_{list}; } } # TODO: use lines instead of fields # TODO: change template to do groups # TODO: configurable threshold for this foreach (@{ $self->{form_spec}{fields} }) { $$_{ulist} = 1 if defined $$_{options} and @{ $$_{options} } >= 3; } $self->{form} = CGI::FormBuilder->new( method => 'GET', javascript => 0, keepextras => 1, title => $self->{form_spec}{title}, #fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], template => { type => 'Text', engine => { TYPE => 'STRING', SOURCE => $form_only ? $self->_form_template : $self->_template, DELIMITERS => [ qw(<% %>) ], }, data => { lines => $self->{form_spec}{lines}, headings => $self->{form_spec}{headings}, 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; # TEMP: dump @lines structure use YAML; warn YAML::Dump($self->{form_spec}->{lines}), "\n"; 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; } } sub write_module { my ($self, $package, $use_tidy) = @_; croak 'Expecting a package name' unless $package; # 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 $@; # don't dump $VARn names $Data::Dumper::Terse = 1; my $title = $self->{form_spec}{title} || ''; my $author = $self->{form_spec}{author} || ''; my $description = $self->{form_spec}{description} || ''; my $headings = Data::Dumper->Dump([$self->{form_spec}{headings}],['headings']); my $fields = Data::Dumper->Dump([ [ map { $$_{name} } @{ $self->{form_spec}{fields} } ] ],['fields']); my %options = %{ $self->{build_options} }; my $source = $options{form_only} ? $self->_form_template : $self->_template; delete $options{form_only}; my $form_options = keys %options > 0 ? Data::Dumper->Dump([$self->{build_options}],['*options']) : ''; my $field_setup = join( "\n", map { '$cgi_form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} } ); my $module = <new( method => 'GET', params => \$cgi, javascript => 0, keepextras => 1, title => q[$title], fields => $fields, template => { type => 'Text', engine => { TYPE => 'STRING', SOURCE => q[$source], DELIMITERS => [ qw(<% %>) ], }, data => { headings => $headings, author => q[$author], description => q[$description], }, }, $form_options ); $field_setup return \$cgi_form; } # module return 1; END my $outfile = (split(/::/, $package))[-1] . '.pm'; 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); } else { # otherwise, just print as is open FORM, "> $outfile"; print FORM $module; close FORM; } } 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 { q[<% $description ? qq[

$description

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

(Required fields are marked in bold.)

] : '' %> <% $start %> <% for my $line (@lines) { if ($$line[0] eq 'head') { $OUT .= qq[ \n] } elsif ($$line[0] eq 'field') { #TODO: we only need the field names, not the full field spec in the lines strucutre local $_ = $field{$$line[1]{name}}; $OUT .= $$_{invalid} ? qq[ ] : qq[ ]; $OUT .= ''; if ($$_{invalid}) { $OUT .= qq[\n]; } else { $OUT .= qq[\n]; } } elsif ($$line[0] eq 'group') { my @field_names = map { $$_{name} } @{ $$line[1]{group} }; my @group_fields = map { $field{$_} } @field_names; $OUT .= (grep { $$_{invalid} } @group_fields) ? qq[ \n] : qq[ \n]; #TODO: validated but not required fields # in a form spec: //EMAIL? #TODO: this doesn't seem to be working; all groups are getting marked as required $OUT .= ' \n]; $OUT .= qq[ \n]; $OUT .= qq[ \n]; } } %>

$$line[1]

' . ($$_{required} ? qq[$$_{label}:] : "$$_{label}:") . '$$_{field} $$_{comment} Missing or invalid value.
$$_{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 .= qq[
<% $submit %>
<% $end %> ]; } sub _template { my $self = shift; q[ <% $title %><% $author ? ' - ' . ucfirst $author : '' %>

<% $title %>

<% $author ? qq[

Created by $author

] : '' %> ] . $self->_form_template . q[
]; } 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 DESCRIPTION =head2 new =head2 parse # parse a file $parser->parse($filename); # or pass a scalar ref for parse a literal string $parser->parse(\$string); Parse the file or string. Returns the parser 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 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. =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 dump Uses L to print out a human-readable representation of the parsed form spec. =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 } !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 inside curly braces. Whitespace between values is irrelevant, although there cannot be any whitespace within a value. To add more descriptive display text to a vlaue in a list, add a square-bracketed ``subscript,'' as in: ...:select{red[Scarlet],blue[Azure],green[Olive Drab]} As you can see, spaces I allowed within the display text for a value. If you have a list of options that is too long to fit comfortably on one line, consider using 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. B 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. 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} 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 =head2 Comments # comment ... Any line beginning with a C<#> is considered a comment. =head1 TODO C directive to include external formspec files Field groups all on one line in the generated form Better tests! =head1 SEE ALSO L =head1 AUTHOR Peter Eichman =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