HTML::FillInForm::Lite - Lightweight FillInForm module in Pure Perl
Index
Code Index:
NAME
HTML::FillInForm::Lite - Lightweight FillInForm module in Pure Perl
VERSION
The document describes HTML::FillInForm::Lite version 1.09
SYNOPSIS
use HTML::FillInForm::Lite;
use CGI;
my $q = CGI->new();
my $h = HTML::FillInForm::Lite->new();
$output = $h->fill(\$html, $q);
$output = $h->fill(\@html, \%data);
$output = $h->fill(\*HTML, \&my_param);
$output = $h->fill('t.html', [$q, \%default]);
# or as a class method with options
$output = HTML::FillInForm::Lite->fill(\$html, $q,
fill_password => 0, # it is default
ignore_fields => ['foo', 'bar'],
target => $form_id,
);
# Moreover, it accepts any object as form data
# (these classes come form Class::DBI's SYNOPSIS)
my $artist = Music::Artist->insert({ id => 1, name => 'U2' });
$output = $h->fill(\$html, $artist);
my $cd = Music::CD->retrieve(1);
$output = $h->fill(\$html, $cd);
# simple function interface
use HTML::FillInForm::Lite qw(fillinform);
# the same as HTML::FillInForm::Lite->fill(...)
$output = fillinform(\$html, $q);
DESCRIPTION
This module fills in HTML forms with Perl data,
which re-implements HTML::FillInForm using regexp-based parser,
not using HTML::Parser.
The difference in the parsers makes HTML::FillInForm::Lite about 2
times faster than HTML::FillInForm.
FUNCTIONS
Simple interface to the fill() method, accepting only a string.
If you pass a single argument to this function, it is interpreted as
form_data, and returns a function that accepts source.
my $fillinform = fillinform($query);
$fillinform->($html); # the same as fillinform($html, $query)
This function is exportable.
METHODS
new(options...)
Creates HTML::FillInForm::Lite processor with options.
There are several options. All the options are disabled when undef is
supplied.
Acceptable options are as follows:
- fill_password => bool
-
To enable passwords to be filled in, set the option true.
Note that the effect of the option is the same as that of HTML::FillInForm,
but by default HTML::FillInForm::Lite ignores password fields.
- ignore_fields => array_ref_of_fields
-
To ignore some fields from filling.
- target => form_id
-
To fill in just the form identified by form_id.
- escape => bool | ref
-
If true is provided (or by default), values filled in text fields will be
HTML-escaped, e.g. <tag> to be <tag>.
If the values are already HTML-escaped, set the option false.
You can supply a subroutine reference to escape the values.
Note that it is not implemented in HTML::FillInForm.
- decode_entity => bool | ref
-
If true is provided , HTML entities in state fields
(namely, radio, checkbox and select) will be decoded,
but normally it is not needed.
You can also supply a subroutine reference to decode HTML entities.
Note that HTML::FillInForm always decodes HTML entities in state fields,
but not supports this option.
- layer => :iolayer
-
To read a file with :iolayer. It is used when a file name is supplied as
source.
For example:
# To read a file encoded in UTF-8
$fif = HTML::FillInForm::Lite->new(layer => ':utf8');
$output = $fif->fill($utf8_file, $fdat);
# To read a file encoded in EUC-JP
$fif = HTML::FillInForm::Lite->new(layer => ':encoding(euc-jp)');
$output = $fif->fill($eucjp_file, $fdat);
Note that it is not implemented in HTML::FillInForm.
DEPENDENCIES
NOTES
Compatibility with HTML::FillInForm
This module implements only the new syntax of HTML::FillInForm
version 2. However, HTML::FillInForm::Lite::Compat provides
an interface compatible with HTML::FillInForm.
Compatibility with legacy HTML
This module is designed to process XHTML 1.x.
And it also supporting a good part of HTML 4.x , but there are some
limitations. First, it doesn't understand HTML-attributes that the name is
omitted.
For example:
<INPUT TYPE=checkbox NAME=foo CHECKED> -- NG.
<INPUT TYPE=checkbox NAME=foo CHECKED=checked> - OK, but obsolete.
<input type="checkbox" name="foo" checked="checked" /> - OK, valid XHTML
Then, it always treats the values of attributes case-sensitively.
In the example above, the value of type must be lower-case.
Moreover, it doesn't recognize omitted closing tags, like:
<select name="foo">
<option>bar
<option>baz
</select>
When you can't get what you want, try to give your source to a HTML lint.
This module processes all the processable, not knowing comments
nor something that shouldn't be processed.
It may cause problems. Suppose there is a code like:
<script> document.write("<input name='foo' />") </script>
HTML::FillInForm::Lite will break the code:
<script> document.write("<input name='foo' value="bar" />") </script>
To avoid such problems, you can use the ignore_fields option.
BUGS
No bugs have been reported.
Please report any bug or feature request to <gfuji(at)cpan.org>,
or through the RT http://rt.cpan.org/.
SEE ALSO
HTML::FillInForm.
HTML::FillInForm::Lite::JA - the document in Japanese.
HTML::FillInForm::Lite::Compat - HTML::FillInForm compatibility layer
AUTHOR
Goro Fuji (藤 吾郎) <gfuji(at)cpan.org>
LICENSE AND COPYRIGHT
Copyright (c) 2008-2010 Goro Fuji, Some rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
package HTML::FillInForm::Lite;
use 5.006_000; # 5.6.0
use strict;
use warnings;
our $VERSION = '1.09';
use Exporter ();
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(fillinform);
#use Smart::Comments '####';
use Carp ();
use Scalar::Util ();
# Regexp for HTML tags
my $form = q{[fF][oO][rR][mM]};
my $input = q{[iI][nN][pP][uU][tT]};
my $select = q{[sS][eE][lL][eE][cC][tT] };
my $option = q{[oO][pP][tT][iI][oO][nN] };
my $textarea = q{[tT][eE][xX][tT][aA][rR][eE][aA]};
my $checked = q{[cC][hH][eE][cC][kK][eE][dD]};
my $selected = q{[sS][eE][lL][eE][cC][tT][eE][dD]};
my $multiple = q{[mM][uU][lL][tT][iI][pP][lL][eE]};
my $id = q{[iI][dD]};
my $type = q{[tT][yY][pP][eE]};
my $name = q{[nN][aA][mM][eE]};
my $value = q{[vV][aA][lL][uU][eE]};
my $SPACE = q{\s};
my $IDENT = q{\w+};
my $ATTR_VALUE = q{(?: " [^"]* " | ' [^']* ' | [^'"/>\s]+ )};
my $ATTR = qq{(?:$SPACE+ $IDENT = $ATTR_VALUE )};
my $FORM = qq{(?: <$form $ATTR+ $SPACE* > )}; # <form>
my $INPUT = qq{(?: <$input $ATTR+ $SPACE*/?> )}; # <input>
my $SELECT = qq{(?: <$select $ATTR+ $SPACE* > )}; # <select>
my $OPTION = qq{(?: <$option $ATTR* $SPACE* > )}; # <option>
my $TEXTAREA = qq{(?: <$textarea $ATTR+ $SPACE* > )}; # <textarea>
my $END_FORM = qq{(?: </$form> )};
my $END_SELECT = qq{(?: </$select> )};
my $END_OPTION = qq{(?: </$option> )};
my $END_TEXTAREA = qq{(?: </$textarea> )};
my $CHECKED = qq{(?: $checked = (?: "$checked " | '$checked' | $checked ) )};
my $SELECTED = qq{(?: $selected = (?: "$selected" | '$selected' | $selected ) )};
my $MULTIPLE = qq{(?: $multiple = (?: "$multiple" | '$multiple' | $multiple ) )};
#my $DISABLED = q{(?: disabled = (?: "disabled" | 'disabled' | disabled ) )};
#sub _extract{ # for debugging only
# my $s = shift;
# my %f = (input => [], select => [], textarea => []);
# @{$f{input}} = $s =~ m{($INPUT)}ogxmsi;
# @{$f{select}} = $s =~ m{($SELECT.*?$END_SELECT)}ogxmsi;
# @{$f{textarea}} = $s =~ m{($TEXTAREA.*?$END_TEXTAREA)}ogxmsi;
#
# return \%f;
#}
if($] >= 5.008_001) {
*is_utf8 = \&utf8::is_utf8;
*utf8_decode = \&utf8::decode;
}
else {
*utf8_decode = *is_utf8 = sub { 0 };
}
sub fillinform { # function interface to fill()
if(@_ == 1) {
my($data) = @_;
my $fif = __PACKAGE__->new();
return sub {
my($form) = @_;
return $fif->fill(\$form, $data);
}
}
else {
my($form, $data) = @_;
return __PACKAGE__->fill(\$form, $data);
}
}
# utilities for getting HTML attributes
sub _unquote{
$_[0] =~ /(['"]) (.*) \1/xms ? $2 : $_[0]; # ' for poor editors
}
sub _get_id{
$_[0] =~ /$id = ($ATTR_VALUE)/oxms ? _unquote($1) : undef;
}
sub _get_type{
$_[0] =~ /$type = ($ATTR_VALUE)/oxms ? _unquote($1) : undef;
}
sub _get_name{
$_[0] =~ /$name = ($ATTR_VALUE)/oxms ? _unquote($1) : undef;
}
sub _get_value{
$_[0] =~ /$value = ($ATTR_VALUE)/oxms ? _unquote($1) : undef;
}
#use macro
# _unquote => \&_unquote,
# _get_id => \&_get_id,
# _get_type => \&_get_type,
# _get_name => \&_get_name,
# _get_value => \&_get_value,
#;
sub new :method{
my $class = shift;
return $class->_parse_option(@_);
}
sub _parse_option{
my $self = shift;
if(ref $self and not @_){ # as instance method with no option
return $self;
}
my %context = (
ignore_types => {
button => 1,
submit => 1,
reset => 1,
password => 1,
image => 1,
file => 1,
},
escape => \&_escape_html,
decode_entity => \&_noop,
layer => '',
);
# merge if needed
if(ref $self){
while(my($key, $val) = each %{$self}){
$context{$key} = ref($val) eq 'HASH' ? { %{$val} } : $val;
}
}
# parse options
while(my($opt, $val) = splice @_, 0, 2){
next unless defined $val;
if( $opt eq 'ignore_fields'
or $opt eq 'disable_fields' ){
@{ $context{$opt} ||= {} }{ @{$val} }
= (1) x @{$val};
}
elsif($opt eq 'fill_password'){
$context{ignore_types}{password} = !$val;
}
elsif($opt eq 'target'){
$context{target} = $val;
}
elsif($opt eq 'escape'){
if($val){
$context{escape} = ref($val) eq 'CODE'
? $val
: \&_escape_html;
}
else{
$context{escape} = \&_noop;
}
}
elsif($opt eq 'layer'){
$context{layer} = $val;
}
elsif($opt eq 'decode_entity'){
if($val){
$context{decode_entity} = ref($val) eq 'CODE'
? $val
: \&_decode_entity;
}
else{
$context{decode_entity} = \&_noop;
}
}
else{
Carp::croak("Unknown option '$opt' supplied");
}
}
return bless \%context => ref($self) || $self;
}
sub fill :method{
my($self, $src, $q, @opt) = @_;
defined $src or Carp::croak('No source supplied');
defined $q or Carp::croak('No data supplied');
my $context = $self->_parse_option(@opt);
### $context
# HTML source to a scalar
my $content;
if(ref($src) eq 'SCALAR'){
$content = ${$src}; # copy
}
elsif(ref($src) eq 'ARRAY'){
$content = join q{}, @{$src};
}
else{
my $is_fh = Scalar::Util::openhandle($src);
if($is_fh or !ref($src)) {
if(!$is_fh){
open my($in), '<'.$context->{layer}, $src
or Carp::croak("Cannot open '$src': $!");
$src = $in;
}
local $/;
$content = readline($src); # slurp
}
else {
$content = ${$src};
}
}
# if $content is utf8-flagged, params should be utf8-encoded
local $context->{utf8} = is_utf8($content);
# param object converted from data or object
local $context->{data} = _to_form_object($q);
# param storage for multi-text fields
local $context->{params} = {};
# Fill in contents
if(defined $context->{target}){
$content =~ s{ ($FORM) (.*?) ($END_FORM) }
{
my($beg, $content, $end) = ($1, $2, $3);
my $id = _get_id($beg);
(defined($id) and $context->{target} eq $id)
? $beg . _fill($context, $content) . $end
: $beg . $content . $end
}goexms;
return $content;
}
else{
return _fill($context, $content);
}
}
sub _fill{
my($context, $content) = @_;
$content =~ s{($INPUT)}
{ _fill_input($context, $1) }goexms;
$content =~ s{($SELECT) (.*?) ($END_SELECT) }
{ $1 . _fill_select($context, $1, $2) . $3 }goexms;
$content =~ s{($TEXTAREA) (.*?) ($END_TEXTAREA) }
{ $1 . _fill_textarea($context, $1, $2) . $3 }goexms;
return $content;
}
sub _fill_input{
my($context, $tag) = @_;
### $tag
my $type = _get_type($tag) || 'text';
if($context->{ignore_types}{ $type }){
return $tag;
}
my $values_ref = $context->_get_param( _get_name($tag) )
or return $tag;
if($type eq 'checkbox' or $type eq 'radio'){
my $value = _get_value($tag);
if(not defined $value){
$value = 'on';
}
else{
$value = $context->{decode_entity}->($value);
}
if(grep { $value eq $_ } @{$values_ref}){
$tag =~ /$CHECKED/oxms
or $tag =~ s{$SPACE* (/?) > \z}
{ checked="checked" $1>}oxms;
}
else{
$tag =~ s/$SPACE+$CHECKED//goxms;
}
}
else{
my $new_value = $context->{escape}->(shift @{$values_ref});
$tag =~ s{$value = $ATTR_VALUE}{value="$new_value"}oxms
or $tag =~ s{$SPACE* (/?) > \z}
{ value="$new_value" $1>}oxms;
}
return $tag;
}
sub _fill_select{
my($context, $tag, $content) = @_;
my $values_ref = $context->_get_param( _get_name($tag) )
or return $content;
if($tag !~ /$MULTIPLE/oxms){
$values_ref = [ shift @{ $values_ref } ]; # in select-one
}
$content =~ s{($OPTION) (.*?) ($END_OPTION)}
{ _fill_option($context, $values_ref, $1, $2) . $2 . $3 }goexms;
return $content;
}
sub _fill_option{
my($context, $values_ref, $tag, $content) = @_;
my $value = _get_value($tag);
unless( defined $value ){
$value = $content;
$value =~ s{\A $SPACE+ } {}oxms;
$value =~ s{ $SPACE{2,}}{ }oxms;
$value =~ s{ $SPACE+ \z} {}oxms;
}
$value = $context->{decode_entity}->($value);
### @_
if(grep{ $value eq $_ } @{$values_ref}){
$tag =~ /$SELECTED/oxms
or $tag =~ s{ $SPACE* > \z}
{ selected="selected">}oxms;
}
else{
$tag =~ s/$SPACE+$SELECTED//goxms;
}
return $tag;
}
sub _fill_textarea{
my($context, $tag, $content) = @_;
my $values_ref = $context->_get_param( _get_name($tag) )
or return $content;
return $context->{escape}->(shift @{$values_ref});
}
# utilities
sub _get_param{
my($context, $name) = @_;
return if not defined $name or $context->{ignore_fields}{$name};
my $ref = $context->{params}{$name};
if(not defined $ref){
$ref = $context->{params}{$name}
= [ $context->{data}->param($name) ];
if($context->{utf8}){
for my $datum( @{$ref} ){
utf8_decode($datum) unless is_utf8($datum);
}
}
}
return @{$ref} ? $ref : undef;
}
sub _noop{
return $_[0];
}
sub _escape_html{
my $s = shift;
# return '' unless defined $s;
$s =~ s/&/&/g;
$s =~ s/</</g;
$s =~ s/>/>/g;
$s =~ s/"/"/g; # " for poor editors
return $s;
}
sub _decode_entity{
my $s = shift;
our %entity2char;
unless(%entity2char){
# load the HTML entity data
local $/ = "__END__\n";
local($@, $!);
open my $data_in, '<', __FILE__ or die $!; # should be success
readline $data_in; # discard the first segment
eval scalar readline($data_in) or die $@;
}
$s =~ s{&(\w+);}{ $entity2char{$1} || "&$1;" }egxms;
$s =~ s{&\#(\d+) ;}{ chr $1 }egxms;
$s =~ s{&\#x([0-9a-fA-F]+);}{ chr hex $1 }egxms;
return $s;
}
#sub _disable{
# my $context = shift;
# my $name = shift;
#
# if($context->{disable_fields}{$name}){
# $_[0] =~ /$DISABLED/oxmsi
# or $_[0] =~ s{$SPACE* /? > \z}
# { disabled="disabled" />}oxmsi;
# }
# return;
#}
sub _to_form_object{
my($ref) = @_;
my $wrapper;
my $type;
if(!Scalar::Util::blessed($ref)){
$type = ref $ref;
if($type eq 'HASH'){
$wrapper = {};
@{$wrapper}{ keys %{$ref} }
= map{
ref($_) eq 'ARRAY' ? $_
: defined($_) ? [$_]
: [ ];
} values %{$ref};
}
elsif($type eq 'ARRAY'){
$wrapper = [];
@{$wrapper} = map{ _to_form_object($_) } @{$ref};
}
elsif($type eq 'CODE'){
$wrapper = \$ref;
}
else{
Carp::croak("Cannot use '$ref' as form data");
}
}
elsif($ref->can('param')){ # a request object like CGI.pm
return $ref;
}
else{
# any object is ok
$wrapper = \$ref;
$type = 'Object';
}
return bless $wrapper => __PACKAGE__ . q{::} . $type;
}
sub HTML::FillInForm::Lite::HASH::param{
my($hash_ref, $key) = @_;
my $value = $hash_ref->{$key} or return;
return @{ $value };
}
sub HTML::FillInForm::Lite::ARRAY::param{
my($ary_ref, $key) = @_;
return map{ $_->param($key) } @{$ary_ref};
}
sub HTML::FillInForm::Lite::CODE::param{
my($ref_to_code_ref, $key) = @_;
return ${$ref_to_code_ref}->($key);
}
sub HTML::FillInForm::Lite::Object::param{
my($ref_to_object, $key) = @_;
my $method = ${$ref_to_object}->can($key) or return;
my(@values) = ${$ref_to_object}->$method();
return @values == 1 && !defined($values[0]) ? () : @values;
}
1;
__END__
our %entity2char = (
quot => chr(34),
amp => chr(38),
apos => chr(39),
lt => chr(60),
gt => chr(62),
AElig => chr(198), Aacute => chr(193),
Acirc => chr(194), Agrave => chr(192),
Aring => chr(197), Atilde => chr(195),
Auml => chr(196), Ccedil => chr(199),
ETH => chr(208), Eacute => chr(201),
Ecirc => chr(202), Egrave => chr(200),
Euml => chr(203), Iacute => chr(205),
Icirc => chr(206), Igrave => chr(204),
Iuml => chr(207), Ntilde => chr(209),
Oacute => chr(211), Ocirc => chr(212),
Ograve => chr(210), Oslash => chr(216),
Otilde => chr(213), Ouml => chr(214),
THORN => chr(222), Uacute => chr(218),
Ucirc => chr(219), Ugrave => chr(217),
Uuml => chr(220), Yacute => chr(221),
aacute => chr(225), acirc => chr(226),
aelig => chr(230), agrave => chr(224),
aring => chr(229), atilde => chr(227),
auml => chr(228), ccedil => chr(231),
eacute => chr(233), ecirc => chr(234),
egrave => chr(232), eth => chr(240),
euml => chr(235), iacute => chr(237),
icirc => chr(238), igrave => chr(236),
iuml => chr(239), ntilde => chr(241),
oacute => chr(243), ocirc => chr(244),
ograve => chr(242), oslash => chr(248),
otilde => chr(245), ouml => chr(246),
szlig => chr(223), thorn => chr(254),
uacute => chr(250), ucirc => chr(251),
ugrave => chr(249), uuml => chr(252),
yacute => chr(253), yuml => chr(255),
copy => chr(169), reg => chr(174),
nbsp => chr(160),
iexcl => chr(161), cent => chr(162),
pound => chr(163), curren => chr(164),
yen => chr(165), brvbar => chr(166),
sect => chr(167), uml => chr(168),
ordf => chr(170), laquo => chr(171),
not => chr(172), shy => chr(173),
macr => chr(175), deg => chr(176),
plusmn => chr(177), sup1 => chr(185),
sup2 => chr(178), sup3 => chr(179),
acute => chr(180), micro => chr(181),
para => chr(182), middot => chr(183),
cedil => chr(184), ordm => chr(186),
raquo => chr(187), frac14 => chr(188),
frac12 => chr(189), frac34 => chr(190),
iquest => chr(191), times => chr(215),
divide => chr(247),
OElig => chr(338), oelig => chr(339),
Scaron => chr(352), scaron => chr(353),
Yuml => chr(376), fnof => chr(402),
circ => chr(710), tilde => chr(732),
Alpha => chr(913), Beta => chr(914),
Gamma => chr(915), Delta => chr(916),
Epsilon => chr(917), Zeta => chr(918),
Eta => chr(919), Theta => chr(920),
Iota => chr(921), Kappa => chr(922),
Lambda => chr(923), Mu => chr(924),
Nu => chr(925), Xi => chr(926),
Omicron => chr(927), Pi => chr(928),
Rho => chr(929), Sigma => chr(931),
Tau => chr(932), Upsilon => chr(933),
Phi => chr(934), Chi => chr(935),
Psi => chr(936), Omega => chr(937),
alpha => chr(945), beta => chr(946),
gamma => chr(947), delta => chr(948),
epsilon => chr(949), zeta => chr(950),
eta => chr(951), theta => chr(952),
iota => chr(953), kappa => chr(954),
lambda => chr(955), mu => chr(956),
nu => chr(957), xi => chr(958),
omicron => chr(959), pi => chr(960),
rho => chr(961), sigmaf => chr(962),
sigma => chr(963), tau => chr(964),
upsilon => chr(965), phi => chr(966),
chi => chr(967), psi => chr(968),
omega => chr(969), thetasym => chr(977),
upsih => chr(978), piv => chr(982),
ensp => chr(8194), emsp => chr(8195),
thinsp => chr(8201), zwnj => chr(8204),
zwj => chr(8205), lrm => chr(8206),
rlm => chr(8207), ndash => chr(8211),
mdash => chr(8212), lsquo => chr(8216),
rsquo => chr(8217), sbquo => chr(8218),
ldquo => chr(8220), rdquo => chr(8221),
bdquo => chr(8222), dagger => chr(8224),
Dagger => chr(8225), bull => chr(8226),
hellip => chr(8230), permil => chr(8240),
prime => chr(8242), Prime => chr(8243),
lsaquo => chr(8249), rsaquo => chr(8250),
oline => chr(8254), frasl => chr(8260),
euro => chr(8364), image => chr(8465),
weierp => chr(8472), real => chr(8476),
trade => chr(8482), alefsym => chr(8501),
larr => chr(8592), uarr => chr(8593),
rarr => chr(8594), darr => chr(8595),
harr => chr(8596), crarr => chr(8629),
lArr => chr(8656), uArr => chr(8657),
rArr => chr(8658), dArr => chr(8659),
hArr => chr(8660), forall => chr(8704),
part => chr(8706), exist => chr(8707),
empty => chr(8709), nabla => chr(8711),
isin => chr(8712), notin => chr(8713),
ni => chr(8715), prod => chr(8719),
sum => chr(8721), minus => chr(8722),
lowast => chr(8727), radic => chr(8730),
prop => chr(8733), infin => chr(8734),
ang => chr(8736), and => chr(8743),
or => chr(8744), cap => chr(8745),
cup => chr(8746), int => chr(8747),
there4 => chr(8756), sim => chr(8764),
cong => chr(8773), asymp => chr(8776),
ne => chr(8800), equiv => chr(8801),
le => chr(8804), ge => chr(8805),
sub => chr(8834), sup => chr(8835),
nsub => chr(8836), sube => chr(8838),
supe => chr(8839), oplus => chr(8853),
otimes => chr(8855), perp => chr(8869),
sdot => chr(8901), lceil => chr(8968),
rceil => chr(8969), lfloor => chr(8970),
rfloor => chr(8971), lang => chr(9001),
rang => chr(9002), loz => chr(9674),
spades => chr(9824), clubs => chr(9827),
hearts => chr(9829), diams => chr(9830),
);
1;
__END__