summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/HTML
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
commit316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch)
treecb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl/lib/HTML
parentcd0f87b5d39480d85ad9bd4ee37f520f75bed560 (diff)
Moving old tlperl prior to committing new one
git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/HTML')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/Entities.pm500
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/Filter.pm112
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/Form.pm1551
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/HeadParser.pm301
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/LinkExtor.pm185
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/Parser.pm1240
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/PullParser.pm209
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/Tagset.pm471
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTML/TokeParser.pm369
9 files changed, 0 insertions, 4938 deletions
diff --git a/Master/tlpkg/tlperl/lib/HTML/Entities.pm b/Master/tlpkg/tlperl/lib/HTML/Entities.pm
deleted file mode 100755
index 38cd41e62b0..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/Entities.pm
+++ /dev/null
@@ -1,500 +0,0 @@
-package HTML::Entities;
-
-=head1 NAME
-
-HTML::Entities - Encode or decode strings with HTML entities
-
-=head1 SYNOPSIS
-
- use HTML::Entities;
-
- $a = "V&aring;re norske tegn b&oslash;r &#230res";
- decode_entities($a);
- encode_entities($a, "\200-\377");
-
-For example, this:
-
- $input = "vis-à-vis Beyoncé's naïve\npapier-mâché résumé";
- print encode_entities($input), "\n"
-
-Prints this out:
-
- vis-&agrave;-vis Beyonc&eacute;'s na&iuml;ve
- papier-m&acirc;ch&eacute; r&eacute;sum&eacute;
-
-=head1 DESCRIPTION
-
-This module deals with encoding and decoding of strings with HTML
-character entities. The module provides the following functions:
-
-=over 4
-
-=item decode_entities( $string, ... )
-
-This routine replaces HTML entities found in the $string with the
-corresponding Unicode character. Under perl 5.6 and earlier only
-characters in the Latin-1 range are replaced. Unrecognized
-entities are left alone.
-
-If multiple strings are provided as argument they are each decoded
-separately and the same number of strings are returned.
-
-If called in void context the arguments are decoded in-place.
-
-This routine is exported by default.
-
-=item _decode_entities( $string, \%entity2char )
-
-=item _decode_entities( $string, \%entity2char, $expand_prefix )
-
-This will in-place replace HTML entities in $string. The %entity2char
-hash must be provided. Named entities not found in the %entity2char
-hash are left alone. Numeric entities are expanded unless their value
-overflow.
-
-The keys in %entity2char are the entity names to be expanded and their
-values are what they should expand into. The values do not have to be
-single character strings. If a key has ";" as suffix,
-then occurrences in $string are only expanded if properly terminated
-with ";". Entities without ";" will be expanded regardless of how
-they are terminated for compatibility with how common browsers treat
-entities in the Latin-1 range.
-
-If $expand_prefix is TRUE then entities without trailing ";" in
-%entity2char will even be expanded as a prefix of a longer
-unrecognized name. The longest matching name in %entity2char will be
-used. This is mainly present for compatibility with an MSIE
-misfeature.
-
- $string = "foo&nbspbar";
- _decode_entities($string, { nb => "@", nbsp => "\xA0" }, 1);
- print $string; # will print "foo bar"
-
-This routine is exported by default.
-
-=item encode_entities( $string )
-
-=item encode_entities( $string, $unsafe_chars )
-
-This routine replaces unsafe characters in $string with their entity
-representation. A second argument can be given to specify which characters to
-consider unsafe. The unsafe characters is specified using the regular
-expression character class syntax (what you find within brackets in regular
-expressions).
-
-The default set of characters to encode are control chars, high-bit chars, and
-the C<< < >>, C<< & >>, C<< > >>, C<< ' >> and C<< " >> characters. But this,
-for example, would encode I<just> the C<< < >>, C<< & >>, C<< > >>, and C<< "
->> characters:
-
- $encoded = encode_entities($input, '<>&"');
-
-and this would only encode non-plain ascii:
-
- $encoded = encode_entities($input, '^\n\x20-\x25\x27-\x7e');
-
-This routine is exported by default.
-
-=item encode_entities_numeric( $string )
-
-=item encode_entities_numeric( $string, $unsafe_chars )
-
-This routine works just like encode_entities, except that the replacement
-entities are always C<&#xI<hexnum>;> and never C<&I<entname>;>. For
-example, C<encode_entities("r\xF4le")> returns "r&ocirc;le", but
-C<encode_entities_numeric("r\xF4le")> returns "r&#xF4;le".
-
-This routine is I<not> exported by default. But you can always
-export it with C<use HTML::Entities qw(encode_entities_numeric);>
-or even C<use HTML::Entities qw(:DEFAULT encode_entities_numeric);>
-
-=back
-
-All these routines modify the string passed as the first argument, if
-called in a void context. In scalar and array contexts, the encoded or
-decoded string is returned (without changing the input string).
-
-If you prefer not to import these routines into your namespace, you can
-call them as:
-
- use HTML::Entities ();
- $decoded = HTML::Entities::decode($a);
- $encoded = HTML::Entities::encode($a);
- $encoded = HTML::Entities::encode_numeric($a);
-
-The module can also export the %char2entity and the %entity2char
-hashes, which contain the mapping from all characters to the
-corresponding entities (and vice versa, respectively).
-
-=head1 COPYRIGHT
-
-Copyright 1995-2006 Gisle Aas. All rights reserved.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
-use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-use vars qw(%entity2char %char2entity);
-
-require 5.004;
-require Exporter;
-@ISA = qw(Exporter);
-
-@EXPORT = qw(encode_entities decode_entities _decode_entities);
-@EXPORT_OK = qw(%entity2char %char2entity encode_entities_numeric);
-
-$VERSION = "3.64";
-sub Version { $VERSION; }
-
-require HTML::Parser; # for fast XS implemented decode_entities
-
-
-%entity2char = (
- # Some normal chars that have special meaning in SGML context
- amp => '&', # ampersand
-'gt' => '>', # greater than
-'lt' => '<', # less than
- quot => '"', # double quote
- apos => "'", # single quote
-
- # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
- AElig => chr(198), # capital AE diphthong (ligature)
- Aacute => chr(193), # capital A, acute accent
- Acirc => chr(194), # capital A, circumflex accent
- Agrave => chr(192), # capital A, grave accent
- Aring => chr(197), # capital A, ring
- Atilde => chr(195), # capital A, tilde
- Auml => chr(196), # capital A, dieresis or umlaut mark
- Ccedil => chr(199), # capital C, cedilla
- ETH => chr(208), # capital Eth, Icelandic
- Eacute => chr(201), # capital E, acute accent
- Ecirc => chr(202), # capital E, circumflex accent
- Egrave => chr(200), # capital E, grave accent
- Euml => chr(203), # capital E, dieresis or umlaut mark
- Iacute => chr(205), # capital I, acute accent
- Icirc => chr(206), # capital I, circumflex accent
- Igrave => chr(204), # capital I, grave accent
- Iuml => chr(207), # capital I, dieresis or umlaut mark
- Ntilde => chr(209), # capital N, tilde
- Oacute => chr(211), # capital O, acute accent
- Ocirc => chr(212), # capital O, circumflex accent
- Ograve => chr(210), # capital O, grave accent
- Oslash => chr(216), # capital O, slash
- Otilde => chr(213), # capital O, tilde
- Ouml => chr(214), # capital O, dieresis or umlaut mark
- THORN => chr(222), # capital THORN, Icelandic
- Uacute => chr(218), # capital U, acute accent
- Ucirc => chr(219), # capital U, circumflex accent
- Ugrave => chr(217), # capital U, grave accent
- Uuml => chr(220), # capital U, dieresis or umlaut mark
- Yacute => chr(221), # capital Y, acute accent
- aacute => chr(225), # small a, acute accent
- acirc => chr(226), # small a, circumflex accent
- aelig => chr(230), # small ae diphthong (ligature)
- agrave => chr(224), # small a, grave accent
- aring => chr(229), # small a, ring
- atilde => chr(227), # small a, tilde
- auml => chr(228), # small a, dieresis or umlaut mark
- ccedil => chr(231), # small c, cedilla
- eacute => chr(233), # small e, acute accent
- ecirc => chr(234), # small e, circumflex accent
- egrave => chr(232), # small e, grave accent
- eth => chr(240), # small eth, Icelandic
- euml => chr(235), # small e, dieresis or umlaut mark
- iacute => chr(237), # small i, acute accent
- icirc => chr(238), # small i, circumflex accent
- igrave => chr(236), # small i, grave accent
- iuml => chr(239), # small i, dieresis or umlaut mark
- ntilde => chr(241), # small n, tilde
- oacute => chr(243), # small o, acute accent
- ocirc => chr(244), # small o, circumflex accent
- ograve => chr(242), # small o, grave accent
- oslash => chr(248), # small o, slash
- otilde => chr(245), # small o, tilde
- ouml => chr(246), # small o, dieresis or umlaut mark
- szlig => chr(223), # small sharp s, German (sz ligature)
- thorn => chr(254), # small thorn, Icelandic
- uacute => chr(250), # small u, acute accent
- ucirc => chr(251), # small u, circumflex accent
- ugrave => chr(249), # small u, grave accent
- uuml => chr(252), # small u, dieresis or umlaut mark
- yacute => chr(253), # small y, acute accent
- yuml => chr(255), # small y, dieresis or umlaut mark
-
- # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
- copy => chr(169), # copyright sign
- reg => chr(174), # registered sign
- nbsp => chr(160), # non breaking space
-
- # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
- 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), # not is a keyword in perl
- 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), # times is a keyword in perl
- divide => chr(247),
-
- ( $] > 5.007 ? (
- '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),
- ) : ())
-);
-
-
-# Make the opposite mapping
-while (my($entity, $char) = each(%entity2char)) {
- $entity =~ s/;\z//;
- $char2entity{$char} = "&$entity;";
-}
-delete $char2entity{"'"}; # only one-way decoding
-
-# Fill in missing entities
-for (0 .. 255) {
- next if exists $char2entity{chr($_)};
- $char2entity{chr($_)} = "&#$_;";
-}
-
-my %subst; # compiled encoding regexps
-
-sub decode_entities_old
-{
- my $array;
- if (defined wantarray) {
- $array = [@_]; # copy
- } else {
- $array = \@_; # modify in-place
- }
- my $c;
- for (@$array) {
- s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
- s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
- s/(&(\w+);?)/$entity2char{$2} || $1/eg;
- }
- wantarray ? @$array : $array->[0];
-}
-
-sub encode_entities
-{
- return undef unless defined $_[0];
- my $ref;
- if (defined wantarray) {
- my $x = $_[0];
- $ref = \$x; # copy
- } else {
- $ref = \$_[0]; # modify in-place
- }
- if (defined $_[1] and length $_[1]) {
- unless (exists $subst{$_[1]}) {
- # Because we can't compile regex we fake it with a cached sub
- my $chars = $_[1];
- $chars =~ s,(?<!\\)([]/]),\\$1,g;
- $chars =~ s,(?<!\\)\\\z,\\\\,;
- my $code = "sub {\$_[0] =~ s/([$chars])/\$char2entity{\$1} || num_entity(\$1)/ge; }";
- $subst{$_[1]} = eval $code;
- die( $@ . " while trying to turn range: \"$_[1]\"\n "
- . "into code: $code\n "
- ) if $@;
- }
- &{$subst{$_[1]}}($$ref);
- } else {
- # Encode control chars, high bit chars and '<', '&', '>', ''' and '"'
- $$ref =~ s/([^\n\r\t !\#\$%\(-;=?-~])/$char2entity{$1} || num_entity($1)/ge;
- }
- $$ref;
-}
-
-sub encode_entities_numeric {
- local %char2entity;
- return &encode_entities; # a goto &encode_entities wouldn't work
-}
-
-
-sub num_entity {
- sprintf "&#x%X;", ord($_[0]);
-}
-
-# Set up aliases
-*encode = \&encode_entities;
-*encode_numeric = \&encode_entities_numeric;
-*encode_numerically = \&encode_entities_numeric;
-*decode = \&decode_entities;
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/HTML/Filter.pm b/Master/tlpkg/tlperl/lib/HTML/Filter.pm
deleted file mode 100755
index c5aa16e6dd8..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/Filter.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-package HTML::Filter;
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-require HTML::Parser;
-@ISA=qw(HTML::Parser);
-
-$VERSION = "3.57";
-
-sub declaration { $_[0]->output("<!$_[1]>") }
-sub process { $_[0]->output($_[2]) }
-sub comment { $_[0]->output("<!--$_[1]-->") }
-sub start { $_[0]->output($_[4]) }
-sub end { $_[0]->output($_[2]) }
-sub text { $_[0]->output($_[1]) }
-
-sub output { print $_[1] }
-
-1;
-
-__END__
-
-=head1 NAME
-
-HTML::Filter - Filter HTML text through the parser
-
-=head1 NOTE
-
-B<This module is deprecated.> The C<HTML::Parser> now provides the
-functionally of C<HTML::Filter> much more efficiently with the the
-C<default> handler.
-
-=head1 SYNOPSIS
-
- require HTML::Filter;
- $p = HTML::Filter->new->parse_file("index.html");
-
-=head1 DESCRIPTION
-
-C<HTML::Filter> is an HTML parser that by default prints the
-original text of each HTML element (a slow version of cat(1) basically).
-The callback methods may be overridden to modify the filtering for some
-HTML elements and you can override output() method which is called to
-print the HTML text.
-
-C<HTML::Filter> is a subclass of C<HTML::Parser>. This means that
-the document should be given to the parser by calling the $p->parse()
-or $p->parse_file() methods.
-
-=head1 EXAMPLES
-
-The first example is a filter that will remove all comments from an
-HTML file. This is achieved by simply overriding the comment method
-to do nothing.
-
- package CommentStripper;
- require HTML::Filter;
- @ISA=qw(HTML::Filter);
- sub comment { } # ignore comments
-
-The second example shows a filter that will remove any E<lt>TABLE>s
-found in the HTML file. We specialize the start() and end() methods
-to count table tags and then make output not happen when inside a
-table.
-
- package TableStripper;
- require HTML::Filter;
- @ISA=qw(HTML::Filter);
- sub start
- {
- my $self = shift;
- $self->{table_seen}++ if $_[0] eq "table";
- $self->SUPER::start(@_);
- }
-
- sub end
- {
- my $self = shift;
- $self->SUPER::end(@_);
- $self->{table_seen}-- if $_[0] eq "table";
- }
-
- sub output
- {
- my $self = shift;
- unless ($self->{table_seen}) {
- $self->SUPER::output(@_);
- }
- }
-
-If you want to collect the parsed text internally you might want to do
-something like this:
-
- package FilterIntoString;
- require HTML::Filter;
- @ISA=qw(HTML::Filter);
- sub output { push(@{$_[0]->{fhtml}}, $_[1]) }
- sub filtered_html { join("", @{$_[0]->{fhtml}}) }
-
-=head1 SEE ALSO
-
-L<HTML::Parser>
-
-=head1 COPYRIGHT
-
-Copyright 1997-1999 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/HTML/Form.pm b/Master/tlpkg/tlperl/lib/HTML/Form.pm
deleted file mode 100755
index bbbd7771716..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/Form.pm
+++ /dev/null
@@ -1,1551 +0,0 @@
-package HTML::Form;
-
-use strict;
-use URI;
-use Carp ();
-
-use vars qw($VERSION $Encode_available);
-$VERSION = "5.829";
-
-eval { require Encode };
-$Encode_available = !$@;
-
-my %form_tags = map {$_ => 1} qw(input textarea button select option);
-
-my %type2class = (
- text => "TextInput",
- password => "TextInput",
- hidden => "TextInput",
- textarea => "TextInput",
-
- "reset" => "IgnoreInput",
-
- radio => "ListInput",
- checkbox => "ListInput",
- option => "ListInput",
-
- button => "SubmitInput",
- submit => "SubmitInput",
- image => "ImageInput",
- file => "FileInput",
-
- keygen => "KeygenInput",
-);
-
-=head1 NAME
-
-HTML::Form - Class that represents an HTML form element
-
-=head1 SYNOPSIS
-
- use HTML::Form;
- $form = HTML::Form->parse($html, $base_uri);
- $form->value(query => "Perl");
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
- $response = $ua->request($form->click);
-
-=head1 DESCRIPTION
-
-Objects of the C<HTML::Form> class represents a single HTML
-C<E<lt>formE<gt> ... E<lt>/formE<gt>> instance. A form consists of a
-sequence of inputs that usually have names, and which can take on
-various values. The state of a form can be tweaked and it can then be
-asked to provide C<HTTP::Request> objects that can be passed to the
-request() method of C<LWP::UserAgent>.
-
-The following methods are available:
-
-=over 4
-
-=item @forms = HTML::Form->parse( $html_document, $base_uri )
-
-=item @forms = HTML::Form->parse( $html_document, base => $base_uri, %opt )
-
-=item @forms = HTML::Form->parse( $response, %opt )
-
-The parse() class method will parse an HTML document and build up
-C<HTML::Form> objects for each <form> element found. If called in scalar
-context only returns the first <form>. Returns an empty list if there
-are no forms to be found.
-
-The required arguments is the HTML document to parse ($html_document) and the
-URI used to retrieve the document ($base_uri). The base URI is needed to resolve
-relative action URIs. The provided HTML document should be a Unicode string
-(or US-ASCII).
-
-By default HTML::Form assumes that the original document was UTF-8 encoded and
-thus encode forms that don't specify an explict I<accept-charset> as UTF-8.
-The charset assumed can be overridden by providing the C<charset> option to
-parse(). It's a good idea to be explict about this parameter as well, thus
-the recommended simplest invocation becomes:
-
- my @forms = HTML::Form->parse(
- Encode::decode($encoding, $html_document_bytes),
- base => $base_uri,
- charset => $encoding,
- );
-
-If the document was retrieved with LWP then the response object provide methods
-to obtain a proper value for C<base> and C<charset>:
-
- my $ua = LWP::UserAgent->new;
- my $response = $ua->get("http://www.example.com/form.html");
- my @forms = HTML::Form->parse($response->decoded_content,
- base => $response->base,
- charset => $response->content_charset,
- );
-
-In fact, the parse() method can parse from an C<HTTP::Response> object
-directly, so the example above can be more conveniently written as:
-
- my $ua = LWP::UserAgent->new;
- my $response = $ua->get("http://www.example.com/form.html");
- my @forms = HTML::Form->parse($response);
-
-Note that any object that implements a decoded_content(), base() and
-content_charset() method with similar behaviour as C<HTTP::Response> will do.
-
-Additional options might be passed in to control how the parse method
-behaves. The following are all the options currently recognized:
-
-=over
-
-=item C<< base => $uri >>
-
-This is the URI used to retrive the original document. This option is not optional ;-)
-
-=item C<< charset => $str >>
-
-Specify what charset the original document was encoded in. This is used as
-the default for accept_charset. If not provided this defaults to "UTF-8".
-
-=item C<< verbose => $bool >>
-
-Warn (print messages to STDERR) about any bad HTML form constructs found.
-You can trap these with $SIG{__WARN__}.
-
-=item C<< strict => $bool >>
-
-Initialize any form objects with the given strict attribute.
-
-=back
-
-=cut
-
-sub parse
-{
- my $class = shift;
- my $html = shift;
- unshift(@_, "base") if @_ == 1;
- my %opt = @_;
-
- require HTML::TokeParser;
- my $p = HTML::TokeParser->new(ref($html) ? $html->decoded_content(ref => 1) : \$html);
- die "Failed to create HTML::TokeParser object" unless $p;
-
- my $base_uri = delete $opt{base};
- my $charset = delete $opt{charset};
- my $strict = delete $opt{strict};
- my $verbose = delete $opt{verbose};
-
- if ($^W) {
- Carp::carp("Unrecognized option $_ in HTML::Form->parse") for sort keys %opt;
- }
-
- unless (defined $base_uri) {
- if (ref($html)) {
- $base_uri = $html->base;
- }
- else {
- Carp::croak("HTML::Form::parse: No \$base_uri provided");
- }
- }
- unless (defined $charset) {
- if (ref($html) and $html->can("content_charset")) {
- $charset = $html->content_charset;
- }
- unless ($charset) {
- $charset = "UTF-8";
- }
- }
-
- my @forms;
- my $f; # current form
-
- my %openselect; # index to the open instance of a select
-
- while (my $t = $p->get_tag) {
- my($tag,$attr) = @$t;
- if ($tag eq "form") {
- my $action = delete $attr->{'action'};
- $action = "" unless defined $action;
- $action = URI->new_abs($action, $base_uri);
- $f = $class->new($attr->{'method'},
- $action,
- $attr->{'enctype'});
- $f->accept_charset($attr->{'accept-charset'}) if $attr->{'accept-charset'};
- $f->{default_charset} = $charset;
- $f->{attr} = $attr;
- $f->strict(1) if $strict;
- %openselect = ();
- push(@forms, $f);
- my(%labels, $current_label);
- while (my $t = $p->get_tag) {
- my($tag, $attr) = @$t;
- last if $tag eq "/form";
-
- # if we are inside a label tag, then keep
- # appending any text to the current label
- if(defined $current_label) {
- $current_label = join " ",
- grep { defined and length }
- $current_label,
- $p->get_phrase;
- }
-
- if ($tag eq "input") {
- $attr->{value_name} =
- exists $attr->{id} && exists $labels{$attr->{id}} ? $labels{$attr->{id}} :
- defined $current_label ? $current_label :
- $p->get_phrase;
- }
-
- if ($tag eq "label") {
- $current_label = $p->get_phrase;
- $labels{ $attr->{for} } = $current_label
- if exists $attr->{for};
- }
- elsif ($tag eq "/label") {
- $current_label = undef;
- }
- elsif ($tag eq "input") {
- my $type = delete $attr->{type} || "text";
- $f->push_input($type, $attr, $verbose);
- }
- elsif ($tag eq "button") {
- my $type = delete $attr->{type} || "submit";
- $f->push_input($type, $attr, $verbose);
- }
- elsif ($tag eq "textarea") {
- $attr->{textarea_value} = $attr->{value}
- if exists $attr->{value};
- my $text = $p->get_text("/textarea");
- $attr->{value} = $text;
- $f->push_input("textarea", $attr, $verbose);
- }
- elsif ($tag eq "select") {
- # rename attributes reserved to come for the option tag
- for ("value", "value_name") {
- $attr->{"select_$_"} = delete $attr->{$_}
- if exists $attr->{$_};
- }
- # count this new select option separately
- my $name = $attr->{name};
- $name = "" unless defined $name;
- $openselect{$name}++;
-
- while ($t = $p->get_tag) {
- my $tag = shift @$t;
- last if $tag eq "/select";
- next if $tag =~ m,/?optgroup,;
- next if $tag eq "/option";
- if ($tag eq "option") {
- my %a = %{$t->[0]};
- # rename keys so they don't clash with %attr
- for (keys %a) {
- next if $_ eq "value";
- $a{"option_$_"} = delete $a{$_};
- }
- while (my($k,$v) = each %$attr) {
- $a{$k} = $v;
- }
- $a{value_name} = $p->get_trimmed_text;
- $a{value} = delete $a{value_name}
- unless defined $a{value};
- $a{idx} = $openselect{$name};
- $f->push_input("option", \%a, $verbose);
- }
- else {
- warn("Bad <select> tag '$tag' in $base_uri\n") if $verbose;
- if ($tag eq "/form" ||
- $tag eq "input" ||
- $tag eq "textarea" ||
- $tag eq "select" ||
- $tag eq "keygen")
- {
- # MSIE implictly terminate the <select> here, so we
- # try to do the same. Actually the MSIE behaviour
- # appears really strange: <input> and <textarea>
- # do implictly close, but not <select>, <keygen> or
- # </form>.
- my $type = ($tag =~ s,^/,,) ? "E" : "S";
- $p->unget_token([$type, $tag, @$t]);
- last;
- }
- }
- }
- }
- elsif ($tag eq "keygen") {
- $f->push_input("keygen", $attr, $verbose);
- }
- }
- }
- elsif ($form_tags{$tag}) {
- warn("<$tag> outside <form> in $base_uri\n") if $verbose;
- }
- }
- for (@forms) {
- $_->fixup;
- }
-
- wantarray ? @forms : $forms[0];
-}
-
-sub new {
- my $class = shift;
- my $self = bless {}, $class;
- $self->{method} = uc(shift || "GET");
- $self->{action} = shift || Carp::croak("No action defined");
- $self->{enctype} = lc(shift || "application/x-www-form-urlencoded");
- $self->{accept_charset} = "UNKNOWN";
- $self->{default_charset} = "UTF-8";
- $self->{inputs} = [@_];
- $self;
-}
-
-
-sub push_input
-{
- my($self, $type, $attr, $verbose) = @_;
- $type = lc $type;
- my $class = $type2class{$type};
- unless ($class) {
- Carp::carp("Unknown input type '$type'") if $verbose;
- $class = "TextInput";
- }
- $class = "HTML::Form::$class";
- my @extra;
- push(@extra, readonly => 1) if $type eq "hidden";
- push(@extra, strict => 1) if $self->{strict};
- if ($type eq "file" && exists $attr->{value}) {
- # it's not safe to trust the value set by the server
- # the user always need to explictly set the names of files to upload
- $attr->{orig_value} = delete $attr->{value};
- }
- delete $attr->{type}; # don't confuse the type argument
- my $input = $class->new(type => $type, %$attr, @extra);
- $input->add_to_form($self);
-}
-
-
-=item $method = $form->method
-
-=item $form->method( $new_method )
-
-This method is gets/sets the I<method> name used for the
-C<HTTP::Request> generated. It is a string like "GET" or "POST".
-
-=item $action = $form->action
-
-=item $form->action( $new_action )
-
-This method gets/sets the URI which we want to apply the request
-I<method> to.
-
-=item $enctype = $form->enctype
-
-=item $form->enctype( $new_enctype )
-
-This method gets/sets the encoding type for the form data. It is a
-string like "application/x-www-form-urlencoded" or "multipart/form-data".
-
-=item $accept = $form->accept_charset
-
-=item $form->accept_charset( $new_accept )
-
-This method gets/sets the list of charset encodings that the server processing
-the form accepts. Current implementation supports only one-element lists.
-Default value is "UNKNOWN" which we interpret as a request to use document
-charset as specified by the 'charset' parameter of the parse() method. To
-encode character strings you should have modern perl with Encode module. On
-older perls the setting of this attribute has no effect.
-
-=cut
-
-BEGIN {
- # Set up some accesor
- for (qw(method action enctype accept_charset)) {
- my $m = $_;
- no strict 'refs';
- *{$m} = sub {
- my $self = shift;
- my $old = $self->{$m};
- $self->{$m} = shift if @_;
- $old;
- };
- }
- *uri = \&action; # alias
-}
-
-=item $value = $form->attr( $name )
-
-=item $form->attr( $name, $new_value )
-
-This method give access to the original HTML attributes of the <form> tag.
-The $name should always be passed in lower case.
-
-Example:
-
- @f = HTML::Form->parse( $html, $foo );
- @f = grep $_->attr("id") eq "foo", @f;
- die "No form named 'foo' found" unless @f;
- $foo = shift @f;
-
-=cut
-
-sub attr {
- my $self = shift;
- my $name = shift;
- return undef unless defined $name;
-
- my $old = $self->{attr}{$name};
- $self->{attr}{$name} = shift if @_;
- return $old;
-}
-
-=item $bool = $form->strict
-
-=item $form->strict( $bool )
-
-Gets/sets the strict attribute of a form. If the strict is turned on
-the methods that change values of the form will croak if you try to
-set illegal values or modify readonly fields. The default is not to be strict.
-
-=cut
-
-sub strict {
- my $self = shift;
- my $old = $self->{strict};
- if (@_) {
- $self->{strict} = shift;
- for my $input (@{$self->{inputs}}) {
- $input->strict($self->{strict});
- }
- }
- return $old;
-}
-
-
-=item @inputs = $form->inputs
-
-This method returns the list of inputs in the form. If called in
-scalar context it returns the number of inputs contained in the form.
-See L</INPUTS> for what methods are available for the input objects
-returned.
-
-=cut
-
-sub inputs
-{
- my $self = shift;
- @{$self->{'inputs'}};
-}
-
-
-=item $input = $form->find_input( $selector )
-
-=item $input = $form->find_input( $selector, $type )
-
-=item $input = $form->find_input( $selector, $type, $index )
-
-This method is used to locate specific inputs within the form. All
-inputs that match the arguments given are returned. In scalar context
-only the first is returned, or C<undef> if none match.
-
-If $selector is specified, then the input's name, id, class attribute must
-match. A selector prefixed with '#' must match the id attribute of the input.
-A selector prefixed with '.' matches the class attribute. A selector prefixed
-with '^' or with no prefix matches the name attribute.
-
-If $type is specified, then the input must have the specified type.
-The following type names are used: "text", "password", "hidden",
-"textarea", "file", "image", "submit", "radio", "checkbox" and "option".
-
-The $index is the sequence number of the input matched where 1 is the
-first. If combined with $name and/or $type then it select the I<n>th
-input with the given name and/or type.
-
-=cut
-
-sub find_input
-{
- my($self, $name, $type, $no) = @_;
- if (wantarray) {
- my @res;
- my $c;
- for (@{$self->{'inputs'}}) {
- next if defined($name) && !$_->selected($name);
- next if $type && $type ne $_->{type};
- $c++;
- next if $no && $no != $c;
- push(@res, $_);
- }
- return @res;
-
- }
- else {
- $no ||= 1;
- for (@{$self->{'inputs'}}) {
- next if defined($name) && !$_->selected($name);
- next if $type && $type ne $_->{type};
- next if --$no;
- return $_;
- }
- return undef;
- }
-}
-
-sub fixup
-{
- my $self = shift;
- for (@{$self->{'inputs'}}) {
- $_->fixup;
- }
-}
-
-
-=item $value = $form->value( $selector )
-
-=item $form->value( $selector, $new_value )
-
-The value() method can be used to get/set the value of some input. If
-strict is enabled and no input has the indicated name, then this method will croak.
-
-If multiple inputs have the same name, only the first one will be
-affected.
-
-The call:
-
- $form->value('foo')
-
-is basically a short-hand for:
-
- $form->find_input('foo')->value;
-
-=cut
-
-sub value
-{
- my $self = shift;
- my $key = shift;
- my $input = $self->find_input($key);
- unless ($input) {
- Carp::croak("No such field '$key'") if $self->{strict};
- return undef unless @_;
- $input = $self->push_input("text", { name => $key, value => "" });
- }
- local $Carp::CarpLevel = 1;
- $input->value(@_);
-}
-
-=item @names = $form->param
-
-=item @values = $form->param( $name )
-
-=item $form->param( $name, $value, ... )
-
-=item $form->param( $name, \@values )
-
-Alternative interface to examining and setting the values of the form.
-
-If called without arguments then it returns the names of all the
-inputs in the form. The names will not repeat even if multiple inputs
-have the same name. In scalar context the number of different names
-is returned.
-
-If called with a single argument then it returns the value or values
-of inputs with the given name. If called in scalar context only the
-first value is returned. If no input exists with the given name, then
-C<undef> is returned.
-
-If called with 2 or more arguments then it will set values of the
-named inputs. This form will croak if no inputs have the given name
-or if any of the values provided does not fit. Values can also be
-provided as a reference to an array. This form will allow unsetting
-all values with the given name as well.
-
-This interface resembles that of the param() function of the CGI
-module.
-
-=cut
-
-sub param {
- my $self = shift;
- if (@_) {
- my $name = shift;
- my @inputs;
- for ($self->inputs) {
- my $n = $_->name;
- next if !defined($n) || $n ne $name;
- push(@inputs, $_);
- }
-
- if (@_) {
- # set
- die "No '$name' parameter exists" unless @inputs;
- my @v = @_;
- @v = @{$v[0]} if @v == 1 && ref($v[0]);
- while (@v) {
- my $v = shift @v;
- my $err;
- for my $i (0 .. @inputs-1) {
- eval {
- $inputs[$i]->value($v);
- };
- unless ($@) {
- undef($err);
- splice(@inputs, $i, 1);
- last;
- }
- $err ||= $@;
- }
- die $err if $err;
- }
-
- # the rest of the input should be cleared
- for (@inputs) {
- $_->value(undef);
- }
- }
- else {
- # get
- my @v;
- for (@inputs) {
- if (defined(my $v = $_->value)) {
- push(@v, $v);
- }
- }
- return wantarray ? @v : $v[0];
- }
- }
- else {
- # list parameter names
- my @n;
- my %seen;
- for ($self->inputs) {
- my $n = $_->name;
- next if !defined($n) || $seen{$n}++;
- push(@n, $n);
- }
- return @n;
- }
-}
-
-
-=item $form->try_others( \&callback )
-
-This method will iterate over all permutations of unvisited enumerated
-values (<select>, <radio>, <checkbox>) and invoke the callback for
-each. The callback is passed the $form as argument. The return value
-from the callback is ignored and the try_others() method itself does
-not return anything.
-
-=cut
-
-sub try_others
-{
- my($self, $cb) = @_;
- my @try;
- for (@{$self->{'inputs'}}) {
- my @not_tried_yet = $_->other_possible_values;
- next unless @not_tried_yet;
- push(@try, [\@not_tried_yet, $_]);
- }
- return unless @try;
- $self->_try($cb, \@try, 0);
-}
-
-sub _try
-{
- my($self, $cb, $try, $i) = @_;
- for (@{$try->[$i][0]}) {
- $try->[$i][1]->value($_);
- &$cb($self);
- $self->_try($cb, $try, $i+1) if $i+1 < @$try;
- }
-}
-
-
-=item $request = $form->make_request
-
-Will return an C<HTTP::Request> object that reflects the current setting
-of the form. You might want to use the click() method instead.
-
-=cut
-
-sub make_request
-{
- my $self = shift;
- my $method = uc $self->{'method'};
- my $uri = $self->{'action'};
- my $enctype = $self->{'enctype'};
- my @form = $self->form;
-
- my $charset = $self->accept_charset eq "UNKNOWN" ? $self->{default_charset} : $self->accept_charset;
- if ($Encode_available) {
- foreach my $fi (@form) {
- $fi = Encode::encode($charset, $fi) unless ref($fi);
- }
- }
-
- if ($method eq "GET") {
- require HTTP::Request;
- $uri = URI->new($uri, "http");
- $uri->query_form(@form);
- return HTTP::Request->new(GET => $uri);
- }
- elsif ($method eq "POST") {
- require HTTP::Request::Common;
- return HTTP::Request::Common::POST($uri, \@form,
- Content_Type => $enctype);
- }
- else {
- Carp::croak("Unknown method '$method'");
- }
-}
-
-
-=item $request = $form->click
-
-=item $request = $form->click( $selector )
-
-=item $request = $form->click( $x, $y )
-
-=item $request = $form->click( $selector, $x, $y )
-
-Will "click" on the first clickable input (which will be of type
-C<submit> or C<image>). The result of clicking is an C<HTTP::Request>
-object that can then be passed to C<LWP::UserAgent> if you want to
-obtain the server response.
-
-If a $selector is specified, we will click on the first clickable input
-matching the selector, and the method will croak if no matching clickable
-input is found. If $selector is I<not> specified, then it
-is ok if the form contains no clickable inputs. In this case the
-click() method returns the same request as the make_request() method
-would do. See description of the find_input() method above for how
-the $selector is specified.
-
-If there are multiple clickable inputs with the same name, then there
-is no way to get the click() method of the C<HTML::Form> to click on
-any but the first. If you need this you would have to locate the
-input with find_input() and invoke the click() method on the given
-input yourself.
-
-A click coordinate pair can also be provided, but this only makes a
-difference if you clicked on an image. The default coordinate is
-(1,1). The upper-left corner of the image is (0,0), but some badly
-coded CGI scripts are known to not recognize this. Therefore (1,1) was
-selected as a safer default.
-
-=cut
-
-sub click
-{
- my $self = shift;
- my $name;
- $name = shift if (@_ % 2) == 1; # odd number of arguments
-
- # try to find first submit button to activate
- for (@{$self->{'inputs'}}) {
- next unless $_->can("click");
- next if $name && !$_->selected($name);
- next if $_->disabled;
- return $_->click($self, @_);
- }
- Carp::croak("No clickable input with name $name") if $name;
- $self->make_request;
-}
-
-
-=item @kw = $form->form
-
-Returns the current setting as a sequence of key/value pairs. Note
-that keys might be repeated, which means that some values might be
-lost if the return values are assigned to a hash.
-
-In scalar context this method returns the number of key/value pairs
-generated.
-
-=cut
-
-sub form
-{
- my $self = shift;
- map { $_->form_name_value($self) } @{$self->{'inputs'}};
-}
-
-
-=item $form->dump
-
-Returns a textual representation of current state of the form. Mainly
-useful for debugging. If called in void context, then the dump is
-printed on STDERR.
-
-=cut
-
-sub dump
-{
- my $self = shift;
- my $method = $self->{'method'};
- my $uri = $self->{'action'};
- my $enctype = $self->{'enctype'};
- my $dump = "$method $uri";
- $dump .= " ($enctype)"
- if $enctype ne "application/x-www-form-urlencoded";
- $dump .= " [$self->{attr}{name}]"
- if exists $self->{attr}{name};
- $dump .= "\n";
- for ($self->inputs) {
- $dump .= " " . $_->dump . "\n";
- }
- print STDERR $dump unless defined wantarray;
- $dump;
-}
-
-
-#---------------------------------------------------
-package HTML::Form::Input;
-
-=back
-
-=head1 INPUTS
-
-An C<HTML::Form> objects contains a sequence of I<inputs>. References to
-the inputs can be obtained with the $form->inputs or $form->find_input
-methods.
-
-Note that there is I<not> a one-to-one correspondence between input
-I<objects> and E<lt>inputE<gt> I<elements> in the HTML document. An
-input object basically represents a name/value pair, so when multiple
-HTML elements contribute to the same name/value pair in the submitted
-form they are combined.
-
-The input elements that are mapped one-to-one are "text", "textarea",
-"password", "hidden", "file", "image", "submit" and "checkbox". For
-the "radio" and "option" inputs the story is not as simple: All
-E<lt>input type="radio"E<gt> elements with the same name will
-contribute to the same input radio object. The number of radio input
-objects will be the same as the number of distinct names used for the
-E<lt>input type="radio"E<gt> elements. For a E<lt>selectE<gt> element
-without the C<multiple> attribute there will be one input object of
-type of "option". For a E<lt>select multipleE<gt> element there will
-be one input object for each contained E<lt>optionE<gt> element. Each
-one of these option objects will have the same name.
-
-The following methods are available for the I<input> objects:
-
-=over 4
-
-=cut
-
-sub new
-{
- my $class = shift;
- my $self = bless {@_}, $class;
- $self;
-}
-
-sub add_to_form
-{
- my($self, $form) = @_;
- push(@{$form->{'inputs'}}, $self);
- $self;
-}
-
-sub strict {
- my $self = shift;
- my $old = $self->{strict};
- if (@_) {
- $self->{strict} = shift;
- }
- $old;
-}
-
-sub fixup {}
-
-
-=item $input->type
-
-Returns the type of this input. The type is one of the following
-strings: "text", "password", "hidden", "textarea", "file", "image", "submit",
-"radio", "checkbox" or "option".
-
-=cut
-
-sub type
-{
- shift->{type};
-}
-
-=item $name = $input->name
-
-=item $input->name( $new_name )
-
-This method can be used to get/set the current name of the input.
-
-=item $input->id
-
-=item $input->class
-
-These methods can be used to get/set the current id or class attribute for the input.
-
-=item $input->selected( $selector )
-
-Returns TRUE if the given selector matched the input. See the description of
-the find_input() method above for a description of the selector syntax.
-
-=item $value = $input->value
-
-=item $input->value( $new_value )
-
-This method can be used to get/set the current value of an
-input.
-
-If strict is enabled and the input only can take an enumerated list of values,
-then it is an error to try to set it to something else and the method will
-croak if you try.
-
-You will also be able to set the value of read-only inputs, but a
-warning will be generated if running under C<perl -w>.
-
-=cut
-
-sub name
-{
- my $self = shift;
- my $old = $self->{name};
- $self->{name} = shift if @_;
- $old;
-}
-
-sub id
-{
- my $self = shift;
- my $old = $self->{id};
- $self->{id} = shift if @_;
- $old;
-}
-
-sub class
-{
- my $self = shift;
- my $old = $self->{class};
- $self->{class} = shift if @_;
- $old;
-}
-
-sub selected {
- my($self, $sel) = @_;
- return undef unless defined $sel;
- my $attr =
- $sel =~ s/^\^// ? "name" :
- $sel =~ s/^#// ? "id" :
- $sel =~ s/^\.// ? "class" :
- "name";
- return 0 unless defined $self->{$attr};
- return $self->{$attr} eq $sel;
-}
-
-sub value
-{
- my $self = shift;
- my $old = $self->{value};
- $self->{value} = shift if @_;
- $old;
-}
-
-=item $input->possible_values
-
-Returns a list of all values that an input can take. For inputs that
-do not have discrete values, this returns an empty list.
-
-=cut
-
-sub possible_values
-{
- return;
-}
-
-=item $input->other_possible_values
-
-Returns a list of all values not tried yet.
-
-=cut
-
-sub other_possible_values
-{
- return;
-}
-
-=item $input->value_names
-
-For some inputs the values can have names that are different from the
-values themselves. The number of names returned by this method will
-match the number of values reported by $input->possible_values.
-
-When setting values using the value() method it is also possible to
-use the value names in place of the value itself.
-
-=cut
-
-sub value_names {
- return
-}
-
-=item $bool = $input->readonly
-
-=item $input->readonly( $bool )
-
-This method is used to get/set the value of the readonly attribute.
-You are allowed to modify the value of readonly inputs, but setting
-the value will generate some noise when warnings are enabled. Hidden
-fields always start out readonly.
-
-=cut
-
-sub readonly {
- my $self = shift;
- my $old = $self->{readonly};
- $self->{readonly} = shift if @_;
- $old;
-}
-
-=item $bool = $input->disabled
-
-=item $input->disabled( $bool )
-
-This method is used to get/set the value of the disabled attribute.
-Disabled inputs do not contribute any key/value pairs for the form
-value.
-
-=cut
-
-sub disabled {
- my $self = shift;
- my $old = $self->{disabled};
- $self->{disabled} = shift if @_;
- $old;
-}
-
-=item $input->form_name_value
-
-Returns a (possible empty) list of key/value pairs that should be
-incorporated in the form value from this input.
-
-=cut
-
-sub form_name_value
-{
- my $self = shift;
- my $name = $self->{'name'};
- return unless defined $name;
- return if $self->disabled;
- my $value = $self->value;
- return unless defined $value;
- return ($name => $value);
-}
-
-sub dump
-{
- my $self = shift;
- my $name = $self->name;
- $name = "<NONAME>" unless defined $name;
- my $value = $self->value;
- $value = "<UNDEF>" unless defined $value;
- my $dump = "$name=$value";
-
- my $type = $self->type;
-
- $type .= " disabled" if $self->disabled;
- $type .= " readonly" if $self->readonly;
- return sprintf "%-30s %s", $dump, "($type)" unless $self->{menu};
-
- my @menu;
- my $i = 0;
- for (@{$self->{menu}}) {
- my $opt = $_->{value};
- $opt = "<UNDEF>" unless defined $opt;
- $opt .= "/$_->{name}"
- if defined $_->{name} && length $_->{name} && $_->{name} ne $opt;
- substr($opt,0,0) = "-" if $_->{disabled};
- if (exists $self->{current} && $self->{current} == $i) {
- substr($opt,0,0) = "!" unless $_->{seen};
- substr($opt,0,0) = "*";
- }
- else {
- substr($opt,0,0) = ":" if $_->{seen};
- }
- push(@menu, $opt);
- $i++;
- }
-
- return sprintf "%-30s %-10s %s", $dump, "($type)", "[" . join("|", @menu) . "]";
-}
-
-
-#---------------------------------------------------
-package HTML::Form::TextInput;
-@HTML::Form::TextInput::ISA=qw(HTML::Form::Input);
-
-#input/text
-#input/password
-#input/hidden
-#textarea
-
-sub value
-{
- my $self = shift;
- my $old = $self->{value};
- $old = "" unless defined $old;
- if (@_) {
- Carp::croak("Input '$self->{name}' is readonly")
- if $self->{strict} && $self->{readonly};
- my $new = shift;
- my $n = exists $self->{maxlength} ? $self->{maxlength} : undef;
- Carp::croak("Input '$self->{name}' has maxlength '$n'")
- if $self->{strict} && defined($n) && defined($new) && length($new) > $n;
- $self->{value} = $new;
- }
- $old;
-}
-
-#---------------------------------------------------
-package HTML::Form::IgnoreInput;
-@HTML::Form::IgnoreInput::ISA=qw(HTML::Form::Input);
-
-#input/button
-#input/reset
-
-sub value { return }
-
-
-#---------------------------------------------------
-package HTML::Form::ListInput;
-@HTML::Form::ListInput::ISA=qw(HTML::Form::Input);
-
-#select/option (val1, val2, ....)
-#input/radio (undef, val1, val2,...)
-#input/checkbox (undef, value)
-#select-multiple/option (undef, value)
-
-sub new
-{
- my $class = shift;
- my $self = $class->SUPER::new(@_);
-
- my $value = delete $self->{value};
- my $value_name = delete $self->{value_name};
- my $type = $self->{type};
-
- if ($type eq "checkbox") {
- $value = "on" unless defined $value;
- $self->{menu} = [
- { value => undef, name => "off", },
- { value => $value, name => $value_name, },
- ];
- $self->{current} = (delete $self->{checked}) ? 1 : 0;
- ;
- }
- else {
- $self->{option_disabled}++
- if $type eq "radio" && delete $self->{disabled};
- $self->{menu} = [
- {value => $value, name => $value_name},
- ];
- my $checked = $self->{checked} || $self->{option_selected};
- delete $self->{checked};
- delete $self->{option_selected};
- if (exists $self->{multiple}) {
- unshift(@{$self->{menu}}, { value => undef, name => "off"});
- $self->{current} = $checked ? 1 : 0;
- }
- else {
- $self->{current} = 0 if $checked;
- }
- }
- $self;
-}
-
-sub add_to_form
-{
- my($self, $form) = @_;
- my $type = $self->type;
-
- return $self->SUPER::add_to_form($form)
- if $type eq "checkbox";
-
- if ($type eq "option" && exists $self->{multiple}) {
- $self->{disabled} ||= delete $self->{option_disabled};
- return $self->SUPER::add_to_form($form);
- }
-
- die "Assert" if @{$self->{menu}} != 1;
- my $m = $self->{menu}[0];
- $m->{disabled}++ if delete $self->{option_disabled};
-
- my $prev = $form->find_input($self->{name}, $self->{type}, $self->{idx});
- return $self->SUPER::add_to_form($form) unless $prev;
-
- # merge menues
- $prev->{current} = @{$prev->{menu}} if exists $self->{current};
- push(@{$prev->{menu}}, $m);
-}
-
-sub fixup
-{
- my $self = shift;
- if ($self->{type} eq "option" && !(exists $self->{current})) {
- $self->{current} = 0;
- }
- $self->{menu}[$self->{current}]{seen}++ if exists $self->{current};
-}
-
-sub disabled
-{
- my $self = shift;
- my $type = $self->type;
-
- my $old = $self->{disabled} || _menu_all_disabled(@{$self->{menu}});
- if (@_) {
- my $v = shift;
- $self->{disabled} = $v;
- for (@{$self->{menu}}) {
- $_->{disabled} = $v;
- }
- }
- return $old;
-}
-
-sub _menu_all_disabled {
- for (@_) {
- return 0 unless $_->{disabled};
- }
- return 1;
-}
-
-sub value
-{
- my $self = shift;
- my $old;
- $old = $self->{menu}[$self->{current}]{value} if exists $self->{current};
- $old = $self->{value} if exists $self->{value};
- if (@_) {
- my $i = 0;
- my $val = shift;
- my $cur;
- my $disabled;
- for (@{$self->{menu}}) {
- if ((defined($val) && defined($_->{value}) && $val eq $_->{value}) ||
- (!defined($val) && !defined($_->{value}))
- )
- {
- $cur = $i;
- $disabled = $_->{disabled};
- last unless $disabled;
- }
- $i++;
- }
- if (!(defined $cur) || $disabled) {
- if (defined $val) {
- # try to search among the alternative names as well
- my $i = 0;
- my $cur_ignorecase;
- my $lc_val = lc($val);
- for (@{$self->{menu}}) {
- if (defined $_->{name}) {
- if ($val eq $_->{name}) {
- $disabled = $_->{disabled};
- $cur = $i;
- last unless $disabled;
- }
- if (!defined($cur_ignorecase) && $lc_val eq lc($_->{name})) {
- $cur_ignorecase = $i;
- }
- }
- $i++;
- }
- unless (defined $cur) {
- $cur = $cur_ignorecase;
- if (defined $cur) {
- $disabled = $self->{menu}[$cur]{disabled};
- }
- elsif ($self->{strict}) {
- my $n = $self->name;
- Carp::croak("Illegal value '$val' for field '$n'");
- }
- }
- }
- elsif ($self->{strict}) {
- my $n = $self->name;
- Carp::croak("The '$n' field can't be unchecked");
- }
- }
- if ($self->{strict} && $disabled) {
- my $n = $self->name;
- Carp::croak("The value '$val' has been disabled for field '$n'");
- }
- if (defined $cur) {
- $self->{current} = $cur;
- $self->{menu}[$cur]{seen}++;
- delete $self->{value};
- }
- else {
- $self->{value} = $val;
- delete $self->{current};
- }
- }
- $old;
-}
-
-=item $input->check
-
-Some input types represent toggles that can be turned on/off. This
-includes "checkbox" and "option" inputs. Calling this method turns
-this input on without having to know the value name. If the input is
-already on, then nothing happens.
-
-This has the same effect as:
-
- $input->value($input->possible_values[1]);
-
-The input can be turned off with:
-
- $input->value(undef);
-
-=cut
-
-sub check
-{
- my $self = shift;
- $self->{current} = 1;
- $self->{menu}[1]{seen}++;
-}
-
-sub possible_values
-{
- my $self = shift;
- map $_->{value}, grep !$_->{disabled}, @{$self->{menu}};
-}
-
-sub other_possible_values
-{
- my $self = shift;
- map $_->{value}, grep !$_->{seen} && !$_->{disabled}, @{$self->{menu}};
-}
-
-sub value_names {
- my $self = shift;
- my @names;
- for (@{$self->{menu}}) {
- my $n = $_->{name};
- $n = $_->{value} unless defined $n;
- push(@names, $n);
- }
- @names;
-}
-
-
-#---------------------------------------------------
-package HTML::Form::SubmitInput;
-@HTML::Form::SubmitInput::ISA=qw(HTML::Form::Input);
-
-#input/image
-#input/submit
-
-=item $input->click($form, $x, $y)
-
-Some input types (currently "submit" buttons and "images") can be
-clicked to submit the form. The click() method returns the
-corresponding C<HTTP::Request> object.
-
-=cut
-
-sub click
-{
- my($self,$form,$x,$y) = @_;
- for ($x, $y) { $_ = 1 unless defined; }
- local($self->{clicked}) = [$x,$y];
- return $form->make_request;
-}
-
-sub form_name_value
-{
- my $self = shift;
- return unless $self->{clicked};
- return $self->SUPER::form_name_value(@_);
-}
-
-
-#---------------------------------------------------
-package HTML::Form::ImageInput;
-@HTML::Form::ImageInput::ISA=qw(HTML::Form::SubmitInput);
-
-sub form_name_value
-{
- my $self = shift;
- my $clicked = $self->{clicked};
- return unless $clicked;
- return if $self->{disabled};
- my $name = $self->{name};
- $name = (defined($name) && length($name)) ? "$name." : "";
- return ("${name}x" => $clicked->[0],
- "${name}y" => $clicked->[1]
- );
-}
-
-#---------------------------------------------------
-package HTML::Form::FileInput;
-@HTML::Form::FileInput::ISA=qw(HTML::Form::TextInput);
-
-=back
-
-If the input is of type C<file>, then it has these additional methods:
-
-=over 4
-
-=item $input->file
-
-This is just an alias for the value() method. It sets the filename to
-read data from.
-
-For security reasons this field will never be initialized from the parsing
-of a form. This prevents the server from triggering stealth uploads of
-arbitrary files from the client machine.
-
-=cut
-
-sub file {
- my $self = shift;
- $self->value(@_);
-}
-
-=item $filename = $input->filename
-
-=item $input->filename( $new_filename )
-
-This get/sets the filename reported to the server during file upload.
-This attribute defaults to the value reported by the file() method.
-
-=cut
-
-sub filename {
- my $self = shift;
- my $old = $self->{filename};
- $self->{filename} = shift if @_;
- $old = $self->file unless defined $old;
- $old;
-}
-
-=item $content = $input->content
-
-=item $input->content( $new_content )
-
-This get/sets the file content provided to the server during file
-upload. This method can be used if you do not want the content to be
-read from an actual file.
-
-=cut
-
-sub content {
- my $self = shift;
- my $old = $self->{content};
- $self->{content} = shift if @_;
- $old;
-}
-
-=item @headers = $input->headers
-
-=item input->headers($key => $value, .... )
-
-This get/set additional header fields describing the file uploaded.
-This can for instance be used to set the C<Content-Type> reported for
-the file.
-
-=cut
-
-sub headers {
- my $self = shift;
- my $old = $self->{headers} || [];
- $self->{headers} = [@_] if @_;
- @$old;
-}
-
-sub form_name_value {
- my($self, $form) = @_;
- return $self->SUPER::form_name_value($form)
- if $form->method ne "POST" ||
- $form->enctype ne "multipart/form-data";
-
- my $name = $self->name;
- return unless defined $name;
- return if $self->{disabled};
-
- my $file = $self->file;
- my $filename = $self->filename;
- my @headers = $self->headers;
- my $content = $self->content;
- if (defined $content) {
- $filename = $file unless defined $filename;
- $file = undef;
- unshift(@headers, "Content" => $content);
- }
- elsif (!defined($file) || length($file) == 0) {
- return;
- }
-
- # legacy (this used to be the way to do it)
- if (ref($file) eq "ARRAY") {
- my $f = shift @$file;
- my $fn = shift @$file;
- push(@headers, @$file);
- $file = $f;
- $filename = $fn unless defined $filename;
- }
-
- return ($name => [$file, $filename, @headers]);
-}
-
-package HTML::Form::KeygenInput;
-@HTML::Form::KeygenInput::ISA=qw(HTML::Form::Input);
-
-sub challenge {
- my $self = shift;
- return $self->{challenge};
-}
-
-sub keytype {
- my $self = shift;
- return lc($self->{keytype} || 'rsa');
-}
-
-1;
-
-__END__
-
-=back
-
-=head1 SEE ALSO
-
-L<LWP>, L<LWP::UserAgent>, L<HTML::Parser>
-
-=head1 COPYRIGHT
-
-Copyright 1998-2008 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/HTML/HeadParser.pm b/Master/tlpkg/tlperl/lib/HTML/HeadParser.pm
deleted file mode 100755
index cb1f3b612a8..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/HeadParser.pm
+++ /dev/null
@@ -1,301 +0,0 @@
-package HTML::HeadParser;
-
-=head1 NAME
-
-HTML::HeadParser - Parse <HEAD> section of a HTML document
-
-=head1 SYNOPSIS
-
- require HTML::HeadParser;
- $p = HTML::HeadParser->new;
- $p->parse($text) and print "not finished";
-
- $p->header('Title') # to access <title>....</title>
- $p->header('Content-Base') # to access <base href="http://...">
- $p->header('Foo') # to access <meta http-equiv="Foo" content="...">
- $p->header('X-Meta-Author') # to access <meta name="author" content="...">
- $p->header('X-Meta-Charset') # to access <meta charset="...">
-
-=head1 DESCRIPTION
-
-The C<HTML::HeadParser> is a specialized (and lightweight)
-C<HTML::Parser> that will only parse the E<lt>HEAD>...E<lt>/HEAD>
-section of an HTML document. The parse() method
-will return a FALSE value as soon as some E<lt>BODY> element or body
-text are found, and should not be called again after this.
-
-Note that the C<HTML::HeadParser> might get confused if raw undecoded
-UTF-8 is passed to the parse() method. Make sure the strings are
-properly decoded before passing them on.
-
-The C<HTML::HeadParser> keeps a reference to a header object, and the
-parser will update this header object as the various elements of the
-E<lt>HEAD> section of the HTML document are recognized. The following
-header fields are affected:
-
-=over 4
-
-=item Content-Base:
-
-The I<Content-Base> header is initialized from the E<lt>base
-href="..."> element.
-
-=item Title:
-
-The I<Title> header is initialized from the E<lt>title>...E<lt>/title>
-element.
-
-=item Isindex:
-
-The I<Isindex> header will be added if there is a E<lt>isindex>
-element in the E<lt>head>. The header value is initialized from the
-I<prompt> attribute if it is present. If no I<prompt> attribute is
-given it will have '?' as the value.
-
-=item X-Meta-Foo:
-
-All E<lt>meta> elements containing a C<name> attribute will result in
-headers using the prefix C<X-Meta-> appended with the value of the
-C<name> attribute as the name of the header, and the value of the
-C<content> attribute as the pushed header value.
-
-E<lt>meta> elements containing a C<http-equiv> attribute will result
-in headers as in above, but without the C<X-Meta-> prefix in the
-header name.
-
-E<lt>meta> elements containing a C<charset> attribute will result in
-an C<X-Meta-Charset> header, using the value of the C<charset>
-attribute as the pushed header value.
-
-=back
-
-=head1 METHODS
-
-The following methods (in addition to those provided by the
-superclass) are available:
-
-=over 4
-
-=cut
-
-
-require HTML::Parser;
-@ISA = qw(HTML::Parser);
-
-use HTML::Entities ();
-
-use strict;
-use vars qw($VERSION $DEBUG);
-#$DEBUG = 1;
-$VERSION = "3.62";
-
-=item $hp = HTML::HeadParser->new
-
-=item $hp = HTML::HeadParser->new( $header )
-
-The object constructor. The optional $header argument should be a
-reference to an object that implement the header() and push_header()
-methods as defined by the C<HTTP::Headers> class. Normally it will be
-of some class that is a or delegates to the C<HTTP::Headers> class.
-
-If no $header is given C<HTML::HeadParser> will create an
-C<HTTP::Headers> object by itself (initially empty).
-
-=cut
-
-sub new
-{
- my($class, $header) = @_;
- unless ($header) {
- require HTTP::Headers;
- $header = HTTP::Headers->new;
- }
-
- my $self = $class->SUPER::new(api_version => 3,
- start_h => ["start", "self,tagname,attr"],
- end_h => ["end", "self,tagname"],
- text_h => ["text", "self,text"],
- ignore_elements => [qw(script style)],
- );
- $self->{'header'} = $header;
- $self->{'tag'} = ''; # name of active element that takes textual content
- $self->{'text'} = ''; # the accumulated text associated with the element
- $self;
-}
-
-=item $hp->header;
-
-Returns a reference to the header object.
-
-=item $hp->header( $key )
-
-Returns a header value. It is just a shorter way to write
-C<$hp-E<gt>header-E<gt>header($key)>.
-
-=cut
-
-sub header
-{
- my $self = shift;
- return $self->{'header'} unless @_;
- $self->{'header'}->header(@_);
-}
-
-sub as_string # legacy
-{
- my $self = shift;
- $self->{'header'}->as_string;
-}
-
-sub flush_text # internal
-{
- my $self = shift;
- my $tag = $self->{'tag'};
- my $text = $self->{'text'};
- $text =~ s/^\s+//;
- $text =~ s/\s+$//;
- $text =~ s/\s+/ /g;
- print "FLUSH $tag => '$text'\n" if $DEBUG;
- if ($tag eq 'title') {
- HTML::Entities::decode($text);
- $self->{'header'}->push_header(Title => $text);
- }
- $self->{'tag'} = $self->{'text'} = '';
-}
-
-# This is an quote from the HTML3.2 DTD which shows which elements
-# that might be present in a <HEAD>...</HEAD>. Also note that the
-# <HEAD> tags themselves might be missing:
-#
-# <!ENTITY % head.content "TITLE & ISINDEX? & BASE? & STYLE? &
-# SCRIPT* & META* & LINK*">
-#
-# <!ELEMENT HEAD O O (%head.content)>
-#
-# From HTML 4.01:
-#
-# <!ENTITY % head.misc "SCRIPT|STYLE|META|LINK|OBJECT">
-# <!ENTITY % head.content "TITLE & BASE?">
-# <!ELEMENT HEAD O O (%head.content;) +(%head.misc;)>
-#
-# Added in HTML 5 as of WD-html5-20090423: noscript, command
-
-sub start
-{
- my($self, $tag, $attr) = @_; # $attr is reference to a HASH
- print "START[$tag]\n" if $DEBUG;
- $self->flush_text if $self->{'tag'};
- if ($tag eq 'meta') {
- my $key = $attr->{'http-equiv'};
- if (!defined($key) || !length($key)) {
- if ($attr->{name}) {
- $key = "X-Meta-\u$attr->{name}";
- } elsif ($attr->{charset}) { # HTML 5 <meta charset="...">
- $key = "X-Meta-Charset";
- $self->{header}->push_header($key => $attr->{charset});
- return;
- } else {
- return;
- }
- }
- $self->{'header'}->push_header($key => $attr->{content});
- } elsif ($tag eq 'base') {
- return unless exists $attr->{href};
- $self->{'header'}->push_header('Content-Base' => $attr->{href});
- } elsif ($tag eq 'isindex') {
- # This is a non-standard header. Perhaps we should just ignore
- # this element
- $self->{'header'}->push_header(Isindex => $attr->{prompt} || '?');
- } elsif ($tag =~ /^(?:title|noscript|object|command)$/) {
- # Just remember tag. Initialize header when we see the end tag.
- $self->{'tag'} = $tag;
- } elsif ($tag eq 'link') {
- return unless exists $attr->{href};
- # <link href="http:..." rel="xxx" rev="xxx" title="xxx">
- my $h_val = "<" . delete($attr->{href}) . ">";
- for (sort keys %{$attr}) {
- next if $_ eq "/"; # XHTML junk
- $h_val .= qq(; $_="$attr->{$_}");
- }
- $self->{'header'}->push_header(Link => $h_val);
- } elsif ($tag eq 'head' || $tag eq 'html') {
- # ignore
- } else {
- # stop parsing
- $self->eof;
- }
-}
-
-sub end
-{
- my($self, $tag) = @_;
- print "END[$tag]\n" if $DEBUG;
- $self->flush_text if $self->{'tag'};
- $self->eof if $tag eq 'head';
-}
-
-sub text
-{
- my($self, $text) = @_;
- print "TEXT[$text]\n" if $DEBUG;
- unless ($self->{first_chunk}) {
- # drop Unicode BOM if found
- if ($self->utf8_mode) {
- $text =~ s/^\xEF\xBB\xBF//;
- }
- else {
- $text =~ s/^\x{FEFF}//;
- }
- $self->{first_chunk}++;
- }
- my $tag = $self->{tag};
- if (!$tag && $text =~ /\S/) {
- # Normal text means start of body
- $self->eof;
- return;
- }
- return if $tag ne 'title';
- $self->{'text'} .= $text;
-}
-
-BEGIN {
- *utf8_mode = sub { 1 } unless HTML::Entities::UNICODE_SUPPORT;;
-}
-
-1;
-
-__END__
-
-=back
-
-=head1 EXAMPLE
-
- $h = HTTP::Headers->new;
- $p = HTML::HeadParser->new($h);
- $p->parse(<<EOT);
- <title>Stupid example</title>
- <base href="http://www.linpro.no/lwp/">
- Normal text starts here.
- EOT
- undef $p;
- print $h->title; # should print "Stupid example"
-
-=head1 SEE ALSO
-
-L<HTML::Parser>, L<HTTP::Headers>
-
-The C<HTTP::Headers> class is distributed as part of the
-I<libwww-perl> package. If you don't have that distribution installed
-you need to provide the $header argument to the C<HTML::HeadParser>
-constructor with your own object that implements the documented
-protocol.
-
-=head1 COPYRIGHT
-
-Copyright 1996-2001 Gisle Aas. All rights reserved.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
diff --git a/Master/tlpkg/tlperl/lib/HTML/LinkExtor.pm b/Master/tlpkg/tlperl/lib/HTML/LinkExtor.pm
deleted file mode 100755
index 8d50439d15f..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/LinkExtor.pm
+++ /dev/null
@@ -1,185 +0,0 @@
-package HTML::LinkExtor;
-
-require HTML::Parser;
-@ISA = qw(HTML::Parser);
-$VERSION = "3.60";
-
-=head1 NAME
-
-HTML::LinkExtor - Extract links from an HTML document
-
-=head1 SYNOPSIS
-
- require HTML::LinkExtor;
- $p = HTML::LinkExtor->new(\&cb, "http://www.perl.org/");
- sub cb {
- my($tag, %links) = @_;
- print "$tag @{[%links]}\n";
- }
- $p->parse_file("index.html");
-
-=head1 DESCRIPTION
-
-I<HTML::LinkExtor> is an HTML parser that extracts links from an
-HTML document. The I<HTML::LinkExtor> is a subclass of
-I<HTML::Parser>. This means that the document should be given to the
-parser by calling the $p->parse() or $p->parse_file() methods.
-
-=cut
-
-use strict;
-use HTML::Tagset ();
-
-# legacy (some applications grabs this hash directly)
-use vars qw(%LINK_ELEMENT);
-*LINK_ELEMENT = \%HTML::Tagset::linkElements;
-
-=over 4
-
-=item $p = HTML::LinkExtor->new
-
-=item $p = HTML::LinkExtor->new( $callback )
-
-=item $p = HTML::LinkExtor->new( $callback, $base )
-
-The constructor takes two optional arguments. The first is a reference
-to a callback routine. It will be called as links are found. If a
-callback is not provided, then links are just accumulated internally
-and can be retrieved by calling the $p->links() method.
-
-The $base argument is an optional base URL used to absolutize all URLs found.
-You need to have the I<URI> module installed if you provide $base.
-
-The callback is called with the lowercase tag name as first argument,
-and then all link attributes as separate key/value pairs. All
-non-link attributes are removed.
-
-=cut
-
-sub new
-{
- my($class, $cb, $base) = @_;
- my $self = $class->SUPER::new(
- start_h => ["_start_tag", "self,tagname,attr"],
- report_tags => [keys %HTML::Tagset::linkElements],
- );
- $self->{extractlink_cb} = $cb;
- if ($base) {
- require URI;
- $self->{extractlink_base} = URI->new($base);
- }
- $self;
-}
-
-sub _start_tag
-{
- my($self, $tag, $attr) = @_;
-
- my $base = $self->{extractlink_base};
- my $links = $HTML::Tagset::linkElements{$tag};
- $links = [$links] unless ref $links;
-
- my @links;
- my $a;
- for $a (@$links) {
- next unless exists $attr->{$a};
- push(@links, $a, $base ? URI->new($attr->{$a}, $base)->abs($base)
- : $attr->{$a});
- }
- return unless @links;
- $self->_found_link($tag, @links);
-}
-
-sub _found_link
-{
- my $self = shift;
- my $cb = $self->{extractlink_cb};
- if ($cb) {
- &$cb(@_);
- } else {
- push(@{$self->{'links'}}, [@_]);
- }
-}
-
-=item $p->links
-
-Returns a list of all links found in the document. The returned
-values will be anonymous arrays with the following elements:
-
- [$tag, $attr => $url1, $attr2 => $url2,...]
-
-The $p->links method will also truncate the internal link list. This
-means that if the method is called twice without any parsing
-between them the second call will return an empty list.
-
-Also note that $p->links will always be empty if a callback routine
-was provided when the I<HTML::LinkExtor> was created.
-
-=cut
-
-sub links
-{
- my $self = shift;
- exists($self->{'links'}) ? @{delete $self->{'links'}} : ();
-}
-
-# We override the parse_file() method so that we can clear the links
-# before we start a new file.
-sub parse_file
-{
- my $self = shift;
- delete $self->{'links'};
- $self->SUPER::parse_file(@_);
-}
-
-=back
-
-=head1 EXAMPLE
-
-This is an example showing how you can extract links from a document
-received using LWP:
-
- use LWP::UserAgent;
- use HTML::LinkExtor;
- use URI::URL;
-
- $url = "http://www.perl.org/"; # for instance
- $ua = LWP::UserAgent->new;
-
- # Set up a callback that collect image links
- my @imgs = ();
- sub callback {
- my($tag, %attr) = @_;
- return if $tag ne 'img'; # we only look closer at <img ...>
- push(@imgs, values %attr);
- }
-
- # Make the parser. Unfortunately, we don't know the base yet
- # (it might be different from $url)
- $p = HTML::LinkExtor->new(\&callback);
-
- # Request document and parse it as it arrives
- $res = $ua->request(HTTP::Request->new(GET => $url),
- sub {$p->parse($_[0])});
-
- # Expand all image URLs to absolute ones
- my $base = $res->base;
- @imgs = map { $_ = url($_, $base)->abs; } @imgs;
-
- # Print them out
- print join("\n", @imgs), "\n";
-
-=head1 SEE ALSO
-
-L<HTML::Parser>, L<HTML::Tagset>, L<LWP>, L<URI::URL>
-
-=head1 COPYRIGHT
-
-Copyright 1996-2001 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/HTML/Parser.pm b/Master/tlpkg/tlperl/lib/HTML/Parser.pm
deleted file mode 100755
index 55cf8d9c51d..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/Parser.pm
+++ /dev/null
@@ -1,1240 +0,0 @@
-package HTML::Parser;
-
-# Copyright 1996-2009, Gisle Aas.
-# Copyright 1999-2000, Michael A. Chase.
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-use strict;
-use vars qw($VERSION @ISA);
-
-$VERSION = "3.64";
-
-require HTML::Entities;
-
-require XSLoader;
-XSLoader::load('HTML::Parser', $VERSION);
-
-sub new
-{
- my $class = shift;
- my $self = bless {}, $class;
- return $self->init(@_);
-}
-
-
-sub init
-{
- my $self = shift;
- $self->_alloc_pstate;
-
- my %arg = @_;
- my $api_version = delete $arg{api_version} || (@_ ? 3 : 2);
- if ($api_version >= 4) {
- require Carp;
- Carp::croak("API version $api_version not supported " .
- "by HTML::Parser $VERSION");
- }
-
- if ($api_version < 3) {
- # Set up method callbacks compatible with HTML-Parser-2.xx
- $self->handler(text => "text", "self,text,is_cdata");
- $self->handler(end => "end", "self,tagname,text");
- $self->handler(process => "process", "self,token0,text");
- $self->handler(start => "start",
- "self,tagname,attr,attrseq,text");
-
- $self->handler(comment =>
- sub {
- my($self, $tokens) = @_;
- for (@$tokens) {
- $self->comment($_);
- }
- }, "self,tokens");
-
- $self->handler(declaration =>
- sub {
- my $self = shift;
- $self->declaration(substr($_[0], 2, -1));
- }, "self,text");
- }
-
- if (my $h = delete $arg{handlers}) {
- $h = {@$h} if ref($h) eq "ARRAY";
- while (my($event, $cb) = each %$h) {
- $self->handler($event => @$cb);
- }
- }
-
- # In the end we try to assume plain attribute or handler
- while (my($option, $val) = each %arg) {
- if ($option =~ /^(\w+)_h$/) {
- $self->handler($1 => @$val);
- }
- elsif ($option =~ /^(text|start|end|process|declaration|comment)$/) {
- require Carp;
- Carp::croak("Bad constructor option '$option'");
- }
- else {
- $self->$option($val);
- }
- }
-
- return $self;
-}
-
-
-sub parse_file
-{
- my($self, $file) = @_;
- my $opened;
- if (!ref($file) && ref(\$file) ne "GLOB") {
- # Assume $file is a filename
- local(*F);
- open(F, "<", $file) || return undef;
- binmode(F); # should we? good for byte counts
- $opened++;
- $file = *F;
- }
- my $chunk = '';
- while (read($file, $chunk, 512)) {
- $self->parse($chunk) || last;
- }
- close($file) if $opened;
- $self->eof;
-}
-
-
-sub netscape_buggy_comment # legacy
-{
- my $self = shift;
- require Carp;
- Carp::carp("netscape_buggy_comment() is deprecated. " .
- "Please use the strict_comment() method instead");
- my $old = !$self->strict_comment;
- $self->strict_comment(!shift) if @_;
- return $old;
-}
-
-# set up method stubs
-sub text { }
-*start = \&text;
-*end = \&text;
-*comment = \&text;
-*declaration = \&text;
-*process = \&text;
-
-1;
-
-__END__
-
-
-=head1 NAME
-
-HTML::Parser - HTML parser class
-
-=head1 SYNOPSIS
-
- use HTML::Parser ();
-
- # Create parser object
- $p = HTML::Parser->new( api_version => 3,
- start_h => [\&start, "tagname, attr"],
- end_h => [\&end, "tagname"],
- marked_sections => 1,
- );
-
- # Parse document text chunk by chunk
- $p->parse($chunk1);
- $p->parse($chunk2);
- #...
- $p->eof; # signal end of document
-
- # Parse directly from file
- $p->parse_file("foo.html");
- # or
- open(my $fh, "<:utf8", "foo.html") || die;
- $p->parse_file($fh);
-
-=head1 DESCRIPTION
-
-Objects of the C<HTML::Parser> class will recognize markup and
-separate it from plain text (alias data content) in HTML
-documents. As different kinds of markup and text are recognized, the
-corresponding event handlers are invoked.
-
-C<HTML::Parser> is not a generic SGML parser. We have tried to
-make it able to deal with the HTML that is actually "out there", and
-it normally parses as closely as possible to the way the popular web
-browsers do it instead of strictly following one of the many HTML
-specifications from W3C. Where there is disagreement, there is often
-an option that you can enable to get the official behaviour.
-
-The document to be parsed may be supplied in arbitrary chunks. This
-makes on-the-fly parsing as documents are received from the network
-possible.
-
-If event driven parsing does not feel right for your application, you
-might want to use C<HTML::PullParser>. This is an C<HTML::Parser>
-subclass that allows a more conventional program structure.
-
-
-=head1 METHODS
-
-The following method is used to construct a new C<HTML::Parser> object:
-
-=over
-
-=item $p = HTML::Parser->new( %options_and_handlers )
-
-This class method creates a new C<HTML::Parser> object and
-returns it. Key/value argument pairs may be provided to assign event
-handlers or initialize parser options. The handlers and parser
-options can also be set or modified later by the method calls described below.
-
-If a top level key is in the form "<event>_h" (e.g., "text_h") then it
-assigns a handler to that event, otherwise it initializes a parser
-option. The event handler specification value must be an array
-reference. Multiple handlers may also be assigned with the 'handlers
-=> [%handlers]' option. See examples below.
-
-If new() is called without any arguments, it will create a parser that
-uses callback methods compatible with version 2 of C<HTML::Parser>.
-See the section on "version 2 compatibility" below for details.
-
-The special constructor option 'api_version => 2' can be used to
-initialize version 2 callbacks while still setting other options and
-handlers. The 'api_version => 3' option can be used if you don't want
-to set any options and don't want to fall back to v2 compatible
-mode.
-
-Examples:
-
- $p = HTML::Parser->new(api_version => 3,
- text_h => [ sub {...}, "dtext" ]);
-
-This creates a new parser object with a text event handler subroutine
-that receives the original text with general entities decoded.
-
- $p = HTML::Parser->new(api_version => 3,
- start_h => [ 'my_start', "self,tokens" ]);
-
-This creates a new parser object with a start event handler method
-that receives the $p and the tokens array.
-
- $p = HTML::Parser->new(api_version => 3,
- handlers => { text => [\@array, "event,text"],
- comment => [\@array, "event,text"],
- });
-
-This creates a new parser object that stores the event type and the
-original text in @array for text and comment events.
-
-=back
-
-The following methods feed the HTML document
-to the C<HTML::Parser> object:
-
-=over
-
-=item $p->parse( $string )
-
-Parse $string as the next chunk of the HTML document. Handlers invoked should
-not attempt to modify the $string in-place until $p->parse returns.
-
-If an invoked event handler aborts parsing by calling $p->eof, then $p->parse()
-will return a FALSE value. Otherwise the return value is a reference to the
-parser object ($p).
-
-=item $p->parse( $code_ref )
-
-If a code reference is passed as the argument to be parsed, then the
-chunks to be parsed are obtained by invoking this function repeatedly.
-Parsing continues until the function returns an empty (or undefined)
-result. When this happens $p->eof is automatically signaled.
-
-Parsing will also abort if one of the event handlers calls $p->eof.
-
-The effect of this is the same as:
-
- while (1) {
- my $chunk = &$code_ref();
- if (!defined($chunk) || !length($chunk)) {
- $p->eof;
- return $p;
- }
- $p->parse($chunk) || return undef;
- }
-
-But it is more efficient as this loop runs internally in XS code.
-
-=item $p->parse_file( $file )
-
-Parse text directly from a file. The $file argument can be a
-filename, an open file handle, or a reference to an open file
-handle.
-
-If $file contains a filename and the file can't be opened, then the
-method returns an undefined value and $! tells why it failed.
-Otherwise the return value is a reference to the parser object.
-
-If a file handle is passed as the $file argument, then the file will
-normally be read until EOF, but not closed.
-
-If an invoked event handler aborts parsing by calling $p->eof,
-then $p->parse_file() may not have read the entire file.
-
-On systems with multi-byte line terminators, the values passed for the
-offset and length argspecs may be too low if parse_file() is called on
-a file handle that is not in binary mode.
-
-If a filename is passed in, then parse_file() will open the file in
-binary mode.
-
-=item $p->eof
-
-Signals the end of the HTML document. Calling the $p->eof method
-outside a handler callback will flush any remaining buffered text
-(which triggers the C<text> event if there is any remaining text).
-
-Calling $p->eof inside a handler will terminate parsing at that point
-and cause $p->parse to return a FALSE value. This also terminates
-parsing by $p->parse_file().
-
-After $p->eof has been called, the parse() and parse_file() methods
-can be invoked to feed new documents with the parser object.
-
-The return value from eof() is a reference to the parser object.
-
-=back
-
-
-Most parser options are controlled by boolean attributes.
-Each boolean attribute is enabled by calling the corresponding method
-with a TRUE argument and disabled with a FALSE argument. The
-attribute value is left unchanged if no argument is given. The return
-value from each method is the old attribute value.
-
-Methods that can be used to get and/or set parser options are:
-
-=over
-
-=item $p->attr_encoded
-
-=item $p->attr_encoded( $bool )
-
-By default, the C<attr> and C<@attr> argspecs will have general
-entities for attribute values decoded. Enabling this attribute leaves
-entities alone.
-
-=item $p->backquote
-
-=item $p->backquote( $bool )
-
-By default, only ' and " are recognized as quote characters around
-attribute values. MSIE also recognizes backquotes for some reason.
-Enabling this attribute provides compatibility with this behaviour.
-
-=item $p->boolean_attribute_value( $val )
-
-This method sets the value reported for boolean attributes inside HTML
-start tags. By default, the name of the attribute is also used as its
-value. This affects the values reported for C<tokens> and C<attr>
-argspecs.
-
-=item $p->case_sensitive
-
-=item $p->case_sensitive( $bool )
-
-By default, tagnames and attribute names are down-cased. Enabling this
-attribute leaves them as found in the HTML source document.
-
-=item $p->closing_plaintext
-
-=item $p->closing_plaintext( $bool )
-
-By default, "plaintext" element can never be closed. Everything up to
-the end of the document is parsed in CDATA mode. This historical
-behaviour is what at least MSIE does. Enabling this attribute makes
-closing "</plaintext>" tag effective and the parsing process will resume
-after seeing this tag. This emulates early gecko-based browsers.
-
-=item $p->empty_element_tags
-
-=item $p->empty_element_tags( $bool )
-
-By default, empty element tags are not recognized as such and the "/"
-before ">" is just treated like a normal name character (unless
-C<strict_names> is enabled). Enabling this attribute make
-C<HTML::Parser> recognize these tags.
-
-Empty element tags look like start tags, but end with the character
-sequence "/>" instead of ">". When recognized by C<HTML::Parser> they
-cause an artificial end event in addition to the start event. The
-C<text> for the artificial end event will be empty and the C<tokenpos>
-array will be undefined even though the the token array will have one
-element containing the tag name.
-
-=item $p->marked_sections
-
-=item $p->marked_sections( $bool )
-
-By default, section markings like <![CDATA[...]]> are treated like
-ordinary text. When this attribute is enabled section markings are
-honoured.
-
-There are currently no events associated with the marked section
-markup, but the text can be returned as C<skipped_text>.
-
-=item $p->strict_comment
-
-=item $p->strict_comment( $bool )
-
-By default, comments are terminated by the first occurrence of "-->".
-This is the behaviour of most popular browsers (like Mozilla, Opera and
-MSIE), but it is not correct according to the official HTML
-standard. Officially, you need an even number of "--" tokens before
-the closing ">" is recognized and there may not be anything but
-whitespace between an even and an odd "--".
-
-The official behaviour is enabled by enabling this attribute.
-
-Enabling of 'strict_comment' also disables recognizing these forms as
-comments:
-
- </ comment>
- <! comment>
-
-
-=item $p->strict_end
-
-=item $p->strict_end( $bool )
-
-By default, attributes and other junk are allowed to be present on end tags in a
-manner that emulates MSIE's behaviour.
-
-The official behaviour is enabled with this attribute. If enabled,
-only whitespace is allowed between the tagname and the final ">".
-
-=item $p->strict_names
-
-=item $p->strict_names( $bool )
-
-By default, almost anything is allowed in tag and attribute names.
-This is the behaviour of most popular browsers and allows us to parse
-some broken tags with invalid attribute values like:
-
- <IMG SRC=newprevlstGr.gif ALT=[PREV LIST] BORDER=0>
-
-By default, "LIST]" is parsed as a boolean attribute, not as
-part of the ALT value as was clearly intended. This is also what
-Mozilla sees.
-
-The official behaviour is enabled by enabling this attribute. If
-enabled, it will cause the tag above to be reported as text
-since "LIST]" is not a legal attribute name.
-
-=item $p->unbroken_text
-
-=item $p->unbroken_text( $bool )
-
-By default, blocks of text are given to the text handler as soon as
-possible (but the parser takes care always to break text at a
-boundary between whitespace and non-whitespace so single words and
-entities can always be decoded safely). This might create breaks that
-make it hard to do transformations on the text. When this attribute is
-enabled, blocks of text are always reported in one piece. This will
-delay the text event until the following (non-text) event has been
-recognized by the parser.
-
-Note that the C<offset> argspec will give you the offset of the first
-segment of text and C<length> is the combined length of the segments.
-Since there might be ignored tags in between, these numbers can't be
-used to directly index in the original document file.
-
-=item $p->utf8_mode
-
-=item $p->utf8_mode( $bool )
-
-Enable this option when parsing raw undecoded UTF-8. This tells the
-parser that the entities expanded for strings reported by C<attr>,
-C<@attr> and C<dtext> should be expanded as decoded UTF-8 so they end
-up compatible with the surrounding text.
-
-If C<utf8_mode> is enabled then it is an error to pass strings
-containing characters with code above 255 to the parse() method, and
-the parse() method will croak if you try.
-
-Example: The Unicode character "\x{2665}" is "\xE2\x99\xA5" when UTF-8
-encoded. The character can also be represented by the entity
-"&hearts;" or "&#x2665". If we feed the parser:
-
- $p->parse("\xE2\x99\xA5&hearts;");
-
-then C<dtext> will be reported as "\xE2\x99\xA5\x{2665}" without
-C<utf8_mode> enabled, but as "\xE2\x99\xA5\xE2\x99\xA5" when enabled.
-The later string is what you want.
-
-This option is only available with perl-5.8 or better.
-
-=item $p->xml_mode
-
-=item $p->xml_mode( $bool )
-
-Enabling this attribute changes the parser to allow some XML
-constructs. This enables the behaviour controlled by individually by
-the C<case_sensitive>, C<empty_element_tags>, C<strict_names> and
-C<xml_pic> attributes and also suppresses special treatment of
-elements that are parsed as CDATA for HTML.
-
-=item $p->xml_pic
-
-=item $p->xml_pic( $bool )
-
-By default, I<processing instructions> are terminated by ">". When
-this attribute is enabled, processing instructions are terminated by
-"?>" instead.
-
-=back
-
-As markup and text is recognized, handlers are invoked. The following
-method is used to set up handlers for different events:
-
-=over
-
-=item $p->handler( event => \&subroutine, $argspec )
-
-=item $p->handler( event => $method_name, $argspec )
-
-=item $p->handler( event => \@accum, $argspec )
-
-=item $p->handler( event => "" );
-
-=item $p->handler( event => undef );
-
-=item $p->handler( event );
-
-This method assigns a subroutine, method, or array to handle an event.
-
-Event is one of C<text>, C<start>, C<end>, C<declaration>, C<comment>,
-C<process>, C<start_document>, C<end_document> or C<default>.
-
-The C<\&subroutine> is a reference to a subroutine which is called to handle
-the event.
-
-The C<$method_name> is the name of a method of $p which is called to handle
-the event.
-
-The C<@accum> is an array that will hold the event information as
-sub-arrays.
-
-If the second argument is "", the event is ignored.
-If it is undef, the default handler is invoked for the event.
-
-The C<$argspec> is a string that describes the information to be reported
-for the event. Any requested information that does not apply to a
-specific event is passed as C<undef>. If argspec is omitted, then it
-is left unchanged.
-
-The return value from $p->handler is the old callback routine or a
-reference to the accumulator array.
-
-Any return values from handler callback routines/methods are always
-ignored. A handler callback can request parsing to be aborted by
-invoking the $p->eof method. A handler callback is not allowed to
-invoke the $p->parse() or $p->parse_file() method. An exception will
-be raised if it tries.
-
-Examples:
-
- $p->handler(start => "start", 'self, attr, attrseq, text' );
-
-This causes the "start" method of object $p to be called for 'start' events.
-The callback signature is $p->start(\%attr, \@attr_seq, $text).
-
- $p->handler(start => \&start, 'attr, attrseq, text' );
-
-This causes subroutine start() to be called for 'start' events.
-The callback signature is start(\%attr, \@attr_seq, $text).
-
- $p->handler(start => \@accum, '"S", attr, attrseq, text' );
-
-This causes 'start' event information to be saved in @accum.
-The array elements will be ['S', \%attr, \@attr_seq, $text].
-
- $p->handler(start => "");
-
-This causes 'start' events to be ignored. It also suppresses
-invocations of any default handler for start events. It is in most
-cases equivalent to $p->handler(start => sub {}), but is more
-efficient. It is different from the empty-sub-handler in that
-C<skipped_text> is not reset by it.
-
- $p->handler(start => undef);
-
-This causes no handler to be associated with start events.
-If there is a default handler it will be invoked.
-
-=back
-
-Filters based on tags can be set up to limit the number of events
-reported. The main bottleneck during parsing is often the huge number
-of callbacks made from the parser. Applying filters can improve
-performance significantly.
-
-The following methods control filters:
-
-=over
-
-=item $p->ignore_elements( @tags )
-
-Both the C<start> event and the C<end> event as well as any events that
-would be reported in between are suppressed. The ignored elements can
-contain nested occurrences of itself. Example:
-
- $p->ignore_elements(qw(script style));
-
-The C<script> and C<style> tags will always nest properly since their
-content is parsed in CDATA mode. For most other tags
-C<ignore_elements> must be used with caution since HTML is often not
-I<well formed>.
-
-=item $p->ignore_tags( @tags )
-
-Any C<start> and C<end> events involving any of the tags given are
-suppressed. To reset the filter (i.e. don't suppress any C<start> and
-C<end> events), call C<ignore_tags> without an argument.
-
-=item $p->report_tags( @tags )
-
-Any C<start> and C<end> events involving any of the tags I<not> given
-are suppressed. To reset the filter (i.e. report all C<start> and
-C<end> events), call C<report_tags> without an argument.
-
-=back
-
-Internally, the system has two filter lists, one for C<report_tags>
-and one for C<ignore_tags>, and both filters are applied. This
-effectively gives C<ignore_tags> precedence over C<report_tags>.
-
-Examples:
-
- $p->ignore_tags(qw(style));
- $p->report_tags(qw(script style));
-
-results in only C<script> events being reported.
-
-=head2 Argspec
-
-Argspec is a string containing a comma-separated list that describes
-the information reported by the event. The following argspec
-identifier names can be used:
-
-=over
-
-=item C<attr>
-
-Attr causes a reference to a hash of attribute name/value pairs to be
-passed.
-
-Boolean attributes' values are either the value set by
-$p->boolean_attribute_value, or the attribute name if no value has been
-set by $p->boolean_attribute_value.
-
-This passes undef except for C<start> events.
-
-Unless C<xml_mode> or C<case_sensitive> is enabled, the attribute
-names are forced to lower case.
-
-General entities are decoded in the attribute values and
-one layer of matching quotes enclosing the attribute values is removed.
-
-The Unicode character set is assumed for entity decoding. With Perl
-version 5.6 or earlier only the Latin-1 range is supported, and
-entities for characters outside the range 0..255 are left unchanged.
-
-=item C<@attr>
-
-Basically the same as C<attr>, but keys and values are passed as
-individual arguments and the original sequence of the attributes is
-kept. The parameters passed will be the same as the @attr calculated
-here:
-
- @attr = map { $_ => $attr->{$_} } @$attrseq;
-
-assuming $attr and $attrseq here are the hash and array passed as the
-result of C<attr> and C<attrseq> argspecs.
-
-This passes no values for events besides C<start>.
-
-=item C<attrseq>
-
-Attrseq causes a reference to an array of attribute names to be
-passed. This can be useful if you want to walk the C<attr> hash in
-the original sequence.
-
-This passes undef except for C<start> events.
-
-Unless C<xml_mode> or C<case_sensitive> is enabled, the attribute
-names are forced to lower case.
-
-=item C<column>
-
-Column causes the column number of the start of the event to be passed.
-The first column on a line is 0.
-
-=item C<dtext>
-
-Dtext causes the decoded text to be passed. General entities are
-automatically decoded unless the event was inside a CDATA section or
-was between literal start and end tags (C<script>, C<style>,
-C<xmp>, C<iframe>, C<title>, C<textarea> and C<plaintext>).
-
-The Unicode character set is assumed for entity decoding. With Perl
-version 5.6 or earlier only the Latin-1 range is supported, and
-entities for characters outside the range 0..255 are left unchanged.
-
-This passes undef except for C<text> events.
-
-=item C<event>
-
-Event causes the event name to be passed.
-
-The event name is one of C<text>, C<start>, C<end>, C<declaration>,
-C<comment>, C<process>, C<start_document> or C<end_document>.
-
-=item C<is_cdata>
-
-Is_cdata causes a TRUE value to be passed if the event is inside a CDATA
-section or between literal start and end tags (C<script>,
-C<style>, C<xmp>, C<iframe>, C<title>, C<textarea> and C<plaintext>).
-
-if the flag is FALSE for a text event, then you should normally
-either use C<dtext> or decode the entities yourself before the text is
-processed further.
-
-=item C<length>
-
-Length causes the number of bytes of the source text of the event to
-be passed.
-
-=item C<line>
-
-Line causes the line number of the start of the event to be passed.
-The first line in the document is 1. Line counting doesn't start
-until at least one handler requests this value to be reported.
-
-=item C<offset>
-
-Offset causes the byte position in the HTML document of the start of
-the event to be passed. The first byte in the document has offset 0.
-
-=item C<offset_end>
-
-Offset_end causes the byte position in the HTML document of the end of
-the event to be passed. This is the same as C<offset> + C<length>.
-
-=item C<self>
-
-Self causes the current object to be passed to the handler. If the
-handler is a method, this must be the first element in the argspec.
-
-An alternative to passing self as an argspec is to register closures
-that capture $self by themselves as handlers. Unfortunately this
-creates circular references which prevent the HTML::Parser object
-from being garbage collected. Using the C<self> argspec avoids this
-problem.
-
-=item C<skipped_text>
-
-Skipped_text returns the concatenated text of all the events that have
-been skipped since the last time an event was reported. Events might
-be skipped because no handler is registered for them or because some
-filter applies. Skipped text also includes marked section markup,
-since there are no events that can catch it.
-
-If an C<"">-handler is registered for an event, then the text for this
-event is not included in C<skipped_text>. Skipped text both before
-and after the C<"">-event is included in the next reported
-C<skipped_text>.
-
-=item C<tag>
-
-Same as C<tagname>, but prefixed with "/" if it belongs to an C<end>
-event and "!" for a declaration. The C<tag> does not have any prefix
-for C<start> events, and is in this case identical to C<tagname>.
-
-=item C<tagname>
-
-This is the element name (or I<generic identifier> in SGML jargon) for
-start and end tags. Since HTML is case insensitive, this name is
-forced to lower case to ease string matching.
-
-Since XML is case sensitive, the tagname case is not changed when
-C<xml_mode> is enabled. The same happens if the C<case_sensitive> attribute
-is set.
-
-The declaration type of declaration elements is also passed as a tagname,
-even if that is a bit strange.
-In fact, in the current implementation tagname is
-identical to C<token0> except that the name may be forced to lower case.
-
-=item C<token0>
-
-Token0 causes the original text of the first token string to be
-passed. This should always be the same as $tokens->[0].
-
-For C<declaration> events, this is the declaration type.
-
-For C<start> and C<end> events, this is the tag name.
-
-For C<process> and non-strict C<comment> events, this is everything
-inside the tag.
-
-This passes undef if there are no tokens in the event.
-
-=item C<tokenpos>
-
-Tokenpos causes a reference to an array of token positions to be
-passed. For each string that appears in C<tokens>, this array
-contains two numbers. The first number is the offset of the start of
-the token in the original C<text> and the second number is the length
-of the token.
-
-Boolean attributes in a C<start> event will have (0,0) for the
-attribute value offset and length.
-
-This passes undef if there are no tokens in the event (e.g., C<text>)
-and for artificial C<end> events triggered by empty element tags.
-
-If you are using these offsets and lengths to modify C<text>, you
-should either work from right to left, or be very careful to calculate
-the changes to the offsets.
-
-=item C<tokens>
-
-Tokens causes a reference to an array of token strings to be passed.
-The strings are exactly as they were found in the original text,
-no decoding or case changes are applied.
-
-For C<declaration> events, the array contains each word, comment, and
-delimited string starting with the declaration type.
-
-For C<comment> events, this contains each sub-comment. If
-$p->strict_comments is disabled, there will be only one sub-comment.
-
-For C<start> events, this contains the original tag name followed by
-the attribute name/value pairs. The values of boolean attributes will
-be either the value set by $p->boolean_attribute_value, or the
-attribute name if no value has been set by
-$p->boolean_attribute_value.
-
-For C<end> events, this contains the original tag name (always one token).
-
-For C<process> events, this contains the process instructions (always one
-token).
-
-This passes C<undef> for C<text> events.
-
-=item C<text>
-
-Text causes the source text (including markup element delimiters) to be
-passed.
-
-=item C<undef>
-
-Pass an undefined value. Useful as padding where the same handler
-routine is registered for multiple events.
-
-=item C<'...'>
-
-A literal string of 0 to 255 characters enclosed
-in single (') or double (") quotes is passed as entered.
-
-=back
-
-The whole argspec string can be wrapped up in C<'@{...}'> to signal
-that the resulting event array should be flattened. This only makes a
-difference if an array reference is used as the handler target.
-Consider this example:
-
- $p->handler(text => [], 'text');
- $p->handler(text => [], '@{text}']);
-
-With two text events; C<"foo">, C<"bar">; then the first example will end
-up with [["foo"], ["bar"]] and the second with ["foo", "bar"] in
-the handler target array.
-
-
-=head2 Events
-
-Handlers for the following events can be registered:
-
-=over
-
-=item C<comment>
-
-This event is triggered when a markup comment is recognized.
-
-Example:
-
- <!-- This is a comment -- -- So is this -->
-
-=item C<declaration>
-
-This event is triggered when a I<markup declaration> is recognized.
-
-For typical HTML documents, the only declaration you are
-likely to find is <!DOCTYPE ...>.
-
-Example:
-
- <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
- "http://www.w3.org/TR/html40/strict.dtd">
-
-DTDs inside <!DOCTYPE ...> will confuse HTML::Parser.
-
-=item C<default>
-
-This event is triggered for events that do not have a specific
-handler. You can set up a handler for this event to catch stuff you
-did not want to catch explicitly.
-
-=item C<end>
-
-This event is triggered when an end tag is recognized.
-
-Example:
-
- </A>
-
-=item C<end_document>
-
-This event is triggered when $p->eof is called and after any remaining
-text is flushed. There is no document text associated with this event.
-
-=item C<process>
-
-This event is triggered when a processing instructions markup is
-recognized.
-
-The format and content of processing instructions are system and
-application dependent.
-
-Examples:
-
- <? HTML processing instructions >
- <? XML processing instructions ?>
-
-=item C<start>
-
-This event is triggered when a start tag is recognized.
-
-Example:
-
- <A HREF="http://www.perl.com/">
-
-=item C<start_document>
-
-This event is triggered before any other events for a new document. A
-handler for it can be used to initialize stuff. There is no document
-text associated with this event.
-
-=item C<text>
-
-This event is triggered when plain text (characters) is recognized.
-The text may contain multiple lines. A sequence of text may be broken
-between several text events unless $p->unbroken_text is enabled.
-
-The parser will make sure that it does not break a word or a sequence
-of whitespace between two text events.
-
-=back
-
-=head2 Unicode
-
-The C<HTML::Parser> can parse Unicode strings when running under
-perl-5.8 or better. If Unicode is passed to $p->parse() then chunks
-of Unicode will be reported to the handlers. The offset and length
-argspecs will also report their position in terms of characters.
-
-It is safe to parse raw undecoded UTF-8 if you either avoid decoding
-entities and make sure to not use I<argspecs> that do, or enable the
-C<utf8_mode> for the parser. Parsing of undecoded UTF-8 might be
-useful when parsing from a file where you need the reported offsets
-and lengths to match the byte offsets in the file.
-
-If a filename is passed to $p->parse_file() then the file will be read
-in binary mode. This will be fine if the file contains only ASCII or
-Latin-1 characters. If the file contains UTF-8 encoded text then care
-must be taken when decoding entities as described in the previous
-paragraph, but better is to open the file with the UTF-8 layer so that
-it is decoded properly:
-
- open(my $fh, "<:utf8", "index.html") || die "...: $!";
- $p->parse_file($fh);
-
-If the file contains text encoded in a charset besides ASCII, Latin-1
-or UTF-8 then decoding will always be needed.
-
-=head1 VERSION 2 COMPATIBILITY
-
-When an C<HTML::Parser> object is constructed with no arguments, a set
-of handlers is automatically provided that is compatible with the old
-HTML::Parser version 2 callback methods.
-
-This is equivalent to the following method calls:
-
- $p->handler(start => "start", "self, tagname, attr, attrseq, text");
- $p->handler(end => "end", "self, tagname, text");
- $p->handler(text => "text", "self, text, is_cdata");
- $p->handler(process => "process", "self, token0, text");
- $p->handler(comment =>
- sub {
- my($self, $tokens) = @_;
- for (@$tokens) {$self->comment($_);}},
- "self, tokens");
- $p->handler(declaration =>
- sub {
- my $self = shift;
- $self->declaration(substr($_[0], 2, -1));},
- "self, text");
-
-Setting up these handlers can also be requested with the "api_version =>
-2" constructor option.
-
-=head1 SUBCLASSING
-
-The C<HTML::Parser> class is subclassable. Parser objects are plain
-hashes and C<HTML::Parser> reserves only hash keys that start with
-"_hparser". The parser state can be set up by invoking the init()
-method, which takes the same arguments as new().
-
-=head1 EXAMPLES
-
-The first simple example shows how you might strip out comments from
-an HTML document. We achieve this by setting up a comment handler that
-does nothing and a default handler that will print out anything else:
-
- use HTML::Parser;
- HTML::Parser->new(default_h => [sub { print shift }, 'text'],
- comment_h => [""],
- )->parse_file(shift || die) || die $!;
-
-An alternative implementation is:
-
- use HTML::Parser;
- HTML::Parser->new(end_document_h => [sub { print shift },
- 'skipped_text'],
- comment_h => [""],
- )->parse_file(shift || die) || die $!;
-
-This will in most cases be much more efficient since only a single
-callback will be made.
-
-The next example prints out the text that is inside the <title>
-element of an HTML document. Here we start by setting up a start
-handler. When it sees the title start tag it enables a text handler
-that prints any text found and an end handler that will terminate
-parsing as soon as the title end tag is seen:
-
- use HTML::Parser ();
-
- sub start_handler
- {
- return if shift ne "title";
- my $self = shift;
- $self->handler(text => sub { print shift }, "dtext");
- $self->handler(end => sub { shift->eof if shift eq "title"; },
- "tagname,self");
- }
-
- my $p = HTML::Parser->new(api_version => 3);
- $p->handler( start => \&start_handler, "tagname,self");
- $p->parse_file(shift || die) || die $!;
- print "\n";
-
-More examples are found in the F<eg/> directory of the C<HTML-Parser>
-distribution: the program C<hrefsub> shows how you can edit all links
-found in a document; the program C<htextsub> shows how to edit the text only; the
-program C<hstrip> shows how you can strip out certain tags/elements
-and/or attributes; and the program C<htext> show how to obtain the
-plain text, but not any script/style content.
-
-You can browse the F<eg/> directory online from the I<[Browse]> link on
-the http://search.cpan.org/~gaas/HTML-Parser/ page.
-
-=head1 BUGS
-
-The <style> and <script> sections do not end with the first "</", but
-need the complete corresponding end tag. The standard behaviour is
-not really practical.
-
-When the I<strict_comment> option is enabled, we still recognize
-comments where there is something other than whitespace between even
-and odd "--" markers.
-
-Once $p->boolean_attribute_value has been set, there is no way to
-restore the default behaviour.
-
-There is currently no way to get both quote characters
-into the same literal argspec.
-
-Empty tags, e.g. "<>" and "</>", are not recognized. SGML allows them
-to repeat the previous start tag or close the previous start tag
-respectively.
-
-NET tags, e.g. "code/.../" are not recognized. This is SGML
-shorthand for "<code>...</code>".
-
-Unclosed start or end tags, e.g. "<tt<b>...</b</tt>" are not
-recognized.
-
-=head1 DIAGNOSTICS
-
-The following messages may be produced by HTML::Parser. The notation
-in this listing is the same as used in L<perldiag>:
-
-=over
-
-=item Not a reference to a hash
-
-(F) The object blessed into or subclassed from HTML::Parser is not a
-hash as required by the HTML::Parser methods.
-
-=item Bad signature in parser state object at %p
-
-(F) The _hparser_xs_state element does not refer to a valid state structure.
-Something must have changed the internal value
-stored in this hash element, or the memory has been overwritten.
-
-=item _hparser_xs_state element is not a reference
-
-(F) The _hparser_xs_state element has been destroyed.
-
-=item Can't find '_hparser_xs_state' element in HTML::Parser hash
-
-(F) The _hparser_xs_state element is missing from the parser hash.
-It was either deleted, or not created when the object was created.
-
-=item API version %s not supported by HTML::Parser %s
-
-(F) The constructor option 'api_version' with an argument greater than
-or equal to 4 is reserved for future extensions.
-
-=item Bad constructor option '%s'
-
-(F) An unknown constructor option key was passed to the new() or
-init() methods.
-
-=item Parse loop not allowed
-
-(F) A handler invoked the parse() or parse_file() method.
-This is not permitted.
-
-=item marked sections not supported
-
-(F) The $p->marked_sections() method was invoked in a HTML::Parser
-module that was compiled without support for marked sections.
-
-=item Unknown boolean attribute (%d)
-
-(F) Something is wrong with the internal logic that set up aliases for
-boolean attributes.
-
-=item Only code or array references allowed as handler
-
-(F) The second argument for $p->handler must be either a subroutine
-reference, then name of a subroutine or method, or a reference to an
-array.
-
-=item No handler for %s events
-
-(F) The first argument to $p->handler must be a valid event name; i.e. one
-of "start", "end", "text", "process", "declaration" or "comment".
-
-=item Unrecognized identifier %s in argspec
-
-(F) The identifier is not a known argspec name.
-Use one of the names mentioned in the argspec section above.
-
-=item Literal string is longer than 255 chars in argspec
-
-(F) The current implementation limits the length of literals in
-an argspec to 255 characters. Make the literal shorter.
-
-=item Backslash reserved for literal string in argspec
-
-(F) The backslash character "\" is not allowed in argspec literals.
-It is reserved to permit quoting inside a literal in a later version.
-
-=item Unterminated literal string in argspec
-
-(F) The terminating quote character for a literal was not found.
-
-=item Bad argspec (%s)
-
-(F) Only identifier names, literals, spaces and commas
-are allowed in argspecs.
-
-=item Missing comma separator in argspec
-
-(F) Identifiers in an argspec must be separated with ",".
-
-=item Parsing of undecoded UTF-8 will give garbage when decoding entities
-
-(W) The first chunk parsed appears to contain undecoded UTF-8 and one
-or more argspecs that decode entities are used for the callback
-handlers.
-
-The result of decoding will be a mix of encoded and decoded characters
-for any entities that expand to characters with code above 127. This
-is not a good thing.
-
-The solution is to use the Encode::encode_utf8() on the data before
-feeding it to the $p->parse(). For $p->parse_file() pass a file that
-has been opened in ":utf8" mode.
-
-The parser can process raw undecoded UTF-8 sanely if the C<utf8_mode>
-is enabled or if the "attr", "@attr" or "dtext" argspecs is avoided.
-
-=item Parsing string decoded with wrong endianness
-
-(W) The first character in the document is U+FFFE. This is not a
-legal Unicode character but a byte swapped BOM. The result of parsing
-will likely be garbage.
-
-=item Parsing of undecoded UTF-32
-
-(W) The parser found the Unicode UTF-32 BOM signature at the start
-of the document. The result of parsing will likely be garbage.
-
-=item Parsing of undecoded UTF-16
-
-(W) The parser found the Unicode UTF-16 BOM signature at the start of
-the document. The result of parsing will likely be garbage.
-
-=back
-
-=head1 SEE ALSO
-
-L<HTML::Entities>, L<HTML::PullParser>, L<HTML::TokeParser>, L<HTML::HeadParser>,
-L<HTML::LinkExtor>, L<HTML::Form>
-
-L<HTML::TreeBuilder> (part of the I<HTML-Tree> distribution)
-
-http://www.w3.org/TR/html4
-
-More information about marked sections and processing instructions may
-be found at C<http://www.sgml.u-net.com/book/sgml-8.htm>.
-
-=head1 COPYRIGHT
-
- Copyright 1996-2008 Gisle Aas. All rights reserved.
- Copyright 1999-2000 Michael A. Chase. All rights reserved.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/HTML/PullParser.pm b/Master/tlpkg/tlperl/lib/HTML/PullParser.pm
deleted file mode 100755
index 30833793251..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/PullParser.pm
+++ /dev/null
@@ -1,209 +0,0 @@
-package HTML::PullParser;
-
-require HTML::Parser;
-@ISA=qw(HTML::Parser);
-$VERSION = "3.57";
-
-use strict;
-use Carp ();
-
-sub new
-{
- my($class, %cnf) = @_;
-
- # Construct argspecs for the various events
- my %argspec;
- for (qw(start end text declaration comment process default)) {
- my $tmp = delete $cnf{$_};
- next unless defined $tmp;
- $argspec{$_} = $tmp;
- }
- Carp::croak("Info not collected for any events")
- unless %argspec;
-
- my $file = delete $cnf{file};
- my $doc = delete $cnf{doc};
- Carp::croak("Can't parse from both 'doc' and 'file' at the same time")
- if defined($file) && defined($doc);
- Carp::croak("No 'doc' or 'file' given to parse from")
- unless defined($file) || defined($doc);
-
- # Create object
- $cnf{api_version} = 3;
- my $self = $class->SUPER::new(%cnf);
-
- my $accum = $self->{pullparser_accum} = [];
- while (my($event, $argspec) = each %argspec) {
- $self->SUPER::handler($event => $accum, $argspec);
- }
-
- if (defined $doc) {
- $self->{pullparser_str_ref} = ref($doc) ? $doc : \$doc;
- $self->{pullparser_str_pos} = 0;
- }
- else {
- if (!ref($file) && ref(\$file) ne "GLOB") {
- require IO::File;
- $file = IO::File->new($file, "r") || return;
- }
-
- $self->{pullparser_file} = $file;
- }
- $self;
-}
-
-
-sub handler
-{
- Carp::croak("Can't set handlers for HTML::PullParser");
-}
-
-
-sub get_token
-{
- my $self = shift;
- while (!@{$self->{pullparser_accum}} && !$self->{pullparser_eof}) {
- if (my $f = $self->{pullparser_file}) {
- # must try to parse more from the file
- my $buf;
- if (read($f, $buf, 512)) {
- $self->parse($buf);
- } else {
- $self->eof;
- $self->{pullparser_eof}++;
- delete $self->{pullparser_file};
- }
- }
- elsif (my $sref = $self->{pullparser_str_ref}) {
- # must try to parse more from the scalar
- my $pos = $self->{pullparser_str_pos};
- my $chunk = substr($$sref, $pos, 512);
- $self->parse($chunk);
- $pos += length($chunk);
- if ($pos < length($$sref)) {
- $self->{pullparser_str_pos} = $pos;
- }
- else {
- $self->eof;
- $self->{pullparser_eof}++;
- delete $self->{pullparser_str_ref};
- delete $self->{pullparser_str_pos};
- }
- }
- else {
- die;
- }
- }
- shift @{$self->{pullparser_accum}};
-}
-
-
-sub unget_token
-{
- my $self = shift;
- unshift @{$self->{pullparser_accum}}, @_;
- $self;
-}
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-HTML::PullParser - Alternative HTML::Parser interface
-
-=head1 SYNOPSIS
-
- use HTML::PullParser;
-
- $p = HTML::PullParser->new(file => "index.html",
- start => 'event, tagname, @attr',
- end => 'event, tagname',
- ignore_elements => [qw(script style)],
- ) || die "Can't open: $!";
- while (my $token = $p->get_token) {
- #...do something with $token
- }
-
-=head1 DESCRIPTION
-
-The HTML::PullParser is an alternative interface to the HTML::Parser class.
-It basically turns the HTML::Parser inside out. You associate a file
-(or any IO::Handle object or string) with the parser at construction time and
-then repeatedly call $parser->get_token to obtain the tags and text
-found in the parsed document.
-
-The following methods are provided:
-
-=over 4
-
-=item $p = HTML::PullParser->new( file => $file, %options )
-
-=item $p = HTML::PullParser->new( doc => \$doc, %options )
-
-A C<HTML::PullParser> can be made to parse from either a file or a
-literal document based on whether the C<file> or C<doc> option is
-passed to the parser's constructor.
-
-The C<file> passed in can either be a file name or a file handle
-object. If a file name is passed, and it can't be opened for reading,
-then the constructor will return an undefined value and $! will tell
-you why it failed. Otherwise the argument is taken to be some object
-that the C<HTML::PullParser> can read() from when it needs more data.
-The stream will be read() until EOF, but not closed.
-
-A C<doc> can be passed plain or as a reference
-to a scalar. If a reference is passed then the value of this scalar
-should not be changed before all tokens have been extracted.
-
-Next the information to be returned for the different token types must
-be set up. This is done by simply associating an argspec (as defined
-in L<HTML::Parser>) with the events you have an interest in. For
-instance, if you want C<start> tokens to be reported as the string
-C<'S'> followed by the tagname and the attributes you might pass an
-C<start>-option like this:
-
- $p = HTML::PullParser->new(
- doc => $document_to_parse,
- start => '"S", tagname, @attr',
- end => '"E", tagname',
- );
-
-At last other C<HTML::Parser> options, like C<ignore_tags>, and
-C<unbroken_text>, can be passed in. Note that you should not use the
-I<event>_h options to set up parser handlers. That would confuse the
-inner logic of C<HTML::PullParser>.
-
-=item $token = $p->get_token
-
-This method will return the next I<token> found in the HTML document,
-or C<undef> at the end of the document. The token is returned as an
-array reference. The content of this array match the argspec set up
-during C<HTML::PullParser> construction.
-
-=item $p->unget_token( @tokens )
-
-If you find out you have read too many tokens you can push them back,
-so that they are returned again the next time $p->get_token is called.
-
-=back
-
-=head1 EXAMPLES
-
-The 'eg/hform' script shows how we might parse the form section of
-HTML::Documents using HTML::PullParser.
-
-=head1 SEE ALSO
-
-L<HTML::Parser>, L<HTML::TokeParser>
-
-=head1 COPYRIGHT
-
-Copyright 1998-2001 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/HTML/Tagset.pm b/Master/tlpkg/tlperl/lib/HTML/Tagset.pm
deleted file mode 100755
index 754137fd6fe..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/Tagset.pm
+++ /dev/null
@@ -1,471 +0,0 @@
-package HTML::Tagset;
-
-use strict;
-
-=head1 NAME
-
-HTML::Tagset - data tables useful in parsing HTML
-
-=head1 VERSION
-
-Version 3.20
-
-=cut
-
-use vars qw( $VERSION );
-
-$VERSION = '3.20';
-
-=head1 SYNOPSIS
-
- use HTML::Tagset;
- # Then use any of the items in the HTML::Tagset package
- # as need arises
-
-=head1 DESCRIPTION
-
-This module contains several data tables useful in various kinds of
-HTML parsing operations.
-
-Note that all tag names used are lowercase.
-
-In the following documentation, a "hashset" is a hash being used as a
-set -- the hash conveys that its keys are there, and the actual values
-associated with the keys are not significant. (But what values are
-there, are always true.)
-
-=cut
-
-use vars qw(
- $VERSION
- %emptyElement %optionalEndTag %linkElements %boolean_attr
- %isHeadElement %isBodyElement %isPhraseMarkup
- %is_Possible_Strict_P_Content
- %isHeadOrBodyElement
- %isList %isTableElement %isFormElement
- %isKnown %canTighten
- @p_closure_barriers
- %isCDATA_Parent
-);
-
-=head1 VARIABLES
-
-Note that none of these variables are exported.
-
-=head2 hashset %HTML::Tagset::emptyElement
-
-This hashset has as values the tag-names (GIs) of elements that cannot
-have content. (For example, "base", "br", "hr".) So
-C<$HTML::Tagset::emptyElement{'hr'}> exists and is true.
-C<$HTML::Tagset::emptyElement{'dl'}> does not exist, and so is not true.
-
-=cut
-
-%emptyElement = map {; $_ => 1 } qw(base link meta isindex
- img br hr wbr
- input area param
- embed bgsound spacer
- basefont col frame
- ~comment ~literal
- ~declaration ~pi
- );
-# The "~"-initial names are for pseudo-elements used by HTML::Entities
-# and TreeBuilder
-
-=head2 hashset %HTML::Tagset::optionalEndTag
-
-This hashset lists tag-names for elements that can have content, but whose
-end-tags are generally, "safely", omissible. Example:
-C<$HTML::Tagset::emptyElement{'li'}> exists and is true.
-
-=cut
-
-%optionalEndTag = map {; $_ => 1 } qw(p li dt dd); # option th tr td);
-
-=head2 hash %HTML::Tagset::linkElements
-
-Values in this hash are tagnames for elements that might contain
-links, and the value for each is a reference to an array of the names
-of attributes whose values can be links.
-
-=cut
-
-%linkElements =
-(
- 'a' => ['href'],
- 'applet' => ['archive', 'codebase', 'code'],
- 'area' => ['href'],
- 'base' => ['href'],
- 'bgsound' => ['src'],
- 'blockquote' => ['cite'],
- 'body' => ['background'],
- 'del' => ['cite'],
- 'embed' => ['pluginspage', 'src'],
- 'form' => ['action'],
- 'frame' => ['src', 'longdesc'],
- 'iframe' => ['src', 'longdesc'],
- 'ilayer' => ['background'],
- 'img' => ['src', 'lowsrc', 'longdesc', 'usemap'],
- 'input' => ['src', 'usemap'],
- 'ins' => ['cite'],
- 'isindex' => ['action'],
- 'head' => ['profile'],
- 'layer' => ['background', 'src'],
- 'link' => ['href'],
- 'object' => ['classid', 'codebase', 'data', 'archive', 'usemap'],
- 'q' => ['cite'],
- 'script' => ['src', 'for'],
- 'table' => ['background'],
- 'td' => ['background'],
- 'th' => ['background'],
- 'tr' => ['background'],
- 'xmp' => ['href'],
-);
-
-=head2 hash %HTML::Tagset::boolean_attr
-
-This hash (not hashset) lists what attributes of what elements can be
-printed without showing the value (for example, the "noshade" attribute
-of "hr" elements). For elements with only one such attribute, its value
-is simply that attribute name. For elements with many such attributes,
-the value is a reference to a hashset containing all such attributes.
-
-=cut
-
-%boolean_attr = (
-# TODO: make these all hashes
- 'area' => 'nohref',
- 'dir' => 'compact',
- 'dl' => 'compact',
- 'hr' => 'noshade',
- 'img' => 'ismap',
- 'input' => { 'checked' => 1, 'readonly' => 1, 'disabled' => 1 },
- 'menu' => 'compact',
- 'ol' => 'compact',
- 'option' => 'selected',
- 'select' => 'multiple',
- 'td' => 'nowrap',
- 'th' => 'nowrap',
- 'ul' => 'compact',
-);
-
-#==========================================================================
-# List of all elements from Extensible HTML version 1.0 Transitional DTD:
-#
-# a abbr acronym address applet area b base basefont bdo big
-# blockquote body br button caption center cite code col colgroup
-# dd del dfn dir div dl dt em fieldset font form h1 h2 h3 h4 h5 h6
-# head hr html i iframe img input ins isindex kbd label legend li
-# link map menu meta noframes noscript object ol optgroup option p
-# param pre q s samp script select small span strike strong style
-# sub sup table tbody td textarea tfoot th thead title tr tt u ul
-# var
-#
-# Varia from Mozilla source internal table of tags:
-# Implemented:
-# xmp listing wbr nobr frame frameset noframes ilayer
-# layer nolayer spacer embed multicol
-# But these are unimplemented:
-# sound?? keygen?? server??
-# Also seen here and there:
-# marquee?? app?? (both unimplemented)
-#==========================================================================
-
-=head2 hashset %HTML::Tagset::isPhraseMarkup
-
-This hashset contains all phrasal-level elements.
-
-=cut
-
-%isPhraseMarkup = map {; $_ => 1 } qw(
- span abbr acronym q sub sup
- cite code em kbd samp strong var dfn strike
- b i u s tt small big
- a img br
- wbr nobr blink
- font basefont bdo
- spacer embed noembed
-); # had: center, hr, table
-
-
-=head2 hashset %HTML::Tagset::is_Possible_Strict_P_Content
-
-This hashset contains all phrasal-level elements that be content of a
-P element, for a strict model of HTML.
-
-=cut
-
-%is_Possible_Strict_P_Content = (
- %isPhraseMarkup,
- %isFormElement,
- map {; $_ => 1} qw( object script map )
- # I've no idea why there's these latter exceptions.
- # I'm just following the HTML4.01 DTD.
-);
-
-#from html4 strict:
-#<!ENTITY % fontstyle "TT | I | B | BIG | SMALL">
-#
-#<!ENTITY % phrase "EM | STRONG | DFN | CODE |
-# SAMP | KBD | VAR | CITE | ABBR | ACRONYM" >
-#
-#<!ENTITY % special
-# "A | IMG | OBJECT | BR | SCRIPT | MAP | Q | SUB | SUP | SPAN | BDO">
-#
-#<!ENTITY % formctrl "INPUT | SELECT | TEXTAREA | LABEL | BUTTON">
-#
-#<!-- %inline; covers inline or "text-level" elements -->
-#<!ENTITY % inline "#PCDATA | %fontstyle; | %phrase; | %special; | %formctrl;">
-
-=head2 hashset %HTML::Tagset::isHeadElement
-
-This hashset contains all elements that elements that should be
-present only in the 'head' element of an HTML document.
-
-=cut
-
-%isHeadElement = map {; $_ => 1 }
- qw(title base link meta isindex script style object bgsound);
-
-=head2 hashset %HTML::Tagset::isList
-
-This hashset contains all elements that can contain "li" elements.
-
-=cut
-
-%isList = map {; $_ => 1 } qw(ul ol dir menu);
-
-=head2 hashset %HTML::Tagset::isTableElement
-
-This hashset contains all elements that are to be found only in/under
-a "table" element.
-
-=cut
-
-%isTableElement = map {; $_ => 1 }
- qw(tr td th thead tbody tfoot caption col colgroup);
-
-=head2 hashset %HTML::Tagset::isFormElement
-
-This hashset contains all elements that are to be found only in/under
-a "form" element.
-
-=cut
-
-%isFormElement = map {; $_ => 1 }
- qw(input select option optgroup textarea button label);
-
-=head2 hashset %HTML::Tagset::isBodyMarkup
-
-This hashset contains all elements that are to be found only in/under
-the "body" element of an HTML document.
-
-=cut
-
-%isBodyElement = map {; $_ => 1 } qw(
- h1 h2 h3 h4 h5 h6
- p div pre plaintext address blockquote
- xmp listing
- center
-
- multicol
- iframe ilayer nolayer
- bgsound
-
- hr
- ol ul dir menu li
- dl dt dd
- ins del
-
- fieldset legend
-
- map area
- applet param object
- isindex script noscript
- table
- center
- form
- ),
- keys %isFormElement,
- keys %isPhraseMarkup, # And everything phrasal
- keys %isTableElement,
-;
-
-
-=head2 hashset %HTML::Tagset::isHeadOrBodyElement
-
-This hashset includes all elements that I notice can fall either in
-the head or in the body.
-
-=cut
-
-%isHeadOrBodyElement = map {; $_ => 1 }
- qw(script isindex style object map area param noscript bgsound);
- # i.e., if we find 'script' in the 'body' or the 'head', don't freak out.
-
-
-=head2 hashset %HTML::Tagset::isKnown
-
-This hashset lists all known HTML elements.
-
-=cut
-
-%isKnown = (%isHeadElement, %isBodyElement,
- map{; $_=>1 }
- qw( head body html
- frame frameset noframes
- ~comment ~pi ~directive ~literal
-));
- # that should be all known tags ever ever
-
-
-=head2 hashset %HTML::Tagset::canTighten
-
-This hashset lists elements that might have ignorable whitespace as
-children or siblings.
-
-=cut
-
-%canTighten = %isKnown;
-delete @canTighten{
- keys(%isPhraseMarkup), 'input', 'select',
- 'xmp', 'listing', 'plaintext', 'pre',
-};
- # xmp, listing, plaintext, and pre are untightenable, and
- # in a really special way.
-@canTighten{'hr','br'} = (1,1);
- # exceptional 'phrasal' things that ARE subject to tightening.
-
-# The one case where I can think of my tightening rules failing is:
-# <p>foo bar<center> <em>baz quux</em> ...
-# ^-- that would get deleted.
-# But that's pretty gruesome code anyhow. You gets what you pays for.
-
-#==========================================================================
-
-=head2 array @HTML::Tagset::p_closure_barriers
-
-This array has a meaning that I have only seen a need for in
-C<HTML::TreeBuilder>, but I include it here on the off chance that someone
-might find it of use:
-
-When we see a "E<lt>pE<gt>" token, we go lookup up the lineage for a p
-element we might have to minimize. At first sight, we might say that
-if there's a p anywhere in the lineage of this new p, it should be
-closed. But that's wrong. Consider this document:
-
- <html>
- <head>
- <title>foo</title>
- </head>
- <body>
- <p>foo
- <table>
- <tr>
- <td>
- foo
- <p>bar
- </td>
- </tr>
- </table>
- </p>
- </body>
- </html>
-
-The second p is quite legally inside a much higher p.
-
-My formalization of the reason why this is legal, but this:
-
- <p>foo<p>bar</p></p>
-
-isn't, is that something about the table constitutes a "barrier" to
-the application of the rule about what p must minimize.
-
-So C<@HTML::Tagset::p_closure_barriers> is the list of all such
-barrier-tags.
-
-=cut
-
-@p_closure_barriers = qw(
- li blockquote
- ul ol menu dir
- dl dt dd
- td th tr table caption
- div
- );
-
-# In an ideal world (i.e., XHTML) we wouldn't have to bother with any of this
-# monkey business of barriers to minimization!
-
-=head2 hashset %isCDATA_Parent
-
-This hashset includes all elements whose content is CDATA.
-
-=cut
-
-%isCDATA_Parent = map {; $_ => 1 }
- qw(script style xmp listing plaintext);
-
-# TODO: there's nothing else that takes CDATA children, right?
-
-# As the HTML3 DTD (Raggett 1995-04-24) noted:
-# The XMP, LISTING and PLAINTEXT tags are incompatible with SGML
-# and derive from very early versions of HTML. They require non-
-# standard parsers and will cause problems for processing
-# documents with standard SGML tools.
-
-
-=head1 CAVEATS
-
-You may find it useful to alter the behavior of modules (like
-C<HTML::Element> or C<HTML::TreeBuilder>) that use C<HTML::Tagset>'s
-data tables by altering the data tables themselves. You are welcome
-to try, but be careful; and be aware that different modules may or may
-react differently to the data tables being changed.
-
-Note that it may be inappropriate to use these tables for I<producing>
-HTML -- for example, C<%isHeadOrBodyElement> lists the tagnames
-for all elements that can appear either in the head or in the body,
-such as "script". That doesn't mean that I am saying your code that
-produces HTML should feel free to put script elements in either place!
-If you are producing programs that spit out HTML, you should be
-I<intimately> familiar with the DTDs for HTML or XHTML (available at
-C<http://www.w3.org/>), and you should slavishly obey them, not
-the data tables in this document.
-
-=head1 SEE ALSO
-
-L<HTML::Element>, L<HTML::TreeBuilder>, L<HTML::LinkExtor>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 1995-2000 Gisle Aas.
-
-Copyright 2000-2005 Sean M. Burke.
-
-Copyright 2005-2008 Andy Lester.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=head1 ACKNOWLEDGEMENTS
-
-Most of the code/data in this module was adapted from code written
-by Gisle Aas for C<HTML::Element>, C<HTML::TreeBuilder>, and
-C<HTML::LinkExtor>. Then it was maintained by Sean M. Burke.
-
-=head1 AUTHOR
-
-Current maintainer: Andy Lester, C<< <andy at petdance.com> >>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-html-tagset at rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=HTML-Tagset>. I will
-be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=cut
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/HTML/TokeParser.pm b/Master/tlpkg/tlperl/lib/HTML/TokeParser.pm
deleted file mode 100755
index 94128dbef75..00000000000
--- a/Master/tlpkg/tlperl/lib/HTML/TokeParser.pm
+++ /dev/null
@@ -1,369 +0,0 @@
-package HTML::TokeParser;
-
-require HTML::PullParser;
-@ISA=qw(HTML::PullParser);
-$VERSION = "3.57";
-
-use strict;
-use Carp ();
-use HTML::Entities qw(decode_entities);
-use HTML::Tagset ();
-
-my %ARGS =
-(
- start => "'S',tagname,attr,attrseq,text",
- end => "'E',tagname,text",
- text => "'T',text,is_cdata",
- process => "'PI',token0,text",
- comment => "'C',text",
- declaration => "'D',text",
-
- # options that default on
- unbroken_text => 1,
-);
-
-
-sub new
-{
- my $class = shift;
- my %cnf;
- if (@_ == 1) {
- my $type = (ref($_[0]) eq "SCALAR") ? "doc" : "file";
- %cnf = ($type => $_[0]);
- }
- else {
- %cnf = @_;
- }
-
- my $textify = delete $cnf{textify} || {img => "alt", applet => "alt"};
-
- my $self = $class->SUPER::new(%cnf, %ARGS) || return undef;
-
- $self->{textify} = $textify;
- $self;
-}
-
-
-sub get_tag
-{
- my $self = shift;
- my $token;
- while (1) {
- $token = $self->get_token || return undef;
- my $type = shift @$token;
- next unless $type eq "S" || $type eq "E";
- substr($token->[0], 0, 0) = "/" if $type eq "E";
- return $token unless @_;
- for (@_) {
- return $token if $token->[0] eq $_;
- }
- }
-}
-
-
-sub _textify {
- my($self, $token) = @_;
- my $tag = $token->[1];
- return undef unless exists $self->{textify}{$tag};
-
- my $alt = $self->{textify}{$tag};
- my $text;
- if (ref($alt)) {
- $text = &$alt(@$token);
- } else {
- $text = $token->[2]{$alt || "alt"};
- $text = "[\U$tag]" unless defined $text;
- }
- return $text;
-}
-
-
-sub get_text
-{
- my $self = shift;
- my @text;
- while (my $token = $self->get_token) {
- my $type = $token->[0];
- if ($type eq "T") {
- my $text = $token->[1];
- decode_entities($text) unless $token->[2];
- push(@text, $text);
- } elsif ($type =~ /^[SE]$/) {
- my $tag = $token->[1];
- if ($type eq "S") {
- if (defined(my $text = _textify($self, $token))) {
- push(@text, $text);
- next;
- }
- } else {
- $tag = "/$tag";
- }
- if (!@_ || grep $_ eq $tag, @_) {
- $self->unget_token($token);
- last;
- }
- push(@text, " ")
- if $tag eq "br" || !$HTML::Tagset::isPhraseMarkup{$token->[1]};
- }
- }
- join("", @text);
-}
-
-
-sub get_trimmed_text
-{
- my $self = shift;
- my $text = $self->get_text(@_);
- $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
- $text;
-}
-
-sub get_phrase {
- my $self = shift;
- my @text;
- while (my $token = $self->get_token) {
- my $type = $token->[0];
- if ($type eq "T") {
- my $text = $token->[1];
- decode_entities($text) unless $token->[2];
- push(@text, $text);
- } elsif ($type =~ /^[SE]$/) {
- my $tag = $token->[1];
- if ($type eq "S") {
- if (defined(my $text = _textify($self, $token))) {
- push(@text, $text);
- next;
- }
- }
- if (!$HTML::Tagset::isPhraseMarkup{$tag}) {
- $self->unget_token($token);
- last;
- }
- push(@text, " ") if $tag eq "br";
- }
- }
- my $text = join("", @text);
- $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
- $text;
-}
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-HTML::TokeParser - Alternative HTML::Parser interface
-
-=head1 SYNOPSIS
-
- require HTML::TokeParser;
- $p = HTML::TokeParser->new("index.html") ||
- die "Can't open: $!";
- $p->empty_element_tags(1); # configure its behaviour
-
- while (my $token = $p->get_token) {
- #...
- }
-
-=head1 DESCRIPTION
-
-The C<HTML::TokeParser> is an alternative interface to the
-C<HTML::Parser> class. It is an C<HTML::PullParser> subclass with a
-predeclared set of token types. If you wish the tokens to be reported
-differently you probably want to use the C<HTML::PullParser> directly.
-
-The following methods are available:
-
-=over 4
-
-=item $p = HTML::TokeParser->new( $filename, %opt );
-
-=item $p = HTML::TokeParser->new( $filehandle, %opt );
-
-=item $p = HTML::TokeParser->new( \$document, %opt );
-
-The object constructor argument is either a file name, a file handle
-object, or the complete document to be parsed. Extra options can be
-provided as key/value pairs and are processed as documented by the base
-classes.
-
-If the argument is a plain scalar, then it is taken as the name of a
-file to be opened and parsed. If the file can't be opened for
-reading, then the constructor will return C<undef> and $! will tell
-you why it failed.
-
-If the argument is a reference to a plain scalar, then this scalar is
-taken to be the literal document to parse. The value of this
-scalar should not be changed before all tokens have been extracted.
-
-Otherwise the argument is taken to be some object that the
-C<HTML::TokeParser> can read() from when it needs more data. Typically
-it will be a filehandle of some kind. The stream will be read() until
-EOF, but not closed.
-
-A newly constructed C<HTML::TokeParser> differ from its base classes
-by having the C<unbroken_text> attribute enabled by default. See
-L<HTML::Parser> for a description of this and other attributes that
-influence how the document is parsed. It is often a good idea to enable
-C<empty_element_tags> behaviour.
-
-Note that the parsing result will likely not be valid if raw undecoded
-UTF-8 is used as a source. When parsing UTF-8 encoded files turn
-on UTF-8 decoding:
-
- open(my $fh, "<:utf8", "index.html") || die "Can't open 'index.html': $!";
- my $p = HTML::TokeParser->new( $fh );
- # ...
-
-If a $filename is passed to the constructor the file will be opened in
-raw mode and the parsing result will only be valid if its content is
-Latin-1 or pure ASCII.
-
-If parsing from an UTF-8 encoded string buffer decode it first:
-
- utf8::decode($document);
- my $p = HTML::TokeParser->new( \$document );
- # ...
-
-=item $p->get_token
-
-This method will return the next I<token> found in the HTML document,
-or C<undef> at the end of the document. The token is returned as an
-array reference. The first element of the array will be a string
-denoting the type of this token: "S" for start tag, "E" for end tag,
-"T" for text, "C" for comment, "D" for declaration, and "PI" for
-process instructions. The rest of the token array depend on the type
-like this:
-
- ["S", $tag, $attr, $attrseq, $text]
- ["E", $tag, $text]
- ["T", $text, $is_data]
- ["C", $text]
- ["D", $text]
- ["PI", $token0, $text]
-
-where $attr is a hash reference, $attrseq is an array reference and
-the rest are plain scalars. The L<HTML::Parser/Argspec> explains the
-details.
-
-=item $p->unget_token( @tokens )
-
-If you find you have read too many tokens you can push them back,
-so that they are returned the next time $p->get_token is called.
-
-=item $p->get_tag
-
-=item $p->get_tag( @tags )
-
-This method returns the next start or end tag (skipping any other
-tokens), or C<undef> if there are no more tags in the document. If
-one or more arguments are given, then we skip tokens until one of the
-specified tag types is found. For example:
-
- $p->get_tag("font", "/font");
-
-will find the next start or end tag for a font-element.
-
-The tag information is returned as an array reference in the same form
-as for $p->get_token above, but the type code (first element) is
-missing. A start tag will be returned like this:
-
- [$tag, $attr, $attrseq, $text]
-
-The tagname of end tags are prefixed with "/", i.e. end tag is
-returned like this:
-
- ["/$tag", $text]
-
-=item $p->get_text
-
-=item $p->get_text( @endtags )
-
-This method returns all text found at the current position. It will
-return a zero length string if the next token is not text. Any
-entities will be converted to their corresponding character.
-
-If one or more arguments are given, then we return all text occurring
-before the first of the specified tags found. For example:
-
- $p->get_text("p", "br");
-
-will return the text up to either a paragraph of linebreak element.
-
-The text might span tags that should be I<textified>. This is
-controlled by the $p->{textify} attribute, which is a hash that
-defines how certain tags can be treated as text. If the name of a
-start tag matches a key in this hash then this tag is converted to
-text. The hash value is used to specify which tag attribute to obtain
-the text from. If this tag attribute is missing, then the upper case
-name of the tag enclosed in brackets is returned, e.g. "[IMG]". The
-hash value can also be a subroutine reference. In this case the
-routine is called with the start tag token content as its argument and
-the return value is treated as the text.
-
-The default $p->{textify} value is:
-
- {img => "alt", applet => "alt"}
-
-This means that <IMG> and <APPLET> tags are treated as text, and that
-the text to substitute can be found in the ALT attribute.
-
-=item $p->get_trimmed_text
-
-=item $p->get_trimmed_text( @endtags )
-
-Same as $p->get_text above, but will collapse any sequences of white
-space to a single space character. Leading and trailing white space is
-removed.
-
-=item $p->get_phrase
-
-This will return all text found at the current position ignoring any
-phrasal-level tags. Text is extracted until the first non
-phrasal-level tag. Textification of tags is the same as for
-get_text(). This method will collapse white space in the same way as
-get_trimmed_text() does.
-
-The definition of <i>phrasal-level tags</i> is obtained from the
-HTML::Tagset module.
-
-=back
-
-=head1 EXAMPLES
-
-This example extracts all links from a document. It will print one
-line for each link, containing the URL and the textual description
-between the <A>...</A> tags:
-
- use HTML::TokeParser;
- $p = HTML::TokeParser->new(shift||"index.html");
-
- while (my $token = $p->get_tag("a")) {
- my $url = $token->[1]{href} || "-";
- my $text = $p->get_trimmed_text("/a");
- print "$url\t$text\n";
- }
-
-This example extract the <TITLE> from the document:
-
- use HTML::TokeParser;
- $p = HTML::TokeParser->new(shift||"index.html");
- if ($p->get_tag("title")) {
- my $title = $p->get_trimmed_text;
- print "Title: $title\n";
- }
-
-=head1 SEE ALSO
-
-L<HTML::PullParser>, L<HTML::Parser>
-
-=head1 COPYRIGHT
-
-Copyright 1998-2005 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut