Changeset 53 in text-formbuilder for trunk/lib


Ignore:
Timestamp:
01/10/05 11:29:49 (20 years ago)
Author:
peichman
Message:

separated basic parser using code out into a separate Class::ParseText::Base base class; updated docs, manifest, and changelog

Location:
trunk/lib
Files:
3 added
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/lib/Text/FormBuilder.pm

    r52 r53  
    44use warnings; 
    55 
    6 use base qw(Exporter); 
     6use base qw(Exporter Class::ParseText::Base); 
    77use vars qw($VERSION @EXPORT); 
    88 
    9 $VERSION = '0.08_01'; 
     9$VERSION = '0.08'; 
    1010@EXPORT = qw(create_form); 
    1111 
     
    5959    if ($destination) { 
    6060        if (ref $destination) { 
    61             croak "[Text::FormBuilder::create_form] Don't know what to do with a ref for $destination"; 
    62             #TODO: what do ref dests mean? 
     61            croak '[' . (caller(0))[3] . "] Don't know what to do with a ref for $destination"; 
     62            #TODO: what DO ref dests mean? 
    6363        } else { 
    6464            # write webpage, script, or module 
     
    7575    } 
    7676} 
    77      
    78  
    79 sub new { 
    80     my $invocant = shift; 
    81     my $class = ref $invocant || $invocant; 
    82     my $self = { 
    83         parser => Text::FormBuilder::Parser->new, 
    84     }; 
    85     return bless $self, $class; 
    86 } 
    87  
    88 sub parse { 
    89     my ($self, $source) = @_; 
    90     if (my $type = ref $source) { 
    91         if ($type eq 'SCALAR') { 
    92             $self->parse_text($$source); 
    93         } elsif ($type eq 'ARRAY') { 
    94             $self->parse_array(@$source); 
    95         } else { 
    96             croak "[Text::FormBuilder::parse] Unknown ref type $type passed as source"; 
    97         } 
    98     } else { 
    99         $self->parse_file($source); 
    100     } 
    101 } 
    102  
    103 sub parse_array { 
    104     my ($self, @lines) = @_; 
    105     # so it can be called as a class method 
    106     $self = $self->new unless ref $self;     
    107     $self->parse_text(join("\n", @lines));     
    108     return $self; 
    109 } 
    110  
    111 sub parse_file { 
    112     my ($self, $filename) = @_; 
    113      
    114     # so it can be called as a class method 
    115     $self = $self->new unless ref $self; 
    116      
    117     local $/ = undef; 
    118     open SRC, "< $filename" or croak "[Text::FormBuilder::parse_file] Can't open $filename: $!" and return; 
    119     my $src = <SRC>; 
    120     close SRC; 
    121      
    122     return $self->parse_text($src); 
    123 } 
    124  
    125 sub parse_text { 
    126     my ($self, $src) = @_; 
    127      
    128     # so it can be called as a class method 
    129     $self = $self->new unless ref $self; 
    130      
    131     # append a newline so that it can be called on a single field easily 
    132     $src .= "\n"; 
    133      
    134     $self->{form_spec} = $self->{parser}->form_spec($src); 
    135      
    136     # mark structures as not built (newly parsed text) 
    137     $self->{built} = 0; 
    138      
     77 
     78# subclass of Class::ParseText::Base 
     79sub init { 
     80    my $self = shift; 
     81    $self->{parser}         = Text::FormBuilder::Parser->new; 
     82    $self->{start_rule}     = 'form_spec'; 
     83    $self->{ensure_newline} = 1; 
    13984    return $self; 
    14085} 
     
    180125                close MESSAGES; 
    181126            } else { 
    182                 carp "[Text::FormBuilder] Could not read messages file $options{messages}: $!"; 
     127                carp '[' . (caller(0))[3] . "] Could not read messages file $options{messages}: $!"; 
    183128            } 
    184129        } 
     
    187132    } 
    188133     
     134    # character set 
    189135    my $charset = $options{charset}; 
    190136     
     
    240186            # for now, we just warn that it doesn't work 
    241187            } elsif (exists $subs{$$_{validate}}) { 
    242                 warn "[Text::FormBuilder] validate coderefs don't work yet"; 
     188                warn '[' . (caller(0))[3] . "] validate coderefs don't work yet"; 
    243189                delete $$_{validate}; 
    244190##                 $$_{validate} = $subs{$$_{validate}}; 
     
    437383    my ($self, $package, $use_tidy) = @_; 
    438384 
    439     croak '[Text::FormBuilder::write_module] Expecting a package name' unless $package; 
     385    croak '[' . (caller(0))[3] . '] Expecting a package name' unless $package; 
    440386     
    441387    # remove a trailing .pm 
     
    471417    my ($self, $script_name, $use_tidy) = @_; 
    472418 
    473     croak '[Text::FormBuilder::write_script] Expecting a script name' unless $script_name; 
     419    croak '[' . (caller(0))[3] . '] Expecting a script name' unless $script_name; 
    474420     
    475421    my $form_code = $self->_form_code; 
     
    506452            Perl::Tidy::perltidy(source => \$source_code, destination => $outfile, argv => $TIDY_OPTIONS); 
    507453        } else { 
    508             carp "Can't tidy the code: $@" if $@; 
     454            carp '[' . (caller(0))[3] . "] Can't tidy the code: $@" if $@; 
    509455            # fallback to just writing it as-is 
    510456            open OUT, "> $outfile" or die $!; 
     
    650596        print YAML::Dump(shift->{form_spec}); 
    651597    } else { 
    652         warn "Can't dump form spec structure: $@"; 
     598        warn '[' . (caller(0))[3] . "] Can't dump form spec structure using YAML: $@"; 
    653599    } 
    654600} 
     
    12651211=head1 COPYRIGHT AND LICENSE 
    12661212 
    1267 Copyright E<copy>2004 by Peter Eichman. 
     1213Copyright E<copy>2004-2005 by Peter Eichman. 
    12681214 
    12691215This program is free software; you can redistribute it and/or 
Note: See TracChangeset for help on using the changeset viewer.