Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Entities.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Entities.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Entities.pm	(revision 27789)
@@ -0,0 +1,495 @@
+package HTML::Entities;
+
+# $Id$
+
+=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 compatiblity 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 (i.e., which to escape). 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, '<>&"');
+
+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);
+
+# The version we (Greenstone) seem to be using looks like it's come
+# from CVS/SVN and so does not parse the following sprintf statement
+# => Doesn't appear to be used anywhere in this file, so commenting out
+#
+#$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+#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
+{
+    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 $code = "sub {\$_[0] =~ s/([$_[1]])/\$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;
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Filter.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Filter.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Filter.pm	(revision 27789)
@@ -0,0 +1,112 @@
+package HTML::Filter;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+require HTML::Parser;
+@ISA=qw(HTML::Parser);
+
+$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+
+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
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Form.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Form.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Form.pm	(revision 27789)
@@ -0,0 +1,1551 @@
+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
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/HeadParser.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/HeadParser.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/HeadParser.pm	(revision 27789)
@@ -0,0 +1,259 @@
+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="...">
+
+=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 will initialize headers with the prefix
+"C<X-Meta->" on the name.  If the E<lt>meta> element contains a
+C<http-equiv> attribute, then it will be honored as the header name.
+
+=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 = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+
+=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 isa or delegates to the C<HTTP::Headers> class.
+
+If no $header is given C<HTML::HeadParser> will create an
+C<HTTP::Header> 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 => 2,
+				  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)>
+
+
+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)) {
+	    return unless $attr->{'name'};
+	    $key = "X-Meta-\u$attr->{'name'}";
+	}
+	$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|script|style)$/) {
+	# 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}) {
+	    $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) = @_;
+    $text =~ s/\x{FEFF}//;  # drop Unicode BOM if found
+    print "TEXT[$text]\n" if $DEBUG;
+    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;
+}
+
+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
+
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/LinkExtor.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/LinkExtor.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/LinkExtor.pm	(revision 27789)
@@ -0,0 +1,187 @@
+package HTML::LinkExtor;
+
+# $Id$
+
+require HTML::Parser;
+@ISA = qw(HTML::Parser);
+$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+
+=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 follwing 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 diffent 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;
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Parser.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Parser.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Parser.pm	(revision 27789)
@@ -0,0 +1,1233 @@
+package HTML::Parser;
+
+# Copyright 1996-2007, 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.56';  # $Date$
+
+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.  The return
+value is normally a reference to the parser object (i.e. $p).
+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.
+
+=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->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 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>, 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>, 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 endianess
+
+(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-2007 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
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/PullParser.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/PullParser.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/PullParser.pm	(revision 27789)
@@ -0,0 +1,211 @@
+package HTML::PullParser;
+
+# $Id$
+
+require HTML::Parser;
+@ISA=qw(HTML::Parser);
+#$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+
+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
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Tagset.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Tagset.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/Tagset.pm	(revision 27789)
@@ -0,0 +1,470 @@
+package HTML::Tagset;
+
+use strict;
+
+=head1 NAME
+
+HTML::Tagset - data tables useful in parsing HTML
+
+=head1 VERSION
+
+Version 3.10
+
+=cut
+
+use vars qw( $VERSION );
+
+$VERSION = '3.10';
+
+=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
+ );
+
+# 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 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;
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser.pm	(revision 27789)
@@ -0,0 +1,371 @@
+package HTML::TokeParser;
+
+# $Id$
+
+require HTML::PullParser;
+@ISA=qw(HTML::PullParser);
+#$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+
+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
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple.pm	(revision 27789)
@@ -0,0 +1,627 @@
+package HTML::TokeParser::Simple;
+
+use strict;
+use HTML::TokeParser;
+use HTML::TokeParser::Simple::Token;
+use HTML::TokeParser::Simple::Token::Tag;
+use HTML::TokeParser::Simple::Token::Tag::Start;
+use HTML::TokeParser::Simple::Token::Tag::End;
+use HTML::TokeParser::Simple::Token::Text;
+use HTML::TokeParser::Simple::Token::Comment;
+use HTML::TokeParser::Simple::Token::Declaration;
+use HTML::TokeParser::Simple::Token::ProcessInstruction;
+
+use vars qw/ @ISA $VERSION $REVISION /;
+
+$REVISION = '$Id$';
+$VERSION  = '3.15';
+@ISA = qw/ HTML::TokeParser /;
+
+# constructors
+
+my %FACTORY_CLASSES = (
+    S   => 'HTML::TokeParser::Simple::Token::Tag::Start',
+    E   => 'HTML::TokeParser::Simple::Token::Tag::End',
+    T   => 'HTML::TokeParser::Simple::Token::Text',
+    C   => 'HTML::TokeParser::Simple::Token::Comment',
+    D   => 'HTML::TokeParser::Simple::Token::Declaration',
+    PI  => 'HTML::TokeParser::Simple::Token::ProcessInstruction',
+);
+
+sub _croak {
+    my ($proto, $message) = @_;
+    require Carp;
+    Carp::croak($message);
+}
+
+sub new {
+    my ($class, @args) = @_;
+    return 1 == @args
+        ? $class->SUPER::new(@args)
+        : $class->_init(@args);
+}
+
+sub _init {
+    my ($class, $source_type, $source) = @_;
+    my %sources = (
+        file   => sub { $source },
+        handle => sub { $source },
+        string => sub { \$source },
+        url    => sub {
+            eval "require LWP::Simple";
+            $class->_croak("Cannot load LWP::Simple: $@") if $@;
+            my $content = LWP::Simple::get($source);
+            $class->_croak("Could not fetch content from ($source)")
+                unless defined $content;
+            return \$content;
+        },
+    );
+    unless (exists $sources{$source_type}) {
+        $class->_croak("Unknown source type ($source_type)");
+    }
+    return $class->new($sources{$source_type}->());
+}
+
+sub get_token {
+    my $self = shift;
+    my @args = @_;
+    my $token = $self->SUPER::get_token( @args );
+    return unless defined $token;
+    if (my $factory_class = $FACTORY_CLASSES{$token->[0]}) {
+        return $factory_class->new($token);
+    }
+    else {
+        # this should never happen
+        $self->_croak("Cannot determine token class for token (@$token)");
+    }
+}
+
+sub get_tag {
+    my $self = shift;
+    my @args = @_;
+    my $token = $self->SUPER::get_tag( @args );
+    return unless defined $token;
+    return $token->[0] =~ /^\//
+        ?  HTML::TokeParser::Simple::Token::Tag::End->new($token)
+        :  HTML::TokeParser::Simple::Token::Tag::Start->new($token);
+}
+
+sub peek {
+    my ($self, $count) = @_;
+    $count  ||= 1;
+    
+    unless ($count =~ /^\d+$/) {
+        $self->_croak("Argument to peek() must be a positive integer, not ($count)");
+    }
+
+    my $items = 0;
+    my $html  = '';
+    my @tokens;
+    while ( $items++ < $count && defined ( my $token = $self->get_token ) ) {
+        $html .= $token->as_is;
+        push @tokens, $token;
+    }
+    $self->unget_token(@tokens);
+    return $html;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple - Easy to use C<HTML::TokeParser> interface
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+
+=head1 DESCRIPTION
+
+C<HTML::TokeParser> is an excellent module that's often used for parsing HTML.
+However, the tokens returned are not exactly intuitive to parse:
+
+ ["S",  $tag, $attr, $attrseq, $text]
+ ["E",  $tag, $text]
+ ["T",  $text, $is_data]
+ ["C",  $text]
+ ["D",  $text]
+ ["PI", $token0, $text]
+
+To simplify this, C<HTML::TokeParser::Simple> allows the user ask more
+intuitive (read: more self-documenting) questions about the tokens returned.
+
+You can also rebuild some tags on the fly.  Frequently, the attributes
+associated with start tags need to be altered, added to, or deleted.  This
+functionality is built in.
+
+Since this is a subclass of C<HTML::TokeParser>, all C<HTML::TokeParser>
+methods are available.  To truly appreciate the power of this module, please
+read the documentation for C<HTML::TokeParser> and C<HTML::Parser>.
+
+=head1 CONTRUCTORS
+
+=head2 C<new($source)>
+
+The constructor for C<HTML::TokeParser::Simple> can be used just like
+C<HTML::TokeParser>'s constructor:
+
+  my $parser = HTML::TokeParser::Simple->new($filename);
+  # or
+  my $parser = HTML::TokeParser::Simple->new($filehandle);
+  # or
+  my $parser = HTML::TokeParser::Simple->new(\$html_string);
+
+=head2 C<new($source_type, $source)>
+
+If you wish to be more explicit, there is a new style of
+constructor avaiable.
+
+  my $parser = HTML::TokeParser::Simple->new(file   => $filename);
+  # or
+  my $parser = HTML::TokeParser::Simple->new(handle => $filehandle);
+  # or
+  my $parser = HTML::TokeParser::Simple->new(string => $html_string);
+
+Note that you do not have to provide a reference for the string if using the
+string constructor.
+
+As a convenience, you can also attempt to fetch the HTML directly from a URL.
+
+  my $parser = HTML::TokeParser::Simple->new(url => 'http://some.url');
+
+This method relies on C<LWP::Simple>.  If this module is not found or the page
+cannot be fetched, the constructor will C<croak()>.
+
+=head1 PARSER METHODS
+
+=head2 get_token
+
+This method will return the next token that C<HTML::TokeParser::get_token()>
+method would return.  However, it will be blessed into a class appropriate
+which represents the token type.
+
+=head2 get_tag
+
+This method will return the next token that C<HTML::TokeParser::get_tag()>
+method would return.  However, it will be blessed into either the
+L<HTML::TokeParser::Simple::Token::Tag::Start> or
+L<HTML::TokeParser::Simple::Token::Tag::End> class.
+
+=head2 peek
+
+As of version C<3.14>, you can now C<peek()> at the upcomings tokens without
+affecting the state of the parser.  By default, C<peek()> will return the text
+of the next token, but specifying an integer C<$count> will return the text of
+the next C<$count> tokens.
+
+This is useful when you're trying to debug where you are in a document.
+
+ warn $parser->peek(3); # show the next 3 tokens
+
+=head1 ACCESSORS
+
+The following methods may be called on the token object which is returned,
+not on the parser object.
+
+=head2 Boolean Accessors
+
+These accessors return true or false.
+
+=over 4
+
+=item * C<is_tag([$tag])>
+
+Use this to determine if you have any tag.  An optional "tag type" may be
+passed.  This will allow you to match if it's a I<particular> tag.  The
+supplied tag is case-insensitive.
+
+ if ( $token->is_tag ) { ... }
+
+Optionally, you may pass a regular expression as an argument.
+
+=item * C<is_start_tag([$tag])>
+
+Use this to determine if you have a start tag.  An optional "tag type" may be
+passed.  This will allow you to match if it's a I<particular> start tag.  The
+supplied tag is case-insensitive.
+
+ if ( $token->is_start_tag ) { ... }
+ if ( $token->is_start_tag( 'font' ) ) { ... }
+
+Optionally, you may pass a regular expression as an argument.  To match all
+header (h1, h2, ... h6) tags:
+
+ if ( $token->is_start_tag( qr/^h[123456]$/ ) ) { ... }
+
+=item * C<is_end_tag([$tag])>
+
+Use this to determine if you have an end tag.  An optional "tag type" may be
+passed.  This will allow you to match if it's a I<particular> end tag.  The
+supplied tag is case-insensitive.
+
+When testing for an end tag, the forward slash on the tag is optional.
+
+ while ( $token = $p->get_token ) {
+   if ( $token->is_end_tag( 'form' ) ) { ... }
+ }
+
+Or:
+
+ while ( $token = $p->get_token ) {
+   if ( $token->is_end_tag( '/form' ) ) { ... }
+ }
+
+Optionally, you may pass a regular expression as an argument.
+
+=item * C<is_text()>
+
+Use this to determine if you have text.  Note that this is I<not> to be
+confused with the C<return_text> (I<deprecated>) method described below!
+C<is_text> will identify text that the user typically sees display in the Web
+browser.
+
+=item * C<is_comment()>
+
+Are you still reading this?  Nobody reads POD.  Don't you know you're supposed
+to go to CLPM, ask a question that's answered in the POD and get flamed?  It's
+a rite of passage.
+
+Really.
+
+C<is_comment> is used to identify comments.  See the HTML::Parser documentation
+for more information about comments.  There's more than you might think.
+
+=item * C<is_declaration()>
+
+This will match the DTD at the top of your HTML. (You I<do> use DTD's, don't
+you?)
+
+=item * C<is_process_instruction()>
+
+Process Instructions are from XML.  This is very handy if you need to parse out
+PHP and similar things with a parser.
+
+Currently, there appear to be some problems with process instructions.  You can
+override C<HTML::TokeParser::Simple::Token::ProcessInstruction> if you need to.
+
+=item * C<is_pi()>
+
+This is a shorthand for C<is_process_instruction()>.
+
+=back
+
+=head2 Data Accessors
+
+Some of these were originally C<return_> methods, but that name was not only
+unwieldy, but also went against reasonable conventions.  The C<get_> methods
+listed below still have C<return_> methods available for backwards
+compatibility reasons, but they merely call their C<get_> counterpart.  For
+example, calling C<return_tag()> actually calls C<get_tag()> internally.
+
+=over 4
+
+=item * C<get_tag()>
+
+Do you have a start tag or end tag?  This will return the type (lower case).
+Note that this is I<not> the same as the C<get_tag()> method on the actual
+parser object.
+
+=item * C<get_attr([$attribute])>
+
+If you have a start tag, this will return a hash ref with the attribute names
+as keys and the values as the values.
+
+If you pass in an attribute name, it will return the value for just that
+attribute.  
+
+Returns false if the token is not a start tag.
+
+=item * C<get_attrseq()>
+
+For a start tag, this is an array reference with the sequence of the
+attributes, if any.
+
+Returns false if the token is not a start tag.
+
+=item * C<return_text()>
+
+This method has been heavily deprecated (for a couple of years) in favor of
+C<as_is>.  Programmers were getting confused over the difference between
+C<is_text>, C<return_text>, and some parser methods such as
+C<HTML::TokeParser::get_text> and friends.
+
+Using this method still succeeds, but will now carp and B<will be removed>
+in the next major release of this module.
+
+=item * C<as_is()>
+
+This is the exact text of whatever the token is representing.
+
+=item * C<get_token0()>
+
+For processing instructions, this will return the token found immediately after
+the opening tag.  Example:  For <?php, "php" will be the start of the returned
+string.
+
+Note that process instruction handling appears to be incomplete in
+C<HTML::TokeParser>.
+
+Returns false if the token is not a process instruction.
+
+=back
+
+=head1 MUTATORS
+
+The C<delete_attr()> and C<set_attr()> methods allow the programmer to rewrite
+start tag attributes on the fly.  It should be noted that bad HTML will be
+"corrected" by this.  Specifically, the new tag will have all attributes
+lower-cased with the values properly quoted.
+
+Self-closing tags (e.g. E<lt>hr /E<gt>) are also handled correctly.  Some older
+browsers require a space prior to the final slash in a self-closed tag.  If
+such a space is detected in the original HTML, it will be preserved.
+
+Calling a mutator on an token type that does not support that property is a
+no-op.  For example:
+
+ if ($token->is_comment) {
+    $token->set_attr(foo => 'bar'); # does nothing
+ }
+
+=over 4
+
+=item * C<delete_attr($name)>
+
+This method attempts to delete the attribute specified.  It will silently fail
+if called on anything other than a start tag.  The argument is
+case-insensitive, but must otherwise be an exact match of the attribute you are
+attempting to delete.  If the attribute is not found, the method will return
+without changing the tag.
+
+ # <body bgcolor="#FFFFFF">
+ $token->delete_attr('bgcolor');
+ print $token->as_is;
+ # <body>
+ 
+After this method is called, if successful, the C<as_is()>, C<get_attr()>
+and C<get_attrseq()> methods will all return updated results.
+
+=item * C<set_attr($name,$value)>
+
+This method will set the value of an attribute.  If the attribute is not found,
+then C<get_attrseq()> will have the new attribute listed at the end.
+
+ # <p>
+ $token->set_attr(class => 'some_class');
+ print $token->as_is;
+ # <p class="some_class">
+
+ # <body bgcolor="#FFFFFF">
+ $token->set_attr('bgcolor','red');
+ print $token->as_is;
+ # <body bgcolor="red">
+
+After this method is called, if successful, the C<as_is()>, C<get_attr()>
+and C<get_attrseq()> methods will all return updated results.
+
+=item * C<set_attr($hashref)>
+
+Under the premise that C<set_> methods should accept what their corresponding
+C<get_> methods emit, the following works:
+
+  $tag->set_attr($tag->get_attr);
+
+Theoretically that's a no-op and for purposes of rendering HTML, it should be.
+However, internally this calls C<$tag-E<gt>rewrite_tag>, so see that method to
+understand how this may affect you.
+
+Of course, this is useless if you want to actually change the attributes, so you
+can do this:
+
+  my $attrs = {
+    class  => 'headline',
+    valign => 'top'
+  };
+  $token->set_attr($attrs) 
+    if $token->is_start_tag('td') &&  $token->get_attr('class') eq 'stories';
+
+=item * C<rewrite_tag()>
+
+This method rewrites the tag.  The tag name and the name of all attributes will
+be lower-cased.  Values that are not quoted with double quotes will be.  This
+may be called on both start or end tags.  Note that both C<set_attr()> and
+C<delete_attr()> call this method prior to returning.
+
+If called on a token that is not a tag, it simply returns.  Regardless of how
+it is called, it returns the token.
+
+ # <body alink=#0000ff BGCOLOR=#ffffff class='none'>
+ $token->rewrite_tag;
+ print $token->as_is;
+ # <body alink="#0000ff" bgcolor="#ffffff" class="none">
+
+A quick cleanup of sloppy HTML is now the following:
+
+ my $parser = HTML::TokeParser::Simple->new( string => $ugly_html );
+ while (my $token = $parser->get_token) {
+     $token->rewrite_tag;
+     print $token->as_is;
+ }
+
+=back
+
+=head1 PARSER VERSUS TOKENS 
+
+The parser returns tokens that are blessed into appropriate classes.  Some
+people get confused and try to call parser methods on tokens and token methods
+on the parser.  To prevent this, C<HTML::TokeParser::Simple> versions 1.4 and
+above now bless all tokens into appropriate token classes.  Please keep this in
+mind while using this module (and many thanks to PodMaster
+L<http://www.perlmonks.org/index.pl?node_id=107642> for pointing out this issue
+to me.)
+
+=head1 EXAMPLES
+
+=head2 Finding comments
+
+For some strange reason, your Pointy-Haired Boss (PHB) is convinced that the
+graphics department is making fun of him by embedding rude things about him in
+HTML comments.  You need to get all HTML comments from the HTML.
+
+ use strict;
+ use HTML::TokeParser::Simple;
+
+ my @html_docs = glob( "*.html" );
+
+ open PHB, "> phbreport.txt" or die "Cannot open phbreport for writing: $!";
+
+ foreach my $doc ( @html_docs ) {
+     print "Processing $doc\n";
+     my $p = HTML::TokeParser::Simple->new( file => $doc );
+     while ( my $token = $p->get_token ) {
+         next unless $token->is_comment;
+         print PHB $token->as_is, "\n";
+     }
+ }
+
+ close PHB;
+
+=head2 Stripping Comments
+
+Uh oh.  Turns out that your PHB was right for a change.  Many of the comments
+in the HTML weren't very polite.  Since your entire graphics department was
+just fired, it falls on you need to strip those comments from the HTML.
+
+ use strict;
+ use HTML::TokeParser::Simple;
+
+ my $new_folder = 'no_comment/';
+ my @html_docs  = glob( "*.html" );
+
+ foreach my $doc ( @html_docs ) {
+     print "Processing $doc\n";
+     my $new_file = "$new_folder$doc";
+
+     open PHB, "> $new_file" or die "Cannot open $new_file for writing: $!";
+
+     my $p = HTML::TokeParser::Simple->new( $file => doc );
+     while ( my $token = $p->get_token ) {
+         next if $token->is_comment;
+         print PHB $token->as_is;
+     }
+     close PHB;
+ }
+
+=head2 Changing form tags
+
+Your company was foo.com and now is bar.com.  Unfortunately, whoever wrote your
+HTML decided to hardcode "http://www.foo.com/" into the C<action> attribute of
+the form tags.  You need to change it to "http://www.bar.com/".
+
+ use strict;
+ use HTML::TokeParser::Simple;
+
+ my $new_folder = 'new_html/';
+ my @html_docs  = glob( "*.html" );
+
+ foreach my $doc ( @html_docs ) {
+     print "Processing $doc\n";
+     my $new_file = "$new_folder$doc";
+
+     open FILE, "> $new_file" or die "Cannot open $new_file for writing: $!";
+
+     my $p = HTML::TokeParser::Simple->new( file => $doc );
+     while ( my $token = $p->get_token ) {
+         if ( $token->is_start_tag('form') ) {
+             my $action = $token->get_attr(action);
+             $action =~ s/www\.foo\.com/www.bar.com/;
+             $token->set_attr('action', $action);
+         }
+         print FILE $token->as_is;
+     }
+     close FILE;
+ }
+
+=head1 CAVEATS
+
+For compatability reasons with C<HTML::TokeParser>, methods that return
+references are violating encapsulation and altering the references directly
+B<will> alter the state of the object.  Subsequent calls to C<rewrite_tag()>
+can thus have unexpected results.  Do not alter these references directly
+unless you are following behavior described in these docs.  In the future,
+certain methods such as C<get_attr>, C<get_attrseq> and others may return a
+copy of the reference rather than the original reference.  This behavior has
+not yet been changed in order to maintain compatability with previous versions
+of this module.  At the present time, your author is not aware of anyone taking
+advantage of this "feature," but it's better to be safe than sorry.
+
+Use of C<$HTML::Parser::VERSION> which is less than 3.25 may result in
+incorrect behavior as older versions do not always handle XHTML correctly.  It
+is the programmer's responsibility to verify that the behavior of this code
+matches the programmer's needs.
+
+Note that C<HTML::Parser> processes text in 512 byte chunks.  This sometimes
+will cause strange behavior and cause text to be broken into more than one
+token.  You can suppress this behavior with the following command:
+
+ $p->unbroken_text( [$bool] );
+
+See the C<HTML::Parser> documentation and
+http://www.perlmonks.org/index.pl?node_id=230667 for more information.
+
+=head1 BUGS
+
+There are no known bugs, but that's no guarantee.
+
+Address bug reports and comments to: E<lt>eop_divo_sitruc@yahoo.comE<gt>.  When
+sending bug reports, please provide the version of C<HTML::Parser>,
+C<HTML::TokeParser>, C<HTML::TokeParser::Simple>, the version of Perl, and the
+version of the operating system you are using.
+
+Reverse the name to email the author.
+
+=head1 SUBCLASSING
+
+You may wish to change the behavior of this module.  You probably do not want
+to subclass C<HTML::TokeParser::Simple>.  Instead, you'll want to subclass one
+of the token classes.  C<HTML::TokeParser::Simple::Token> is the base class for
+all tokens.  Global behavioral changes should go there.  Otherwise, see the
+appropriate token class for the behavior you wish to alter.
+
+=head1 SEE ALSO
+
+L<HTML::TokeParser::Simple::Token>
+
+L<HTML::TokeParser::Simple::Token::Tag>
+
+L<HTML::TokeParser::Simple::Token::Text>
+
+L<HTML::TokeParser::Simple::Token::Comment>
+
+L<HTML::TokeParser::Simple::Token::Declaration>
+
+L<HTML::TokeParser::Simple::Token::ProcessInstruction>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by Curtis "Ovid" Poe.  All rights reserved.  This program is
+free software; you may redistribute it and/or modify it under the same terms as
+Perl itself
+
+=head1 AUTHOR
+
+Curtis "Ovid" Poe E<lt>eop_divo_sitruc@yahoo.comE<gt>
+
+Reverse the name to email the author.
+
+=cut
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token.pm	(revision 27789)
@@ -0,0 +1,133 @@
+package HTML::TokeParser::Simple::Token;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '3.0';
+
+sub new {
+    my ($class, $token) = @_;
+    $class->_croak("This class should not be instantiated") if __PACKAGE__ eq $class;
+    return bless $token, $class;
+}
+
+sub _croak {
+    my ($proto, $message) = @_;
+    require Carp;
+    Carp::croak($message);
+}
+
+sub _carp {
+    my ($proto, $message) = @_;
+    require Carp;
+    Carp::carp($message);
+}
+
+sub is_tag         {}
+sub is_start_tag   {}
+sub is_end_tag     {}
+sub is_text        {}
+sub is_comment     {}
+sub is_declaration {}
+sub is_pi          {}
+sub is_process_instruction {}
+
+sub rewrite_tag    { shift }
+sub delete_attr    {}
+sub set_attr       {}
+sub get_tag        {}
+sub return_tag     {}  # deprecated
+sub get_attr       {}
+sub return_attr    {}  # deprecated
+sub get_attrseq    {}
+sub return_attrseq {}  # deprecated
+sub get_token0     {}
+sub return_token0  {}  # deprecated
+
+# get_foo methods
+
+sub return_text {
+    my ($self) = @_;
+    $self->_carp('return_text() is deprecated.  Use as_is() instead');
+    goto &as_is;
+}
+
+sub as_is { return shift->[-1] }
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token - Base class for C<HTML::TokeParser::Simple>
+tokens.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+This is the base class for all returned tokens.  It should never be
+instantiated directly.  In fact, it will C<croak()> if it is.
+
+=head1 METHODS
+
+The following list of methods are provided by this class.  Most of these are
+stub methods which must be overridden in a subclass.  See 
+L<HTML::TokeParser::Simple> for descriptions of these methods.
+
+=over 4
+
+=item * as_is
+
+=item * delete_attr
+
+=item * get_attr
+
+=item * get_attrseq
+
+=item * get_tag
+
+=item * get_token0
+
+=item * is_comment
+
+=item * is_declaration
+
+=item * is_end_tag
+
+=item * is_pi
+
+=item * is_process_instruction
+
+=item * is_start_tag
+
+=item * is_tag
+
+=item * is_text
+
+=item * return_attr
+
+=item * return_attrseq
+
+=item * return_tag
+
+=item * return_text
+
+=item * return_token0
+
+=item * rewrite_tag
+
+=item * set_attr
+
+=back
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Comment.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Comment.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Comment.pm	(revision 27789)
@@ -0,0 +1,44 @@
+package HTML::TokeParser::Simple::Token::Comment;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '1.0';
+use base 'HTML::TokeParser::Simple::Token';
+
+sub is_comment { 1 }
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token::Comment - Token.pm comment class.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+This is the class for comment tokens.
+
+See L<HTML::Parser> for detailed information about comments.
+
+=head1 OVERRIDDEN METHODS
+
+=head2 is_comment
+
+C<is_comment()> will return true if the token is the DTD at the top of the
+HTML.
+
+=cut
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Declaration.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Declaration.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Declaration.pm	(revision 27789)
@@ -0,0 +1,42 @@
+package HTML::TokeParser::Simple::Token::Declaration;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '1.0';
+use base 'HTML::TokeParser::Simple::Token';
+
+sub is_declaration { 1 }
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token::Declaration - Token.pm declaration class.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+This is the declaration class for tokens. 
+
+=head1 OVERRIDDEN METHODS
+
+=head2 is_declaration
+
+C<is_declaration()> will return true if the token is the DTD at the top of the
+HTML.
+
+=cut
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/ProcessInstruction.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/ProcessInstruction.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/ProcessInstruction.pm	(revision 27789)
@@ -0,0 +1,63 @@
+package HTML::TokeParser::Simple::Token::ProcessInstruction;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '2.0';
+use base 'HTML::TokeParser::Simple::Token';
+
+sub return_token0 { goto &get_token0 } # deprecated
+
+sub get_token0 {
+    return shift->[1];
+}
+
+sub is_pi { 1 }
+
+sub is_process_instruction { 1 }
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token::ProcessInstruction - Token.pm process instruction class.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+Process Instructions are from XML.  This is very handy if you need to parse out
+PHP and similar things with a parser.
+
+Currently, there appear to be some problems with process instructions.  You can
+override this class if you need finer grained handling of process instructions.
+
+C<is_pi()> and C<is_process_instruction()> both return true.
+
+=head1 OVERRIDDEN METHODS
+
+=over 4
+
+=item * get_token0
+
+=item * is_pi
+
+=item * is_process_instruction
+
+=item * return_token0
+
+=back
+
+=cut
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag.pm	(revision 27789)
@@ -0,0 +1,84 @@
+package HTML::TokeParser::Simple::Token::Tag;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '1.2';
+use base 'HTML::TokeParser::Simple::Token';
+
+my %INSTANCE;
+
+sub new {
+    my ($class, $object) = @_;
+    $class->_croak("This is a base class that should not be instantiated") 
+        if __PACKAGE__ eq $class;
+    my $self = bless $object, $class;
+    $self->_init;
+}
+
+sub _get_attrseq { return [] }
+
+sub _get_attr { return {} }
+
+sub _set_text   { 
+    my $self = shift; 
+    $self->[-1] = shift;
+    return $self;
+}
+
+# attribute munging methods
+# get_foo methods
+
+sub return_text {
+    carp('return_text() is deprecated.  Use as_is() instead');
+    goto &as_is;
+}
+
+sub as_is {
+    return shift->_get_text;
+}
+
+sub get_tag {
+    return shift->_get_tag;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token::Tag - Token.pm tag class.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+This is the base class for start and end tokens.  It should not be
+instantiated.  See C<HTML::TokeParser::Simple::Token::Tag::Start> and
+C<HTML::TokeParser::Simple::Token::Tag::End> for details.
+
+=head1 OVERRIDDEN METHODS
+
+The following list of methods are provided by this class.  See
+L<HTML::TokeParser::Simple> for descriptions of these methods.
+
+=over 4
+
+=item * as_is
+
+=item * get_tag
+
+=item * return_text
+
+=back
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag/End.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag/End.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag/End.pm	(revision 27789)
@@ -0,0 +1,135 @@
+package HTML::TokeParser::Simple::Token::Tag::End;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '1.0';
+use base 'HTML::TokeParser::Simple::Token::Tag';
+
+my %TOKEN = (
+    tag   => 1,
+    text  => 2
+);
+
+# in order to maintain the 'drop-in replacement' ability with HTML::TokeParser,
+# we cannot alter the array refs.  Thus we must store instance data here.  Ugh.
+
+my %INSTANCE;
+
+sub _init {
+    my $self = shift;
+    if ('E' eq $self->[0]) {
+        $INSTANCE{$self}{offset} = 0;
+        $INSTANCE{$self}{tag}    = $self->[1];
+    }
+    else {
+        $INSTANCE{$self}{offset} = -1;
+        my $tag = $self->[0];
+        $tag =~ s/^\///;
+        $INSTANCE{$self}{tag}    = $tag;
+    }
+    return $self;
+}
+
+sub _get_offset { return $INSTANCE{+shift}{offset} }
+sub _get_text   { return shift->[-1] }
+
+sub _get_tag {
+    my $self  = shift;
+    return $INSTANCE{$self}{tag};
+}
+
+sub DESTROY     { delete $INSTANCE{+shift} }
+
+sub rewrite_tag {
+    my $self    = shift;
+    # capture the final slash if the tag is self-closing
+    my ($self_closing) = $self->_get_text =~ m{(\s?/)>$};
+    $self_closing ||= '';
+    
+    my $first = $self->is_end_tag ? '/' : '';
+    my $tag = sprintf '<%s%s%s>', $first, $self->get_tag, $self_closing;
+    $self->_set_text($tag);
+    return $self;
+}
+
+sub return_text {
+    require Carp;
+    Carp::carp('return_text() is deprecated.  Use as_is() instead');
+    goto &as_is;
+}
+
+sub as_is {
+    return shift->_get_text;
+}
+
+sub get_tag {
+    return shift->_get_tag;
+}
+
+# is_foo methods
+
+sub is_tag {
+    my $self = shift;
+    return $self->is_end_tag( @_ );
+}
+
+sub is_end_tag {
+    my ($self, $tag) = @_;
+    return $tag ? $self->_match_tag($tag) : 1;
+}
+
+sub _match_tag {
+    my ($self, $tag) = @_;
+    if ('Regexp' eq ref $tag) {
+        return $self->_get_tag =~ $tag;
+    }
+    else {
+        $tag = lc $tag;
+        $tag =~ s/^\///;
+        return $self->_get_tag eq $tag;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token::Tag::End - Token.pm "end tag" class.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+This class does most of the heavy lifting for C<HTML::TokeParser::Simple>.  See
+the C<HTML::TokeParser::Simple> docs for details.
+
+=head1 OVERRIDDEN METHODS
+
+=over 4
+
+=item * as_is
+
+=item * get_tag
+
+=item * is_end_tag
+
+=item * is_tag
+
+=item * return_text
+
+=item * rewrite_tag
+
+=cut
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag/Start.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag/Start.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Tag/Start.pm	(revision 27789)
@@ -0,0 +1,229 @@
+package HTML::TokeParser::Simple::Token::Tag::Start;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '1.0';
+use base 'HTML::TokeParser::Simple::Token::Tag';
+
+use HTML::Entities qw/encode_entities/;
+
+my %TOKEN = (
+    tag     => 1,
+    attr    => 2,
+    attrseq => 3,
+    text    => 4
+);
+
+my %INSTANCE;
+
+sub _init {
+    my $self = shift;
+    if ('S' eq $self->[0]) {
+        $INSTANCE{$self}{offset} = 0;
+        $INSTANCE{$self}{tag}    = $self->[1];
+    }
+    else {
+        $INSTANCE{$self}{offset} = -1;
+        my $tag = $self->[0];
+        $tag =~ s/^\///;
+        $INSTANCE{$self}{tag}    = $tag;
+    }
+    return $self;
+}
+
+sub _get_offset { return $INSTANCE{+shift}{offset} }
+sub _get_text   { return shift->[-1] }
+
+sub _get_tag {
+    my $self  = shift;
+    return $INSTANCE{$self}{tag};
+}
+
+sub _get_attrseq {
+    my $self  = shift;
+    my $index = $TOKEN{attrseq} + $self->_get_offset;
+    return $self->[$index];
+}
+
+sub _get_attr {
+    my $self  = shift;
+    my $index = $TOKEN{attr} + $self->_get_offset;
+    return $self->[$index];
+}
+
+sub DESTROY     { delete $INSTANCE{+shift} }
+
+sub return_attr    { goto &get_attr }
+sub return_attrseq { goto &get_attrseq }
+sub return_tag     { goto &get_tag }
+
+# attribute munging methods
+
+sub set_attr {
+    my ($self, $name, $value) = @_;
+    return 'HASH' eq ref $name
+        ? $self->_set_attr_from_hashref($name)
+        : $self->_set_attr_from_string($name, $value);
+}
+
+sub _set_attr_from_string {
+    my ($self, $name, $value) = @_;
+    $name = lc $name;
+    my $attr    = $self->get_attr;
+    my $attrseq = $self->get_attrseq;
+    unless (exists $attr->{$name}) {
+        push @$attrseq => $name;
+    }
+    $attr->{$name} = $value;
+    $self->rewrite_tag;
+}
+
+sub _set_attr_from_hashref {
+    my ($self, $attr_hash) = @_;
+    while (my ($attr, $value) = each %$attr_hash) {
+        $self->set_attr($attr, $value);
+    }
+    return $self;
+}
+
+sub rewrite_tag {
+    my $self    = shift;
+    my $attr    = $self->get_attr;
+    my $attrseq = $self->get_attrseq;
+
+    # capture the final slash if the tag is self-closing
+    my ($self_closing) = $self->_get_text =~ m{(\s?/)>$};
+    $self_closing ||= '';
+    
+    my $tag = '';
+    foreach ( @$attrseq ) {
+        next if $_ eq '/'; # is this a bug in HTML::TokeParser?
+        $tag .= sprintf qq{ %s="%s"} => $_, encode_entities($attr->{$_});
+    }
+    my $first = $self->is_end_tag ? '/' : '';
+    $tag = sprintf '<%s%s%s%s>', $first, $self->get_tag, $tag, $self_closing;
+    $self->_set_text($tag);
+    return $self;
+}
+
+sub delete_attr {
+    my ($self,$name) = @_;
+    $name = lc $name;
+    my $attr = $self->get_attr;
+    return unless exists $attr->{$name};
+    delete $attr->{$name};
+    my $attrseq = $self->get_attrseq;
+    @$attrseq = grep { $_ ne $name } @$attrseq;
+    $self->rewrite_tag;
+}
+
+# get_foo methods
+
+sub return_text {
+    require Carp;
+    Carp::carp('return_text() is deprecated.  Use as_is() instead');
+    goto &as_is;
+}
+
+sub as_is {
+    return shift->_get_text;
+}
+
+sub get_tag {
+    return shift->_get_tag;
+}
+
+sub get_token0 {
+    return '';
+}
+
+sub get_attr {
+    my $self = shift;
+    my $attributes = $self->_get_attr;
+    return @_ ? $attributes->{lc shift} : $attributes;
+}
+
+sub get_attrseq {
+    my $self = shift;
+    $self->_get_attrseq;
+}
+
+# is_foo methods
+
+sub is_tag {
+    my $self = shift;
+    return $self->is_start_tag( @_ );
+}
+
+sub is_start_tag {
+    my ($self, $tag) = @_;
+    return $tag ? $self->_match_tag($tag) : 1;
+}
+
+sub _match_tag {
+    my ($self, $tag) = @_;
+    return 'Regexp' eq ref $tag
+        ? $self->_get_tag =~ $tag
+        : $self->_get_tag eq lc $tag;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token::Tag::Start - Token.pm "start tag" class.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+This class does most of the heavy lifting for C<HTML::TokeParser::Simple>.  See
+the C<HTML::TokeParser::Simple> docs for details.
+
+=head1 OVERRIDDEN METHODS
+
+=over 4
+
+=item * as_is
+
+=item * delete_attr
+
+=item * get_attr
+
+=item * get_attrseq
+
+=item * get_tag
+
+=item * get_token0
+
+=item * is_start_tag
+
+=item * is_tag
+
+=item * return_attr
+
+=item * return_attrseq
+
+=item * return_tag
+
+=item * return_text
+
+=item * rewrite_tag
+
+=item * set_attr
+
+=cut
+
Index: /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Text.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Text.pm	(revision 27789)
+++ /main/trunk/greenstone2/perllib/cpan/perl-5.8/HTML/TokeParser/Simple/Token/Text.pm	(revision 27789)
@@ -0,0 +1,50 @@
+package HTML::TokeParser::Simple::Token::Text;
+
+use strict;
+
+use vars qw/ $VERSION $REVISION /;
+$REVISION = '$Id$';
+$VERSION  = '1.0';
+use base 'HTML::TokeParser::Simple::Token';
+
+sub as_is {
+    return shift->[1];
+}
+
+sub is_text { 1 }
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser::Simple::Token::Text - Token.pm text class.
+
+=head1 SYNOPSIS
+
+ use HTML::TokeParser::Simple;
+ my $p = HTML::TokeParser::Simple->new( $somefile );
+
+ while ( my $token = $p->get_token ) {
+     # This prints all text in an HTML doc (i.e., it strips the HTML)
+     next unless $token->is_text;
+     print $token->as_is;
+ }
+
+=head1 DESCRIPTION
+
+This class represents "text" tokens.  See the C<HTML::TokeParser::Simple>
+documentation for details.
+
+=head1 OVERRIDDEN METHODS
+
+=over 4
+
+=item * as_is
+
+=item * is_text
+
+=back
+
+=cut
