- Timestamp:
- 03/14/05 17:07:10 (20 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/lib/Text/FormBuilder.pm
r68 r69 15 15 use Text::FormBuilder::Parser; 16 16 use CGI::FormBuilder; 17 18 use Data::Dumper; 19 $Data::Dumper::Terse = 1; # don't dump $VARn names 20 $Data::Dumper::Quotekeys = 0; # don't quote simple string keys 17 21 18 22 # the static default options passed to CGI::FormBuilder->new … … 262 266 } 263 267 264 $self->{form} = CGI::FormBuilder->new( 268 # gather together all of the form options 269 $self->{form_options} = { 265 270 %DEFAULT_OPTIONS, 266 271 # need to explicity set the fields so that simple text fields get picked up … … 283 288 }, 284 289 %options, 285 ); 290 }; 291 292 # create the form object 293 $self->{form} = CGI::FormBuilder->new(%{ $self->{form_options} }); 294 295 # ...and set up its fields 286 296 $self->{form}->field(%{ $_ }) foreach @{ $self->{form_spec}{fields} }; 287 297 … … 308 318 } 309 319 310 # generates the core code to create the $form object 311 # the generated code assumes that you have a CGI.pm 312 # object named $q 313 sub _form_code { 320 # dump the form options as eval-able code 321 sub _form_options_code { 314 322 my $self = shift; 315 316 # automatically call build if needed to 317 # allow the new->parse->write shortcut 318 $self->build unless $self->{built}; 319 320 # conditionally use Data::Dumper 321 eval 'use Data::Dumper;'; 322 die "Can't write module; need Data::Dumper. $@" if $@; 323 324 $Data::Dumper::Terse = 1; # don't dump $VARn names 325 $Data::Dumper::Quotekeys = 0; # don't quote simple string keys 326 327 my $css; 328 $css = $self->{build_options}{css} || $DEFAULT_CSS; 329 $css .= $self->{build_options}{extra_css} if $self->{build_options}{extra_css}; 330 331 my %options = ( 332 %DEFAULT_OPTIONS, 333 title => $self->{form_spec}{title}, 334 text => $self->{form_spec}{description}, 335 fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], 336 required => [ map { $$_{name} } grep { $$_{required} } @{ $self->{form_spec}{fields} } ], 337 template => { 338 type => 'Text', 339 engine => { 340 TYPE => 'STRING', 341 SOURCE => $self->{build_options}{form_only} ? 342 $self->_form_template : 343 $self->_template($css, $self->{build_options}{charset}), 344 DELIMITERS => [ qw(<% %>) ], 345 }, 346 data => { 347 sections => $self->{form_spec}{sections}, 348 author => $self->{form_spec}{author}, 349 description => $self->{form_spec}{description}, 350 }, 351 }, 352 %{ $self->{build_options} }, 323 my $d = Data::Dumper->new([ $self->{form_options} ], [ '*options' ]); 324 return keys %{ $self->{form_options} } > 0 ? $d->Dump : ''; 325 } 326 # dump the field setup subs as eval-able code 327 # pass in the variable name of the form object 328 # (defaults to '$form') 329 sub _field_setup_code { 330 my $self = shift; 331 my $object_name = shift || '$form'; 332 return join( 333 "\n", 334 map { $object_name . '->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} } 353 335 ); 354 355 # remove our custom options 356 delete $options{$_} foreach qw(form_only css extra_css); 357 358 my %module_subs; 359 my $d = Data::Dumper->new([ \%options ], [ '*options' ]); 360 361 my $form_options = keys %options > 0 ? $d->Dump : ''; 362 363 my $field_setup = join( 364 "\n", 365 map { '$form->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} } 366 ); 367 368 return <<END; 369 my \$form = CGI::FormBuilder->new( 370 params => \$q, 371 $form_options 372 ); 373 374 $field_setup 375 END 376 } 336 } 377 337 378 338 sub write_module { … … 385 345 ## warn "[Text::FromBuilder::write_module] Removed extra '.pm' from package name\n" if $package =~ s/\.pm$//; 386 346 387 my $form_code = $self->_form_code; 388 347 my $form_options = $self->_form_options_code; 348 my $field_setup = $self->_field_setup_code('$self'); 349 350 # old style of module 351 # TODO: how to keep this (as deprecated method) 352 my $old_module = <<END; 353 package $package; 354 use strict; 355 use warnings; 356 357 use CGI::FormBuilder; 358 359 sub get_form { 360 my \$q = shift; 361 362 my \$self = CGI::FormBuilder->new( 363 $form_options, 364 \@_, 365 ); 366 367 $field_setup 368 369 return \$self; 370 } 371 372 # module return 373 1; 374 END 375 376 # new style of module 389 377 my $module = <<END; 390 378 package $package; … … 392 380 use warnings; 393 381 394 use CGI::FormBuilder; 395 396 sub get_form { 397 my \$q = shift; 398 399 $form_code 400 401 return \$form; 382 use base qw(CGI::FormBuilder); 383 384 sub new { 385 my \$invocant = shift; 386 my \$class = ref \$invocant || \$invocant; 387 388 my \$self = CGI::FormBuilder->new( 389 $form_options, 390 \@_, 391 ); 392 393 $field_setup 394 395 # re-bless into this class 396 bless \$self, \$class; 402 397 } 403 398 … … 405 400 1; 406 401 END 407 408 402 _write_output_file($module, (split(/::/, $package))[-1] . '.pm', $use_tidy); 409 403 return $self; … … 415 409 croak '[' . (caller(0))[3] . '] Expecting a script name' unless $script_name; 416 410 417 my $form_code = $self->_form_code; 418 411 my $form_options = $self->_form_options_code; 412 my $field_setup = $self->_field_setup_code('$form'); 413 419 414 my $script = <<END; 420 415 #!/usr/bin/perl … … 422 417 use warnings; 423 418 424 use CGI;425 419 use CGI::FormBuilder; 426 420 427 my \$q = CGI->new; 428 429 $form_code 421 my \$form = CGI::FormBuilder->new( 422 $form_options 423 ); 424 425 $field_setup 430 426 431 427 unless (\$form->submitted && \$form->validate) {
Note: See TracChangeset
for help on using the changeset viewer.