- Timestamp:
- 11/18/04 14:26:18 (20 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/lib/Text/FormBuilder.pm
r32 r33 6 6 use vars qw($VERSION); 7 7 8 $VERSION = '0.06_0 2';8 $VERSION = '0.06_03'; 9 9 10 10 use Carp; … … 32 32 END 33 33 34 my %DEFAULT_MESSAGES = ( 35 text_formbuilder_created => 'Created by %s', 36 text_formbuilder_madewith => 'Made with %s', 37 text_formbuilder_required => 'Required fields are marked in <strong>bold</strong>.', 38 ); 39 34 40 sub new { 35 41 my $invocant = shift; … … 81 87 } 82 88 89 # this is where a lot of the magic happens 83 90 sub build { 84 91 my ($self, %options) = @_; 85 86 # save the build options so they can be used from write_module87 $self->{build_options} = { %options };88 92 89 93 # our custom %options: 90 94 # form_only: use only the form part of the template 91 95 my $form_only = $options{form_only}; 96 97 # css, extra_css: allow for custom inline stylesheets 98 # neat trick: extra_css => '@import(my_external_stylesheet.css);' 99 # will let you use an external stylesheet 92 100 my $css; 93 101 $css = $options{css} || $DEFAULT_CSS; 94 102 $css .= $options{extra_css} if $options{extra_css}; 95 103 96 # remove our custom options 97 delete $options{$_} foreach qw(form_only css extra_css); 98 99 # substitute in custom pattern definitions for field validation 100 if (my %patterns = %{ $self->{form_spec}{patterns} || {} }) { 101 foreach (@{ $self->{form_spec}{fields} }) { 102 if ($$_{validate} and exists $patterns{$$_{validate}}) { 103 $$_{validate} = $patterns{$$_{validate}}; 104 # messages 105 if ($options{messages}) { 106 # if its a hashref, we'll just pass it on to CGI::FormBuilder 107 108 if (my $ref = ref $options{messages}) { 109 # hashref pass on to CGI::FormBuilder 110 croak "[Text::FormBuilder] Argument to 'messages' option must be a filename or hashref" unless $ref eq 'HASH'; 111 while (my ($key,$value) = each %DEFAULT_MESSAGES) { 112 $options{messages}{$key} ||= $DEFAULT_MESSAGES{$key}; 113 } 114 } else { 115 # filename, just *warn* on missing, and use defaults 116 if (-f $options{messages} && -r _ && open(MESSAGES, "< $options{messages}")) { 117 $options{messages} = {}; 118 while(<MESSAGES>) { 119 next if /^\s*#/ || /^\s*$/; 120 chomp; 121 my($key,$value) = split ' ', $_, 2; 122 ($options{messages}{$key} = $value) =~ s/\s+$//; 123 } 124 close MESSAGES; 125 } else { 126 carp "Could not read messages file $options{messages}: $!"; 104 127 } 105 128 } 106 129 } 130 131 # save the build options so they can be used from write_module 132 $self->{build_options} = { %options }; 133 134 # remove our custom options before we hand off to CGI::FormBuilder 135 delete $options{$_} foreach qw(form_only css extra_css); 107 136 108 137 # expand groups … … 124 153 } 125 154 155 # the actual fields that are given to CGI::FormBuilder 126 156 $self->{form_spec}{fields} = []; 127 157 128 158 for my $section (@{ $self->{form_spec}{sections} || [] }) { 129 #for my $line (@{ $self->{form_spec}{lines} || [] }) {130 159 for my $line (@{ $$section{lines} }) { 131 160 if ($$line[0] eq 'group') { … … 133 162 } elsif ($$line[0] eq 'field') { 134 163 push @{ $self->{form_spec}{fields} }, $$line[1]; 164 } 165 } 166 } 167 168 # substitute in custom pattern definitions for field validation 169 if (my %patterns = %{ $self->{form_spec}{patterns} || {} }) { 170 foreach (@{ $self->{form_spec}{fields} }) { 171 if ($$_{validate} and exists $patterns{$$_{validate}}) { 172 $$_{validate} = $patterns{$$_{validate}}; 135 173 } 136 174 } … … 175 213 } 176 214 177 # because this messes up things at the CGI::FormBuilder::field level 178 # it seems to be marking required based on the existance of a 'required' 179 # param, not whether it is true or defined 215 # remove false $$_{required} params because this messes up things at 216 # the CGI::FormBuilder::field level; it seems to be marking required 217 # based on the existance of a 'required' param, not whether it is 218 # true or defined 180 219 $$_{required} or delete $$_{required} foreach @{ $self->{form_spec}{fields} }; 181 220 182 # need to explicity set the fields so that simple text fields get picked up183 221 $self->{form} = CGI::FormBuilder->new( 184 222 %DEFAULT_OPTIONS, 223 # need to explicity set the fields so that simple text fields get picked up 185 224 fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], 186 225 required => [ map { $$_{name} } grep { $$_{required} } @{ $self->{form_spec}{fields} } ], … … 239 278 die "Can't write module; need Data::Dumper. $@" if $@; 240 279 241 # don't dump $VARn names242 $Data::Dumper:: Terse = 1;280 $Data::Dumper::Terse = 1; # don't dump $VARn names 281 $Data::Dumper::Quotekeys = 0; # don't quote simple string keys 243 282 244 283 my $css; … … 268 307 ); 269 308 270 my $source = $options{form_only} ? $self->_form_template : $self->_template;271 272 309 # remove our custom options 273 310 delete $options{$_} foreach qw(form_only css extra_css); … … 309 346 eval 'use Perl::Tidy'; 310 347 die "Can't tidy the code: $@" if $@; 311 Perl::Tidy::perltidy(source => \$module, destination => $outfile );348 Perl::Tidy::perltidy(source => \$module, destination => $outfile, argv => '-nolq -ci=4'); 312 349 } else { 313 350 # otherwise, just print as is … … 329 366 330 367 sub _form_template { 331 q[<% $description ? qq[<p id="description">$description</p>] : '' %> 368 my $self = shift; 369 #warn keys %{ $self->{build_options}{messages} }; 370 my $msg_required = $self->{build_options}{messages}{text_formbuilder_required}; 371 return q[<% $description ? qq[<p id="description">$description</p>] : '' %> 332 372 <% (grep { $_->{required} } @fields) ? qq[<p id="instructions">(Required fields are marked in <strong>bold</strong>.)</p>] : '' %> 333 373 <% $start %> … … 358 398 $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>'; 359 399 } 400 401 # mark invalid fields 360 402 if ($$_{invalid}) { 361 403 $OUT .= qq[<td>$$_{field} $$_{comment} Missing or invalid value.</td>]; … … 363 405 $OUT .= qq[<td>$$_{field} $$_{comment}</td>]; 364 406 } 407 365 408 $OUT .= qq[</tr>\n]; 366 409 … … 391 434 } 392 435 393 sub _ template {436 sub _pre_template { 394 437 my $self = shift; 395 438 my $css = shift || $DEFAULT_CSS; 439 return 396 440 q[<html> 397 441 <head> 398 442 <title><% $title %><% $author ? ' - ' . ucfirst $author : '' %></title> 399 <style type="text/css">] . 400 $css . q[ 401 </style> 443 <style type="text/css"> 444 ] . 445 $css . 446 q[ </style> 447 <% $jshead %> 402 448 </head> 403 449 <body> … … 405 451 <h1><% $title %></h1> 406 452 <% $author ? qq[<p id="author">Created by $author</p>] : '' %> 407 ] . $self->_form_template . q[ 408 <hr /> 453 ]; 454 } 455 456 sub _post_template { 457 q[<hr /> 409 458 <div id="footer"> 410 459 <p id="creator">Made with <a href="http://formbuilder.org/">CGI::FormBuilder</a> version <% CGI::FormBuilder->VERSION %>.</p> … … 415 464 } 416 465 466 sub _template { 467 my $self = shift; 468 my $css = shift || $DEFAULT_CSS; 469 return $self->_pre_template($css) . $self->_form_template . $self->_post_template; 470 } 471 417 472 sub dump { 418 473 eval "use YAML;"; … … 578 633 Uses L<YAML> to print out a human-readable representation of the parsed 579 634 form spec. 635 636 =head1 DEFAULTS 637 638 These are the default settings that are passed to C<< CGI::FormBuilder->new >>: 639 640 method => 'GET' 641 javascript => 0 642 keepextras => 1 643 644 Any of these can be overriden by the C<build> method: 645 646 # use POST instead 647 $parser->build(method => 'POST')->write; 580 648 581 649 =head1 LANGUAGE … … 785 853 Allow for custom wrappers around the C<form_template> 786 854 787 Use the custom message file format for messages in the built in template 855 Use the custom message file format for messages in the built in template (i18n/l10n) 788 856 789 857 Maybe use HTML::Template instead of Text::Template for the built in template
Note: See TracChangeset
for help on using the changeset viewer.