From 539135f1864a2356d0eb3666e0f5b335680872a4 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 17 Feb 2011 17:32:35 +0000 Subject: New tlperl part XII git-svn-id: svn://tug.org/texlive/trunk@21434 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/lib/Pod/Checker.pm | 1268 +++++++++++ Master/tlpkg/tlperl/lib/Pod/Escapes.pm | 721 +++++++ Master/tlpkg/tlperl/lib/Pod/Find.pm | 535 +++++ Master/tlpkg/tlperl/lib/Pod/Functions.pm | 376 ++++ Master/tlpkg/tlperl/lib/Pod/Html.pm | 2235 ++++++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/InputObjects.pm | 936 ++++++++ Master/tlpkg/tlperl/lib/Pod/LaTeX.pm | 1876 ++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Man.pm | 1764 +++++++++++++++ Master/tlpkg/tlperl/lib/Pod/ParseLink.pm | 192 ++ Master/tlpkg/tlperl/lib/Pod/ParseUtils.pm | 855 ++++++++ Master/tlpkg/tlperl/lib/Pod/Parser.pm | 1829 ++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Perldoc.pm | 1966 +++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm | 81 + Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm | 148 ++ Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm | 75 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm | 190 ++ Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm | 103 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm | 93 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm | 88 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm | 95 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm | 132 ++ Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm | 66 + Master/tlpkg/tlperl/lib/Pod/PlainText.pm | 738 +++++++ Master/tlpkg/tlperl/lib/Pod/Plainer.pm | 100 + Master/tlpkg/tlperl/lib/Pod/Select.pm | 746 +++++++ Master/tlpkg/tlperl/lib/Pod/Simple.pm | 1535 ++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Simple.pod | 274 +++ Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm | 1930 +++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm | 196 ++ Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm | 178 ++ Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsText.pm | 155 ++ Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsXML.pm | 170 ++ Master/tlpkg/tlperl/lib/Pod/Simple/HTML.pm | 978 +++++++++ Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm | 1370 ++++++++++++ Master/tlpkg/tlperl/lib/Pod/Simple/HTMLLegacy.pm | 104 + Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm | 174 ++ Master/tlpkg/tlperl/lib/Pod/Simple/Methody.pm | 152 ++ Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm | 93 + Master/tlpkg/tlperl/lib/Pod/Simple/PullParser.pm | 843 ++++++++ .../tlperl/lib/Pod/Simple/PullParserEndToken.pm | 120 ++ .../tlperl/lib/Pod/Simple/PullParserStartToken.pm | 161 ++ .../tlperl/lib/Pod/Simple/PullParserTextToken.pm | 128 ++ .../tlpkg/tlperl/lib/Pod/Simple/PullParserToken.pm | 163 ++ Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm | 699 ++++++ Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm | 1043 +++++++++ Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm | 180 ++ Master/tlpkg/tlperl/lib/Pod/Simple/Subclassing.pod | 946 +++++++++ Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm | 185 ++ Master/tlpkg/tlperl/lib/Pod/Simple/TextContent.pm | 112 + Master/tlpkg/tlperl/lib/Pod/Simple/TiedOutFH.pm | 105 + Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm | 35 + .../tlpkg/tlperl/lib/Pod/Simple/TranscodeDumb.pm | 63 + .../tlpkg/tlperl/lib/Pod/Simple/TranscodeSmart.pm | 44 + Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm | 717 +++++++ Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm | 185 ++ Master/tlpkg/tlperl/lib/Pod/Text.pm | 878 ++++++++ Master/tlpkg/tlperl/lib/Pod/Text/Color.pm | 155 ++ Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm | 208 ++ Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm | 195 ++ Master/tlpkg/tlperl/lib/Pod/Usage.pm | 730 +++++++ 60 files changed, 32412 insertions(+) create mode 100644 Master/tlpkg/tlperl/lib/Pod/Checker.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Escapes.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Find.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Functions.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Html.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/InputObjects.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/LaTeX.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Man.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/ParseLink.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/ParseUtils.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Parser.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/PlainText.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Plainer.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Select.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple.pod create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsText.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsXML.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/HTML.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/HTMLLegacy.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Methody.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/PullParser.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/PullParserEndToken.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/PullParserStartToken.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/PullParserTextToken.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/PullParserToken.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Subclassing.pod create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/TextContent.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/TiedOutFH.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeDumb.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeSmart.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Text.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Text/Color.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm create mode 100644 Master/tlpkg/tlperl/lib/Pod/Usage.pm (limited to 'Master/tlpkg/tlperl/lib/Pod') diff --git a/Master/tlpkg/tlperl/lib/Pod/Checker.pm b/Master/tlpkg/tlperl/lib/Pod/Checker.pm new file mode 100644 index 00000000000..a2305423b23 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Pod/Checker.pm @@ -0,0 +1,1268 @@ +############################################################################# +# Pod/Checker.pm -- check pod documents for syntax errors +# +# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved. +# This file is part of "PodParser". PodParser is free software; +# you can redistribute it and/or modify it under the same terms +# as Perl itself. +############################################################################# + +package Pod::Checker; +use strict; + +use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES); +$VERSION = '1.45'; ## Current version of this package +require 5.005; ## requires this Perl version or later + +use Pod::ParseUtils; ## for hyperlinks and lists + +=head1 NAME + +Pod::Checker, podchecker() - check pod documents for syntax errors + +=head1 SYNOPSIS + + use Pod::Checker; + + $syntax_okay = podchecker($filepath, $outputpath, %options); + + my $checker = new Pod::Checker %options; + $checker->parse_from_file($filepath, \*STDERR); + +=head1 OPTIONS/ARGUMENTS + +C<$filepath> is the input POD to read and C<$outputpath> is +where to write POD syntax error messages. Either argument may be a scalar +indicating a file-path, or else a reference to an open filehandle. +If unspecified, the input-file it defaults to C<\*STDIN>, and +the output-file defaults to C<\*STDERR>. + +=head2 podchecker() + +This function can take a hash of options: + +=over 4 + +=item B<-warnings> =E I + +Turn warnings on/off. I is usually 1 for on, but higher values +trigger additional warnings. See L<"Warnings">. + +=back + +=head1 DESCRIPTION + +B will perform syntax checking of Perl5 POD format documentation. + +Curious/ambitious users are welcome to propose additional features they wish +to see in B and B and verify that the checks are +consistent with L. + +The following checks are currently performed: + +=over 4 + +=item * + +Unknown '=xxxx' commands, unknown 'XE...E' interior-sequences, +and unterminated interior sequences. + +=item * + +Check for proper balancing of C<=begin> and C<=end>. The contents of such +a block are generally ignored, i.e. no syntax checks are performed. + +=item * + +Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>. + +=item * + +Check for same nested interior-sequences (e.g. +C...LE...E...E>). + +=item * + +Check for malformed or non-existing entities C...E>. + +=item * + +Check for correct syntax of hyperlinks C...E>. See L +for details. + +=item * + +Check for unresolved document-internal links. This check may also reveal +misspelled links that seem to be internal links but should be links +to something else. + +=back + +=head1 DIAGNOSTICS + +=head2 Errors + +=over 4 + +=item * empty =headn + +A heading (C<=head1> or C<=head2>) without any text? That ain't no +heading! + +=item * =over on line I without closing =back + +The C<=over> command does not have a corresponding C<=back> before the +next heading (C<=head1> or C<=head2>) or the end of the file. + +=item * =item without previous =over + +=item * =back without previous =over + +An C<=item> or C<=back> command has been found outside a +C<=over>/C<=back> block. + +=item * No argument for =begin + +A C<=begin> command was found that is not followed by the formatter +specification. + +=item * =end without =begin + +A standalone C<=end> command was found. + +=item * Nested =begin's + +There were at least two consecutive C<=begin> commands without +the corresponding C<=end>. Only one C<=begin> may be active at +a time. + +=item * =for without formatter specification + +There is no specification of the formatter after the C<=for> command. + +=item * unresolved internal link I + +The given link to I does not have a matching node in the current +POD. This also happened when a single word node name is not enclosed in +C<"">. + +=item * Unknown command "I" + +An invalid POD command has been found. Valid are C<=head1>, C<=head2>, +C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, +C<=for>, C<=pod>, C<=cut> + +=item * Unknown interior-sequence "I" + +An invalid markup command has been encountered. Valid are: +CE>, CE>, CE>, CE>, +CE>, CE>, CE>, CE>, +CE> + +=item * nested commands IE...IE...E...E + +Two nested identical markup commands have been found. Generally this +does not make sense. + +=item * garbled entity I + +The I found cannot be interpreted as a character entity. + +=item * Entity number out of range + +An entity specified by number (dec, hex, oct) is out of range (1-255). + +=item * malformed link LEE + +The link found cannot be parsed because it does not conform to the +syntax described in L. + +=item * nonempty ZEE + +The CE> sequence is supposed to be empty. + +=item * empty XEE + +The index entry specified contains nothing but whitespace. + +=item * Spurious text after =pod / =cut + +The commands C<=pod> and C<=cut> do not take any arguments. + +=item * Spurious character(s) after =back + +The C<=back> command does not take any arguments. + +=back + +=head2 Warnings + +These may not necessarily cause trouble, but indicate mediocre style. + +=over 4 + +=item * multiple occurrence of link target I + +The POD file has some C<=item> and/or C<=head> commands that have +the same text. Potential hyperlinks to such a text cannot be unique then. +This warning is printed only with warning level greater than one. + +=item * line containing nothing but whitespace in paragraph + +There is some whitespace on a seemingly empty line. POD is very sensitive +to such things, so this is flagged. B users switch on the B +option to avoid this problem. + +=begin _disabled_ + +=item * file does not start with =head + +The file starts with a different POD directive than head. +This is most probably something you do not want. + +=end _disabled_ + +=item * previous =item has no contents + +There is a list C<=item> right above the flagged line that has no +text contents. You probably want to delete empty items. + +=item * preceding non-item paragraph(s) + +A list introduced by C<=over> starts with a text or verbatim paragraph, +but continues with C<=item>s. Move the non-item paragraph out of the +C<=over>/C<=back> block. + +=item * =item type mismatch (I vs. I) + +A list started with e.g. a bullet-like C<=item> and continued with a +numbered one. This is obviously inconsistent. For most translators the +type of the I C<=item> determines the type of the list. + +=item * I unescaped CE> in paragraph + +Angle brackets not written as CltE> and CgtE> +can potentially cause errors as they could be misinterpreted as +markup commands. This is only printed when the -warnings level is +greater than 1. + +=item * Unknown entity + +A character entity was found that does not belong to the standard +ISO set or the POD specials C and C. + +=item * No items in =over + +The list opened with C<=over> does not contain any items. + +=item * No argument for =item + +C<=item> without any parameters is deprecated. It should either be followed +by C<*> to indicate an unordered list, by a number (optionally followed +by a dot) to indicate an ordered (numbered) list or simple text for a +definition list. + +=item * empty section in previous paragraph + +The previous section (introduced by a C<=head> command) does not contain +any text. This usually indicates that something is missing. Note: A +C<=head1> followed immediately by C<=head2> does not trigger this warning. + +=item * Verbatim paragraph in NAME section + +The NAME section (C<=head1 NAME>) should consist of a single paragraph +with the script/module name, followed by a dash `-' and a very short +description of what the thing is good for. + +=item * =headI without preceding higher level + +For example if there is a C<=head2> in the POD file prior to a +C<=head1>. + +=back + +=head2 Hyperlinks + +There are some warnings with respect to malformed hyperlinks: + +=over 4 + +=item * ignoring leading/trailing whitespace in link + +There is whitespace at the beginning or the end of the contents of +LE...E. + +=item * (section) in '$page' deprecated + +There is a section detected in the page name of LE...E, e.g. +Cpasswd(2)E>. POD hyperlinks may point to POD documents only. +Please write Cpasswd(2)E> instead. Some formatters are able +to expand this to appropriate code. For links to (builtin) functions, +please say Cperlfunc/mkdirE>, without (). + +=item * alternative text/node '%s' contains non-escaped | or / + +The characters C<|> and C are special in the LE...E context. +Although the hyperlink parser does its best to determine which "/" is +text and which is a delimiter in case of doubt, one ought to escape +these literal characters like this: + + / E + | E + +=back + +=head1 RETURN VALUE + +B returns the number of POD syntax errors found or -1 if +there were no POD commands at all found in the file. + +=head1 EXAMPLES + +See L + +=head1 INTERFACE + +While checking, this module collects document properties, e.g. the nodes +for hyperlinks (C<=headX>, C<=item>) and index entries (CE>). +POD translators can use this feature to syntax-check and get the nodes in +a first pass before actually starting to convert. This is expensive in terms +of execution time, but allows for very robust conversions. + +Since PodParser-1.24 the B module uses only the B +method to print errors and warnings. The summary output (e.g. +"Pod syntax OK") has been dropped from the module and has been included in +B (the script). This allows users of B to +control completely the output behavior. Users of B (the script) +get the well-known behavior. + +=cut + +############################################################################# + +#use diagnostics; +use Carp qw(croak); +use Exporter; +use Pod::Parser; + +@ISA = qw(Pod::Parser); +@EXPORT = qw(&podchecker); + +my %VALID_COMMANDS = ( + 'pod' => 1, + 'cut' => 1, + 'head1' => 1, + 'head2' => 1, + 'head3' => 1, + 'head4' => 1, + 'over' => 1, + 'back' => 1, + 'item' => 1, + 'for' => 1, + 'begin' => 1, + 'end' => 1, + 'encoding' => 1, +); + +my %VALID_SEQUENCES = ( + 'I' => 1, + 'B' => 1, + 'S' => 1, + 'C' => 1, + 'L' => 1, + 'F' => 1, + 'X' => 1, + 'Z' => 1, + 'E' => 1, +); + +# stolen from HTML::Entities +my %ENTITIES = ( + # Some normal chars that have special meaning in SGML context + amp => '&', # ampersand +'gt' => '>', # greater than +'lt' => '<', # less than + quot => '"', # double quote + + # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML + AElig => 'Æ', # capital AE diphthong (ligature) + Aacute => 'Á', # capital A, acute accent + Acirc => 'Â', # capital A, circumflex accent + Agrave => 'À', # capital A, grave accent + Aring => 'Å', # capital A, ring + Atilde => 'Ã', # capital A, tilde + Auml => 'Ä', # capital A, dieresis or umlaut mark + Ccedil => 'Ç', # capital C, cedilla + ETH => 'Ð', # capital Eth, Icelandic + Eacute => 'É', # capital E, acute accent + Ecirc => 'Ê', # capital E, circumflex accent + Egrave => 'È', # capital E, grave accent + Euml => 'Ë', # capital E, dieresis or umlaut mark + Iacute => 'Í', # capital I, acute accent + Icirc => 'Î', # capital I, circumflex accent + Igrave => 'Ì', # capital I, grave accent + Iuml => 'Ï', # capital I, dieresis or umlaut mark + Ntilde => 'Ñ', # capital N, tilde + Oacute => 'Ó', # capital O, acute accent + Ocirc => 'Ô', # capital O, circumflex accent + Ograve => 'Ò', # capital O, grave accent + Oslash => 'Ø', # capital O, slash + Otilde => 'Õ', # capital O, tilde + Ouml => 'Ö', # capital O, dieresis or umlaut mark + THORN => 'Þ', # capital THORN, Icelandic + Uacute => 'Ú', # capital U, acute accent + Ucirc => 'Û', # capital U, circumflex accent + Ugrave => 'Ù', # capital U, grave accent + Uuml => 'Ü', # capital U, dieresis or umlaut mark + Yacute => 'Ý', # capital Y, acute accent + aacute => 'á', # small a, acute accent + acirc => 'â', # small a, circumflex accent + aelig => 'æ', # small ae diphthong (ligature) + agrave => 'à', # small a, grave accent + aring => 'å', # small a, ring + atilde => 'ã', # small a, tilde + auml => 'ä', # small a, dieresis or umlaut mark + ccedil => 'ç', # small c, cedilla + eacute => 'é', # small e, acute accent + ecirc => 'ê', # small e, circumflex accent + egrave => 'è', # small e, grave accent + eth => 'ð', # small eth, Icelandic + euml => 'ë', # small e, dieresis or umlaut mark + iacute => 'í', # small i, acute accent + icirc => 'î', # small i, circumflex accent + igrave => 'ì', # small i, grave accent + iuml => 'ï', # small i, dieresis or umlaut mark + ntilde => 'ñ', # small n, tilde + oacute => 'ó', # small o, acute accent + ocirc => 'ô', # small o, circumflex accent + ograve => 'ò', # small o, grave accent + oslash => 'ø', # small o, slash + otilde => 'õ', # small o, tilde + ouml => 'ö', # small o, dieresis or umlaut mark + szlig => 'ß', # small sharp s, German (sz ligature) + thorn => 'þ', # small thorn, Icelandic + uacute => 'ú', # small u, acute accent + ucirc => 'û', # small u, circumflex accent + ugrave => 'ù', # small u, grave accent + uuml => 'ü', # small u, dieresis or umlaut mark + yacute => 'ý', # small y, acute accent + yuml => 'ÿ', # small y, dieresis or umlaut mark + + # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) + copy => '©', # copyright sign + reg => '®', # registered sign + nbsp => "\240", # non breaking space + + # Additional ISO-8859/1 entities listed in rfc1866 (section 14) + iexcl => '¡', + cent => '¢', + pound => '£', + curren => '¤', + yen => '¥', + brvbar => '¦', + sect => '§', + uml => '¨', + ordf => 'ª', + laquo => '«', +'not' => '¬', # not is a keyword in perl + shy => '­', + macr => '¯', + deg => '°', + plusmn => '±', + sup1 => '¹', + sup2 => '²', + sup3 => '³', + acute => '´', + micro => 'µ', + para => '¶', + middot => '·', + cedil => '¸', + ordm => 'º', + raquo => '»', + frac14 => '¼', + frac12 => '½', + frac34 => '¾', + iquest => '¿', +'times' => '×', # times is a keyword in perl + divide => '÷', + +# some POD special entities + verbar => '|', + sol => '/' +); + +##--------------------------------------------------------------------------- + +##--------------------------------- +## Function definitions begin here +##--------------------------------- + +sub podchecker { + my ($infile, $outfile, %options) = @_; + local $_; + + ## Set defaults + $infile ||= \*STDIN; + $outfile ||= \*STDERR; + + ## Now create a pod checker + my $checker = new Pod::Checker(%options); + + ## Now check the pod document for errors + $checker->parse_from_file($infile, $outfile); + + ## Return the number of errors found + return $checker->num_errors(); +} + +##--------------------------------------------------------------------------- + +##------------------------------- +## Method definitions begin here +##------------------------------- + +################################## + +=over 4 + +=item Cnew( %options )> + +Return a reference to a new Pod::Checker object that inherits from +Pod::Parser and is used for calling the required methods later. The +following options are recognized: + +C<-warnings =E num> + Print warnings if C is true. The higher the value of C, +the more warnings are printed. Currently there are only levels 1 and 2. + +C<-quiet =E num> + If C is true, do not print any errors/warnings. This is useful +when Pod::Checker is used to munge POD code into plain text from within +POD formatters. + +=cut + +## sub new { +## my $this = shift; +## my $class = ref($this) || $this; +## my %params = @_; +## my $self = {%params}; +## bless $self, $class; +## $self->initialize(); +## return $self; +## } + +sub initialize { + my $self = shift; + ## Initialize number of errors, and setup an error function to + ## increment this number and then print to the designated output. + $self->{_NUM_ERRORS} = 0; + $self->{_NUM_WARNINGS} = 0; + $self->{-quiet} ||= 0; + # set the error handling subroutine + $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror'); + $self->{_commands} = 0; # total number of POD commands encountered + $self->{_list_stack} = []; # stack for nested lists + $self->{_have_begin} = ''; # stores =begin + $self->{_links} = []; # stack for internal hyperlinks + $self->{_nodes} = []; # stack for =head/=item nodes + $self->{_index} = []; # text in X<> + # print warnings? + $self->{-warnings} = 1 unless(defined $self->{-warnings}); + $self->{_current_head1} = ''; # the current =head1 block + $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings}); +} + +################################## + +=item C<$checker-Epoderror( @args )> + +=item C<$checker-Epoderror( {%opts}, @args )> + +Internal method for printing errors and warnings. If no options are +given, simply prints "@_". The following options are recognized and used +to form the output: + + -msg + +A message to print prior to C<@args>. + + -line + +The line number the error occurred in. + + -file + +The file (name) the error occurred in. + + -severity + +The error level, should be 'WARNING' or 'ERROR'. + +=cut + +# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) +sub poderror { + my $self = shift; + my %opts = (ref $_[0]) ? %{shift()} : (); + + ## Retrieve options + chomp( my $msg = ($opts{-msg} || '')."@_" ); + my $line = (exists $opts{-line}) ? " at line $opts{-line}" : ''; + my $file = (exists $opts{-file}) ? " in file $opts{-file}" : ''; + unless (exists $opts{-severity}) { + ## See if can find severity in message prefix + $opts{-severity} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// ); + } + my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : ''; + + ## Increment error count and print message " + ++($self->{_NUM_ERRORS}) + if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); + ++($self->{_NUM_WARNINGS}) + if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING')); + unless($self->{-quiet}) { + my $out_fh = $self->output_handle() || \*STDERR; + print $out_fh ($severity, $msg, $line, $file, "\n") + if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); + } +} + +################################## + +=item C<$checker-Enum_errors()> + +Set (if argument specified) and retrieve the number of errors found. + +=cut + +sub num_errors { + return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; +} + +################################## + +=item C<$checker-Enum_warnings()> + +Set (if argument specified) and retrieve the number of warnings found. + +=cut + +sub num_warnings { + return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS}; +} + +################################## + +=item C<$checker-Ename()> + +Set (if argument specified) and retrieve the canonical name of POD as +found in the C<=head1 NAME> section. + +=cut + +sub name { + return (@_ > 1 && $_[1]) ? + ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; +} + +################################## + +=item C<$checker-Enode()> + +Add (if argument specified) and retrieve the nodes (as defined by C<=headX> +and C<=item>) of the current POD. The nodes are returned in the order of +their occurrence. They consist of plain text, each piece of whitespace is +collapsed to a single blank. + +=cut + +sub node { + my ($self,$text) = @_; + if(defined $text) { + $text =~ s/\s+$//s; # strip trailing whitespace + $text =~ s/\s+/ /gs; # collapse whitespace + # add node, order important! + push(@{$self->{_nodes}}, $text); + # keep also a uniqueness counter + $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); + return $text; + } + @{$self->{_nodes}}; +} + +################################## + +=item C<$checker-Eidx()> + +Add (if argument specified) and retrieve the index entries (as defined by +CE>) of the current POD. They consist of plain text, each piece +of whitespace is collapsed to a single blank. + +=cut + +# set/return index entries of current POD +sub idx { + my ($self,$text) = @_; + if(defined $text) { + $text =~ s/\s+$//s; # strip trailing whitespace + $text =~ s/\s+/ /gs; # collapse whitespace + # add node, order important! + push(@{$self->{_index}}, $text); + # keep also a uniqueness counter + $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); + return $text; + } + @{$self->{_index}}; +} + +################################## + +=item C<$checker-Ehyperlink()> + +Add (if argument specified) and retrieve the hyperlinks (as defined by +CE>) of the current POD. They consist of a 2-item array: line +number and C object. + +=back + +=cut + +# set/return hyperlinks of the current POD +sub hyperlink { + my $self = shift; + if($_[0]) { + push(@{$self->{_links}}, $_[0]); + return $_[0]; + } + @{$self->{_links}}; +} + +## overrides for Pod::Parser + +sub end_pod { + ## Do some final checks and + ## print the number of errors found + my $self = shift; + my $infile = $self->input_file(); + + if(@{$self->{_list_stack}}) { + my $list; + while(($list = $self->_close_list('EOF',$infile)) && + $list->indent() ne 'auto') { + $self->poderror({ -line => 'EOF', -file => $infile, + -severity => 'ERROR', -msg => '=over on line ' . + $list->start() . ' without closing =back' }); + } + } + + # check validity of document internal hyperlinks + # first build the node names from the paragraph text + my %nodes; + foreach($self->node()) { + $nodes{$_} = 1; + if(/^(\S+)\s+\S/) { + # we have more than one word. Use the first as a node, too. + # This is used heavily in perlfunc.pod + $nodes{$1} ||= 2; # derived node + } + } + foreach($self->idx()) { + $nodes{$_} = 3; # index node + } + foreach($self->hyperlink()) { + my ($line,$link) = @$_; + # _TODO_ what if there is a link to the page itself by the name, + # e.g. in Tk::Pod : L + if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { + my $node = $self->_check_ptree($self->parse_text($link->node(), + $line), $line, $infile, 'L'); + if($node && !$nodes{$node}) { + $self->poderror({ -line => $line || '', -file => $infile, + -severity => 'ERROR', + -msg => "unresolved internal link '$node'"}); + } + } + } + + # check the internal nodes for uniqueness. This pertains to + # =headX, =item and X<...> + if($self->{-warnings} && $self->{-warnings}>1) { + foreach(grep($self->{_unique_nodes}->{$_} > 1, + keys %{$self->{_unique_nodes}})) { + $self->poderror({ -line => '-', -file => $infile, + -severity => 'WARNING', + -msg => "multiple occurrence of link target '$_'"}); + } + } + + # no POD found here + $self->num_errors(-1) if($self->{_commands} == 0); +} + +# check a POD command directive +sub command { + my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; + my ($file, $line) = $pod_para->file_line; + ## Check the command syntax + my $arg; # this will hold the command argument + if (! $VALID_COMMANDS{$cmd}) { + $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', + -msg => "Unknown command '$cmd'" }); + } + else { # found a valid command + $self->{_commands}++; # delete this line if below is enabled again + + ##### following check disabled due to strong request + #if(!$self->{_commands}++ && $cmd !~ /^head/) { + # $self->poderror({ -line => $line, -file => $file, + # -severity => 'WARNING', + # -msg => "file does not start with =head" }); + #} + + # check syntax of particular command + if($cmd eq 'over') { + # check for argument + $arg = $self->interpolate_and_check($paragraph, $line,$file); + my $indent = 4; # default + if($arg && $arg =~ /^\s*(\d+)\s*$/) { + $indent = $1; + } + # start a new list + $self->_open_list($indent,$line,$file); + } + elsif($cmd eq 'item') { + # are we in a list? + unless(@{$self->{_list_stack}}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => '=item without previous =over' }); + # auto-open in case we encounter many more + $self->_open_list('auto',$line,$file); + } + my $list = $self->{_list_stack}->[0]; + # check whether the previous item had some contents + if(defined $self->{_list_item_contents} && + $self->{_list_item_contents} == 0) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'previous =item has no contents' }); + } + if($list->{_has_par}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'preceding non-item paragraph(s)' }); + delete $list->{_has_par}; + } + # check for argument + $arg = $self->interpolate_and_check($paragraph, $line, $file); + if($arg && $arg =~ /(\S+)/) { + $arg =~ s/[\s\n]+$//; + my $type; + if($arg =~ /^[*]\s*(\S*.*)/) { + $type = 'bullet'; + $self->{_list_item_contents} = $1 ? 1 : 0; + $arg = $1; + } + elsif($arg =~ /^\d+\.?\s+(\S*)/) { + $type = 'number'; + $self->{_list_item_contents} = $1 ? 1 : 0; + $arg = $1; + } + else { + $type = 'definition'; + $self->{_list_item_contents} = 1; + } + my $first = $list->type(); + if($first && $first ne $type) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "=item type mismatch ('$first' vs. '$type')"}); + } + else { # first item + $list->type($type); + } + } + else { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'No argument for =item' }); + $arg = ' '; # empty + $self->{_list_item_contents} = 0; + } + # add this item + $list->item($arg); + # remember this node + $self->node($arg); + } + elsif($cmd eq 'back') { + # check if we have an open list + unless(@{$self->{_list_stack}}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => '=back without previous =over' }); + } + else { + # check for spurious characters + $arg = $self->interpolate_and_check($paragraph, $line,$file); + if($arg && $arg =~ /\S/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => 'Spurious character(s) after =back' }); + } + # close list + my $list = $self->_close_list($line,$file); + # check for empty lists + if(!$list->item() && $self->{-warnings}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'No items in =over (at line ' . + $list->start() . ') / =back list'}); + } + } + } + elsif($cmd =~ /^head(\d+)/) { + my $hnum = $1; + $self->{"_have_head_$hnum"}++; # count head types + if($hnum > 1 && !$self->{'_have_head_'.($hnum -1)}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "=head$hnum without preceding higher level"}); + } + # check whether the previous =head section had some contents + if(defined $self->{_commands_in_head} && + $self->{_commands_in_head} == 0 && + defined $self->{_last_head} && + $self->{_last_head} >= $hnum) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'empty section in previous paragraph'}); + } + $self->{_commands_in_head} = -1; + $self->{_last_head} = $hnum; + # check if there is an open list + if(@{$self->{_list_stack}}) { + my $list; + while(($list = $self->_close_list($line,$file)) && + $list->indent() ne 'auto') { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => '=over on line '. $list->start() . + " without closing =back (at $cmd)" }); + } + } + # remember this node + $arg = $self->interpolate_and_check($paragraph, $line,$file); + $arg =~ s/[\s\n]+$//s; + $self->node($arg); + unless(length($arg)) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "empty =$cmd"}); + } + if($cmd eq 'head1') { + $self->{_current_head1} = $arg; + } else { + $self->{_current_head1} = ''; + } + } + elsif($cmd eq 'begin') { + if($self->{_have_begin}) { + # already have a begin + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => q{Nested =begin's (first at line } . + $self->{_have_begin} . ')'}); + } + else { + # check for argument + $arg = $self->interpolate_and_check($paragraph, $line,$file); + unless($arg && $arg =~ /(\S+)/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => 'No argument for =begin'}); + } + # remember the =begin + $self->{_have_begin} = "$line:$1"; + } + } + elsif($cmd eq 'end') { + if($self->{_have_begin}) { + # close the existing =begin + $self->{_have_begin} = ''; + # check for spurious characters + $arg = $self->interpolate_and_check($paragraph, $line,$file); + # the closing argument is optional + #if($arg && $arg =~ /\S/) { + # $self->poderror({ -line => $line, -file => $file, + # -severity => 'WARNING', + # -msg => "Spurious character(s) after =end" }); + #} + } + else { + # don't have a matching =begin + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => '=end without =begin' }); + } + } + elsif($cmd eq 'for') { + unless($paragraph =~ /\s*(\S+)\s*/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => '=for without formatter specification' }); + } + $arg = ''; # do not expand paragraph below + } + elsif($cmd =~ /^(pod|cut)$/) { + # check for argument + $arg = $self->interpolate_and_check($paragraph, $line,$file); + if($arg && $arg =~ /(\S+)/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "Spurious text after =$cmd"}); + } + } + $self->{_commands_in_head}++; + ## Check the interior sequences in the command-text + $self->interpolate_and_check($paragraph, $line,$file) + unless(defined $arg); + } +} + +sub _open_list +{ + my ($self,$indent,$line,$file) = @_; + my $list = Pod::List->new( + -indent => $indent, + -start => $line, + -file => $file); + unshift(@{$self->{_list_stack}}, $list); + undef $self->{_list_item_contents}; + $list; +} + +sub _close_list +{ + my ($self,$line,$file) = @_; + my $list = shift(@{$self->{_list_stack}}); + if(defined $self->{_list_item_contents} && + $self->{_list_item_contents} == 0) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'previous =item has no contents' }); + } + undef $self->{_list_item_contents}; + $list; +} + +# process a block of some text +sub interpolate_and_check { + my ($self, $paragraph, $line, $file) = @_; + ## Check the interior sequences in the command-text + # and return the text + $self->_check_ptree( + $self->parse_text($paragraph,$line), $line, $file, ''); +} + +sub _check_ptree { + my ($self,$ptree,$line,$file,$nestlist) = @_; + local($_); + my $text = ''; + # process each node in the parse tree + foreach(@$ptree) { + # regular text chunk + unless(ref) { + # count the unescaped angle brackets + # complain only when warning level is greater than 1 + if($self->{-warnings} && $self->{-warnings}>1) { + my $count; + if($count = tr/<>/<>/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "$count unescaped <> in paragraph" }); + } + } + $text .= $_; + next; + } + # have an interior sequence + my $cmd = $_->cmd_name(); + my $contents = $_->parse_tree(); + ($file,$line) = $_->file_line(); + # check for valid tag + if (! $VALID_SEQUENCES{$cmd}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => qq(Unknown interior-sequence '$cmd')}); + # expand it anyway + $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); + next; + } + if($nestlist =~ /$cmd/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "nested commands $cmd<...$cmd<...>...>"}); + # _TODO_ should we add the contents anyway? + # expand it anyway, see below + } + if($cmd eq 'E') { + # preserve entities + if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => 'garbled entity ' . $_->raw_text()}); + next; + } + my $ent = $$contents[0]; + my $val; + if($ent =~ /^0x[0-9a-f]+$/i) { + # hexadec entity + $val = hex($ent); + } + elsif($ent =~ /^0\d+$/) { + # octal + $val = oct($ent); + } + elsif($ent =~ /^\d+$/) { + # numeric entity + $val = $ent; + } + if(defined $val) { + if($val>0 && $val<256) { + $text .= chr($val); + } + else { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => 'Entity number out of range ' . $_->raw_text()}); + } + } + elsif($ENTITIES{$ent}) { + # known ISO entity + $text .= $ENTITIES{$ent}; + } + else { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'Unknown entity ' . $_->raw_text()}); + $text .= "E<$ent>"; + } + } + elsif($cmd eq 'L') { + # try to parse the hyperlink + my $link = Pod::Hyperlink->new($contents->raw_text()); + unless(defined $link) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => 'malformed link ' . $_->raw_text() ." : $@"}); + next; + } + $link->line($line); # remember line + if($self->{-warnings}) { + foreach my $w ($link->warning()) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => $w }); + } + } + # check the link text + $text .= $self->_check_ptree($self->parse_text($link->text(), + $line), $line, $file, "$nestlist$cmd"); + # remember link + $self->hyperlink([$line,$link]); + } + elsif($cmd =~ /[BCFIS]/) { + # add the guts + $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); + } + elsif($cmd eq 'Z') { + if(length($contents->raw_text())) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => 'Nonempty Z<>'}); + } + } + elsif($cmd eq 'X') { + my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); + if($idx =~ /^\s*$/s) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => 'Empty X<>'}); + } + else { + # remember this node + $self->idx($idx); + } + } + else { + # not reached + croak 'internal error'; + } + } + $text; +} + +# process a block of verbatim text +sub verbatim { + ## Nothing particular to check + my ($self, $paragraph, $line_num, $pod_para) = @_; + + $self->_preproc_par($paragraph); + + if($self->{_current_head1} eq 'NAME') { + my ($file, $line) = $pod_para->file_line; + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'Verbatim paragraph in NAME section' }); + } +} + +# process a block of regular text +sub textblock { + my ($self, $paragraph, $line_num, $pod_para) = @_; + my ($file, $line) = $pod_para->file_line; + + $self->_preproc_par($paragraph); + + # skip this paragraph if in a =begin block + unless($self->{_have_begin}) { + my $block = $self->interpolate_and_check($paragraph, $line,$file); + if($self->{_current_head1} eq 'NAME') { + if($block =~ /^\s*(\S+?)\s*[,-]/) { + # this is the canonical name + $self->{-name} = $1 unless(defined $self->{-name}); + } + } + } +} + +sub _preproc_par +{ + my $self = shift; + $_[0] =~ s/[\s\n]+$//; + if($_[0]) { + $self->{_commands_in_head}++; + $self->{_list_item_contents}++ if(defined $self->{_list_item_contents}); + if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) { + $self->{_list_stack}->[0]->{_has_par} = 1; + } + } +} + +1; + +__END__ + +=head1 AUTHOR + +Please report bugs using L. + +Brad Appleton Ebradapp@enteract.comE (initial version), +Marek Rouchal Emarekr@cpan.orgE + +Based on code for B written by +Tom Christiansen Etchrist@mox.perl.comE + +=cut + diff --git a/Master/tlpkg/tlperl/lib/Pod/Escapes.pm b/Master/tlpkg/tlperl/lib/Pod/Escapes.pm new file mode 100644 index 00000000000..de4d75a7b83 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Pod/Escapes.pm @@ -0,0 +1,721 @@ + +require 5; +# The documentation is at the end. +# Time-stamp: "2004-05-07 15:31:25 ADT" +package Pod::Escapes; +require Exporter; +@ISA = ('Exporter'); +$VERSION = '1.04'; +@EXPORT_OK = qw( + %Code2USASCII + %Name2character + %Name2character_number + %Latin1Code_to_fallback + %Latin1Char_to_fallback + e2char + e2charnum +); +%EXPORT_TAGS = ('ALL' => \@EXPORT_OK); + +#========================================================================== + +use strict; +use vars qw( + %Code2USASCII + %Name2character + %Name2character_number + %Latin1Code_to_fallback + %Latin1Char_to_fallback + $FAR_CHAR + $FAR_CHAR_NUMBER + $NOT_ASCII +); + +$FAR_CHAR = "?" unless defined $FAR_CHAR; +$FAR_CHAR_NUMBER = ord($FAR_CHAR) unless defined $FAR_CHAR_NUMBER; + +$NOT_ASCII = 'A' ne chr(65) unless defined $NOT_ASCII; + +#-------------------------------------------------------------------------- +sub e2char { + my $in = $_[0]; + return undef unless defined $in and length $in; + + # Convert to decimal: + if($in =~ m/^(0[0-7]*)$/s ) { + $in = oct $in; + } elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) { + $in = hex $1; + } # else it's decimal, or named + + if($NOT_ASCII) { + # We're in bizarro world of not-ASCII! + # Cope with US-ASCII codes, use fallbacks for Latin-1, or use FAR_CHAR. + unless($in =~ m/^\d+$/s) { + # It's a named character reference. Get its numeric Unicode value. + $in = $Name2character{$in}; + return undef unless defined $in; # (if there's no such name) + $in = ord $in; # (All ents must be one character long.) + # ...So $in holds the char's US-ASCII numeric value, which we'll + # now go get the local equivalent for. + } + + # It's numeric, whether by origin or by mutation from a known name + return $Code2USASCII{$in} # so "65" => "A" everywhere + || $Latin1Code_to_fallback{$in} # Fallback. + || $FAR_CHAR; # Fall further back + } + + # Normal handling: + if($in =~ m/^\d+$/s) { + if($] < 5.007 and $in > 255) { # can't be trusted with Unicode + return $FAR_CHAR; + } else { + return chr($in); + } + } else { + return $Name2character{$in}; # returns undef if unknown + } +} + +#-------------------------------------------------------------------------- +sub e2charnum { + my $in = $_[0]; + return undef unless defined $in and length $in; + + # Convert to decimal: + if($in =~ m/^(0[0-7]*)$/s ) { + $in = oct $in; + } elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) { + $in = hex $1; + } # else it's decimal, or named + + if($in =~ m/^\d+$/s) { + return 0 + $in; + } else { + return $Name2character_number{$in}; # returns undef if unknown + } +} + +#-------------------------------------------------------------------------- + +%Name2character_number = ( + # General XML/XHTML: + 'lt' => 60, + 'gt' => 62, + 'quot' => 34, + 'amp' => 38, + 'apos' => 39, + + # POD-specific: + 'sol' => 47, + 'verbar' => 124, + + 'lchevron' => 171, # legacy for laquo + 'rchevron' => 187, # legacy for raquo + + # Remember, grave looks like \ (as in virtu\) + # acute looks like / (as in re/sume/) + # circumflex looks like ^ (as in papier ma^che/) + # umlaut/dieresis looks like " (as in nai"ve, Chloe") + + # From the XHTML 1 .ent files: + 'nbsp' , 160, + 'iexcl' , 161, + 'cent' , 162, + 'pound' , 163, + 'curren' , 164, + 'yen' , 165, + 'brvbar' , 166, + 'sect' , 167, + 'uml' , 168, + 'copy' , 169, + 'ordf' , 170, + 'laquo' , 171, + 'not' , 172, + 'shy' , 173, + 'reg' , 174, + 'macr' , 175, + 'deg' , 176, + 'plusmn' , 177, + 'sup2' , 178, + 'sup3' , 179, + 'acute' , 180, + 'micro' , 181, + 'para' , 182, + 'middot' , 183, + 'cedil' , 184, + 'sup1' , 185, + 'ordm' , 186, + 'raquo' , 187, + 'frac14' , 188, + 'frac12' , 189, + 'frac34' , 190, + 'iquest' , 191, + 'Agrave' , 192, + 'Aacute' , 193, + 'Acirc' , 194, + 'Atilde' , 195, + 'Auml' , 196, + 'Aring' , 197, + 'AElig' , 198, + 'Ccedil' , 199, + 'Egrave' , 200, + 'Eacute' , 201, + 'Ecirc' , 202, + 'Euml' , 203, + 'Igrave' , 204, + 'Iacute' , 205, + 'Icirc' , 206, + 'Iuml' , 207, + 'ETH' , 208, + 'Ntilde' , 209, + 'Ograve' , 210, + 'Oacute' , 211, + 'Ocirc' , 212, + 'Otilde' , 213, + 'Ouml' , 214, + 'times' , 215, + 'Oslash' , 216, + 'Ugrave' , 217, + 'Uacute' , 218, + 'Ucirc' , 219, + 'Uuml' , 220, + 'Yacute' , 221, + 'THORN' , 222, + 'szlig' , 223, + 'agrave' , 224, + 'aacute' , 225, + 'acirc' , 226, + 'atilde' , 227, + 'auml' , 228, + 'aring' , 229, + 'aelig' , 230, + 'ccedil' , 231, + 'egrave' , 232, + 'eacute' , 233, + 'ecirc' , 234, + 'euml' , 235, + 'igrave' , 236, + 'iacute' , 237, + 'icirc' , 238, + 'iuml' , 239, + 'eth' , 240, + 'ntilde' , 241, + 'ograve' , 242, + 'oacute' , 243, + 'ocirc' , 244, + 'otilde' , 245, + 'ouml' , 246, + 'divide' , 247, + 'oslash' , 248, + 'ugrave' , 249, + 'uacute' , 250, + 'ucirc' , 251, + 'uuml' , 252, + 'yacute' , 253, + 'thorn' , 254, + 'yuml' , 255, + + 'fnof' , 402, + 'Alpha' , 913, + 'Beta' , 914, + 'Gamma' , 915, + 'Delta' , 916, + 'Epsilon' , 917, + 'Zeta' , 918, + 'Eta' , 919, + 'Theta' , 920, + 'Iota' , 921, + 'Kappa' , 922, + 'Lambda' , 923, + 'Mu' , 924, + 'Nu' , 925, + 'Xi' , 926, + 'Omicron' , 927, + 'Pi' , 928, + 'Rho' , 929, + 'Sigma' , 931, + 'Tau' , 932, + 'Upsilon' , 933, + 'Phi' , 934, + 'Chi' , 935, + 'Psi' , 936, + 'Omega' , 937, + 'alpha' , 945, + 'beta' , 946, + 'gamma' , 947, + 'delta' , 948, + 'epsilon' , 949, + 'zeta' , 950, + 'eta' , 951, + 'theta' , 952, + 'iota' , 953, + 'kappa' , 954, + 'lambda' , 955, + 'mu' , 956, + 'nu' , 957, + 'xi' , 958, + 'omicron' , 959, + 'pi' , 960, + 'rho' , 961, + 'sigmaf' , 962, + 'sigma' , 963, + 'tau' , 964, + 'upsilon' , 965, + 'phi' , 966, + 'chi' , 967, + 'psi' , 968, + 'omega' , 969, + 'thetasym' , 977, + 'upsih' , 978, + 'piv' , 982, + 'bull' , 8226, + 'hellip' , 8230, + 'prime' , 8242, + 'Prime' , 8243, + 'oline' , 8254, + 'frasl' , 8260, + 'weierp' , 8472, + 'image' , 8465, + 'real' , 8476, + 'trade' , 8482, + 'alefsym' , 8501, + 'larr' , 8592, + 'uarr' , 8593, + 'rarr' , 8594, + 'darr' , 8595, + 'harr' , 8596, + 'crarr' , 8629, + 'lArr' , 8656, + 'uArr' , 8657, + 'rArr' , 8658, + 'dArr' , 8659, + 'hArr' , 8660, + 'forall' , 8704, + 'part' , 8706, + 'exist' , 8707, + 'empty' , 8709, + 'nabla' , 8711, + 'isin' , 8712, + 'notin' , 8713, + 'ni' , 8715, + 'prod' , 8719, + 'sum' , 8721, + 'minus' , 8722, + 'lowast' , 8727, + 'radic' , 8730, + 'prop' , 8733, + 'infin' , 8734, + 'ang' , 8736, + 'and' , 8743, + 'or' , 8744, + 'cap' , 8745, + 'cup' , 8746, + 'int' , 8747, + 'there4' , 8756, + 'sim' , 8764, + 'cong' , 8773, + 'asymp' , 8776, + 'ne' , 8800, + 'equiv' , 8801, + 'le' , 8804, + 'ge' , 8805, + 'sub' , 8834, + 'sup' , 8835, + 'nsub' , 8836, + 'sube' , 8838, + 'supe' , 8839, + 'oplus' , 8853, + 'otimes' , 8855, + 'perp' , 8869, + 'sdot' , 8901, + 'lceil' , 8968, + 'rceil' , 8969, + 'lfloor' , 8970, + 'rfloor' , 8971, + 'lang' , 9001, + 'rang' , 9002, + 'loz' , 9674, + 'spades' , 9824, + 'clubs' , 9827, + 'hearts' , 9829, + 'diams' , 9830, + 'OElig' , 338, + 'oelig' , 339, + 'Scaron' , 352, + 'scaron' , 353, + 'Yuml' , 376, + 'circ' , 710, + 'tilde' , 732, + 'ensp' , 8194, + 'emsp' , 8195, + 'thinsp' , 8201, + 'zwnj' , 8204, + 'zwj' , 8205, + 'lrm' , 8206, + 'rlm' , 8207, + 'ndash' , 8211, + 'mdash' , 8212, + 'lsquo' , 8216, + 'rsquo' , 8217, + 'sbquo' , 8218, + 'ldquo' , 8220, + 'rdquo' , 8221, + 'bdquo' , 8222, + 'dagger' , 8224, + 'Dagger' , 8225, + 'permil' , 8240, + 'lsaquo' , 8249, + 'rsaquo' , 8250, + 'euro' , 8364, +); + + +# Fill out %Name2character... +{ + %Name2character = (); + my($name, $number); + while( ($name, $number) = each %Name2character_number) { + if($] < 5.007 and $number > 255) { + $Name2character{$name} = $FAR_CHAR; + # substitute for Unicode characters, for perls + # that can't reliable handle them + } else { + $Name2character{$name} = chr $number; + # normal case + } + } + # So they resolve 'right' even in EBCDIC-land + $Name2character{'lt' } = '<'; + $Name2character{'gt' } = '>'; + $Name2character{'quot'} = '"'; + $Name2character{'amp' } = '&'; + $Name2character{'apos'} = "'"; + $Name2character{'sol' } = '/'; + $Name2character{'verbar'} = '|'; +} + +#-------------------------------------------------------------------------- + +%Code2USASCII = ( +# mostly generated by +# perl -e "printf qq{ \x25 3s, '\x25s',\n}, $_, chr($_) foreach (32 .. 126)" + 32, ' ', + 33, '!', + 34, '"', + 35, '#', + 36, '$', + 37, '%', + 38, '&', + 39, "'", #! + 40, '(', + 41, ')', + 42, '*', + 43, '+', + 44, ',', + 45, '-', + 46, '.', + 47, '/', + 48, '0', + 49, '1', + 50, '2', + 51, '3', + 52, '4', + 53, '5', + 54, '6', + 55, '7', + 56, '8', + 57, '9', + 58, ':', + 59, ';', + 60, '<', + 61, '=', + 62, '>', + 63, '?', + 64, '@', + 65, 'A', + 66, 'B', + 67, 'C', + 68, 'D', + 69, 'E', + 70, 'F', + 71, 'G', + 72, 'H', + 73, 'I', + 74, 'J', + 75, 'K', + 76, 'L', + 77, 'M', + 78, 'N', + 79, 'O', + 80, 'P', + 81, 'Q', + 82, 'R', + 83, 'S', + 84, 'T', + 85, 'U', + 86, 'V', + 87, 'W', + 88, 'X', + 89, 'Y', + 90, 'Z', + 91, '[', + 92, "\\", #! + 93, ']', + 94, '^', + 95, '_', + 96, '`', + 97, 'a', + 98, 'b', + 99, 'c', + 100, 'd', + 101, 'e', + 102, 'f', + 103, 'g', + 104, 'h', + 105, 'i', + 106, 'j', + 107, 'k', + 108, 'l', + 109, 'm', + 110, 'n', + 111, 'o', + 112, 'p', + 113, 'q', + 114, 'r', + 115, 's', + 116, 't', + 117, 'u', + 118, 'v', + 119, 'w', + 120, 'x', + 121, 'y', + 122, 'z', + 123, '{', + 124, '|', + 125, '}', + 126, '~', +); + +#-------------------------------------------------------------------------- + +%Latin1Code_to_fallback = (); +@Latin1Code_to_fallback{0xA0 .. 0xFF} = ( +# Copied from Text/Unidecode/x00.pm: + +' ', qq{!}, qq{C/}, 'PS', qq{\$?}, qq{Y=}, qq{|}, 'SS', qq{"}, qq{(c)}, 'a', qq{<<}, qq{!}, "", qq{(r)}, qq{-}, +'deg', qq{+-}, '2', '3', qq{'}, 'u', 'P', qq{*}, qq{,}, '1', 'o', qq{>>}, qq{1/4}, qq{1/2}, qq{3/4}, qq{?}, +'A', 'A', 'A', 'A', 'A', 'A', 'AE', 'C', 'E', 'E', 'E', 'E', 'I', 'I', 'I', 'I', +'D', 'N', 'O', 'O', 'O', 'O', 'O', 'x', 'O', 'U', 'U', 'U', 'U', 'U', 'Th', 'ss', +'a', 'a', 'a', 'a', 'a', 'a', 'ae', 'c', 'e', 'e', 'e', 'e', 'i', 'i', 'i', 'i', +'d', 'n', 'o', 'o', 'o', 'o', 'o', qq{/}, 'o', 'u', 'u', 'u', 'u', 'y', 'th', 'y', + +); + +{ + # Now stuff %Latin1Char_to_fallback: + %Latin1Char_to_fallback = (); + my($k,$v); + while( ($k,$v) = each %Latin1Code_to_fallback) { + $Latin1Char_to_fallback{chr $k} = $v; + #print chr($k), ' => ', $v, "\n"; + } +} + +#-------------------------------------------------------------------------- +1; +__END__ + +=head1 NAME + +Pod::Escapes -- for resolving Pod EE...E sequences + +=head1 SYNOPSIS + + use Pod::Escapes qw(e2char); + ...la la la, parsing POD, la la la... + $text = e2char($e_node->label); + unless(defined $text) { + print "Unknown E sequence \"", $e_node->label, "\"!"; + } + ...else print/interpolate $text... + +=head1 DESCRIPTION + +This module provides things that are useful in decoding +Pod EE...E sequences. Presumably, it should be used +only by Pod parsers and/or formatters. + +By default, Pod::Escapes exports none of its symbols. But +you can request any of them to be exported. +Either request them individually, as with +C, +or you can do C to get all +exportable symbols. + +=head1 GOODIES + +=over + +=item e2char($e_content) + +Given a name or number that could appear in a +Cname_or_numE> sequence, this returns the string that +it stands for. For example, C, C, +C, and C all return "/", +because CsolE>, C47E>, C0x2fE>, +and C057E>, all mean "/". If +the name has no known value (as with a name of "qacute") or is +syntactally invalid (as with a name of "1/4"), this returns undef. + +=item e2charnum($e_content) + +Given a name or number that could appear in a +Cname_or_numE> sequence, this returns the number of +the Unicode character that this stands for. For example, +C, C, +C, and C all return 47, +because CsolE>, C47E>, C0x2fE>, +and C057E>, all mean "/", whose Unicode number is 47. If +the name has no known value (as with a name of "qacute") or is +syntactally invalid (as with a name of "1/4"), this returns undef. + +=item $Name2character{I} + +Maps from names (as in CIE>) like "eacute" or "sol" +to the string that each stands for. Note that this does not +include numerics (like "64" or "x981c"). Under old Perl versions +(before 5.7) you get a "?" in place of characters whose Unicode +value is over 255. + +=item $Name2character_number{I} + +Maps from names (as in CIE>) like "eacute" or "sol" +to the Unicode value that each stands for. For example, +C<$Name2character_number{'eacute'}> is 201, and +C<$Name2character_number{'eacute'}> is 8364. You get the correct +Unicode value, regardless of the version of Perl you're using -- +which differs from C<%Name2character>'s behavior under pre-5.7 Perls. + +Note that this hash does not +include numerics (like "64" or "x981c"). + +=item $Latin1Code_to_fallback{I} + +For numbers in the range 160 (0x00A0) to 255 (0x00FF), this maps +from the character code for a Latin-1 character (like 233 for +lowercase e-acute) to the US-ASCII character that best aproximates +it (like "e"). You may find this useful if you are rendering +POD in a format that you think deals well only with US-ASCII +characters. + +=item $Latin1Char_to_fallback{I} + +Just as above, but maps from characters (like "\xE9", +lowercase e-acute) to characters (like "e"). + +=item $Code2USASCII{I} + +This maps from US-ASCII codes (like 32) to the corresponding +character (like space, for 32). Only characters 32 to 126 are +defined. This is meant for use by C when it senses +that it's running on a non-ASCII platform (where chr(32) doesn't +get you a space -- but $Code2USASCII{32} will). It's +documented here just in case you might find it useful. + +=back + +=head1 CAVEATS + +On Perl versions before 5.7, Unicode characters with a value +over 255 (like lambda or emdash) can't be conveyed. This +module does work under such early Perl versions, but in the +place of each such character, you get a "?". Latin-1 +characters (characters 160-255) are unaffected. + +Under EBCDIC platforms, C may not always be the +same as C, and ditto for +C<$Name2character{$name}> and +C. + +=head1 SEE ALSO + +L + +L + +L + +=head1 COPYRIGHT AND DISCLAIMERS + +Copyright (c) 2001-2004 Sean M. Burke. All rights reserved. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +This program is distributed in the hope that it will be useful, but +without any warranty; without even the implied warranty of +merchantability or fitness for a particular purpose. + +Portions of the data tables in this module are derived from the +entity declarations in the W3C XHTML specification. + +Currently (October 2001), that's these three: + + http://www.w3.org/TR/xhtml1/DTD/xhtml-lat1.ent + http://www.w3.org/TR/xhtml1/DTD/xhtml-special.ent + http://www.w3.org/TR/xhtml1/DTD/xhtml-symbol.ent + +=head1 AUTHOR + +Sean M. Burke C + +=cut + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# What I used for reading the XHTML .ent files: + +use strict; +my(@norms, @good, @bad); +my $dir = 'c:/sgml/docbook/'; +my %escapes; +foreach my $file (qw( + xhtml-symbol.ent + xhtml-lat1.ent + xhtml-special.ent +)) { + open(IN, "<$dir$file") or die "can't read-open $dir$file: $!"; + print "Reading $file...\n"; + while() { + if(m//) { + my($name, $value) = ($1,$2); + next if $name eq 'quot' or $name eq 'apos' or $name eq 'gt'; + + $value = hex $1 if $value =~ m/^x([a-fA-F0-9]+)$/s; + print "ILLEGAL VALUE $value" unless $value =~ m/^\d+$/s; + if($value > 255) { + push @good , sprintf " %-10s , chr(%s),\n", "'$name'", $value; + push @bad , sprintf " %-10s , \$bad,\n", "'$name'", $value; + } else { + push @norms, sprintf " %-10s , chr(%s),\n", "'$name'", $value; + } + } elsif(m/ +# +# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code +# from Nick Ing-Simmon's PodToHtml). All rights reserved. +# This file is part of "PodParser". Pod::Find is free software; +# you can redistribute it and/or modify it under the same terms +# as Perl itself. +############################################################################# + +package Pod::Find; +use strict; + +use vars qw($VERSION); +$VERSION = '1.35'; ## Current version of this package +require 5.005; ## requires this Perl version or later +use Carp; + +BEGIN { + if ($] < 5.006) { + require Symbol; + import Symbol; + } +} + +############################################################################# + +=head1 NAME + +Pod::Find - find POD documents in directory trees + +=head1 SYNOPSIS + + use Pod::Find qw(pod_find simplify_name); + my %pods = pod_find({ -verbose => 1, -inc => 1 }); + foreach(keys %pods) { + print "found library POD `$pods{$_}' in $_\n"; + } + + print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n"; + + $location = pod_where( { -inc => 1 }, "Pod::Find" ); + +=head1 DESCRIPTION + +B provides a set of functions to locate POD files. Note that +no function is exported by default to avoid pollution of your namespace, +so be sure to specify them in the B statement if you need them: + + use Pod::Find qw(pod_find); + +From this version on the typical SCM (software configuration management) +files/directories like RCS, CVS, SCCS, .svn are ignored. + +=cut + +#use diagnostics; +use Exporter; +use File::Spec; +use File::Find; +use Cwd; + +use vars qw(@ISA @EXPORT_OK $VERSION); +@ISA = qw(Exporter); +@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod); + +# package global variables +my $SIMPLIFY_RX; + +=head2 C + +The function B searches for POD documents in a given set of +files and/or directories. It returns a hash with the file names as keys +and the POD name as value. The POD name is derived from the file name +and its position in the directory tree. + +E.g. when searching in F<$HOME/perl5lib>, the file +F<$HOME/perl5lib/MyModule.pm> would get the POD name I, +whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be +I. The name information can be used for POD +translators. + +Only text files containing at least one valid POD command are found. + +A warning is printed if more than one POD file with the same POD name +is found, e.g. F in different directories. This usually +indicates duplicate occurrences of modules in the I<@INC> search path. + +B The first argument for B may be a hash reference +with options. The rest are either directories that are searched +recursively or files. The POD names of files are the plain basenames +with any Perl-like extension (.pm, .pl, .pod) stripped. + +=over 4 + +=item C<-verbose =E 1> + +Print progress information while scanning. + +=item C<-perl =E 1> + +Apply Perl-specific heuristics to find the correct PODs. This includes +stripping Perl-like extensions, omitting subdirectories that are numeric +but do I match the current Perl interpreter's version id, suppressing +F as a module hierarchy name etc. + +=item C<-script =E 1> + +Search for PODs in the current Perl interpreter's installation +B. This is taken from the local L module. + +=item C<-inc =E 1> + +Search for PODs in the current Perl interpreter's I<@INC> paths. This +automatically considers paths specified in the C environment +as this is included in I<@INC> by the Perl interpreter itself. + +=back + +=cut + +# return a hash of the POD files found +# first argument may be a hashref (options), +# rest is a list of directories to search recursively +sub pod_find +{ + my %opts; + if(ref $_[0]) { + %opts = %{shift()}; + } + + $opts{-verbose} ||= 0; + $opts{-perl} ||= 0; + + my (@search) = @_; + + if($opts{-script}) { + require Config; + push(@search, $Config::Config{scriptdir}) + if -d $Config::Config{scriptdir}; + $opts{-perl} = 1; + } + + if($opts{-inc}) { + if ($^O eq 'MacOS') { + # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS + my @new_INC = @INC; + for (@new_INC) { + if ( $_ eq '.' ) { + $_ = ':'; + } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) { + $_ = ':'. $_; + } else { + $_ =~ s{^\./}{:}; + } + } + push(@search, grep($_ ne File::Spec->curdir, @new_INC)); + } else { + push(@search, grep($_ ne File::Spec->curdir, @INC)); + } + + $opts{-perl} = 1; + } + + if($opts{-perl}) { + require Config; + # this code simplifies the POD name for Perl modules: + # * remove "site_perl" + # * remove e.g. "i586-linux" (from 'archname') + # * remove e.g. 5.00503 + # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) + + # Mac OS: + # * remove ":?site_perl:" + # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod) + + if ($^O eq 'MacOS') { + $SIMPLIFY_RX = + qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!; + } else { + $SIMPLIFY_RX = + qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!; + } + } + + my %dirs_visited; + my %pods; + my %names; + my $pwd = cwd(); + + foreach my $try (@search) { + unless(File::Spec->file_name_is_absolute($try)) { + # make path absolute + $try = File::Spec->catfile($pwd,$try); + } + # simplify path + # on VMS canonpath will vmsify:[the.path], but File::Find::find + # wants /unixy/paths + $try = File::Spec->canonpath($try) if ($^O ne 'VMS'); + $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS'); + my $name; + if(-f $try) { + if($name = _check_and_extract_name($try, $opts{-verbose})) { + _check_for_duplicates($try, $name, \%names, \%pods); + } + next; + } + my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!; + File::Find::find( sub { + my $item = $File::Find::name; + if(-d) { + if($item =~ m{/(?:RCS|CVS|SCCS|\.svn)$}) { + $File::Find::prune = 1; + return; + } + elsif($dirs_visited{$item}) { + warn "Directory '$item' already seen, skipping.\n" + if($opts{-verbose}); + $File::Find::prune = 1; + return; + } + else { + $dirs_visited{$item} = 1; + } + if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) { + $File::Find::prune = 1; + warn "Perl $] version mismatch on $_, skipping.\n" + if($opts{-verbose}); + } + return; + } + if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { + _check_for_duplicates($item, $name, \%names, \%pods); + } + }, $try); # end of File::Find::find + } + chdir $pwd; + return %pods; +} + +sub _check_for_duplicates { + my ($file, $name, $names_ref, $pods_ref) = @_; + if($$names_ref{$name}) { + warn "Duplicate POD found (shadowing?): $name ($file)\n"; + warn ' Already seen in ', + join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; + } + else { + $$names_ref{$name} = 1; + } + return $$pods_ref{$file} = $name; +} + +sub _check_and_extract_name { + my ($file, $verbose, $root_rx) = @_; + + # check extension or executable flag + # this involves testing the .bat extension on Win32! + unless(-f $file && -T $file && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) { + return; + } + + return unless contains_pod($file,$verbose); + + # strip non-significant path components + # TODO what happens on e.g. Win32? + my $name = $file; + if(defined $root_rx) { + $name =~ s/$root_rx//s; + $name =~ s/$SIMPLIFY_RX//s if(defined $SIMPLIFY_RX); + } + else { + if ($^O eq 'MacOS') { + $name =~ s/^.*://s; + } else { + $name =~ s{^.*/}{}s; + } + } + _simplify($name); + $name =~ s{/+}{::}g; + if ($^O eq 'MacOS') { + $name =~ s{:+}{::}g; # : -> :: + } else { + $name =~ s{/+}{::}g; # / -> :: + } + return $name; +} + +=head2 C + +The function B is equivalent to B, but also +strips Perl-like extensions (.pm, .pl, .pod) and extensions like +F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively. + +=cut + +# basic simplification of the POD name: +# basename & strip extension +sub simplify_name { + my ($str) = @_; + # remove all path components + if ($^O eq 'MacOS') { + $str =~ s/^.*://s; + } else { + $str =~ s{^.*/}{}s; + } + _simplify($str); + return $str; +} + +# internal sub only +sub _simplify { + # strip Perl's own extensions + $_[0] =~ s/\.(pod|pm|plx?)\z//i; + # strip meaningless extensions on Win32 and OS/2 + $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i); + # strip meaningless extensions on VMS + $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS'); +} + +# contribution from Tim Jenness + +=head2 C + +Returns the location of a pod document given a search directory +and a module (e.g. C) or script (e.g. C) name. + +Options: + +=over 4 + +=item C<-inc =E 1> + +Search @INC for the pod and also the C defined in the +L module. + +=item C<-dirs =E [ $dir1, $dir2, ... ]> + +Reference to an array of search directories. These are searched in order +before looking in C<@INC> (if B<-inc>). Current directory is used if +none are specified. + +=item C<-verbose =E 1> + +List directories as they are searched + +=back + +Returns the full path of the first occurrence to the file. +Package names (eg 'A::B') are automatically converted to directory +names in the selected directory. (eg on unix 'A::B' is converted to +'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the +search automatically if required. + +A subdirectory F is also checked if it exists in any of the given +search directories. This ensures that e.g. L is +found. + +It is assumed that if a module name is supplied, that that name +matches the file name. Pods are not opened to check for the 'NAME' +entry. + +A check is made to make sure that the file that is found does +contain some pod documentation. + +=cut + +sub pod_where { + + # default options + my %options = ( + '-inc' => 0, + '-verbose' => 0, + '-dirs' => [ File::Spec->curdir ], + ); + + # Check for an options hash as first argument + if (defined $_[0] && ref($_[0]) eq 'HASH') { + my $opt = shift; + + # Merge default options with supplied options + %options = (%options, %$opt); + } + + # Check usage + carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_)); + + # Read argument + my $pod = shift; + + # Split on :: and then join the name together using File::Spec + my @parts = split (/::/, $pod); + + # Get full directory list + my @search_dirs = @{ $options{'-dirs'} }; + + if ($options{'-inc'}) { + + require Config; + + # Add @INC + if ($^O eq 'MacOS' && $options{'-inc'}) { + # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS + my @new_INC = @INC; + for (@new_INC) { + if ( $_ eq '.' ) { + $_ = ':'; + } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) { + $_ = ':'. $_; + } else { + $_ =~ s{^\./}{:}; + } + } + push (@search_dirs, @new_INC); + } elsif ($options{'-inc'}) { + push (@search_dirs, @INC); + } + + # Add location of pod documentation for perl man pages (eg perlfunc) + # This is a pod directory in the private install tree + #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'}, + # 'pod'); + #push (@search_dirs, $perlpoddir) + # if -d $perlpoddir; + + # Add location of binaries such as pod2text + push (@search_dirs, $Config::Config{'scriptdir'}) + if -d $Config::Config{'scriptdir'}; + } + + warn 'Search path is: '.join(' ', @search_dirs)."\n" + if $options{'-verbose'}; + + # Loop over directories + Dir: foreach my $dir ( @search_dirs ) { + + # Don't bother if can't find the directory + if (-d $dir) { + warn "Looking in directory $dir\n" + if $options{'-verbose'}; + + # Now concatenate this directory with the pod we are searching for + my $fullname = File::Spec->catfile($dir, @parts); + warn "Filename is now $fullname\n" + if $options{'-verbose'}; + + # Loop over possible extensions + foreach my $ext ('', '.pod', '.pm', '.pl') { + my $fullext = $fullname . $ext; + if (-f $fullext && + contains_pod($fullext, $options{'-verbose'}) ) { + warn "FOUND: $fullext\n" if $options{'-verbose'}; + return $fullext; + } + } + } else { + warn "Directory $dir does not exist\n" + if $options{'-verbose'}; + next Dir; + } + # for some strange reason the path on MacOS/darwin/cygwin is + # 'pods' not 'pod' + # this could be the case also for other systems that + # have a case-tolerant file system, but File::Spec + # does not recognize 'darwin' yet. And cygwin also has "pods", + # but is not case tolerant. Oh well... + if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i) + && -d File::Spec->catdir($dir,'pods')) { + $dir = File::Spec->catdir($dir,'pods'); + redo Dir; + } + if(-d File::Spec->catdir($dir,'pod')) { + $dir = File::Spec->catdir($dir,'pod'); + redo Dir; + } + } + # No match; + return; +} + +=head2 C + +Returns true if the supplied filename (not POD module) contains some pod +information. + +=cut + +sub contains_pod { + my $file = shift; + my $verbose = 0; + $verbose = shift if @_; + + # check for one line of POD + my $podfh; + if ($] < 5.006) { + $podfh = gensym(); + } + + unless(open($podfh,"<$file")) { + warn "Error: $file is unreadable: $!\n"; + return; + } + + local $/ = undef; + my $pod = <$podfh>; + close($podfh) || die "Error closing $file: $!\n"; + unless($pod =~ /^=(head\d|pod|over|item|cut)\b/m) { + warn "No POD in $file, skipping.\n" + if($verbose); + return 0; + } + + return 1; +} + +=head1 AUTHOR + +Please report bugs using L. + +Marek Rouchal Emarekr@cpan.orgE, +heavily borrowing code from Nick Ing-Simmons' PodToHtml. + +Tim Jenness Et.jenness@jach.hawaii.eduE provided +C and C. + +=head1 SEE ALSO + +L, L, L + +=cut + +1; + diff --git a/Master/tlpkg/tlperl/lib/Pod/Functions.pm b/Master/tlpkg/tlperl/lib/Pod/Functions.pm new file mode 100644 index 00000000000..5181c3990bf --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Pod/Functions.pm @@ -0,0 +1,376 @@ +package Pod::Functions; +use strict; + +=head1 NAME + +Pod::Functions - Group Perl's functions a la perlfunc.pod + +=head1 SYNOPSIS + + use Pod::Functions; + + my @misc_ops = @{ $Kinds{ 'Misc' } }; + my $misc_dsc = $Type_Description{ 'Misc' }; + +or + + perl /path/to/lib/Pod/Functions.pm + +This will print a grouped list of Perl's functions, like the +L section. + +=head1 DESCRIPTION + +It exports the following variables: + +=over 4 + +=item %Kinds + +This holds a hash-of-lists. Each list contains the functions in the category +the key denotes. + +=item %Type + +In this hash each key represents a function and the value is the category. +The category can be a comma separated list. + +=item %Flavor + +In this hash each key represents a function and the value is a short +description of that function. + +=item %Type_Description + +In this hash each key represents a category of functions and the value is +a short description of that category. + +=item @Type_Order + +This list of categories is used to produce the same order as the +L section. + +=back + +=head1 CHANGES + +1.02 20020813 + de-typo in the SYNOPSIS section (thanks Mike Castle for noticing) + +1.01 20011229 + fixed some bugs that slipped in after 5.6.1 + added the pod + finished making it strict safe + +1.00 ?? + first numbered version + +=cut + +our $VERSION = '1.04'; + +require Exporter; + +our @ISA = qw(Exporter); +our @EXPORT = qw(%Kinds %Type %Flavor %Type_Description @Type_Order); + +our(%Kinds, %Type, %Flavor); + +our %Type_Description = ( + 'ARRAY' => 'Functions for real @ARRAYs', + 'Binary' => 'Functions for fixed length data or records', + 'File' => 'Functions for filehandles, files, or directories', + 'Flow' => 'Keywords related to control flow of your perl program', + 'HASH' => 'Functions for real %HASHes', + 'I/O' => 'Input and output functions', + 'LIST' => 'Functions for list data', + 'Math' => 'Numeric functions', + 'Misc' => 'Miscellaneous functions', + 'Modules' => 'Keywords related to perl modules', + 'Network' => 'Fetching network info', + 'Objects' => 'Keywords related to classes and object-orientedness', + 'Process' => 'Functions for processes and process groups', + 'Regexp' => 'Regular expressions and pattern matching', + 'Socket' => 'Low-level socket functions', + 'String' => 'Functions for SCALARs or strings', + 'SysV' => 'System V interprocess communication functions', + 'Time' => 'Time-related functions', + 'User' => 'Fetching user and group info', + 'Namespace' => 'Keywords altering or affecting scoping of identifiers', +); + +our @Type_Order = qw{ + String + Regexp + Math + ARRAY + LIST + HASH + I/O + Binary + File + Flow + Namespace + Misc + Process + Modules + Objects + Socket + SysV + User + Network + Time +}; + +while () { + chomp; + s/#.*//; + next unless $_; + my($name, $type, $text) = split " ", $_, 3; + $Type{$name} = $type; + $Flavor{$name} = $text; + for my $t ( split /[,\s]+/, $type ) { + push @{$Kinds{$t}}, $name; + } +} + +close DATA; + +my( $typedesc, $list ); +unless (caller) { + foreach my $type ( @Type_Order ) { + $list = join(", ", sort @{$Kinds{$type}}); + $typedesc = $Type_Description{$type} . ":"; + write; + } +} + +format = + +^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $typedesc +~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $typedesc + ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $list +. + +1; + +__DATA__ +-X File a file test (-r, -x, etc) +abs Math absolute value function +accept Socket accept an incoming socket connect +alarm Process schedule a SIGALRM +atan2 Math arctangent of Y/X in the range -PI to PI +bind Socket binds an address to a socket +binmode I/O prepare binary files for I/O +bless Objects create an object +caller Flow,Namespace get context of the current subroutine call +chdir File change your current working directory +chmod File changes the permissions on a list of files +chomp String remove a trailing record separator from a string +chop String remove the last character from a string +chown File change the ownership on a list of files +chr String get character this number represents +chroot File make directory new root for path lookups +close I/O close file (or pipe or socket) handle +closedir I/O close directory handle +connect Socket connect to a remote socket +continue Flow optional trailing block in a while or foreach +cos Math cosine function +crypt String one-way passwd-style encryption +dbmclose Objects,I/O breaks binding on a tied dbm file +dbmopen Objects,I/O create binding on a tied dbm file +defined Misc test whether a value, variable, or function is defined +delete HASH deletes a value from a hash +die I/O,Flow raise an exception or bail out +do Flow,Modules turn a BLOCK into a TERM +dump Misc,Flow create an immediate core dump +each HASH retrieve the next key/value pair from a hash +endgrent User be done using group file +endhostent User be done using hosts file +endnetent User be done using networks file +endprotoent Network be done using protocols file +endpwent User be done using passwd file +endservent Network be done using services file +eof I/O test a filehandle for its end +eval Flow,Misc catch exceptions or compile and run code +exec Process abandon this program to run another +exists HASH test whether a hash key is present +exit Flow terminate this program +exp Math raise I to a power +fcntl File file control system call +fileno I/O return file descriptor from filehandle +flock I/O lock an entire file with an advisory lock +fork Process create a new process just like this one +format I/O declare a picture format with use by the write() function +formline Misc internal function used for formats +getc I/O get the next character from the filehandle +getgrent User get next group record +getgrgid User get group record given group user ID +getgrnam User get group record given group name +gethostbyaddr Network get host record given its address +gethostbyname Network get host record given name +gethostent Network get next hosts record +getlogin User return who logged in at this tty +getnetbyaddr Network get network record given its address +getnetbyname Network get networks record given name +getnetent Network get next networks record +getpeername Socket find the other end of a socket connection +getpgrp Process get process group +getppid Process get parent process ID +getpriority Process get current nice value +getprotobyname Network get protocol record given name +getprotobynumber Network get protocol record numeric protocol +getprotoent Network get next protocols record +getpwent User get next passwd record +getpwnam User get passwd record given user login name +getpwuid User get passwd record given user ID +getservbyname Network get services record given its name +getservbyport Network get services record given numeric port +getservent Network get next services record +getsockname Socket retrieve the sockaddr for a given socket +getsockopt Socket get socket options on a given socket +glob File expand filenames using wildcards +gmtime Time convert UNIX time into record or string using Greenwich time +goto Flow create spaghetti code +grep LIST locate elements in a list test true against a given criterion +hex Math,String convert a string to a hexadecimal number +import Modules,Namespace patch a module's namespace into your own +index String find a substring within a string +int Math get the integer portion of a number +ioctl File system-dependent device control system call +join LIST join a list into a string using a separator +keys HASH retrieve list of indices from a hash +kill Process send a signal to a process or process group +last Flow exit a block prematurely +lc String return lower-case version of a string +lcfirst String return a string with just the next letter in lower case +length String return the number of bytes in a string +link File create a hard link in the filesystem +listen Socket register your socket as a server +local Misc,Namespace create a temporary value for a global variable (dynamic scoping) +localtime Time convert UNIX time into record or string using local time +lock Threads get a thread lock on a variable, subroutine, or method +log Math retrieve the natural logarithm for a number +lstat File stat a symbolic link +m// Regexp match a string with a regular expression pattern +map LIST apply a change to a list to get back a new list with the changes +mkdir File create a directory +msgctl SysV SysV IPC message control operations +msgget SysV get SysV IPC message queue +msgrcv SysV receive a SysV IPC message from a message queue +msgsnd SysV send a SysV IPC message to a message queue +my Misc,Namespace declare and assign a local variable (lexical scoping) +next Flow iterate a block prematurely +no Modules unimport some module symbols or semantics at compile time +package Modules,Objects,Namespace declare a separate global namespace +prototype Flow,Misc get the prototype (if any) of a subroutine +oct String,Math convert a string to an octal number +open File open a file, pipe, or descriptor +opendir File open a directory +ord String find a character's numeric representation +our Misc,Namespace declare and assign a package variable (lexical scoping) +pack Binary,String convert a list into a binary representation +pipe Process open a pair of connected filehandles +pop ARRAY remove the last element from an array and return it +pos Regexp find or set the offset for the last/next m//g search +print I/O output a list to a filehandle +printf I/O output a formatted list to a filehandle +push ARRAY append one or more elements to an array +q/STRING/ String singly quote a string +qq/STRING/ String doubly quote a string +quotemeta Regexp quote regular expression magic characters +qw/STRING/ LIST quote a list of words +qx/STRING/ Process backquote quote a string +qr/STRING/ Regexp Compile pattern +rand Math retrieve the next pseudorandom number +read I/O,Binary fixed-length buffered input from a filehandle +readdir I/O get a directory from a directory handle +readline I/O fetch a record from a file +readlink File determine where a symbolic link is pointing +readpipe Process execute a system command and collect standard output +recv Socket receive a message over a Socket +redo Flow start this loop iteration over again +ref Objects find out the type of thing being referenced +rename File change a filename +require Modules load in external functions from a library at runtime +reset Misc clear all variables of a given name +return Flow get out of a function early +reverse String,LIST flip a string or a list +rewinddir I/O reset directory handle +rindex String right-to-left substring search +rmdir File remove a directory +s/// Regexp replace a pattern with a string +scalar Misc force a scalar context +seek I/O reposition file pointer for random-access I/O +seekdir I/O reposition directory pointer +select I/O reset default output or do I/O multiplexing +semctl SysV SysV semaphore control operations +semget SysV get set of SysV semaphores +semop SysV SysV semaphore operations +send Socket send a message over a socket +setgrent User prepare group file for use +sethostent Network prepare hosts file for use +setnetent Network prepare networks file for use +setpgrp Process set the process group of a process +setpriority Process set a process's nice value +setprotoent Network prepare protocols file for use +setpwent User prepare passwd file for use +setservent Network prepare services file for use +setsockopt Socket set some socket options +shift ARRAY remove the first element of an array, and return it +shmctl SysV SysV shared memory operations +shmget SysV get SysV shared memory segment identifier +shmread SysV read SysV shared memory +shmwrite SysV write SysV shared memory +shutdown Socket close down just half of a socket connection +sin Math return the sine of a number +sleep Process block for some number of seconds +socket Socket create a socket +socketpair Socket create a pair of sockets +sort LIST sort a list of values +splice ARRAY add or remove elements anywhere in an array +split Regexp split up a string using a regexp delimiter +sprintf String formatted print into a string +sqrt Math square root function +srand Math seed the random number generator +stat File get a file's status information +study Regexp optimize input data for repeated searches +sub Flow declare a subroutine, possibly anonymously +substr String get or alter a portion of a string +symlink File create a symbolic link to a file +syscall I/O,Binary execute an arbitrary system call +sysopen File open a file, pipe, or descriptor +sysread I/O,Binary fixed-length unbuffered input from a filehandle +sysseek I/O,Binary position I/O pointer on handle used with sysread and syswrite +system Process run a separate program +syswrite I/O,Binary fixed-length unbuffered output to a filehandle +tell I/O get current seekpointer on a filehandle +telldir I/O get current seekpointer on a directory handle +tie Objects bind a variable to an object class +tied Objects get a reference to the object underlying a tied variable +time Time return number of seconds since 1970 +times Process,Time return elapsed time for self and child processes +tr/// String transliterate a string +truncate I/O shorten a file +uc String return upper-case version of a string +ucfirst String return a string with just the next letter in upper case +umask File set file creation mode mask +undef Misc remove a variable or function definition +unlink File remove one link to a file +unpack Binary,LIST convert binary structure into normal perl variables +unshift ARRAY prepend more elements to the beginning of a list +untie Objects break a tie binding to a variable +use Modules,Namespace load a module and import its namespace +use Objects load in a module at compile time +utime File set a file's last access and modify times +values HASH return a list of the values in a hash +vec Binary test or set particular bits in a string +wait Process wait for any child process to die +waitpid Process wait for a particular child process to die +wantarray Misc,Flow get void vs scalar vs list context of current subroutine call +warn I/O print debugging info +write I/O print a picture record +y/// String transliterate a string diff --git a/Master/tlpkg/tlperl/lib/Pod/Html.pm b/Master/tlpkg/tlperl/lib/Pod/Html.pm new file mode 100644 index 00000000000..6174dd74576 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Pod/Html.pm @@ -0,0 +1,2235 @@ +package Pod::Html; +use strict; +require Exporter; + +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); +$VERSION = 1.09; +@ISA = qw(Exporter); +@EXPORT = qw(pod2html htmlify); +@EXPORT_OK = qw(anchorify); + +use Carp; +use Config; +use Cwd; +use File::Spec; +use File::Spec::Unix; +use Getopt::Long; + +use locale; # make \w work right in non-ASCII lands + +=head1 NAME + +Pod::Html - module to convert pod files to HTML + +=head1 SYNOPSIS + + use Pod::Html; + pod2html([options]); + +=head1 DESCRIPTION + +Converts files from pod format (see L) to HTML format. It +can automatically generate indexes and cross-references, and it keeps +a cache of things it knows how to cross-reference. + +=head1 FUNCTIONS + +=head2 pod2html + + pod2html("pod2html", + "--podpath=lib:ext:pod:vms", + "--podroot=/usr/src/perl", + "--htmlroot=/perl/nmanual", + "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop", + "--recurse", + "--infile=foo.pod", + "--outfile=/perl/nmanual/foo.html"); + +pod2html takes the following arguments: + +=over 4 + +=item backlink + + --backlink="Back to Top" + +Adds "Back to Top" links in front of every C heading (except for +the first). By default, no backlinks are generated. + +=item cachedir + + --cachedir=name + +Creates the item and directory caches in the given directory. + +=item css + + --css=stylesheet + +Specify the URL of a cascading style sheet. Also disables all HTML/CSS +C