Index: tags/0.03/Changes
===================================================================
--- tags/0.03/Changes	(revision 13)
+++ tags/0.03/Changes	(revision 13)
@@ -0,0 +1,6 @@
+Revision history for Perl extension Text::FormBuilder.
+
+0.01  Mon Oct  4 09:25:07 2004
+	- original version; created by h2xs 1.23 with options
+		-Xn Text::FormBuilder
+
Index: tags/0.03/MANIFEST
===================================================================
--- tags/0.03/MANIFEST	(revision 13)
+++ tags/0.03/MANIFEST	(revision 13)
@@ -0,0 +1,9 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/Text-FormBuilder.t
+lib/Text/FormBuilder.pm
+lib/Text/FormBuilder/Parser.pm
+bin/fb.pl
+META.yml                                 Module meta-data (added by MakeMaker)
Index: tags/0.03/Makefile.PL
===================================================================
--- tags/0.03/Makefile.PL	(revision 13)
+++ tags/0.03/Makefile.PL	(revision 13)
@@ -0,0 +1,15 @@
+#use 5.008004;
+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.12,
+                         }, # 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 <peichman@wam.umd.edu>') : ()),
+);
Index: tags/0.03/README
===================================================================
--- tags/0.03/README	(revision 13)
+++ tags/0.03/README	(revision 13)
@@ -0,0 +1,40 @@
+Text-FormBuilder version 0.01
+=============================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+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:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2004 by A. U. Thor
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.4 or,
+at your option, any later version of Perl 5 you may have available.
+
+
Index: tags/0.03/bin/fb-cgi.pl
===================================================================
--- tags/0.03/bin/fb-cgi.pl	(revision 13)
+++ tags/0.03/bin/fb-cgi.pl	(revision 13)
@@ -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.03/bin/fb.pl
===================================================================
--- tags/0.03/bin/fb.pl	(revision 13)
+++ tags/0.03/bin/fb.pl	(revision 13)
@@ -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 <parameter>=<value>
+
+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<action> parameter:
+
+    $ fb ... -D action=/cgi-bin/some_script.pl
+
+=item -o <output file>
Index: tags/0.03/lib/Text/FormBuilder.pm
===================================================================
--- tags/0.03/lib/Text/FormBuilder.pm	(revision 13)
+++ tags/0.03/lib/Text/FormBuilder.pm	(revision 13)
@@ -0,0 +1,420 @@
+package Text::FormBuilder;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.03';
+
+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, $filename) = @_;
+    
+    # so it can be called as a class method
+    $self = $self->new unless ref $self;
+    
+    local $/ = undef;
+    open SRC, "< $filename";
+    my $src = <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);
+    return $self;
+}
+
+sub build {
+    my ($self, %options) = @_;
+    
+    $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};
+    }
+    
+    # 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: option switch for this
+##     #TODO: goes with CGI::FormBuilder 2.13
+##     foreach (@{ $self->{form_spec}{fields} }) {
+##         $$_{ulist} = 1 if $$_{type} and $$_{type} =~ /checkbox|radio/ 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 => {
+                headings => $self->{form_spec}{headings},
+                author   => $self->{form_spec}{author},
+            },
+        },
+        %options,
+    );
+    $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} };
+    
+    return $self;
+}
+
+sub write {
+    my ($self, $outfile) = @_;
+    if ($outfile) {
+        open FORM, "> $outfile";
+        print FORM $self->form->render;
+        close FORM;
+    } else {
+        print $self->form->render;
+    }
+}
+
+sub write_module {
+    my ($self, $package) = @_;
+
+    use Data::Dumper;
+    # don't dump $VARn names
+    $Data::Dumper::Terse = 1;
+    
+    my $title = $self->{form_spec}{title} || '';
+    my $author = $self->{form_spec}{author} || '';
+    my $headings = Data::Dumper->Dump([$self->{form_spec}{headings}],['headings']);
+    my $fields = Data::Dumper->Dump([ [ map { $$_{name} } @{ $self->{form_spec}{fields} } ] ],['fields']);
+    
+    my $source = $self->{build_options}{form_only} ? $self->_form_template : $self->_template;
+    
+    my $options = keys %{ $self->{build_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 = <<END;
+package $package;
+use strict;
+use warnings;
+
+use CGI::FormBuilder;
+
+sub form {
+    my \$cgi = shift;
+    my \$cgi_form = CGI::FormBuilder->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],
+            },
+        },
+        $options
+    );
+    
+    $field_setup
+    
+    return \$cgi_form;
+}
+
+# module return
+1;
+END
+    my $outfile = (split(/::/, $package))[-1] . '.pm';
+    
+    if ($outfile) {
+        open FORM, "> $outfile";
+        print FORM $module;
+        close FORM;
+    } else {
+        print $module;
+    }
+}
+
+sub form { shift->{form} }
+
+sub _form_template {
+q[<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p>
+<% $start %>
+<table>
+<% my $i; foreach(@fields) {
+    $OUT .= qq[  <tr><th class="sectionhead" colspan="2"><h2>$headings[$i]</h2></th></tr>\n] if $headings[$i];
+    $OUT .= qq[  <tr>];
+    $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>';
+    $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n];
+    $i++;
+} %>
+  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr>
+</table>
+<% $end %>
+];
+}
+
+sub _template {
+    my $self = shift;
+q[<html>
+<head>
+  <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title>
+  <style type="text/css">
+    #author, #footer { font-style: italic; }
+    th { text-align: left; }
+    th h2 { padding: .125em .5em; background: #eee; }
+    th.label { font-weight: normal; text-align: right; vertical-align: top; }
+  </style>
+</head>
+<body>
+
+<h1><% $title %></h1>
+<% $author ? qq[<p id="author">Created by $author</p>] : '' %>
+] . $self->_form_template . q[
+<hr />
+<div id="footer">
+  <p id="creator">Made with <a href="http://formbuilder.org/">CGI::FormBuilder</a> version <% $CGI::FormBuilder::VERSION %>.</p>
+</div>
+</body>
+</html>
+];
+}
+
+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 - Parser for a minilanguage describing web forms
+
+=head1 SYNOPSIS
+
+    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;
+
+=head1 DESCRIPTION
+
+=head2 new
+
+=head2 parse
+
+    $parser->parse($src_file);
+    
+    # or as a class method
+    my $parser = Txt::FormBuilder->parse($src_file);
+
+=head2 parse_text
+
+=head2 build
+
+    $parser->build(%options);
+
+Builds the CGI::FormBuilder object. Options directly used by C<build> are:
+
+=over
+
+=item form_only
+
+Only uses the form portion of the template, and omits the surrounding html,
+title, author, and the standard footer.
+
+=back
+
+All other options given to C<build> are passed on verbatim to the
+L<CGI::FormBuilder> constructor. Any options given here override the
+defaults that this module uses.
+
+=head2 form
+
+    my $form = $parser->form;
+
+Returns the L<CGI::FormBuilder> object.
+
+=head2 write
+
+    $parser->write($out_file);
+    # or just print to STDOUT
+    $parser->write;
+
+Calls C<render> 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);
+
+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.
+
+    #!/usr/bin/perl -w
+    use strict;
+    
+    # your CGI script
+    
+    use CGI;
+    use MyForm;
+    
+    my $q = CGI->new;
+    my $form = MyForm::form($q);
+    
+    # do the standard CGI::FormBuilder stuff
+    if ($form->submitted && $form->validate) {
+        # process results
+    } else {
+        print $q->header;
+        print $form->render;
+    }
+    
+
+=head2 dump
+
+Uses L<YAML> to print out a human-readable representaiton of the parsed
+form spec.
+
+=head1 LANGUAGE
+
+    field_name[size]|descriptive label[hint]:type=default{option1[display string],option2[display string],...}//validate
+    
+    !title ...
+    
+    !author ...
+    
+    !pattern name /regular expression/
+    !list name {
+        option1[display string],
+        option2[display string],
+        ...
+    }
+    
+    !list name &{ CODE }
+    
+    !head ...
+
+=head2 Directives
+
+=over
+
+=item C<!pattern>
+
+Defines a validation pattern.
+
+=item C<!list>
+
+Defines a list for use in a C<radio>, C<checkbox>, or C<select> field.
+
+=item C<!title>
+
+=item C<!author>
+
+=item C<!head>
+
+Inserts a heading between two fields. There can only be one heading between
+any two fields; the parser will warn you if you try to put two headings right
+next to each other.
+
+=back
+
+=head2 Fields
+
+Form fields are each described on a single line.
+
+If you have a list of options that is too long to fit comfortably on one line,
+consider using the C<!list> directive.
+
+=head2 Comments
+
+    # comment ...
+
+Any line beginning with a C<#> is considered a comment.
+
+=head1 TODO
+
+=head2 Langauge
+
+Directive for a descriptive or explanatory paragraph about the form
+
+=head1 SEE ALSO
+
+L<CGI::FormBuilder>
+
+=cut
Index: tags/0.03/lib/Text/FormBuilder/Makefile
===================================================================
--- tags/0.03/lib/Text/FormBuilder/Makefile	(revision 13)
+++ tags/0.03/lib/Text/FormBuilder/Makefile	(revision 13)
@@ -0,0 +1,3 @@
+# pre-compile the parser from the grammar
+Parser.pm: grammar
+	perl -MParse::RecDescent - grammar Text::FormBuilder::Parser
Index: tags/0.03/lib/Text/FormBuilder/grammar
===================================================================
--- tags/0.03/lib/Text/FormBuilder/grammar	(revision 13)
+++ tags/0.03/lib/Text/FormBuilder/grammar	(revision 13)
@@ -0,0 +1,116 @@
+{ my ($title, $author, %lists, %patterns, @fields, @headings, $type, @options, $list_var, $size, $rows, $cols); }
+
+form_spec: (list_def | line)(s) 
+    {
+	$return = {
+	    title    => $title,
+	    author   => $author,
+	    lists    => \%lists, 
+	    patterns => \%patterns, 
+	    headings => \@headings,
+	    fields   => \@fields,
+	}
+    }
+
+list_def: '!list' list_name (static_list | dynamic_list)
+    { $lists{$item{list_name}} = [ @options ]; @options = () }
+
+static_list: '{' option(s /,\s*/) /,?/ '}'
+
+dynamic_list: '&' <perl_codeblock>
+    {
+	my @results = (eval $item[2]);
+	if (ref $results[0] eq 'HASH') {
+	    @options = @results;
+	} else {    
+	    @options = map { { $_ => $_ } } @results;
+	}
+    }
+
+list_name: /[A-Z_]+/
+
+line: <skip:'[ \t]*'> ( title | author | pattern_def | heading | 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' /.*/
+    { $author = $item[2] }
+
+pattern_def: '!pattern' pattern_name pattern
+    { $patterns{$item{pattern_name}} = $item{pattern} }
+
+pattern_name: /[A-Z_]+/
+pattern: /.*/
+
+heading: '!head' /.*/
+    { warn "[Text::FormBuilder] Header before field " . scalar(@fields) . " redefined at input text line $thisline\n" if defined $headings[@fields];
+    $headings[@fields] = $item[2] }
+
+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],
+	};
+	
+	$$field{options} = [ @options ] if @options;
+	
+	$$field{rows} = $rows if defined $rows;
+	$$field{cols} = $cols if defined $cols;
+	$$field{size} = $size if defined $size;
+	
+	push @fields, $field;
+	
+	$type = undef;
+	$list_var = undef;
+	$size = undef;
+	$rows = undef;
+	$cols = undef;
+	@options = ();
+        
+    }
+    
+name: identifier
+
+field_size: '[' ( row_col | size ) ']'
+
+size: /\d+/
+    { $size = $item[1] }
+
+row_col: /\d+/ /,\s*/ /\d+/
+    { $rows = $item[1]; $cols = $item[3] }
+
+label: '|' /[^:\[\{\/]+/i
+
+hint: '[' /[^\]]+/ ']'    { $item[2] }
+
+type: ':' /textarea|text|password|file|checkbox|radio|select|hidden|static/
+
+default: '=' /[^\@\{\s]+/
+
+option_list: options | list_var
+    
+options: '{' option(s /,\s*/) '}'
+
+list_var: /@[A-Z_]+/ { $list_var = $item[1] }
+
+option: value display_text(?)
+    { push @options, { $item{value} => $item{'display_text(?)'}[0] } }
+
+value: identifier
+
+display_text: '[' /[^\]]+/i ']'    { $item[2] }
+
+validate: '//' value
+
+comment: '#' /.*/
+blank:
+
+identifier: /\w+/
Index: tags/0.03/t/Text-FormBuilder.t
===================================================================
--- tags/0.03/t/Text-FormBuilder.t	(revision 13)
+++ tags/0.03/t/Text-FormBuilder.t	(revision 13)
@@ -0,0 +1,21 @@
+# 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 tests => 4;
+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');
+
+my $p2 = Text::FormBuilder->parse_text('');
+isa_ok($p2, 'Text::FormBuilder', 'new parser (from parse_text as class method)');
