Index: /trunk/Changes =================================================================== --- /trunk/Changes (revision 52) +++ /trunk/Changes (revision 53) @@ -1,7 +1,9 @@ Release history for Text::FormBuilder. -0.08 +0.08 - 10 Jan 2005 * failure to load Perl::Tidy is no longer fatal * create_form tries to emit tidy code + * separated basic parser using code out into a separate + Class::ParseText::Base base class 0.07 - 16 Dec 2004 Index: /trunk/MANIFEST =================================================================== --- /trunk/MANIFEST (revision 52) +++ /trunk/MANIFEST (revision 53) @@ -8,3 +8,4 @@ lib/Text/FormBuilder/Parser.pm lib/Text/FormBuilder/grammar +lib/Class/ParseText/Base.pm META.yml Module meta-data (added by MakeMaker) Index: /trunk/bin/fb.pl =================================================================== --- /trunk/bin/fb.pl (revision 52) +++ /trunk/bin/fb.pl (revision 53) @@ -55,4 +55,5 @@ # write a CGI script $ fb myform -o form.cgi + $ fb myform -o form.pl =back Index: /trunk/lib/Class/ParseText/Base.pm =================================================================== --- /trunk/lib/Class/ParseText/Base.pm (revision 53) +++ /trunk/lib/Class/ParseText/Base.pm (revision 53) @@ -0,0 +1,223 @@ +package Class::ParseText::Base; + +use strict; +use warnings; +use Carp; + +use base qw(Class::Base); +use vars qw($VERSION); + +$VERSION = '0.01'; + +# (caller(0))[3] => fully qualified subname (e.g. My::Package::function) + +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 '[' . (caller(0))[3] . "] 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 '[' . (caller(0))[3] . "] Can't open $filename: $!"; + my $src = ; + close SRC; + + return $self->parse_text($src); +} + +#TODO: get this working +sub parse_handle { + my ($self, $fh) = @_; + + # so it can be called as a class method + $self = $self->new unless ref $self; + + my $src; + while ($_ = readline($fh)) { $src .= $_ } + warn $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; + + croak '[' . (caller(0))[3] . '] No parser defined for this class (perhaps you need to override init?)' + unless defined $self->{parser}; + + # optionally ensure that the source text ends in a newline + $src =~ /\n$/ or $src .= "\n" if $self->{ensure_newline}; + + # get the name of the start rule + my $start_rule = $self->{start_rule}; + croak '[' . (caller(0))[3] . '] No start rule given for the parser' unless defined $start_rule; + $self->{$start_rule} = $self->{parser}->$start_rule($src); + + # mark structures as not built (newly parsed text) + $self->{built} = 0; + + return $self; +} + + +# module return +1; + +=head1 NAME + +Class::ParseText::Base - Base class for modules using Parse::RecDescent parsers + +=head1 SYNOPSIS + + package My::Parser; + use strict; + + use base qw(Class::ParseText::Base); + + # you need to provide an init method, to set the parser and start rule + sub init { + my $self = shift; + + # set the parser and start rule that should be used + $self->{parser} = Parse::RecDescent->new($grammar); + $self->{start_rule} = 'foo'; + $self->{ensure_newline} = 1; + + return $self; + } + + package main; + + my $p = My::Parser->new; + + $p->parse_text($source_text); + $p->parse(\$source_text); + + $p->parse_array(@source_lines); + $p->parse(\@source_lines); + + $p->parse_file($filename); + $p->parse($filename); + +=head1 REQUIRES + +This base class is in turn based on L. + +=head1 DESCRIPTION + +All of the parse rules set C<< $self->{built} >> to false, to indicate that +a fresh source has been read, and (probably) needs to be analyzed. + +=head2 new + + my $p = My::Parser->new; + +Creates a new parser object. In general, calling C explicitly is not +necessary, since all of the C methods will invoke the constructor +for you if they are called as a class method. + + # as a class method + my $p = My::Parser->parse_file('some_source.txt'); + +=head2 parse_file + + $p->parse_file($filename); + +Parses the contents of of the file C<$filename>. Returns the parser object. + +=head2 parse_array + + $p->parse_array(@lines); + +Joins C<@lines> with newlines and parses. Returns the parser object. + +=head2 parse_text + + $p->parse_text($source); + +Parse the literal C<$source>. Returns the parser object. + +=head2 parse + + $p->parse($src); + +Automagic method that tries to pick the correct C method to use. + + ref $src method + ======== ================== + ARRAY parse_array(@$src) + SCALAR parse_text($$src) + undef parse_file($src) + +Passing other ref types in C<$src> (e.g. C) will cause C to die. + +=head1 SUBCLASSING + +This class is definitely intended to be subclassed. The only method you should +need to override is the C method, to set the parser object that will do the +actual work. + +=head2 init + +The following properties of the object should be set: + +=over + +=item C + +The Parse::RecDescent derived parser object to use. + +=item C + +The name of the initial rule to start parsing with. The results of +the parse are stored in the object with this same name as their key. + +=item C + +Set to true to ensure that the text to be parsed ends in a newline. + +=back + +=head1 TODO + +C method + +Expand to use other sorts of parsing modules (e.g. Parse::Yapp) + +=head1 AUTHOR + +Peter Eichman, C<< >> + +=head1 COPYRIGHT AND LICENSE + +Copyright E2005 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: /trunk/lib/Text/FormBuilder.pm =================================================================== --- /trunk/lib/Text/FormBuilder.pm (revision 52) +++ /trunk/lib/Text/FormBuilder.pm (revision 53) @@ -4,8 +4,8 @@ use warnings; -use base qw(Exporter); +use base qw(Exporter Class::ParseText::Base); use vars qw($VERSION @EXPORT); -$VERSION = '0.08_01'; +$VERSION = '0.08'; @EXPORT = qw(create_form); @@ -59,6 +59,6 @@ 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? + croak '[' . (caller(0))[3] . "] Don't know what to do with a ref for $destination"; + #TODO: what DO ref dests mean? } else { # write webpage, script, or module @@ -75,66 +75,11 @@ } } - - -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; - + +# subclass of Class::ParseText::Base +sub init { + my $self = shift; + $self->{parser} = Text::FormBuilder::Parser->new; + $self->{start_rule} = 'form_spec'; + $self->{ensure_newline} = 1; return $self; } @@ -180,5 +125,5 @@ close MESSAGES; } else { - carp "[Text::FormBuilder] Could not read messages file $options{messages}: $!"; + carp '[' . (caller(0))[3] . "] Could not read messages file $options{messages}: $!"; } } @@ -187,4 +132,5 @@ } + # character set my $charset = $options{charset}; @@ -240,5 +186,5 @@ # for now, we just warn that it doesn't work } elsif (exists $subs{$$_{validate}}) { - warn "[Text::FormBuilder] validate coderefs don't work yet"; + warn '[' . (caller(0))[3] . "] validate coderefs don't work yet"; delete $$_{validate}; ## $$_{validate} = $subs{$$_{validate}}; @@ -437,5 +383,5 @@ my ($self, $package, $use_tidy) = @_; - croak '[Text::FormBuilder::write_module] Expecting a package name' unless $package; + croak '[' . (caller(0))[3] . '] Expecting a package name' unless $package; # remove a trailing .pm @@ -471,5 +417,5 @@ my ($self, $script_name, $use_tidy) = @_; - croak '[Text::FormBuilder::write_script] Expecting a script name' unless $script_name; + croak '[' . (caller(0))[3] . '] Expecting a script name' unless $script_name; my $form_code = $self->_form_code; @@ -506,5 +452,5 @@ Perl::Tidy::perltidy(source => \$source_code, destination => $outfile, argv => $TIDY_OPTIONS); } else { - carp "Can't tidy the code: $@" if $@; + carp '[' . (caller(0))[3] . "] Can't tidy the code: $@" if $@; # fallback to just writing it as-is open OUT, "> $outfile" or die $!; @@ -650,5 +596,5 @@ print YAML::Dump(shift->{form_spec}); } else { - warn "Can't dump form spec structure: $@"; + warn '[' . (caller(0))[3] . "] Can't dump form spec structure using YAML: $@"; } } @@ -1265,5 +1211,5 @@ =head1 COPYRIGHT AND LICENSE -Copyright E2004 by Peter Eichman. +Copyright E2004-2005 by Peter Eichman. This program is free software; you can redistribute it and/or Index: /trunk/t/Text-FormBuilder.t =================================================================== --- /trunk/t/Text-FormBuilder.t (revision 52) +++ /trunk/t/Text-FormBuilder.t (revision 53) @@ -16,4 +16,7 @@ my $p = Text::FormBuilder->new; isa_ok($p, 'Text::FormBuilder', 'new parser'); +isa_ok($p, 'Class::ParseText::Base', 'subclass of Class::Parsetext::Base'); +can_ok($p, qw(parse_file parse_array parse_text parse)); # inherited parse_* methods + 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)');