File Coverage

blib/lib/HTML/Defaultify.pm

Criterion	Covered	Total	%
statement	15	178	8.4
branch	0	100	0.0
condition	0	12	0.0
subroutine	5	19	26.3
pod	6	14	42.8
total	26	323	8.0

line	stmt	sub	time	code
1				#!/usr/local/bin/perl -w
2				#
3				# HTML::Defaultify-- Pre-fill default values into an existing HTML form.
4				#
5				# The main purpose of this module is the defaultify() routine, which
6				# takes a block of HTML and a hash of default values, and returns that HTML
7				# with all form fields set based on those default values. Default values
8				# (hash elements) may each be given in any of three forms: as a single
9				# scalar, as a list in "\0"-delimited form, or as a reference to an actual
10				# list. If the HTML contains more than one form, you can name which form to
11				# defaultify. Return values are the defaultified block of HTML and a hash of
12				# all unused default values (which may be useful as input to hidden_vars()).
13				# Multiple form fields with the same name are handled correctly. Besides
14				# the main defaultify() routine, this module includes several related
15				# routines which the programmer may find useful.
16				#
17				# This package prefers to have the HTML::Entities module available, but
18				# can improvise without it.
19				#
20				# Copyright (c) 1996, 1997, 2002 James Marshall (james@jmarshall.com).
21				# Adapted from the toolbox htmlutil.pl, which is (c) 1996, 1997 by same.
22				# All rights reserved.
23				#
24				# This program is free software; you can redistribute it and/or modify it
25				# under the same terms as Perl itself.
26				#
27				# Exported by default:
28				# $new_HTML= &defaultify($HTML, \%defaults [, $form_name]) ;
29				# ($new_HTML, $unused_defs)= &defaultify($HTML, \%defaults [, $form_name]) ;
30				#
31				# $my_subset_ref= &subhash(\%hash, @keys_to_include) ;
32				#
33				# Export is allowed:
34				# $hidden_vars= &hidden_vars($unused_defaults_ref) ;
35				# $hidden_vars= &hidden_vars(%unused_defaults) ;
36				# $hidden_tag= &hidden_var($name, $value) ;
37				#
38				# ($tag_name, $attr_ref)= &parse_tag($tag) ;
39				# $new_tag= &build_tag($tag_name, $attr_ref) ;
40				# $new_tag= &build_tag($tag_name, %attr) ;
41				#
42				#
43				# For better documentation, see "perldoc HTML::Defaultify" (or
44				# "perldoc -F this_file_name.pm").
45				#
46				# For the latest, see http://www.jmarshall.com/tools/defaultify/ .
47				#
48
49				#---- package-definition-related stuff -------------------------------------
50
51				package HTML::Defaultify ;
52
53	1	1	814	use strict ;
	1		1
	1		47
54	1	1	6	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS) ;
	1		1
	1		176
55
56				require Exporter ;
57				@ISA= qw(Exporter) ;
58
59				$VERSION= '1.01' ;
60				@EXPORT= qw( defaultify subhash ) ;
61				@EXPORT_OK= qw( hidden_vars hidden_var parse_tag build_tag ) ;
62
63				%EXPORT_TAGS= (
64				parse => [qw( parse_tag build_tag )],
65				all => [@EXPORT, @EXPORT_OK],
66				) ;
67
68
69				#---- actual package code below --------------------------------------------
70
71	1	1	5	use Carp ;
	1		12
	1		103
72
73	1	1	6	use vars qw($HAS_HTML_ENTITIES) ;
	1		1
	1		3476
74
75				# Load HTML::Entities if available; set $HAS_HTML_ENTITIES accordingly.
76	1	1	901	eval 'use HTML::Entities' ;
	1		348667
	1		126
77				$HAS_HTML_ENTITIES= ($@ eq '') ;
78
79
80				# defaultify()-- takes a chunk of HTML that includes form input fields,
81				# and sets defaults according to the hash sent.
82				# Returns defaultified HTML block, and a reference to a hash of all defaults
83				# that were not used (possibly for use with hidden_vars()).
84				# In scalar context, only returns defaultified HTML block.
85				#
86				# ($new_HTML, $unused_defs)= &defaultify($HTML, $defaults [, $form_name]) ;
87				# $new_HTML= &defaultify($HTML, $defaults [, $form_name]) ;
88				#
89				# $defaults is a reference to a hash of default values. Each default (hash
90				# element) may be a scalar, a list in the form of a "\0"-delimited scalar,
91				# or a reference to a real list.
92				# As a special case, if $defaults is undefined, this routine clears all default
93				# settings from $HTML, even if they were set with tag attributes, etc.
94				# As another special case, if $defaults is a CGI object (from CGI.pm), this
95				# routine uses its existing parameters as the default set, by calling its
96				# Vars() method.
97				# If you have an existing hash instead of a reference, use e.g. \%my_hash .
98				# If $form_name is given, then only the form(s) with that name in $HTML will
99				# be defaultified. Otherwise, all of $HTML will be defaultified.
100				# Tags inside comments or blocks,
126				# and blocks from $HTML, to avoid matching tags
127				# inside them. Replace these extractions with markers, so they can be
128				# restored after defaultification is complete. Somewhat hacky approach,
129				# but works.
130				# Extractions are stored in @extracts, and the markers consist of: a random
131				# string not otherwise in $HTML, plus each extraction's location in
132				# @extracts, plus "\0".
133				# All four kinds of extractions (two comment formats, scripts, and styles)
134				# are handled simultaneously. This correctly handles cases of when
135				# "
150				# or tags. This is most likely what the HTML author expects
151				# anyway, though it violates the HTML spec. Worse, browsers vary on
152				# whether they'll end a "
153				# inside the script code. Balancing all this, for here it's a reasonable
154				# policy to end those blocks on "" and "".
155				# There's a potential problem with the marker: Even if it's not in
156				# $HTML, certain sequences could cause problems. Consider a marker of
157				# "xy1xy", and a comment preceded by "xy1". After the comment->marker
158				# replacement, the string is "xy1xy1xy" and will match too early. But
159				# since we know \d+\0 will always follow the marker, then excluding
160				# digits and \0 from the marker will prevent a wrong match like this.
161				# I'm pretty sure this solves it, but please tell me if you think of
162				# any combinations that could break this.
163
164				# Generate a random 5-character string. Exclude digits, \0, and
165				# what the hell, "<" and ">".
166				# srand is automatically called in Perl 5.004 and later.
167	0			do {
168	0			$marker= pack("C5", map {rand(193)+63} 1..5) ; # start after ">"
	0
169				} while $HTML=~ /\Q$marker/ ;
170
171				# Extract comments,