From f64d7ab506e73cd9643989e77ffd13654c3d5f55 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Sun, 27 Feb 2011 21:02:16 +0000 Subject: LWP module plus dependencies git-svn-id: svn://tug.org/texlive/trunk@21533 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/lib/Bundle/LWP.pm | 44 + Master/tlpkg/tlperl/lib/File/Listing.pm | 412 +++++ Master/tlpkg/tlperl/lib/HTML/Entities.pm | 485 ++++++ Master/tlpkg/tlperl/lib/HTML/Filter.pm | 112 ++ Master/tlpkg/tlperl/lib/HTML/Form.pm | 1551 ++++++++++++++++++ Master/tlpkg/tlperl/lib/HTML/HeadParser.pm | 307 ++++ Master/tlpkg/tlperl/lib/HTML/LinkExtor.pm | 185 +++ Master/tlpkg/tlperl/lib/HTML/Parser.pm | 1240 ++++++++++++++ Master/tlpkg/tlperl/lib/HTML/PullParser.pm | 209 +++ Master/tlpkg/tlperl/lib/HTML/Tagset.pm | 471 ++++++ Master/tlpkg/tlperl/lib/HTML/TokeParser.pm | 369 +++++ Master/tlpkg/tlperl/lib/HTTP/Config.pm | 436 +++++ Master/tlpkg/tlperl/lib/HTTP/Cookies.pm | 781 +++++++++ Master/tlpkg/tlperl/lib/HTTP/Cookies/Microsoft.pm | 329 ++++ Master/tlpkg/tlperl/lib/HTTP/Cookies/Netscape.pm | 114 ++ Master/tlpkg/tlperl/lib/HTTP/Daemon.pm | 903 +++++++++++ Master/tlpkg/tlperl/lib/HTTP/Date.pm | 389 +++++ Master/tlpkg/tlperl/lib/HTTP/Headers.pm | 849 ++++++++++ Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm | 98 ++ Master/tlpkg/tlperl/lib/HTTP/Headers/ETag.pm | 94 ++ Master/tlpkg/tlperl/lib/HTTP/Headers/Util.pm | 199 +++ Master/tlpkg/tlperl/lib/HTTP/Message.pm | 1102 +++++++++++++ Master/tlpkg/tlperl/lib/HTTP/Negotiate.pm | 529 ++++++ Master/tlpkg/tlperl/lib/HTTP/Request.pm | 242 +++ Master/tlpkg/tlperl/lib/HTTP/Request/Common.pm | 511 ++++++ Master/tlpkg/tlperl/lib/HTTP/Response.pm | 641 ++++++++ Master/tlpkg/tlperl/lib/HTTP/Status.pm | 254 +++ Master/tlpkg/tlperl/lib/LWP.pm | 654 ++++++++ Master/tlpkg/tlperl/lib/LWP/Authen/Basic.pm | 65 + Master/tlpkg/tlperl/lib/LWP/Authen/Digest.pm | 68 + Master/tlpkg/tlperl/lib/LWP/Authen/Ntlm.pm | 180 +++ Master/tlpkg/tlperl/lib/LWP/ConnCache.pm | 310 ++++ Master/tlpkg/tlperl/lib/LWP/Debug.pm | 110 ++ Master/tlpkg/tlperl/lib/LWP/DebugFile.pm | 5 + Master/tlpkg/tlperl/lib/LWP/MediaTypes.pm | 298 ++++ Master/tlpkg/tlperl/lib/LWP/MemberMixin.pm | 44 + Master/tlpkg/tlperl/lib/LWP/Protocol.pm | 291 ++++ Master/tlpkg/tlperl/lib/LWP/Protocol/GHTTP.pm | 73 + Master/tlpkg/tlperl/lib/LWP/Protocol/cpan.pm | 72 + Master/tlpkg/tlperl/lib/LWP/Protocol/data.pm | 52 + Master/tlpkg/tlperl/lib/LWP/Protocol/file.pm | 146 ++ Master/tlpkg/tlperl/lib/LWP/Protocol/ftp.pm | 543 +++++++ Master/tlpkg/tlperl/lib/LWP/Protocol/gopher.pm | 213 +++ Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm | 475 ++++++ Master/tlpkg/tlperl/lib/LWP/Protocol/http10.pm | 289 ++++ Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm | 51 + Master/tlpkg/tlperl/lib/LWP/Protocol/https10.pm | 75 + Master/tlpkg/tlperl/lib/LWP/Protocol/loopback.pm | 26 + Master/tlpkg/tlperl/lib/LWP/Protocol/mailto.pm | 183 +++ Master/tlpkg/tlperl/lib/LWP/Protocol/nntp.pm | 145 ++ Master/tlpkg/tlperl/lib/LWP/Protocol/nogo.pm | 24 + Master/tlpkg/tlperl/lib/LWP/RobotUA.pm | 308 ++++ Master/tlpkg/tlperl/lib/LWP/Simple.pm | 253 +++ Master/tlpkg/tlperl/lib/LWP/UserAgent.pm | 1699 ++++++++++++++++++++ Master/tlpkg/tlperl/lib/LWP/media.types | 1064 ++++++++++++ Master/tlpkg/tlperl/lib/Net/HTTP.pm | 279 ++++ Master/tlpkg/tlperl/lib/Net/HTTP/Methods.pm | 593 +++++++ Master/tlpkg/tlperl/lib/Net/HTTP/NB.pm | 105 ++ Master/tlpkg/tlperl/lib/Net/HTTPS.pm | 59 + Master/tlpkg/tlperl/lib/URI.pm | 1109 +++++++++++++ Master/tlpkg/tlperl/lib/URI/Escape.pm | 208 +++ Master/tlpkg/tlperl/lib/URI/Heuristic.pm | 253 +++ Master/tlpkg/tlperl/lib/URI/IRI.pm | 44 + Master/tlpkg/tlperl/lib/URI/QueryParam.pm | 200 +++ Master/tlpkg/tlperl/lib/URI/Split.pm | 96 ++ Master/tlpkg/tlperl/lib/URI/URL.pm | 305 ++++ Master/tlpkg/tlperl/lib/URI/WithBase.pm | 171 ++ Master/tlpkg/tlperl/lib/URI/_foreign.pm | 6 + Master/tlpkg/tlperl/lib/URI/_generic.pm | 249 +++ Master/tlpkg/tlperl/lib/URI/_idna.pm | 78 + Master/tlpkg/tlperl/lib/URI/_ldap.pm | 140 ++ Master/tlpkg/tlperl/lib/URI/_login.pm | 10 + Master/tlpkg/tlperl/lib/URI/_punycode.pm | 202 +++ Master/tlpkg/tlperl/lib/URI/_query.pm | 92 ++ Master/tlpkg/tlperl/lib/URI/_segment.pm | 20 + Master/tlpkg/tlperl/lib/URI/_server.pm | 162 ++ Master/tlpkg/tlperl/lib/URI/_userpass.pm | 51 + Master/tlpkg/tlperl/lib/URI/data.pm | 140 ++ Master/tlpkg/tlperl/lib/URI/file.pm | 328 ++++ Master/tlpkg/tlperl/lib/URI/file/Base.pm | 80 + Master/tlpkg/tlperl/lib/URI/file/FAT.pm | 23 + Master/tlpkg/tlperl/lib/URI/file/Mac.pm | 120 ++ Master/tlpkg/tlperl/lib/URI/file/OS2.pm | 28 + Master/tlpkg/tlperl/lib/URI/file/QNX.pm | 18 + Master/tlpkg/tlperl/lib/URI/file/Unix.pm | 55 + Master/tlpkg/tlperl/lib/URI/file/Win32.pm | 84 + Master/tlpkg/tlperl/lib/URI/ftp.pm | 45 + Master/tlpkg/tlperl/lib/URI/gopher.pm | 94 ++ Master/tlpkg/tlperl/lib/URI/http.pm | 25 + Master/tlpkg/tlperl/lib/URI/https.pm | 9 + Master/tlpkg/tlperl/lib/URI/ldap.pm | 122 ++ Master/tlpkg/tlperl/lib/URI/ldapi.pm | 30 + Master/tlpkg/tlperl/lib/URI/ldaps.pm | 9 + Master/tlpkg/tlperl/lib/URI/mailto.pm | 72 + Master/tlpkg/tlperl/lib/URI/mms.pm | 8 + Master/tlpkg/tlperl/lib/URI/news.pm | 68 + Master/tlpkg/tlperl/lib/URI/nntp.pm | 6 + Master/tlpkg/tlperl/lib/URI/pop.pm | 68 + Master/tlpkg/tlperl/lib/URI/rlogin.pm | 7 + Master/tlpkg/tlperl/lib/URI/rsync.pm | 12 + Master/tlpkg/tlperl/lib/URI/rtsp.pm | 8 + Master/tlpkg/tlperl/lib/URI/rtspu.pm | 8 + Master/tlpkg/tlperl/lib/URI/sip.pm | 86 + Master/tlpkg/tlperl/lib/URI/sips.pm | 9 + Master/tlpkg/tlperl/lib/URI/snews.pm | 10 + Master/tlpkg/tlperl/lib/URI/ssh.pm | 11 + Master/tlpkg/tlperl/lib/URI/telnet.pm | 7 + Master/tlpkg/tlperl/lib/URI/tn3270.pm | 7 + Master/tlpkg/tlperl/lib/URI/urn.pm | 97 ++ Master/tlpkg/tlperl/lib/URI/urn/isbn.pm | 102 ++ Master/tlpkg/tlperl/lib/URI/urn/oid.pm | 18 + Master/tlpkg/tlperl/lib/WWW/RobotRules.pm | 445 +++++ .../tlpkg/tlperl/lib/WWW/RobotRules/AnyDBM_File.pm | 170 ++ Master/tlpkg/tlperl/lib/auto/HTML/Parser/.packlist | 9 + Master/tlpkg/tlperl/lib/auto/HTML/Parser/Parser.bs | 0 .../tlpkg/tlperl/lib/auto/HTML/Parser/Parser.dll | Bin 0 -> 46592 bytes Master/tlpkg/tlperl/lib/auto/HTML/Tagset/.packlist | 1 + Master/tlpkg/tlperl/lib/auto/LWP/.packlist | 65 + Master/tlpkg/tlperl/lib/auto/URI/.packlist | 52 + Master/tlpkg/tlperl/lib/lwpcook.pod | 309 ++++ Master/tlpkg/tlperl/lib/lwptut.pod | 839 ++++++++++ Master/tlpkg/tlperl/lib/perllocal.pod | 132 ++ 122 files changed, 28840 insertions(+) create mode 100644 Master/tlpkg/tlperl/lib/Bundle/LWP.pm create mode 100644 Master/tlpkg/tlperl/lib/File/Listing.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/Entities.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/Filter.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/Form.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/HeadParser.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/LinkExtor.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/Parser.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/PullParser.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/Tagset.pm create mode 100644 Master/tlpkg/tlperl/lib/HTML/TokeParser.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Config.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Cookies.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Cookies/Microsoft.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Cookies/Netscape.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Daemon.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Date.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Headers.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Headers/ETag.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Headers/Util.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Message.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Negotiate.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Request.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Request/Common.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Response.pm create mode 100644 Master/tlpkg/tlperl/lib/HTTP/Status.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Authen/Basic.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Authen/Digest.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Authen/Ntlm.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/ConnCache.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Debug.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/DebugFile.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/MediaTypes.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/MemberMixin.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/GHTTP.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/cpan.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/data.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/file.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/ftp.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/gopher.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/http10.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/https10.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/loopback.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/mailto.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/nntp.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Protocol/nogo.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/RobotUA.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/Simple.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/UserAgent.pm create mode 100644 Master/tlpkg/tlperl/lib/LWP/media.types create mode 100644 Master/tlpkg/tlperl/lib/Net/HTTP.pm create mode 100644 Master/tlpkg/tlperl/lib/Net/HTTP/Methods.pm create mode 100644 Master/tlpkg/tlperl/lib/Net/HTTP/NB.pm create mode 100644 Master/tlpkg/tlperl/lib/Net/HTTPS.pm create mode 100644 Master/tlpkg/tlperl/lib/URI.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/Escape.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/Heuristic.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/IRI.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/QueryParam.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/Split.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/URL.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/WithBase.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_foreign.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_generic.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_idna.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_ldap.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_login.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_punycode.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_query.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_segment.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_server.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/_userpass.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/data.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file/Base.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file/FAT.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file/Mac.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file/OS2.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file/QNX.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file/Unix.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/file/Win32.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/ftp.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/gopher.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/http.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/https.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/ldap.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/ldapi.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/ldaps.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/mailto.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/mms.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/news.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/nntp.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/pop.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/rlogin.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/rsync.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/rtsp.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/rtspu.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/sip.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/sips.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/snews.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/ssh.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/telnet.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/tn3270.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/urn.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/urn/isbn.pm create mode 100644 Master/tlpkg/tlperl/lib/URI/urn/oid.pm create mode 100644 Master/tlpkg/tlperl/lib/WWW/RobotRules.pm create mode 100644 Master/tlpkg/tlperl/lib/WWW/RobotRules/AnyDBM_File.pm create mode 100644 Master/tlpkg/tlperl/lib/auto/HTML/Parser/.packlist create mode 100644 Master/tlpkg/tlperl/lib/auto/HTML/Parser/Parser.bs create mode 100644 Master/tlpkg/tlperl/lib/auto/HTML/Parser/Parser.dll create mode 100644 Master/tlpkg/tlperl/lib/auto/HTML/Tagset/.packlist create mode 100644 Master/tlpkg/tlperl/lib/auto/LWP/.packlist create mode 100644 Master/tlpkg/tlperl/lib/auto/URI/.packlist create mode 100644 Master/tlpkg/tlperl/lib/lwpcook.pod create mode 100644 Master/tlpkg/tlperl/lib/lwptut.pod (limited to 'Master/tlpkg') diff --git a/Master/tlpkg/tlperl/lib/Bundle/LWP.pm b/Master/tlpkg/tlperl/lib/Bundle/LWP.pm new file mode 100644 index 00000000000..1f2f0454cc6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Bundle/LWP.pm @@ -0,0 +1,44 @@ +package Bundle::LWP; + +$VERSION = "5.835"; + +1; + +__END__ + +=head1 NAME + +Bundle::LWP - install all libwww-perl related modules + +=head1 SYNOPSIS + + perl -MCPAN -e 'install Bundle::LWP' + +=head1 CONTENTS + +MIME::Base64 - Used in authentication headers + +Digest::MD5 - Needed to do Digest authentication + +URI 1.10 - There are URIs everywhere + +Net::FTP 2.58 - If you want ftp://-support + +HTML::Tagset - Needed by HTML::Parser + +HTML::Parser - Needed by HTML::HeadParser + +HTML::HeadParser - To get the correct $res->base + +LWP - The reason why you need the modules above + +=head1 DESCRIPTION + +This bundle defines all prerequisite modules for libwww-perl. Bundles +have special meaning for the CPAN module. When you install the bundle +module all modules mentioned in L will be installed +instead. + +=head1 SEE ALSO + +L diff --git a/Master/tlpkg/tlperl/lib/File/Listing.pm b/Master/tlpkg/tlperl/lib/File/Listing.pm new file mode 100644 index 00000000000..53a6ddc66be --- /dev/null +++ b/Master/tlpkg/tlperl/lib/File/Listing.pm @@ -0,0 +1,412 @@ +package File::Listing; + +sub Version { $VERSION; } +$VERSION = "5.837"; + +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(parse_dir); + +use strict; + +use Carp (); +use HTTP::Date qw(str2time); + + + +sub parse_dir ($;$$$) +{ + my($dir, $tz, $fstype, $error) = @_; + + $fstype ||= 'unix'; + $fstype = "File::Listing::" . lc $fstype; + + my @args = $_[0]; + push(@args, $tz) if(@_ >= 2); + push(@args, $error) if(@_ >= 4); + + $fstype->parse(@args); +} + + +sub line { Carp::croak("Not implemented yet"); } +sub init { } # Dummy sub + + +sub file_mode ($) +{ + # This routine was originally borrowed from Graham Barr's + # Net::FTP package. + + local $_ = shift; + my $mode = 0; + my($type,$ch); + + s/^(.)// and $type = $1; + + while (/(.)/g) { + $mode <<= 1; + $mode |= 1 if $1 ne "-" && + $1 ne 'S' && + $1 ne 't' && + $1 ne 'T'; + } + + $type eq "d" and $mode |= 0040000 or # Directory + $type eq "l" and $mode |= 0120000 or # Symbolic Link + $mode |= 0100000; # Regular File + + $mode |= 0004000 if /^...s....../i; + $mode |= 0002000 if /^......s.../i; + $mode |= 0001000 if /^.........t/i; + + $mode; +} + + +sub parse +{ + my($pkg, $dir, $tz, $error) = @_; + + # First let's try to determine what kind of dir parameter we have + # received. We allow both listings, reference to arrays and + # file handles to read from. + + if (ref($dir) eq 'ARRAY') { + # Already splitted up + } + elsif (ref($dir) eq 'GLOB') { + # A file handle + } + elsif (ref($dir)) { + Carp::croak("Illegal argument to parse_dir()"); + } + elsif ($dir =~ /^\*\w+(::\w+)+$/) { + # This scalar looks like a file handle, so we assume it is + } + else { + # A normal scalar listing + $dir = [ split(/\n/, $dir) ]; + } + + $pkg->init(); + + my @files = (); + if (ref($dir) eq 'ARRAY') { + for (@$dir) { + push(@files, $pkg->line($_, $tz, $error)); + } + } + else { + local($_); + while (<$dir>) { + chomp; + push(@files, $pkg->line($_, $tz, $error)); + } + } + wantarray ? @files : \@files; +} + + + +package File::Listing::unix; + +use HTTP::Date qw(str2time); + +# A place to remember current directory from last line parsed. +use vars qw($curdir @ISA); + +@ISA = qw(File::Listing); + + + +sub init +{ + $curdir = ''; +} + + +sub line +{ + shift; # package name + local($_) = shift; + my($tz, $error) = @_; + + s/\015//g; + #study; + + my ($kind, $size, $date, $name); + if (($kind, $size, $date, $name) = + /^([\-FlrwxsStTdD]{10}) # Type and permission bits + .* # Graps + \D(\d+) # File size + \s+ # Some space + (\w{3}\s+\d+\s+(?:\d{1,2}:\d{2}|\d{4})|\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}) # Date + \s+ # Some more space + (.*)$ # File name + /x ) + + { + return if $name eq '.' || $name eq '..'; + $name = "$curdir/$name" if length $curdir; + my $type = '?'; + if ($kind =~ /^l/ && $name =~ /(.*) -> (.*)/ ) { + $name = $1; + $type = "l $2"; + } + elsif ($kind =~ /^[\-F]/) { # (hopefully) a regular file + $type = 'f'; + } + elsif ($kind =~ /^[dD]/) { + $type = 'd'; + $size = undef; # Don't believe the reported size + } + return [$name, $type, $size, str2time($date, $tz), + File::Listing::file_mode($kind)]; + + } + elsif (/^(.+):$/ && !/^[dcbsp].*\s.*\s.*:$/ ) { + my $dir = $1; + return () if $dir eq '.'; + $curdir = $dir; + return (); + } + elsif (/^[Tt]otal\s+(\d+)$/ || /^\s*$/) { + return (); + } + elsif (/not found/ || # OSF1, HPUX, and SunOS return + # "$file not found" + /No such file/ || # IRIX returns + # "UX:ls: ERROR: Cannot access $file: No such file or directory" + # Solaris returns + # "$file: No such file or directory" + /cannot find/ # Windows NT returns + # "The system cannot find the path specified." + ) { + return () unless defined $error; + &$error($_) if ref($error) eq 'CODE'; + warn "Error: $_\n" if $error eq 'warn'; + return (); + } + elsif ($_ eq '') { # AIX, and Linux return nothing + return () unless defined $error; + &$error("No such file or directory") if ref($error) eq 'CODE'; + warn "Warning: No such file or directory\n" if $error eq 'warn'; + return (); + } + else { + # parse failed, check if the dosftp parse understands it + File::Listing::dosftp->init(); + return(File::Listing::dosftp->line($_,$tz,$error)); + } + +} + + + +package File::Listing::dosftp; + +use HTTP::Date qw(str2time); + +# A place to remember current directory from last line parsed. +use vars qw($curdir @ISA); + +@ISA = qw(File::Listing); + + + +sub init +{ + $curdir = ''; +} + + +sub line +{ + shift; # package name + local($_) = shift; + my($tz, $error) = @_; + + s/\015//g; + + my ($date, $size_or_dir, $name, $size); + + # 02-05-96 10:48AM 1415 src.slf + # 09-10-96 09:18AM sl_util + if (($date, $size_or_dir, $name) = + /^(\d\d-\d\d-\d\d\s+\d\d:\d\d\wM) # Date and time info + \s+ # Some space + (<\w{3}>|\d+) # Dir or Size + \s+ # Some more space + (.+)$ # File name + /x ) + { + return if $name eq '.' || $name eq '..'; + $name = "$curdir/$name" if length $curdir; + my $type = '?'; + if ($size_or_dir eq '') { + $type = "d"; + $size = ""; # directories have no size in the pc listing + } + else { + $type = 'f'; + $size = $size_or_dir; + } + return [$name, $type, $size, str2time($date, $tz), undef]; + } + else { + return () unless defined $error; + &$error($_) if ref($error) eq 'CODE'; + warn "Can't parse: $_\n" if $error eq 'warn'; + return (); + } + +} + + + +package File::Listing::vms; +@File::Listing::vms::ISA = qw(File::Listing); + +package File::Listing::netware; +@File::Listing::netware::ISA = qw(File::Listing); + + + +package File::Listing::apache; + +use vars qw(@ISA); + +@ISA = qw(File::Listing); + + +sub init { } + + +sub line { + shift; # package name + local($_) = shift; + my($tz, $error) = @_; # ignored for now... + + if (m!.*.*?(\d+)-([a-zA-Z]+|\d+)-(\d+)\s+(\d+):(\d+)\s+(?:([\d\.]+[kMG]?|-))!i) { + my($filename, $filesize) = ($1, $7); + my($d,$m,$y, $H,$M) = ($2,$3,$4,$5,$6); + if ($m =~ /^\d+$/) { + ($d,$y) = ($y,$d) # iso date + } + else { + $m = _monthabbrev_number($m); + } + + $filesize = 0 if $filesize eq '-'; + if ($filesize =~ s/k$//i) { + $filesize *= 1024; + } + elsif ($filesize =~ s/M$//) { + $filesize *= 1024*1024; + } + elsif ($filesize =~ s/G$//) { + $filesize *= 1024*1024*1024; + } + $filesize = int $filesize; + + require Time::Local; + my $filetime = Time::Local::timelocal(0,$M,$H,$d,$m-1,_guess_year($y)-1900); + my $filetype = ($filename =~ s|/$|| ? "d" : "f"); + return [$filename, $filetype, $filesize, $filetime, undef]; + } + + return (); +} + + +sub _guess_year { + my $y = shift; + if ($y >= 90) { + $y = 1900+$y; + } + elsif ($y < 100) { + $y = 2000+$y; + } + $y; +} + + +sub _monthabbrev_number { + my $mon = shift; + +{'Jan' => 1, + 'Feb' => 2, + 'Mar' => 3, + 'Apr' => 4, + 'May' => 5, + 'Jun' => 6, + 'Jul' => 7, + 'Aug' => 8, + 'Sep' => 9, + 'Oct' => 10, + 'Nov' => 11, + 'Dec' => 12, + }->{$mon}; +} + + +1; + +__END__ + +=head1 NAME + +File::Listing - parse directory listing + +=head1 SYNOPSIS + + use File::Listing qw(parse_dir); + $ENV{LANG} = "C"; # dates in non-English locales not supported + for (parse_dir(`ls -l`)) { + ($name, $type, $size, $mtime, $mode) = @$_; + next if $type ne 'f'; # plain file + #... + } + + # directory listing can also be read from a file + open(LISTING, "zcat ls-lR.gz|"); + $dir = parse_dir(\*LISTING, '+0000'); + +=head1 DESCRIPTION + +This module exports a single function called parse_dir(), which can be +used to parse directory listings. + +The first parameter to parse_dir() is the directory listing to parse. +It can be a scalar, a reference to an array of directory lines or a +glob representing a filehandle to read the directory listing from. + +The second parameter is the time zone to use when parsing time stamps +in the listing. If this value is undefined, then the local time zone is +assumed. + +The third parameter is the type of listing to assume. Currently +supported formats are 'unix', 'apache' and 'dosftp'. The default +value 'unix'. Ideally, the listing type should be determined +automatically. + +The fourth parameter specifies how unparseable lines should be treated. +Values can be 'ignore', 'warn' or a code reference. Warn means that +the perl warn() function will be called. If a code reference is +passed, then this routine will be called and the return value from it +will be incorporated in the listing. The default is 'ignore'. + +Only the first parameter is mandatory. + +The return value from parse_dir() is a list of directory entries. In +a scalar context the return value is a reference to the list. The +directory entries are represented by an array consisting of [ +$filename, $filetype, $filesize, $filetime, $filemode ]. The +$filetype value is one of the letters 'f', 'd', 'l' or '?'. The +$filetime value is the seconds since Jan 1, 1970. The +$filemode is a bitmask like the mode returned by stat(). + +=head1 CREDITS + +Based on lsparse.pl (from Lee McLoughlin's ftp mirror package) and +Net::FTP's parse_dir (Graham Barr). diff --git a/Master/tlpkg/tlperl/lib/HTML/Entities.pm b/Master/tlpkg/tlperl/lib/HTML/Entities.pm new file mode 100644 index 00000000000..9cba0c896ad --- /dev/null +++ b/Master/tlpkg/tlperl/lib/HTML/Entities.pm @@ -0,0 +1,485 @@ +package HTML::Entities; + +=encoding utf8 + +=head1 NAME + +HTML::Entities - Encode or decode strings with HTML entities + +=head1 SYNOPSIS + + use HTML::Entities; + + $a = "Våre norske tegn bør æres"; + 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-à-vis Beyoncé's naïve + papier-mâché résumé + +=head1 DESCRIPTION + +This module deals with encoding and decoding of strings with HTML +character entities. The module provides the following functions: + +=over 4 + +=item decode_entities( $string, ... ) + +This routine replaces HTML entities found in the $string with the +corresponding Unicode character. Under perl 5.6 and earlier only +characters in the Latin-1 range are replaced. Unrecognized +entities are left alone. + +If multiple strings are provided as argument they are each decoded +separately and the same number of strings are returned. + +If called in void context the arguments are decoded in-place. + +This routine is exported by default. + +=item _decode_entities( $string, \%entity2char ) + +=item _decode_entities( $string, \%entity2char, $expand_prefix ) + +This will in-place replace HTML entities in $string. The %entity2char +hash must be provided. Named entities not found in the %entity2char +hash are left alone. Numeric entities are expanded unless their value +overflow. + +The keys in %entity2char are the entity names to be expanded and their +values are what they should expand into. The values do not have to be +single character strings. If a key has ";" as suffix, +then occurrences in $string are only expanded if properly terminated +with ";". Entities without ";" will be expanded regardless of how +they are terminated for compatibility with how common browsers treat +entities in the Latin-1 range. + +If $expand_prefix is TRUE then entities without trailing ";" in +%entity2char will even be expanded as a prefix of a longer +unrecognized name. The longest matching name in %entity2char will be +used. This is mainly present for compatibility with an MSIE +misfeature. + + $string = "foo bar"; + _decode_entities($string, { nb => "@", nbsp => "\xA0" }, 1); + print $string; # will print "foo bar" + +This routine is exported by default. + +=item encode_entities( $string ) + +=item encode_entities( $string, $unsafe_chars ) + +This routine replaces unsafe characters in $string with their entity +representation. A second argument can be given to specify which characters to +consider unsafe. The unsafe characters is specified using the regular +expression character class syntax (what you find within brackets in regular +expressions). + +The default set of characters to encode are control chars, high-bit chars, and +the C<< < >>, C<< & >>, C<< > >>, C<< ' >> and C<< " >> characters. But this, +for example, would encode I the C<< < >>, C<< & >>, C<< > >>, and C<< " +>> characters: + + $encoded = encode_entities($input, '<>&"'); + +and this would only encode non-plain ascii: + + $encoded = encode_entities($input, '^\n\x20-\x25\x27-\x7e'); + +This routine is exported by default. + +=item encode_entities_numeric( $string ) + +=item encode_entities_numeric( $string, $unsafe_chars ) + +This routine works just like encode_entities, except that the replacement +entities are always C<&#xI;> and never C<&I;>. For +example, C returns "rôle", but +C returns "rôle". + +This routine is I exported by default. But you can always +export it with C +or even C + +=back + +All these routines modify the string passed as the first argument, if +called in a void context. In scalar and array contexts, the encoded or +decoded string is returned (without changing the input string). + +If you prefer not to import these routines into your namespace, you can +call them as: + + use HTML::Entities (); + $decoded = HTML::Entities::decode($a); + $encoded = HTML::Entities::encode($a); + $encoded = HTML::Entities::encode_numeric($a); + +The module can also export the %char2entity and the %entity2char +hashes, which contain the mapping from all characters to the +corresponding entities (and vice versa, respectively). + +=head1 COPYRIGHT + +Copyright 1995-2006 Gisle Aas. All rights reserved. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use vars qw(%entity2char %char2entity); + +require 5.004; +require Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw(encode_entities decode_entities _decode_entities); +@EXPORT_OK = qw(%entity2char %char2entity encode_entities_numeric); + +$VERSION = "3.68"; +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 encode_entities +{ + return undef unless defined $_[0]; + my $ref; + if (defined wantarray) { + my $x = $_[0]; + $ref = \$x; # copy + } else { + $ref = \$_[0]; # modify in-place + } + if (defined $_[1] and length $_[1]) { + unless (exists $subst{$_[1]}) { + # Because we can't compile regex we fake it with a cached sub + my $chars = $_[1]; + $chars =~ s,(?', ''' and '"' + $$ref =~ s/([^\n\r\t !\#\$%\(-;=?-~])/$char2entity{$1} || num_entity($1)/ge; + } + $$ref; +} + +sub encode_entities_numeric { + local %char2entity; + return &encode_entities; # a goto &encode_entities wouldn't work +} + + +sub num_entity { + sprintf "&#x%X;", ord($_[0]); +} + +# Set up aliases +*encode = \&encode_entities; +*encode_numeric = \&encode_entities_numeric; +*encode_numerically = \&encode_entities_numeric; +*decode = \&decode_entities; + +1; diff --git a/Master/tlpkg/tlperl/lib/HTML/Filter.pm b/Master/tlpkg/tlperl/lib/HTML/Filter.pm new file mode 100644 index 00000000000..c5aa16e6dd8 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/HTML/Filter.pm @@ -0,0 +1,112 @@ +package HTML::Filter; + +use strict; +use vars qw(@ISA $VERSION); + +require HTML::Parser; +@ISA=qw(HTML::Parser); + +$VERSION = "3.57"; + +sub declaration { $_[0]->output("") } +sub process { $_[0]->output($_[2]) } +sub comment { $_[0]->output("") } +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 The C now provides the +functionally of C much more efficiently with the the +C handler. + +=head1 SYNOPSIS + + require HTML::Filter; + $p = HTML::Filter->new->parse_file("index.html"); + +=head1 DESCRIPTION + +C 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 is a subclass of C. 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 ETABLE>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 + +=head1 COPYRIGHT + +Copyright 1997-1999 Gisle Aas. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut diff --git a/Master/tlpkg/tlperl/lib/HTML/Form.pm b/Master/tlpkg/tlperl/lib/HTML/Form.pm new file mode 100644 index 00000000000..bbbd7771716 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/HTML/Form.pm @@ -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 class represents a single HTML +CformE ... E/formE> 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 objects that can be passed to the +request() method of C. + +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 objects for each
element found. If called in scalar +context only returns the first . 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 as UTF-8. +The charset assumed can be overridden by providing the C 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 and C: + + 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 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 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 here, so we + # try to do the same. Actually the MSIE behaviour + # appears really strange: and