- Timestamp:
- 01/10/05 11:29:49 (20 years ago)
- Location:
- trunk/lib
- Files:
-
- 3 added
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/lib/Text/FormBuilder.pm
r52 r53 4 4 use warnings; 5 5 6 use base qw(Exporter );6 use base qw(Exporter Class::ParseText::Base); 7 7 use vars qw($VERSION @EXPORT); 8 8 9 $VERSION = '0.08 _01';9 $VERSION = '0.08'; 10 10 @EXPORT = qw(create_form); 11 11 … … 59 59 if ($destination) { 60 60 if (ref $destination) { 61 croak "[Text::FormBuilder::create_form] Don't know what to do with a ref for $destination";62 #TODO: what doref 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? 63 63 } else { 64 64 # write webpage, script, or module … … 75 75 } 76 76 } 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 79 sub init { 80 my $self = shift; 81 $self->{parser} = Text::FormBuilder::Parser->new; 82 $self->{start_rule} = 'form_spec'; 83 $self->{ensure_newline} = 1; 139 84 return $self; 140 85 } … … 180 125 close MESSAGES; 181 126 } else { 182 carp "[Text::FormBuilder] Could not read messages file $options{messages}: $!";127 carp '[' . (caller(0))[3] . "] Could not read messages file $options{messages}: $!"; 183 128 } 184 129 } … … 187 132 } 188 133 134 # character set 189 135 my $charset = $options{charset}; 190 136 … … 240 186 # for now, we just warn that it doesn't work 241 187 } 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"; 243 189 delete $$_{validate}; 244 190 ## $$_{validate} = $subs{$$_{validate}}; … … 437 383 my ($self, $package, $use_tidy) = @_; 438 384 439 croak '[ Text::FormBuilder::write_module] Expecting a package name' unless $package;385 croak '[' . (caller(0))[3] . '] Expecting a package name' unless $package; 440 386 441 387 # remove a trailing .pm … … 471 417 my ($self, $script_name, $use_tidy) = @_; 472 418 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; 474 420 475 421 my $form_code = $self->_form_code; … … 506 452 Perl::Tidy::perltidy(source => \$source_code, destination => $outfile, argv => $TIDY_OPTIONS); 507 453 } else { 508 carp "Can't tidy the code: $@" if $@;454 carp '[' . (caller(0))[3] . "] Can't tidy the code: $@" if $@; 509 455 # fallback to just writing it as-is 510 456 open OUT, "> $outfile" or die $!; … … 650 596 print YAML::Dump(shift->{form_spec}); 651 597 } else { 652 warn "Can't dump form spec structure: $@";598 warn '[' . (caller(0))[3] . "] Can't dump form spec structure using YAML: $@"; 653 599 } 654 600 } … … 1265 1211 =head1 COPYRIGHT AND LICENSE 1266 1212 1267 Copyright E<copy>2004 by Peter Eichman.1213 Copyright E<copy>2004-2005 by Peter Eichman. 1268 1214 1269 1215 This program is free software; you can redistribute it and/or
Note: See TracChangeset
for help on using the changeset viewer.