home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / FillInForm.pm < prev    next >
Encoding:
Perl POD Document  |  2003-06-10  |  13.7 KB  |  495 lines
  1. package HTML::FillInForm;
  2.  
  3. use integer; # no floating point math so far!
  4. use strict; # and no funny business, either.
  5.  
  6. use Carp; # generate better errors with more context
  7.  
  8. # required for attr_encoded
  9. use HTML::Parser 3.26;
  10.  
  11. # required for UNIVERSAL->can
  12. require 5.005;
  13.  
  14. use vars qw($VERSION @ISA);
  15. $VERSION = '1.02';
  16.  
  17. @ISA = qw(HTML::Parser);
  18.  
  19. sub new {
  20.   my ($class) = @_;
  21.   my $self = bless {}, $class;
  22.   $self->init;
  23.   # tell HTML::Parser not to decode attributes
  24.   $self->attr_encoded(1);
  25.   $self->boolean_attribute_value('__BOOLEAN__');
  26.   return $self;
  27. }
  28.  
  29. # a few shortcuts to fill()
  30. sub fill_file { my $self = shift; return $self->fill('file',@_); }
  31. sub fill_arrayref { my $self = shift; return $self->fill('arrayref',@_); }
  32. sub fill_scalarref { my $self = shift; return $self->fill('scalarref',@_); }
  33.  
  34. sub fill {
  35.   my ($self, %option) = @_;
  36.  
  37.   my %ignore_fields;
  38.   %ignore_fields = map { $_ => 1 } ( ref $option{'ignore_fields'} eq 'ARRAY' )
  39.     ? @{ $option{ignore_fields} } : $option{ignore_fields} if exists( $option{ignore_fields} );
  40.   
  41.   if (my $fdat = $option{fdat}){
  42.     # Copy the structure to prevent side-effects.
  43.     my %copy;
  44.     while(my($key, $val) = each %$fdat) {
  45.       $copy{ $key } = ref $val eq 'ARRAY' ? [ @$val ] : $val;
  46.     }
  47.     $self->{fdat} = \%copy;
  48.   }
  49.   if(my $objects = $option{fobject}){
  50.     unless(ref($objects) eq 'ARRAY'){
  51.       $objects = [ $objects ];
  52.     }
  53.     $self->{fdat} = {} unless exists $self->{fdat};
  54.     for my $object (@$objects){
  55.       # make sure objects in 'param_object' parameter support param()
  56.       defined($object->can('param')) or
  57.     croak("HTML::FillInForm->fill called with fobject option, containing object of type " . ref($object) . " which lacks a param() method!");
  58.       foreach my $k ($object->param()){
  59.         next if exists $ignore_fields{$k};
  60.     # we expect param to return an array if there are multiple values
  61.     my @v = $object->param($k);
  62.     $self->{fdat}->{$k} = scalar(@v)>1 ? \@v : $v[0];
  63.      }
  64.     }
  65.   }
  66.   if (my $target = $option{target}){
  67.     $self->{'target'} = $target;
  68.   }
  69.  
  70.   if (defined($option{fill_password})){
  71.     $self->{fill_password} = $option{fill_password};
  72.   } else {
  73.     $self->{fill_password} = 1;
  74.   }
  75.  
  76.   # make sure method has data to fill in HTML form with!
  77.   unless(exists $self->{fdat}){
  78.     croak("HTML::FillInForm->fillInForm() called without 'fobject' or 'fdat' parameter set");
  79.   }
  80.  
  81.   if(my $file = $option{file}){
  82.     $self->parse_file($file);
  83.   } elsif (my $scalarref = $option{scalarref}){
  84.     $self->parse($$scalarref);
  85.   } elsif (my $arrayref = $option{arrayref}){
  86.     for (@$arrayref){
  87.       $self->parse($_);
  88.     }
  89.   }
  90.   return delete $self->{output};
  91. }
  92.  
  93. # handles opening HTML tags such as <input ...>
  94. sub start {
  95.   my ($self, $tagname, $attr, $attrseq, $origtext) = @_;
  96.  
  97.   # set the current form
  98.   if ($tagname eq 'form') {
  99.     if (exists $attr->{'name'}) {
  100.       $self->{'current_form'} = $attr->{'name'};
  101.     } else {
  102.       # in case of previous one without </FORM>
  103.       delete $self->{'current_form'};
  104.     }
  105.   }
  106.  
  107.   # This form is not my target.
  108.   if (exists $self->{'target'} &&
  109.       (! exists $self->{'current_form'} ||
  110.        $self->{'current_form'} ne $self->{'target'})) {
  111.     $self->{'output'} .= $origtext;
  112.     return;
  113.   }
  114.   
  115.   # HTML::Parser converts tagname to lowercase, so we don't need /i
  116.   if ($self->{option_no_value}) {
  117.     $self->{output} .= '>';
  118.     delete $self->{option_no_value};
  119.   }
  120.   if ($tagname eq 'input'){
  121.     my $value = exists $attr->{'name'} ? $self->{fdat}->{$attr->{'name'}} : undef;
  122.     # force hidden fields to have a value
  123.     $value = '' if exists($attr->{'type'}) && $attr->{'type'} eq 'hidden' && ! exists $attr->{'value'} && ! defined $value;
  124.     if (defined($value)){
  125.       $value = $self->escapeHTMLStringOrList($value);
  126.       # check for input type, noting that default type is text
  127.       if (!exists $attr->{'type'} ||
  128.       $attr->{'type'} =~ /^(text|textfield|hidden|)$/i){
  129.     $value = (shift @$value || '') if ref($value) eq 'ARRAY';
  130.     $attr->{'value'} = $value;
  131.       } elsif (lc $attr->{'type'} eq 'password' && $self->{fill_password}) {
  132.     $value = (shift @$value || '') if ref($value) eq 'ARRAY';
  133.     $attr->{'value'} = $value;
  134.       } elsif (lc $attr->{'type'} eq 'radio'){
  135.     $value = (shift @$value || '') if ref($value) eq 'ARRAY';
  136.     # value for radio boxes default to 'on', works with netscape
  137.     $attr->{'value'} = 'on' unless exists $attr->{'value'};
  138.     if ($attr->{'value'} eq $value){
  139.       $attr->{'checked'} = '__BOOLEAN__';
  140.     } else {
  141.       delete $attr->{'checked'};
  142.     }
  143.       } elsif (lc $attr->{'type'} eq 'checkbox'){
  144.     # value for checkboxes default to 'on', works with netscape
  145.     $attr->{'value'} = 'on' unless exists $attr->{'value'};
  146.  
  147.     delete $attr->{'checked'}; # Everything is unchecked to start
  148.         $value = [ $value ] unless ref($value) eq 'ARRAY';
  149.     foreach my $v ( @$value ) {
  150.       if ( $attr->{'value'} eq $v ) {
  151.         $attr->{'checked'} = '__BOOLEAN__';
  152.       }
  153.     }
  154. #      } else {
  155. #    warn(qq(Input field of unknown type "$attr->{type}": $origtext));
  156.       }
  157.     }
  158.     $self->{output} .= "<$tagname";
  159.     while (my ($key, $value) = each %$attr) {
  160.       if($value eq '__BOOLEAN__'){
  161.         next if $key eq '/';
  162.     # boolean attribute
  163.     $self->{output} .= " $key";
  164.       } else {
  165.     $self->{output} .= sprintf qq( %s="%s"), $key, $value;
  166.       }
  167.     }
  168.     # extra space put here to work around Opera 6.01/6.02 bug
  169.     $self->{output} .= ' /' if $attr->{'/'};
  170.     $self->{output} .= ">";
  171.   } elsif ($tagname eq 'option'){
  172.     my $value = $self->{fdat}->{$self->{selectName}};
  173.     if (defined($value)){
  174.       $value = $self->escapeHTMLStringOrList($value);
  175.       $value = [ $value ] unless ( ref($value) eq 'ARRAY' );
  176.       delete $attr->{selected} if exists $attr->{selected};
  177.  
  178.       if(defined($attr->{'value'})){
  179.         # option tag has value attr - <OPTION VALUE="foo">bar</OPTION>
  180.     foreach my $v ( @$value ) {
  181.       if ( $attr->{'value'} eq $v ) {
  182.         $attr->{selected} = '__BOOLEAN__';
  183.       }
  184.         }
  185.       } else {
  186.         # option tag has no value attr - <OPTION>bar</OPTION>
  187.     # save for processing under text handler
  188.     $self->{option_no_value} = $value;
  189.       }
  190.     }
  191.     $self->{output} .= "<$tagname";
  192.     while (my ($key, $value) = each %$attr) {
  193.       if($value eq '__BOOLEAN__'){
  194.         next if $key eq '/';
  195.     # boolean attribute
  196.     $self->{output} .= " $key";
  197.       } else {
  198.     $self->{output} .= sprintf qq( %s="%s"), $key, $value;
  199.       }
  200.     }
  201.     unless ($self->{option_no_value}){
  202.       # we can close option tag here
  203.       $self->{output} .= ">";
  204.     }
  205.   } elsif ($tagname eq 'textarea'){
  206.     if (defined(my $value = $self->{fdat}->{$attr->{'name'}})){
  207.       $value = $self->escapeHTMLStringOrList($value);
  208.       $value = (shift @$value || '') if ref($value) eq 'ARRAY';
  209.       # <textarea> foobar </textarea> -> <textarea> $value </textarea>
  210.       # we need to set outputText to 'no' so that 'foobar' won't be printed
  211.       $self->{outputText} = 'no';
  212.       $self->{output} .= $origtext . $value;
  213.     } else {
  214.       $self->{output} .= $origtext;
  215.     }
  216.   } elsif ($tagname eq 'select'){
  217.     $self->{selectName} = $attr->{'name'};
  218.     $self->{output} .= $origtext;
  219.   } else {
  220.     $self->{output} .= $origtext;
  221.   }
  222. }
  223.  
  224. # handles non-html text
  225. sub text {
  226.   my ($self, $origtext) = @_;
  227.   # just output text, unless replaced value of <textarea> tag
  228.   unless(exists $self->{outputText} && $self->{outputText} eq 'no'){
  229.     if(exists $self->{option_no_value}){
  230.       # dealing with option tag with no value - <OPTION>bar</OPTION>
  231.       my $values = $self->{option_no_value};
  232.       my $value = $origtext;
  233.       $value =~ s/^\s+//;
  234.       $value =~ s/\s+$//;
  235.       foreach my $v ( @$values ) {
  236.     if ( $value eq $v ) {
  237.       $self->{output} .= " selected";
  238.         }
  239.       }
  240.       # close <OPTION> tag
  241.       $self->{output} .= ">$origtext";
  242.       delete $self->{option_no_value};
  243.     } else {
  244.       $self->{output} .= $origtext;
  245.     }
  246.   }
  247. }
  248.  
  249. # handles closing HTML tags such as </textarea>
  250. sub end {
  251.   my ($self, $tagname, $origtext) = @_;
  252.   if ($self->{option_no_value}) {
  253.     $self->{output} .= '>';
  254.     delete $self->{option_no_value};
  255.   }
  256.   if($tagname eq 'select'){
  257.     delete $self->{selectName};
  258.   } elsif ($tagname eq 'textarea'){
  259.     delete $self->{outputText};
  260.   } elsif ($tagname eq 'form') {
  261.     delete $self->{'current_form'};
  262.   }
  263.   $self->{output} .= $origtext;
  264. }
  265.  
  266. sub escapeHTMLStringOrList {
  267.   my ($self, $toencode) = @_;
  268.  
  269.   if (ref($toencode) eq 'ARRAY') {
  270.     foreach my $elem (@$toencode) {
  271.       $elem = $self->escapeHTML($elem);
  272.     }
  273.     return $toencode;
  274.   } else {
  275.     return $self->escapeHTML($toencode);
  276.   }
  277. }
  278.  
  279. sub escapeHTML {
  280.   my ($self, $toencode) = @_;
  281.  
  282.   return undef unless defined($toencode);
  283.   $toencode =~ s/&/&/g;
  284.   $toencode =~ s/\"/"/g;
  285.   $toencode =~ s/>/>/g;
  286.   $toencode =~ s/</</g;
  287.   return $toencode;
  288. }
  289.  
  290. sub comment {
  291.   my ( $self, $text ) = @_;
  292.   $self->{output} .= '<!--' . $text . '-->';
  293. }
  294.  
  295. sub process {
  296.   my ( $self, $token0, $text ) = @_;
  297.   $self->{output} .= $text;
  298. }
  299.  
  300. sub declaration {
  301.   my ( $self, $text ) = @_;
  302.   $self->{output} .= '<!' . $text . '>';
  303. }
  304.  
  305. 1;
  306.  
  307. __END__
  308.  
  309. =head1 NAME
  310.  
  311. HTML::FillInForm - Populates HTML Forms with CGI data.
  312.  
  313. =head1 DESCRIPTION
  314.  
  315. This module automatically inserts data from a previous HTML form into the HTML input, textarea and select tags.
  316. It is a subclass of L<HTML::Parser> and uses it to parse the HTML and insert the values into the form tags.
  317.  
  318. One useful application is after a user submits an HTML form without filling out a
  319. required field.  HTML::FillInForm can be used to redisplay the HTML form
  320. with all the form elements containing the submitted info.
  321.  
  322. =head1 SYNOPSIS
  323.  
  324. This examples fills data into a HTML form stored in C<$htmlForm> from CGI parameters that are stored
  325. in C<$q>.  For example, it will set the value of any "name" textfield to "John Smith".
  326.  
  327.   my $q = new CGI;
  328.  
  329.   $q->param("name","John Smith");
  330.  
  331.   my $fif = new HTML::FillInForm;
  332.   my $output = $fif->fill(scalarref => \$html,
  333.               fobject => $q);
  334.  
  335. =head1 METHODS
  336.  
  337. =over 4
  338.  
  339. =item new
  340.  
  341. Call C<new()> to create a new FillInForm object:
  342.  
  343.   $fif = new HTML::FillInForm;
  344.  
  345. =item fill
  346.  
  347. To fill in a HTML form contained in a scalar C<$html>:
  348.  
  349.   $output = $fif->fill(scalarref => \$html,
  350.              fobject => $q);
  351.  
  352. Returns filled in HTML form contained in C<$html> with data from C<$q>.
  353. C<$q> is required to have a C<param()> method that works like
  354. CGI's C<param()>.
  355.  
  356.   $output = $fif->fill(scalarref => \$html,
  357.              fobject => [$q1, $q2]);
  358.  
  359. Note that you can pass multiple objects as an array reference.
  360.  
  361.   $output = $fif->fill(scalarref => \$html,
  362.              fdat => \%fdat);
  363.  
  364. Returns filled in HTML form contained in C<$html> with data from C<%fdat>.
  365. To pass multiple values using C<%fdat> use an array reference.
  366.  
  367. Alternately you can use
  368.  
  369.   $output = $fif->fill(arrayref => \@array_of_lines,
  370.              fobject => $q);
  371.  
  372. and
  373.  
  374.   $output = $fif->fill(file => 'form.tmpl',
  375.              fobject => $q);
  376.  
  377. Suppose you have multiple forms in a html and among them there is only
  378. one form you want to fill in, specify target.
  379.  
  380.   $output = $fif->fill(scalarref => \$html,
  381.                        fobject => $q,
  382.                        target => 'form1');
  383.  
  384. This will fill in only the form inside
  385.  
  386.   <FORM name="form1"> ... </FORM>
  387.  
  388. Note that this method fills in password fields by default.  To disable, pass
  389.  
  390.   fill_password => 0
  391.  
  392. To disable the filling of some fields, use the C<ignore_fields> option:
  393.  
  394.   $output = $fif->fill(scalarref => \$html,
  395.                        fobject => $q,
  396.                        ignore_fields => ['prev','next']);
  397.  
  398. =back
  399.  
  400. =head1 CALLING FROM OTHER MODULES
  401.  
  402. =head2 Apache::PageKit
  403.  
  404. To use HTML::FillInForm in L<Apache::PageKit> is easy.   It is
  405. automatically called for any page that includes a <form> tag.
  406. It can be turned on or off by using the C<fill_in_form> configuration
  407. option.
  408.  
  409. =head2 Apache::ASP v2.09 and above
  410.  
  411. HTML::FillInForm is now integrated with Apache::ASP.  To activate, use
  412.  
  413.   PerlSetVar FormFill 1
  414.   $Response->{FormFill} = 1
  415.  
  416. =head2 HTML::Mason
  417.  
  418. Using HTML::FillInForm from HTML::Mason is covered in the FAQ on
  419. the masonhq.com website at
  420. L<http://www.masonhq.com/docs/faq/#how_can_i_integrate_html_fillin>
  421.  
  422. =head1 VERSION
  423.  
  424. This documentation describes HTML::FillInForm module version 1.02.
  425.  
  426. =head1 SECURITY
  427.  
  428. Note that you might want to think about caching issues if you have password
  429. fields on your page.  There is a discussion of this issue at
  430.  
  431. http://www.perlmonks.org/index.pl?node_id=70482
  432.  
  433. In summary, some browsers will cache the output of CGI scripts, and you
  434. can control this by setting the Expires header.  For example, use
  435. C<-expires> in L<CGI.pm> or set C<browser_cache> to I<no> in 
  436. Config.xml file of L<Apache::PageKit>.
  437.  
  438. =head1 TRANSLATION
  439.  
  440. Kato Atsushi has translated these docs into Japanese, available from
  441.  
  442. http://perldoc.jp
  443.  
  444. =head1 BUGS
  445.  
  446. Please submit any bug reports to tjmather@maxmind.com.
  447.  
  448. =head1 NOTES
  449.  
  450. Requires Perl 5.005 and L<HTML::Parser> version 3.26.
  451.  
  452. I wrote this module because I wanted to be able to insert CGI data
  453. into HTML forms,
  454. but without combining the HTML and Perl code.  CGI.pm and Embperl allow you so
  455. insert CGI data into forms, but require that you mix HTML with Perl.
  456.  
  457. =head1 AUTHOR
  458.  
  459. (c) 2002 Thomas J. Mather, tjmather@maxmind.com
  460.  
  461. All rights reserved. This package is free software; you can
  462. redistribute it and/or modify it under the same terms as Perl itself.
  463.  
  464. Paid support is available from directly from the author of this package.
  465. Please see L<http://www.maxmind.com/app/opensourceservices> for more details.
  466.  
  467. =head1 SEE ALSO
  468.  
  469. L<HTML::Parser>, L<Data::FormValidator>, L<HTML::Template>, L<Apache::PageKit>
  470.  
  471. =head1 CREDITS
  472.  
  473. Fixes, Bug Reports, Docs have been generously provided by:
  474.  
  475.   Tatsuhiko Miyagawa
  476.   Boris Zentner
  477.   Patrick Michael Kane
  478.   Ade Olonoh
  479.   Tom Lancaster
  480.   Martin H Sluka
  481.   Mark Stosberg
  482.   Jonathan Swartz
  483.   Trevor Schellhorn
  484.   Jim Miner
  485.   Paul Lindner
  486.   Maurice Aubrey
  487.   Andrew Creer
  488.   Joseph Yanni
  489.   Philip Mak
  490.   Jost Krieger
  491.   Gabriel Burka
  492.   Bill Moseley
  493.  
  494. Thanks!
  495.