From ccf29645c02dcd2e530892cd3cad48f3b555cd3d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 7 Jan 2008 13:06:47 +0000 Subject: add all the pod stuff, hope now that it is enough git-svn-id: svn://tug.org/texlive/trunk@6115 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/lib/Pod/Checker.pm | 1270 +++++++++++++ Master/tlpkg/tlperl/lib/Pod/Find.pm | 523 ++++++ Master/tlpkg/tlperl/lib/Pod/Functions.pm | 376 ++++ Master/tlpkg/tlperl/lib/Pod/Html.pm | 2123 ++++++++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/InputObjects.pm | 941 ++++++++++ Master/tlpkg/tlperl/lib/Pod/LaTeX.pm | 1876 +++++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Man.pm | 1413 ++++++++++++++ Master/tlpkg/tlperl/lib/Pod/ParseLink.pm | 184 ++ Master/tlpkg/tlperl/lib/Pod/ParseUtils.pm | 852 +++++++++ Master/tlpkg/tlperl/lib/Pod/Parser.pm | 1799 ++++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Perldoc.pm | 1762 ++++++++++++++++++ Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm | 28 + Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm | 106 ++ Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm | 72 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm | 187 ++ Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm | 100 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm | 90 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm | 85 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm | 91 + Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm | 129 ++ Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm | 63 + Master/tlpkg/tlperl/lib/Pod/PlainText.pm | 705 +++++++ Master/tlpkg/tlperl/lib/Pod/Plainer.pm | 69 + Master/tlpkg/tlperl/lib/Pod/Select.pm | 754 ++++++++ Master/tlpkg/tlperl/lib/Pod/Text.pm | 848 +++++++++ Master/tlpkg/tlperl/lib/Pod/Text/Color.pm | 145 ++ Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm | 208 +++ Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm | 180 ++ 28 files changed, 16979 insertions(+) create mode 100644 Master/tlpkg/tlperl/lib/Pod/Checker.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/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 (limited to 'Master/tlpkg/tlperl') diff --git a/Master/tlpkg/tlperl/lib/Pod/Checker.pm b/Master/tlpkg/tlperl/lib/Pod/Checker.pm new file mode 100644 index 00000000000..49162da4a27 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Pod/Checker.pm @@ -0,0 +1,1270 @@ +############################################################################# +# 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 vars qw($VERSION); +$VERSION = 1.43; ## 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 nonexisting 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 happend 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 bulletted 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 wrt. 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 behaviour. Users of B (the script) +get the well-known behaviour. + +=cut + +############################################################################# + +use strict; +#use diagnostics; +use Carp; +use Exporter; +use Pod::Parser; + +use vars qw(@ISA @EXPORT); +@ISA = qw(Pod::Parser); +@EXPORT = qw(&podchecker); + +use vars qw(%VALID_COMMANDS %VALID_SEQUENCES); + +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, +); + +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 => "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 + die "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/Find.pm b/Master/tlpkg/tlperl/lib/Pod/Find.pm new file mode 100644 index 00000000000..0b085b8c9e3 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Pod/Find.pm @@ -0,0 +1,523 @@ +############################################################################# +# Pod/Find.pm -- finds files containing POD documentation +# +# Author: Marek Rouchal +# +# 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 vars qw($VERSION); +$VERSION = 1.34; ## Current version of this package +require 5.005; ## requires this Perl version or later +use Carp; + +############################################################################# + +=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 strict; +#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 prepended to 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; + %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; + } + $$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 undef; + } + + return undef 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!!os 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; # / -> :: + } + $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); + $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 undef; +} + +=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 + unless(open(POD,"<$file")) { + warn "Error: $file is unreadable: $!\n"; + return undef; + } + + local $/ = undef; + my $pod = ; + close(POD) || die "Error closing $file: $!\n"; + unless($pod =~ /^=(head\d|pod|over|item)\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..0e250cf0b50 --- /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.03'; + +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 owership 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 filesytem +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 stirng +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..4b9752bc6fc --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Pod/Html.pm @@ -0,0 +1,2123 @@ +package Pod::Html; +use strict; +require Exporter; + +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); +$VERSION = 1.0504; +@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 ARGUMENTS + +Pod::Html 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