diff options
Diffstat (limited to 'chromium/third_party/cygwin/lib/perl5/5.10/Pod')
59 files changed, 0 insertions, 30433 deletions
diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Checker.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Checker.pm deleted file mode 100644 index fb877e2a2db..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Checker.pm +++ /dev/null @@ -1,1271 +0,0 @@ -############################################################################# -# 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_01"; ## 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<gt> I<val> - -Turn warnings on/off. I<val> is usually 1 for on, but higher values -trigger additional warnings. See L<"Warnings">. - -=back - -=head1 DESCRIPTION - -B<podchecker> will perform syntax checking of Perl5 POD format documentation. - -Curious/ambitious users are welcome to propose additional features they wish -to see in B<Pod::Checker> and B<podchecker> and verify that the checks are -consistent with L<perlpod>. - -The following checks are currently performed: - -=over 4 - -=item * - -Unknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' 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<lt>...LE<lt>...E<gt>...E<gt>>). - -=item * - -Check for malformed or non-existing entities C<EE<lt>...E<gt>>. - -=item * - -Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod> -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<N> 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<NAME> - -The given link to I<NAME> 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<CMD>" - -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<SEQ>" - -An invalid markup command has been encountered. Valid are: -C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>, -C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>, -C<ZE<lt>E<gt>> - -=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt> - -Two nested identical markup commands have been found. Generally this -does not make sense. - -=item * garbled entity I<STRING> - -The I<STRING> 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 LE<lt>E<gt> - -The link found cannot be parsed because it does not conform to the -syntax described in L<perlpod>. - -=item * nonempty ZE<lt>E<gt> - -The C<ZE<lt>E<gt>> sequence is supposed to be empty. - -=item * empty XE<lt>E<gt> - -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<name> - -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<vi> users switch on the B<list> -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<one> vs. I<two>) - -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<first> C<=item> determines the type of the list. - -=item * I<N> unescaped C<E<lt>E<gt>> in paragraph - -Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>> -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<verbar> and C<sol>. - -=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<n> 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<lt>...E<gt>. - -=item * (section) in '$page' deprecated - -There is a section detected in the page name of LE<lt>...E<gt>, e.g. -C<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only. -Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able -to expand this to appropriate code. For links to (builtin) functions, -please say C<LE<lt>perlfunc/mkdirE<gt>>, without (). - -=item * alternative text/node '%s' contains non-escaped | or / - -The characters C<|> and C</> are special in the LE<lt>...E<gt> 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<sol> - | E<verbar> - -=back - -=head1 RETURN VALUE - -B<podchecker> 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</SYNOPSIS> - -=head1 INTERFACE - -While checking, this module collects document properties, e.g. the nodes -for hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>). -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<Pod::Checker> module uses only the B<poderror> -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<podchecker> (the script). This allows users of B<Pod::Checker> to -control completely the output behavior. Users of B<podchecker> (the script) -get the well-known behavior. - -=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, - '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 C<Pod::Checker-E<gt>new( %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<gt> num> - Print warnings if C<num> is true. The higher the value of C<num>, -the more warnings are printed. Currently there are only levels 1 and 2. - -C<-quiet =E<gt> num> - If C<num> 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-E<gt>poderror( @args )> - -=item C<$checker-E<gt>poderror( {%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-E<gt>num_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-E<gt>num_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-E<gt>name()> - -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-E<gt>node()> - -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-E<gt>idx()> - -Add (if argument specified) and retrieve the index entries (as defined by -C<XE<lt>E<gt>>) 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-E<gt>hyperlink()> - -Add (if argument specified) and retrieve the hyperlinks (as defined by -C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line -number and C<Pod::Hyperlink> 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<Tk::Pod/"DESCRIPTION"> - 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<http://rt.cpan.org>. - -Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version), -Marek Rouchal E<lt>marekr@cpan.orgE<gt> - -Based on code for B<Pod::Text::pod2text()> written by -Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Escapes.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Escapes.pm deleted file mode 100644 index de4d75a7b83..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Escapes.pm +++ /dev/null @@ -1,721 +0,0 @@ - -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<lt>...E<gt> 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<lt>...E<gt> 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<use Pod::Escapes qw(symbolname symbolname2...);>, -or you can do C<use Pod::Escapes qw(:ALL);> to get all -exportable symbols. - -=head1 GOODIES - -=over - -=item e2char($e_content) - -Given a name or number that could appear in a -C<EE<lt>name_or_numE<gt>> sequence, this returns the string that -it stands for. For example, C<e2char('sol')>, C<e2char('47')>, -C<e2char('0x2F')>, and C<e2char('057')> all return "/", -because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>, -and C<EE<lt>057E<gt>>, 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 -C<EE<lt>name_or_numE<gt>> sequence, this returns the number of -the Unicode character that this stands for. For example, -C<e2char('sol')>, C<e2char('47')>, -C<e2char('0x2F')>, and C<e2char('057')> all return 47, -because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>, -and C<EE<lt>057E<gt>>, 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<name>} - -Maps from names (as in C<EE<lt>I<name>E<gt>>) 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<name>} - -Maps from names (as in C<EE<lt>I<name>E<gt>>) 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<integer>} - -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<character>} - -Just as above, but maps from characters (like "\xE9", -lowercase e-acute) to characters (like "e"). - -=item $Code2USASCII{I<integer>} - -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<e2char($x)> 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<e2char($n)> may not always be the -same as C<chr(e2charnum($n))>, and ditto for -C<$Name2character{$name}> and -C<chr($Name2character_number{$name})>. - -=head1 SEE ALSO - -L<perlpod|perlpod> - -L<perlpodspec|perlpodspec> - -L<Text::Unidecode|Text::Unidecode> - -=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<sburke@cpan.org> - -=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(<IN>) { - if(m/<!ENTITY\s+(\S+)\s+"&#([^;]+);">/) { - 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/<!ENT/) { - print "# Skipping $_"; - } - - } - close(IN); -} - -print @norms; -print "\n ( \$] .= 5.006001 ? (\n"; -print @good; -print " ) : (\n"; -print @bad; -print " )\n);\n"; - -__END__ -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Find.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Find.pm deleted file mode 100644 index 0b085b8c9e3..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Find.pm +++ /dev/null @@ -1,523 +0,0 @@ -############################################################################# -# Pod/Find.pm -- finds files containing POD documentation -# -# Author: Marek Rouchal <marekr@cpan.org> -# -# 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<Pod::Find> 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<use> 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<pod_find( { %opts } , @directories )> - -The function B<pod_find> 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<MyModule>, -whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be -I<Myclass::Subclass>. 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<CPAN.pm> in different directories. This usually -indicates duplicate occurrences of modules in the I<@INC> search path. - -B<OPTIONS> The first argument for B<pod_find> 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<gt> 1> - -Print progress information while scanning. - -=item C<-perl =E<gt> 1> - -Apply Perl-specific heuristics to find the correct PODs. This includes -stripping Perl-like extensions, omitting subdirectories that are numeric -but do I<not> match the current Perl interpreter's version id, suppressing -F<site_perl> as a module hierarchy name etc. - -=item C<-script =E<gt> 1> - -Search for PODs in the current Perl interpreter's installation -B<scriptdir>. This is taken from the local L<Config|Config> module. - -=item C<-inc =E<gt> 1> - -Search for PODs in the current Perl interpreter's I<@INC> paths. This -automatically considers paths specified in the C<PERL5LIB> 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<simplify_name( $str )> - -The function B<simplify_name> is equivalent to B<basename>, 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 <t.jenness@jach.hawaii.edu> - -=head2 C<pod_where( { %opts }, $pod )> - -Returns the location of a pod document given a search directory -and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name. - -Options: - -=over 4 - -=item C<-inc =E<gt> 1> - -Search @INC for the pod and also the C<scriptdir> defined in the -L<Config|Config> module. - -=item C<-dirs =E<gt> [ $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<gt> 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<pod/> is also checked if it exists in any of the given -search directories. This ensures that e.g. L<perlfunc|perlfunc> 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<contains_pod( $file , $verbose )> - -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 = <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<http://rt.cpan.org>. - -Marek Rouchal E<lt>marekr@cpan.orgE<gt>, -heavily borrowing code from Nick Ing-Simmons' PodToHtml. - -Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided -C<pod_where> and C<contains_pod>. - -=head1 SEE ALSO - -L<Pod::Parser>, L<Pod::Checker>, L<perldoc> - -=cut - -1; - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Functions.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Functions.pm deleted file mode 100644 index 0e250cf0b50..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Functions.pm +++ /dev/null @@ -1,376 +0,0 @@ -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<perlfunc/"Perl Functions by Category"> 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<perlfunc/"Perl Functions by Category"> section. - -=back - -=head1 CHANGES - -1.02 20020813 <abe@ztreet.demon.nl> - de-typo in the SYNOPSIS section (thanks Mike Castle for noticing) - -1.01 20011229 <abe@ztreet.demon.nl> - 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 (<DATA>) { - 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<e> 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/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Html.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Html.pm deleted file mode 100644 index 99f95a92108..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Html.pm +++ /dev/null @@ -1,2233 +0,0 @@ -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<perlpod>) 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<head1> 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<style> attributes that are output by default (to avoid conflicts). - -=item flush - - --flush - -Flushes the item and directory caches. - -=item header - - --header - --noheader - -Creates header and footer blocks containing the text of the C<NAME> -section. By default, no headers are generated. - -=item help - - --help - -Displays the usage message. - -=item hiddendirs - - --hiddendirs - --nohiddendirs - -Include hidden directories in the search for POD's in podpath if recurse -is set. -The default is not to traverse any directory whose name begins with C<.>. -See L</"podpath"> and L</"recurse">. - -[This option is for backward compatibility only. -It's hard to imagine that one would usefully create a module with a -name component beginning with C<.>.] - -=item htmldir - - --htmldir=name - -Sets the directory in which the resulting HTML file is placed. This -is used to generate relative links to other files. Not passing this -causes all links to be absolute, since this is the value that tells -Pod::Html the root of the documentation tree. - -=item htmlroot - - --htmlroot=name - -Sets the base URL for the HTML files. When cross-references are made, -the HTML root is prepended to the URL. - -=item index - - --index - --noindex - -Generate an index at the top of the HTML file. This is the default -behaviour. - -=item infile - - --infile=name - -Specify the pod file to convert. Input is taken from STDIN if no -infile is specified. - -=item libpods - - --libpods=name:...:name - -List of page names (eg, "perlfunc") which contain linkable C<=item>s. - -=item netscape - - --netscape - --nonetscape - -B<Deprecated>, has no effect. For backwards compatibility only. - -=item outfile - - --outfile=name - -Specify the HTML file to create. Output goes to STDOUT if no outfile -is specified. - -=item podpath - - --podpath=name:...:name - -Specify which subdirectories of the podroot contain pod files whose -HTML converted forms can be linked to in cross references. - -=item podroot - - --podroot=name - -Specify the base directory for finding library pods. - -=item quiet - - --quiet - --noquiet - -Don't display I<mostly harmless> warning messages. These messages -will be displayed by default. But this is not the same as C<verbose> -mode. - -=item recurse - - --recurse - --norecurse - -Recurse into subdirectories specified in podpath (default behaviour). - -=item title - - --title=title - -Specify the title of the resulting HTML file. - -=item verbose - - --verbose - --noverbose - -Display progress messages. By default, they won't be displayed. - -=back - -=head2 htmlify - - htmlify($heading); - -Converts a pod section specification to a suitable section specification -for HTML. Note that we keep spaces and special characters except -C<", ?> (Netscape problem) and the hyphen (writer's problem...). - -=head2 anchorify - - anchorify(@heading); - -Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note -that C<anchorify()> is not exported by default. - -=head1 ENVIRONMENT - -Uses C<$Config{pod2html}> to setup default options. - -=head1 AUTHOR - -Tom Christiansen, E<lt>tchrist@perl.comE<gt>. - -=head1 SEE ALSO - -L<perlpod> - -=head1 COPYRIGHT - -This program is distributed under the Artistic License. - -=cut - -my($Cachedir); -my($Dircache, $Itemcache); -my @Begin_Stack; -my @Libpods; -my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl); -my($Podfile, @Podpath, $Podroot); -my $Css; - -my $Recurse; -my $Quiet; -my $HiddenDirs; -my $Verbose; -my $Doindex; - -my $Backlink; -my($Listlevel, @Listtype); -my $ListNewTerm; -use vars qw($Ignore); # need to localize it later. - -my(%Items_Named, @Items_Seen); -my($Title, $Header); - -my $Top; -my $Paragraph; - -my %Sections; - -# Caches -my %Pages = (); # associative array used to find the location - # of pages referenced by L<> links. -my %Items = (); # associative array used to find the location - # of =item directives referenced by C<> links - -my %Local_Items; -my $Is83; - -my $Curdir = File::Spec->curdir; - -init_globals(); - -sub init_globals { - $Cachedir = "."; # The directory to which item and directory - # caches will be written. - - $Dircache = "pod2htmd.tmp"; - $Itemcache = "pod2htmi.tmp"; - - @Begin_Stack = (); # begin/end stack - - @Libpods = (); # files to search for links from C<> directives - $Htmlroot = "/"; # http-server base directory from which all - # relative paths in $podpath stem. - $Htmldir = ""; # The directory to which the html pages - # will (eventually) be written. - $Htmlfile = ""; # write to stdout by default - $Htmlfileurl = ""; # The url that other files would use to - # refer to this file. This is only used - # to make relative urls that point to - # other files. - - $Podfile = ""; # read from stdin by default - @Podpath = (); # list of directories containing library pods. - $Podroot = $Curdir; # filesystem base directory from which all - # relative paths in $podpath stem. - $Css = ''; # Cascading style sheet - $Recurse = 1; # recurse on subdirectories in $podpath. - $Quiet = 0; # not quiet by default - $Verbose = 0; # not verbose by default - $Doindex = 1; # non-zero if we should generate an index - $Backlink = ''; # text for "back to top" links - $Listlevel = 0; # current list depth - @Listtype = (); # list types for open lists - $ListNewTerm = 0; # indicates new term in definition list; used - # to correctly open/close <dd> tags - $Ignore = 1; # whether or not to format text. we don't - # format text until we hit our first pod - # directive. - - @Items_Seen = (); # for multiples of the same item in perlfunc - %Items_Named = (); - $Header = 0; # produce block header/footer - $Title = ''; # title to give the pod(s) - $Top = 1; # true if we are at the top of the doc. used - # to prevent the first <hr /> directive. - $Paragraph = ''; # which paragraph we're processing (used - # for error messages) - %Sections = (); # sections within this page - - %Local_Items = (); - $Is83 = $^O eq 'dos'; # Is it an 8.3 filesystem? -} - -# -# clean_data: global clean-up of pod data -# -sub clean_data($){ - my( $dataref ) = @_; - for my $i ( 0..$#{$dataref} ) { - ${$dataref}[$i] =~ s/\s+\Z//; - - # have a look for all-space lines - if( ${$dataref}[$i] =~ /^\s+$/m and $dataref->[$i] !~ /^\s/ ){ - my @chunks = split( /^\s+$/m, ${$dataref}[$i] ); - splice( @$dataref, $i, 1, @chunks ); - } - } -} - - -sub pod2html { - local(@ARGV) = @_; - local($/); - local $_; - - init_globals(); - - $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN()); - - # cache of %Pages and %Items from last time we ran pod2html - - #undef $opt_help if defined $opt_help; - - # parse the command-line parameters - parse_command_line(); - - # escape the backlink argument (same goes for title but is done later...) - $Backlink = html_escape($Backlink) if defined $Backlink; - - # set some variables to their default values if necessary - local *POD; - unless (@ARGV && $ARGV[0]) { - $Podfile = "-" unless $Podfile; # stdin - open(POD, "<$Podfile") - || die "$0: cannot open $Podfile file for input: $!\n"; - } else { - $Podfile = $ARGV[0]; # XXX: might be more filenames - *POD = *ARGV; - } - $Htmlfile = "-" unless $Htmlfile; # stdout - $Htmlroot = "" if $Htmlroot eq "/"; # so we don't get a // - $Htmldir =~ s#/\z## ; # so we don't get a // - if ( $Htmlroot eq '' - && defined( $Htmldir ) - && $Htmldir ne '' - && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir - ) - { - # Set the 'base' url for this file, so that we can use it - # as the location from which to calculate relative links - # to other files. If this is '', then absolute links will - # be used throughout. - $Htmlfileurl= "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1); - } - - # read the pod a paragraph at a time - warn "Scanning for sections in input file(s)\n" if $Verbose; - $/ = ""; - my @poddata = <POD>; - close(POD); - - # be eol agnostic - for (@poddata) { - if (/\r/) { - if (/\r\n/) { - @poddata = map { s/\r\n/\n/g; - /\n\n/ ? - map { "$_\n\n" } split /\n\n/ : - $_ } @poddata; - } else { - @poddata = map { s/\r/\n/g; - /\n\n/ ? - map { "$_\n\n" } split /\n\n/ : - $_ } @poddata; - } - last; - } - } - - clean_data( \@poddata ); - - # scan the pod for =head[1-6] directives and build an index - my $index = scan_headings(\%Sections, @poddata); - - unless($index) { - warn "No headings in $Podfile\n" if $Verbose; - } - - # open the output file - open(HTML, ">$Htmlfile") - || die "$0: cannot open $Htmlfile file for output: $!\n"; - - # put a title in the HTML file if one wasn't specified - if ($Title eq '') { - TITLE_SEARCH: { - for (my $i = 0; $i < @poddata; $i++) { - if ($poddata[$i] =~ /^=head1\s*NAME\b/m) { - for my $para ( @poddata[$i, $i+1] ) { - last TITLE_SEARCH - if ($Title) = $para =~ /(\S+\s+-+.*\S)/s; - } - } - - } - } - } - if (!$Title and $Podfile =~ /\.pod\z/) { - # probably a split pod so take first =head[12] as title - for (my $i = 0; $i < @poddata; $i++) { - last if ($Title) = $poddata[$i] =~ /^=head[12]\s*(.*)/; - } - warn "adopted '$Title' as title for $Podfile\n" - if $Verbose and $Title; - } - if ($Title) { - $Title =~ s/\s*\(.*\)//; - } else { - warn "$0: no title for $Podfile.\n" unless $Quiet; - $Podfile =~ /^(.*)(\.[^.\/]+)?\z/s; - $Title = ($Podfile eq "-" ? 'No Title' : $1); - warn "using $Title" if $Verbose; - } - $Title = html_escape($Title); - - my $csslink = ''; - my $bodystyle = ' style="background-color: white"'; - my $tdstyle = ' style="background-color: #cccccc"'; - - if ($Css) { - $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />); - $csslink =~ s,\\,/,g; - $csslink =~ s,(/.):,$1|,; - $bodystyle = ''; - $tdstyle = ''; - } - - my $block = $Header ? <<END_OF_BLOCK : ''; -<table border="0" width="100%" cellspacing="0" cellpadding="3"> -<tr><td class="block"$tdstyle valign="middle"> -<big><strong><span class="block"> $Title</span></strong></big> -</td></tr> -</table> -END_OF_BLOCK - - print HTML <<END_OF_HEAD; -<?xml version="1.0" ?> -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xmlns="http://www.w3.org/1999/xhtml"> -<head> -<title>$Title</title>$csslink -<meta http-equiv="content-type" content="text/html; charset=utf-8" /> -<link rev="made" href="mailto:$Config{perladmin}" /> -</head> - -<body$bodystyle> -$block -END_OF_HEAD - - # load/reload/validate/cache %Pages and %Items - get_cache($Dircache, $Itemcache, \@Podpath, $Podroot, $Recurse); - - # scan the pod for =item directives - scan_items( \%Local_Items, "", @poddata); - - # put an index at the top of the file. note, if $Doindex is 0 we - # still generate an index, but surround it with an html comment. - # that way some other program can extract it if desired. - $index =~ s/--+/-/g; - - my $hr = ($Doindex and $index) ? qq(<hr name="index" />) : ""; - - unless ($Doindex) - { - $index = qq(<!--\n$index\n-->\n); - } - - print HTML << "END_OF_INDEX"; - -<!-- INDEX BEGIN --> -<div name="index"> -<p><a name=\"__index__\"></a></p> -$index -$hr -</div> -<!-- INDEX END --> - -END_OF_INDEX - - # now convert this file - my $after_item; # set to true after an =item - warn "Converting input file $Podfile\n" if $Verbose; - foreach my $i (0..$#poddata){ - $_ = $poddata[$i]; - $Paragraph = $i+1; - if (/^(=.*)/s) { # is it a pod directive? - $Ignore = 0; - $after_item = 0; - $_ = $1; - if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin - process_begin($1, $2); - } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end - process_end($1, $2); - } elsif (/^=cut/) { # =cut - process_cut(); - } elsif (/^=pod/) { # =pod - process_pod(); - } else { - next if @Begin_Stack && $Begin_Stack[-1] ne 'html'; - - if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading - process_head( $1, $2, $Doindex && $index ); - } elsif (/^=item\s*(.*\S)?/sm) { # =item text - process_item( $1 ); - $after_item = 1; - } elsif (/^=over\s*(.*)/) { # =over N - process_over(); - } elsif (/^=back/) { # =back - process_back(); - } elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for - process_for($1,$2); - } else { - /^=(\S*)\s*/; - warn "$0: $Podfile: unknown pod directive '$1' in " - . "paragraph $Paragraph. ignoring.\n" unless $Quiet; - } - } - $Top = 0; - } - else { - next if $Ignore; - next if @Begin_Stack && $Begin_Stack[-1] ne 'html'; - print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html'; - my $text = $_; - - # Open tag for definition list as we have something to put in it - if( $ListNewTerm ){ - print HTML "<dd>\n"; - $ListNewTerm = 0; - } - - if( $text =~ /\A\s+/ ){ - process_pre( \$text ); - print HTML "<pre>\n$text</pre>\n"; - - } else { - process_text( \$text ); - - # experimental: check for a paragraph where all lines - # have some ...\t...\t...\n pattern - if( $text =~ /\t/ ){ - my @lines = split( "\n", $text ); - if( @lines > 1 ){ - my $all = 2; - foreach my $line ( @lines ){ - if( $line =~ /\S/ && $line !~ /\t/ ){ - $all--; - last if $all == 0; - } - } - if( $all > 0 ){ - $text =~ s/\t+/<td>/g; - $text =~ s/^/<tr><td>/gm; - $text = '<table cellspacing="0" cellpadding="0">' . - $text . '</table>'; - } - } - } - ## end of experimental - - print HTML "<p>$text</p>\n"; - } - $after_item = 0; - } - } - - # finish off any pending directives - finish_list(); - - # link to page index - print HTML "<p><a href=\"#__index__\"><small>$Backlink</small></a></p>\n" - if $Doindex and $index and $Backlink; - - print HTML <<END_OF_TAIL; -$block -</body> - -</html> -END_OF_TAIL - - # close the html file - close(HTML); - - warn "Finished\n" if $Verbose; -} - -############################################################################## - -sub usage { - my $podfile = shift; - warn "$0: $podfile: @_\n" if @_; - die <<END_OF_USAGE; -Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> - --podpath=<name>:...:<name> --podroot=<name> - --libpods=<name>:...:<name> --recurse --verbose --index - --netscape --norecurse --noindex --cachedir=<name> - - --backlink - set text for "back to top" links (default: none). - --cachedir - directory for the item and directory cache files. - --css - stylesheet URL - --flush - flushes the item and directory caches. - --[no]header - produce block header/footer (default is no headers). - --help - prints this message. - --hiddendirs - search hidden directories in podpath - --htmldir - directory for resulting HTML files. - --htmlroot - http-server base directory from which all relative paths - in podpath stem (default is /). - --[no]index - generate an index at the top of the resulting html - (default behaviour). - --infile - filename for the pod to convert (input taken from stdin - by default). - --libpods - colon-separated list of pages to search for =item pod - directives in as targets of C<> and implicit links (empty - by default). note, these are not filenames, but rather - page names like those that appear in L<> links. - --outfile - filename for the resulting html file (output sent to - stdout by default). - --podpath - colon-separated list of directories containing library - pods (empty by default). - --podroot - filesystem base directory from which all relative paths - in podpath stem (default is .). - --[no]quiet - suppress some benign warning messages (default is off). - --[no]recurse - recurse on those subdirectories listed in podpath - (default behaviour). - --title - title that will appear in resulting html file. - --[no]verbose - self-explanatory (off by default). - --[no]netscape - deprecated, has no effect. for backwards compatibility only. - -END_OF_USAGE - -} - -sub parse_command_line { - my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help, - $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods, - $opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet, - $opt_recurse,$opt_title,$opt_verbose,$opt_hiddendirs); - - unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; - my $result = GetOptions( - 'backlink=s' => \$opt_backlink, - 'cachedir=s' => \$opt_cachedir, - 'css=s' => \$opt_css, - 'flush' => \$opt_flush, - 'header!' => \$opt_header, - 'help' => \$opt_help, - 'hiddendirs!'=> \$opt_hiddendirs, - 'htmldir=s' => \$opt_htmldir, - 'htmlroot=s' => \$opt_htmlroot, - 'index!' => \$opt_index, - 'infile=s' => \$opt_infile, - 'libpods=s' => \$opt_libpods, - 'netscape!' => \$opt_netscape, - 'outfile=s' => \$opt_outfile, - 'podpath=s' => \$opt_podpath, - 'podroot=s' => \$opt_podroot, - 'quiet!' => \$opt_quiet, - 'recurse!' => \$opt_recurse, - 'title=s' => \$opt_title, - 'verbose!' => \$opt_verbose, - ); - usage("-", "invalid parameters") if not $result; - - usage("-") if defined $opt_help; # see if the user asked for help - $opt_help = ""; # just to make -w shut-up. - - @Podpath = split(":", $opt_podpath) if defined $opt_podpath; - @Libpods = split(":", $opt_libpods) if defined $opt_libpods; - - $Backlink = $opt_backlink if defined $opt_backlink; - $Cachedir = $opt_cachedir if defined $opt_cachedir; - $Css = $opt_css if defined $opt_css; - $Header = $opt_header if defined $opt_header; - $Htmldir = $opt_htmldir if defined $opt_htmldir; - $Htmlroot = $opt_htmlroot if defined $opt_htmlroot; - $Doindex = $opt_index if defined $opt_index; - $Podfile = $opt_infile if defined $opt_infile; - $HiddenDirs = $opt_hiddendirs if defined $opt_hiddendirs; - $Htmlfile = $opt_outfile if defined $opt_outfile; - $Podroot = $opt_podroot if defined $opt_podroot; - $Quiet = $opt_quiet if defined $opt_quiet; - $Recurse = $opt_recurse if defined $opt_recurse; - $Title = $opt_title if defined $opt_title; - $Verbose = $opt_verbose if defined $opt_verbose; - - warn "Flushing item and directory caches\n" - if $opt_verbose && defined $opt_flush; - $Dircache = "$Cachedir/pod2htmd.tmp"; - $Itemcache = "$Cachedir/pod2htmi.tmp"; - if (defined $opt_flush) { - 1 while unlink($Dircache, $Itemcache); - } -} - - -my $Saved_Cache_Key; - -sub get_cache { - my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; - my @cache_key_args = @_; - - # A first-level cache: - # Don't bother reading the cache files if they still apply - # and haven't changed since we last read them. - - my $this_cache_key = cache_key(@cache_key_args); - - return if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key; - - # load the cache of %Pages and %Items if possible. $tests will be - # non-zero if successful. - my $tests = 0; - if (-f $dircache && -f $itemcache) { - warn "scanning for item cache\n" if $Verbose; - $tests = load_cache($dircache, $itemcache, $podpath, $podroot); - } - - # if we didn't succeed in loading the cache then we must (re)build - # %Pages and %Items. - if (!$tests) { - warn "scanning directories in pod-path\n" if $Verbose; - scan_podpath($podroot, $recurse, 0); - } - $Saved_Cache_Key = cache_key(@cache_key_args); -} - -sub cache_key { - my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; - return join('!', $dircache, $itemcache, $recurse, - @$podpath, $podroot, stat($dircache), stat($itemcache)); -} - -# -# load_cache - tries to find if the caches stored in $dircache and $itemcache -# are valid caches of %Pages and %Items. if they are valid then it loads -# them and returns a non-zero value. -# -sub load_cache { - my($dircache, $itemcache, $podpath, $podroot) = @_; - my($tests); - local $_; - - $tests = 0; - - open(CACHE, "<$itemcache") || - die "$0: error opening $itemcache for reading: $!\n"; - $/ = "\n"; - - # is it the same podpath? - $_ = <CACHE>; - chomp($_); - $tests++ if (join(":", @$podpath) eq $_); - - # is it the same podroot? - $_ = <CACHE>; - chomp($_); - $tests++ if ($podroot eq $_); - - # load the cache if its good - if ($tests != 2) { - close(CACHE); - return 0; - } - - warn "loading item cache\n" if $Verbose; - while (<CACHE>) { - /(.*?) (.*)$/; - $Items{$1} = $2; - } - close(CACHE); - - warn "scanning for directory cache\n" if $Verbose; - open(CACHE, "<$dircache") || - die "$0: error opening $dircache for reading: $!\n"; - $/ = "\n"; - $tests = 0; - - # is it the same podpath? - $_ = <CACHE>; - chomp($_); - $tests++ if (join(":", @$podpath) eq $_); - - # is it the same podroot? - $_ = <CACHE>; - chomp($_); - $tests++ if ($podroot eq $_); - - # load the cache if its good - if ($tests != 2) { - close(CACHE); - return 0; - } - - warn "loading directory cache\n" if $Verbose; - while (<CACHE>) { - /(.*?) (.*)$/; - $Pages{$1} = $2; - } - - close(CACHE); - - return 1; -} - -# -# scan_podpath - scans the directories specified in @podpath for directories, -# .pod files, and .pm files. it also scans the pod files specified in -# @Libpods for =item directives. -# -sub scan_podpath { - my($podroot, $recurse, $append) = @_; - my($pwd, $dir); - my($libpod, $dirname, $pod, @files, @poddata); - - unless($append) { - %Items = (); - %Pages = (); - } - - # scan each directory listed in @Podpath - $pwd = getcwd(); - chdir($podroot) - || die "$0: error changing to directory $podroot: $!\n"; - foreach $dir (@Podpath) { - scan_dir($dir, $recurse); - } - - # scan the pods listed in @Libpods for =item directives - foreach $libpod (@Libpods) { - # if the page isn't defined then we won't know where to find it - # on the system. - next unless defined $Pages{$libpod} && $Pages{$libpod}; - - # if there is a directory then use the .pod and .pm files within it. - # NOTE: Only finds the first so-named directory in the tree. -# if ($Pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) { - if ($Pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) { - # find all the .pod and .pm files within the directory - $dirname = $1; - opendir(DIR, $dirname) || - die "$0: error opening directory $dirname: $!\n"; - @files = grep(/(\.pod|\.pm)\z/ && ! -d $_, readdir(DIR)); - closedir(DIR); - - # scan each .pod and .pm file for =item directives - foreach $pod (@files) { - open(POD, "<$dirname/$pod") || - die "$0: error opening $dirname/$pod for input: $!\n"; - @poddata = <POD>; - close(POD); - clean_data( \@poddata ); - - scan_items( \%Items, "$dirname/$pod", @poddata); - } - - # use the names of files as =item directives too. -### Don't think this should be done this way - confuses issues.(WL) -### foreach $pod (@files) { -### $pod =~ /^(.*)(\.pod|\.pm)$/; -### $Items{$1} = "$dirname/$1.html" if $1; -### } - } elsif ($Pages{$libpod} =~ /([^:]*\.pod):/ || - $Pages{$libpod} =~ /([^:]*\.pm):/) { - # scan the .pod or .pm file for =item directives - $pod = $1; - open(POD, "<$pod") || - die "$0: error opening $pod for input: $!\n"; - @poddata = <POD>; - close(POD); - clean_data( \@poddata ); - - scan_items( \%Items, "$pod", @poddata); - } else { - warn "$0: shouldn't be here (line ".__LINE__."\n" unless $Quiet; - } - } - @poddata = (); # clean-up a bit - - chdir($pwd) - || die "$0: error changing to directory $pwd: $!\n"; - - # cache the item list for later use - warn "caching items for later use\n" if $Verbose; - open(CACHE, ">$Itemcache") || - die "$0: error open $Itemcache for writing: $!\n"; - - print CACHE join(":", @Podpath) . "\n$podroot\n"; - foreach my $key (keys %Items) { - print CACHE "$key $Items{$key}\n"; - } - - close(CACHE); - - # cache the directory list for later use - warn "caching directories for later use\n" if $Verbose; - open(CACHE, ">$Dircache") || - die "$0: error open $Dircache for writing: $!\n"; - - print CACHE join(":", @Podpath) . "\n$podroot\n"; - foreach my $key (keys %Pages) { - print CACHE "$key $Pages{$key}\n"; - } - - close(CACHE); -} - -# -# scan_dir - scans the directory specified in $dir for subdirectories, .pod -# files, and .pm files. notes those that it finds. this information will -# be used later in order to figure out where the pages specified in L<> -# links are on the filesystem. -# -sub scan_dir { - my($dir, $recurse) = @_; - my($t, @subdirs, @pods, $pod, $dirname, @dirs); - local $_; - - @subdirs = (); - @pods = (); - - opendir(DIR, $dir) || - die "$0: error opening directory $dir: $!\n"; - while (defined($_ = readdir(DIR))) { - if (-d "$dir/$_" && $_ ne "." && $_ ne ".." - && ($HiddenDirs || !/^\./) - ) { # directory - $Pages{$_} = "" unless defined $Pages{$_}; - $Pages{$_} .= "$dir/$_:"; - push(@subdirs, $_); - } elsif (/\.pod\z/) { # .pod - s/\.pod\z//; - $Pages{$_} = "" unless defined $Pages{$_}; - $Pages{$_} .= "$dir/$_.pod:"; - push(@pods, "$dir/$_.pod"); - } elsif (/\.html\z/) { # .html - s/\.html\z//; - $Pages{$_} = "" unless defined $Pages{$_}; - $Pages{$_} .= "$dir/$_.pod:"; - } elsif (/\.pm\z/) { # .pm - s/\.pm\z//; - $Pages{$_} = "" unless defined $Pages{$_}; - $Pages{$_} .= "$dir/$_.pm:"; - push(@pods, "$dir/$_.pm"); - } elsif (-T "$dir/$_") { # script(?) - local *F; - if (open(F, "$dir/$_")) { - my $line; - while (defined($line = <F>)) { - if ($line =~ /^=(?:pod|head1)/) { - $Pages{$_} = "" unless defined $Pages{$_}; - $Pages{$_} .= "$dir/$_.pod:"; - last; - } - } - close(F); - } - } - } - closedir(DIR); - - # recurse on the subdirectories if necessary - if ($recurse) { - foreach my $subdir (@subdirs) { - scan_dir("$dir/$subdir", $recurse); - } - } -} - -# -# scan_headings - scan a pod file for head[1-6] tags, note the tags, and -# build an index. -# -sub scan_headings { - my($sections, @data) = @_; - my($tag, $which_head, $otitle, $listdepth, $index); - - local $Ignore = 0; - - $listdepth = 0; - $index = ""; - - # scan for =head directives, note their name, and build an index - # pointing to each of them. - foreach my $line (@data) { - if ($line =~ /^=(head)([1-6])\s+(.*)/) { - ($tag, $which_head, $otitle) = ($1,$2,$3); - - my $title = depod( $otitle ); - my $name = anchorify( $title ); - $$sections{$name} = 1; - $title = process_text( \$otitle ); - - while ($which_head != $listdepth) { - if ($which_head > $listdepth) { - $index .= "\n" . ("\t" x $listdepth) . "<ul>\n"; - $listdepth++; - } elsif ($which_head < $listdepth) { - $listdepth--; - $index .= "\n" . ("\t" x $listdepth) . "</ul>\n"; - } - } - - $index .= "\n" . ("\t" x $listdepth) . "<li>" . - "<a href=\"#" . $name . "\">" . - $title . "</a></li>"; - } - } - - # finish off the lists - while ($listdepth--) { - $index .= "\n" . ("\t" x $listdepth) . "</ul>\n"; - } - - # get rid of bogus lists - $index =~ s,\t*<ul>\s*</ul>\n,,g; - - return $index; -} - -# -# scan_items - scans the pod specified by $pod for =item directives. we -# will use this information later on in resolving C<> links. -# -sub scan_items { - my( $itemref, $pod, @poddata ) = @_; - my($i, $item); - local $_; - - $pod =~ s/\.pod\z//; - $pod .= ".html" if $pod; - - foreach $i (0..$#poddata) { - my $txt = depod( $poddata[$i] ); - - # figure out what kind of item it is. - # Build string for referencing this item. - if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bulleted list - next unless $1; - $item = $1; - } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list - $item = $1; - } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # definition list - $item = $1; - } else { - next; - } - my $fid = fragment_id( $item ); - $$itemref{$fid} = "$pod" if $fid; - } -} - -# -# process_head - convert a pod head[1-6] tag and convert it to HTML format. -# -sub process_head { - my($tag, $heading, $hasindex) = @_; - - # figure out the level of the =head - $tag =~ /head([1-6])/; - my $level = $1; - - finish_list(); - - print HTML "<p>\n"; - if( $level == 1 && ! $Top ){ - print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n" - if $hasindex and $Backlink; - print HTML "</p>\n<hr />\n" - } else { - print HTML "</p>\n"; - } - - my $name = anchorify( depod( $heading ) ); - my $convert = process_text( \$heading ); - print HTML "<h$level><a name=\"$name\">$convert</a></h$level>\n"; -} - - -# -# emit_item_tag - print an =item's text -# Note: The global $EmittedItem is used for inhibiting self-references. -# -my $EmittedItem; - -sub emit_item_tag($$$){ - my( $otext, $text, $compact ) = @_; - my $item = fragment_id( depod($text) , -generate); - Carp::confess("Undefined fragment '$text' (".depod($text).") from fragment_id() in emit_item_tag() in $Podfile") - if !defined $item; - $EmittedItem = $item; - ### print STDERR "emit_item_tag=$item ($text)\n"; - - print HTML '<strong>'; - if ($Items_Named{$item}++) { - print HTML process_text( \$otext ); - } else { - my $name = $item; - $name = anchorify($name); - print HTML qq{<a name="$name" class="item">}, process_text( \$otext ), '</a>'; - } - print HTML "</strong>"; - undef( $EmittedItem ); -} - -sub new_listitem { - my( $tag ) = @_; - # Open tag for definition list as we have something to put in it - if( ($tag ne 'dl') && ($ListNewTerm) ){ - print HTML "<dd>\n"; - $ListNewTerm = 0; - } - - if( $Items_Seen[$Listlevel]++ == 0 ){ - # start of new list - push( @Listtype, "$tag" ); - print HTML "<$tag>\n"; - } else { - # if this is not the first item, close the previous one - if ( $tag eq 'dl' ){ - print HTML "</dd>\n" unless $ListNewTerm; - } else { - print HTML "</li>\n"; - } - } - my $opentag = $tag eq 'dl' ? 'dt' : 'li'; - print HTML "<$opentag>"; -} - -# -# process_item - convert a pod item tag and convert it to HTML format. -# -sub process_item { - my( $otext ) = @_; - - # lots of documents start a list without doing an =over. this is - # bad! but, the proper thing to do seems to be to just assume - # they did do an =over. so warn them once and then continue. - if( $Listlevel == 0 ){ - warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; - process_over(); - } - - # remove formatting instructions from the text - my $text = depod( $otext ); - - # all the list variants: - if( $text =~ /\A\*/ ){ # bullet - new_listitem( 'ul' ); - if ($text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text - my $tag = $1; - $otext =~ s/\A\*\s+//; - emit_item_tag( $otext, $tag, 1 ); - print HTML "\n"; - } - - } elsif( $text =~ /\A\d+/ ){ # numbered list - new_listitem( 'ol' ); - if ($text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text - my $tag = $1; - $otext =~ s/\A\d+\.?\s*//; - emit_item_tag( $otext, $tag, 1 ); - print HTML "\n"; - } - - } else { # definition list - # new_listitem takes care of opening the <dt> tag - new_listitem( 'dl' ); - if ($text =~ /\A(.+)\Z/s ){ # should have text - emit_item_tag( $otext, $text, 1 ); - # write the definition term and close <dt> tag - print HTML "</dt>\n"; - } - # trigger opening a <dd> tag for the actual definition; will not - # happen if next paragraph is also a definition term (=item) - $ListNewTerm = 1; - } - print HTML "\n"; -} - -# -# process_over - process a pod over tag and start a corresponding HTML list. -# -sub process_over { - # start a new list - $Listlevel++; - push( @Items_Seen, 0 ); -} - -# -# process_back - process a pod back tag and convert it to HTML format. -# -sub process_back { - if( $Listlevel == 0 ){ - warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; - return; - } - - # close off the list. note, I check to see if $Listtype[$Listlevel] is - # defined because an =item directive may have never appeared and thus - # $Listtype[$Listlevel] may have never been initialized. - $Listlevel--; - if( defined $Listtype[$Listlevel] ){ - if ( $Listtype[$Listlevel] eq 'dl' ){ - print HTML "</dd>\n" unless $ListNewTerm; - } else { - print HTML "</li>\n"; - } - print HTML "</$Listtype[$Listlevel]>\n"; - pop( @Listtype ); - $ListNewTerm = 0; - } - - # clean up item count - pop( @Items_Seen ); -} - -# -# process_cut - process a pod cut tag, thus start ignoring pod directives. -# -sub process_cut { - $Ignore = 1; -} - -# -# process_pod - process a pod tag, thus stop ignoring pod directives -# until we see a corresponding cut. -# -sub process_pod { - # no need to set $Ignore to 0 cause the main loop did it -} - -# -# process_for - process a =for pod tag. if it's for html, spit -# it out verbatim, if illustration, center it, otherwise ignore it. -# -sub process_for { - my($whom, $text) = @_; - if ( $whom =~ /^(pod2)?html$/i) { - print HTML $text; - } elsif ($whom =~ /^illustration$/i) { - 1 while chomp $text; - for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) { - $text .= $ext, last if -r "$text$ext"; - } - print HTML qq{<p align="center"><img src="$text" alt="$text illustration" /></p>}; - } -} - -# -# process_begin - process a =begin pod tag. this pushes -# whom we're beginning on the begin stack. if there's a -# begin stack, we only print if it us. -# -sub process_begin { - my($whom, $text) = @_; - $whom = lc($whom); - push (@Begin_Stack, $whom); - if ( $whom =~ /^(pod2)?html$/) { - print HTML $text if $text; - } -} - -# -# process_end - process a =end pod tag. pop the -# begin stack. die if we're mismatched. -# -sub process_end { - my($whom, $text) = @_; - $whom = lc($whom); - if (!defined $Begin_Stack[-1] or $Begin_Stack[-1] ne $whom ) { - Carp::confess("Unmatched begin/end at chunk $Paragraph in pod $Podfile\n") - } - pop( @Begin_Stack ); -} - -# -# process_pre - indented paragraph, made into <pre></pre> -# -sub process_pre { - my( $text ) = @_; - my( $rest ); - return if $Ignore; - - $rest = $$text; - - # insert spaces in place of tabs - $rest =~ s#(.+)# - my $line = $1; - 1 while $line =~ s/(\t+)/' ' x ((length($1) * 8) - $-[0] % 8)/e; - $line; - #eg; - - # convert some special chars to HTML escapes - $rest = html_escape($rest); - - # try and create links for all occurrences of perl.* within - # the preformatted text. - $rest =~ s{ - (\s*)(perl\w+) - }{ - if ( defined $Pages{$2} ){ # is a link - qq($1<a href="$Htmlroot/$Pages{$2}">$2</a>); - } elsif (defined $Pages{dosify($2)}) { # is a link - qq($1<a href="$Htmlroot/$Pages{dosify($2)}">$2</a>); - } else { - "$1$2"; - } - }xeg; - $rest =~ s{ - (<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)? - }{ - my $url ; - if ( $Htmlfileurl ne '' ){ - # Here, we take advantage of the knowledge - # that $Htmlfileurl ne '' implies $Htmlroot eq ''. - # Since $Htmlroot eq '', we need to prepend $Htmldir - # on the fron of the link to get the absolute path - # of the link's target. We check for a leading '/' - # to avoid corrupting links that are #, file:, etc. - my $old_url = $3 ; - $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/}; - $url = relativize_url( "$old_url.html", $Htmlfileurl ); - } else { - $url = "$3.html" ; - } - "$1$url" ; - }xeg; - - # Look for embedded URLs and make them into links. We don't - # relativize them since they are best left as the author intended. - - my $urls = '(' . join ('|', qw{ - http - telnet - mailto - news - gopher - file - wais - ftp - } ) - . ')'; - - my $ltrs = '\w'; - my $gunk = '/#~:.?+=&%@!\-'; - my $punc = '.:!?\-;'; - my $any = "${ltrs}${gunk}${punc}"; - - $rest =~ s{ - \b # start at word boundary - ( # begin $1 { - $urls : # need resource and a colon - (?!:) # Ignore File::, among others. - [$any] +? # followed by one or more of any valid - # character, but be conservative and - # take only what you need to.... - ) # end $1 } - (?= - " > # maybe pre-quoted '<a href="...">' - | # or: - [$punc]* # 0 or more punctuation - (?: # followed - [^$any] # by a non-url char - | # or - $ # end of the string - ) # - | # or else - $ # then end of the string - ) - }{<a href="$1">$1</a>}igox; - - # text should be as it is (verbatim) - $$text = $rest; -} - - -# -# pure text processing -# -# pure_text/inIS_text: differ with respect to automatic C<> recognition. -# we don't want this to happen within IS -# -sub pure_text($){ - my $text = shift(); - process_puretext( $text, 1 ); -} - -sub inIS_text($){ - my $text = shift(); - process_puretext( $text, 0 ); -} - -# -# process_puretext - process pure text (without pod-escapes) converting -# double-quotes and handling implicit C<> links. -# -sub process_puretext { - my($text, $notinIS) = @_; - - ## Guessing at func() or [\$\@%&]*var references in plain text is destined - ## to produce some strange looking ref's. uncomment to disable: - ## $notinIS = 0; - - my(@words, $lead, $trail); - - # keep track of leading and trailing white-space - $lead = ($text =~ s/\A(\s+)//s ? $1 : ""); - $trail = ($text =~ s/(\s+)\Z//s ? $1 : ""); - - # split at space/non-space boundaries - @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text ); - - # process each word individually - foreach my $word (@words) { - # skip space runs - next if $word =~ /^\s*$/; - # see if we can infer a link or a function call - # - # NOTE: This is a word based search, it won't automatically - # mark "substr($var, 1, 2)" because the 1st word would be "substr($var" - # User has to enclose those with proper C<> - - if( $notinIS && $word =~ - m/ - ^([a-z_]{2,}) # The function name - \( - ([0-9][a-z]* # Manual page(1) or page(1M) - |[^)]*[\$\@\%][^)]+ # ($foo), (1, @foo), (%hash) - | # () - ) - \) - ([.,;]?)$ # a possible punctuation follows - /xi - ) { - # has parenthesis so should have been a C<> ref - ## try for a pagename (perlXXX(1))? - my( $func, $args, $rest ) = ( $1, $2, $3 || '' ); - if( $args =~ /^\d+$/ ){ - my $url = page_sect( $word, '' ); - if( defined $url ){ - $word = qq(<a href="$url" class="man">the $word manpage</a>$rest); - next; - } - } - ## try function name for a link, append tt'ed argument list - $word = emit_C( $func, '', "($args)") . $rest; - -#### disabled. either all (including $\W, $\w+{.*} etc.) or nothing. -## } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) { -## # perl variables, should be a C<> ref -## $word = emit_C( $word ); - - } elsif ($word =~ m,^\w+://\w,) { - # looks like a URL - # Don't relativize it: leave it as the author intended - $word = qq(<a href="$word">$word</a>); - } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) { - # looks like an e-mail address - my ($w1, $w2, $w3) = ("", $word, ""); - ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/; - ($w1, $w2, $w3) = ("<", $1, ">$2") if $word =~ /^<(.*?)>(,?)/; - $word = qq($w1<a href="mailto:$w2">$w2</a>$w3); - } else { - $word = html_escape($word) if $word =~ /["&<>]/; - } - } - - # put everything back together - return $lead . join( '', @words ) . $trail; -} - - -# -# process_text - handles plaintext that appears in the input pod file. -# there may be pod commands embedded within the text so those must be -# converted to html commands. -# - -sub process_text1($$;$$); -sub pattern ($) { $_[0] ? '\s+'.('>' x ($_[0] + 1)) : '>' } -sub closing ($) { local($_) = shift; (defined && s/\s+\z//) ? length : 0 } - -sub process_text { - return if $Ignore; - my( $tref ) = @_; - my $res = process_text1( 0, $tref ); - $res =~ s/\s+$//s; - $$tref = $res; -} - -sub process_text_rfc_links { - my $text = shift; - - # For every "RFCnnnn" or "RFC nnn", link it to the authoritative - # ource. Do not use the /i modifier here. Require "RFC" to be written in - # in capital letters. - - $text =~ s{ - (?<=[^<>[:alpha:]]) # Make sure this is not an URL already - (RFC\s*([0-9]{1,5}))(?![0-9]) # max 5 digits - } - {<a href="http://www.ietf.org/rfc/rfc$2.txt" class="rfc">$1</a>}gx; - - $text; -} - -sub process_text1($$;$$){ - my( $lev, $rstr, $func, $closing ) = @_; - my $res = ''; - - unless (defined $func) { - $func = ''; - $lev++; - } - - if( $func eq 'B' ){ - # B<text> - boldface - $res = '<strong>' . process_text1( $lev, $rstr ) . '</strong>'; - - } elsif( $func eq 'C' ){ - # C<code> - can be a ref or <code></code> - # need to extract text - my $par = go_ahead( $rstr, 'C', $closing ); - - ## clean-up of the link target - my $text = depod( $par ); - - ### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ; - ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n"; - - $res = emit_C( $text, $lev > 1 || ($par =~ /[BI]</) ); - - } elsif( $func eq 'E' ){ - # E<x> - convert to character - $$rstr =~ s/^([^>]*)>//; - my $escape = $1; - $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i; - $res = "&$escape;"; - - } elsif( $func eq 'F' ){ - # F<filename> - italicize - $res = '<em class="file">' . process_text1( $lev, $rstr ) . '</em>'; - - } elsif( $func eq 'I' ){ - # I<text> - italicize - $res = '<em>' . process_text1( $lev, $rstr ) . '</em>'; - - } elsif( $func eq 'L' ){ - # L<link> - link - ## L<text|cross-ref> => produce text, use cross-ref for linking - ## L<cross-ref> => make text from cross-ref - ## need to extract text - my $par = go_ahead( $rstr, 'L', $closing ); - - # some L<>'s that shouldn't be: - # a) full-blown URL's are emitted as-is - if( $par =~ m{^\w+://}s ){ - return make_URL_href( $par ); - } - # b) C<...> is stripped and treated as C<> - if( $par =~ /^C<(.*)>$/ ){ - my $text = depod( $1 ); - return emit_C( $text, $lev > 1 || ($par =~ /[BI]</) ); - } - - # analyze the contents - $par =~ s/\n/ /g; # undo word-wrapped tags - my $opar = $par; - my $linktext; - if( $par =~ s{^([^|]+)\|}{} ){ - $linktext = $1; - } - - # make sure sections start with a / - $par =~ s{^"}{/"}; - - my( $page, $section, $ident ); - - # check for link patterns - if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){ # name/ident - # we've got a name/ident (no quotes) - if (length $2) { - ( $page, $ident ) = ( $1, $2 ); - } else { - ( $page, $section ) = ( $1, $2 ); - } - ### print STDERR "--> L<$par> to page $page, ident $ident\n"; - - } elsif( $par =~ m{^(.*?)/"?(.*?)"?$} ){ # [name]/"section" - # even though this should be a "section", we go for ident first - ( $page, $ident ) = ( $1, $2 ); - ### print STDERR "--> L<$par> to page $page, section $section\n"; - - } elsif( $par =~ /\s/ ){ # this must be a section with missing quotes - ( $page, $section ) = ( '', $par ); - ### print STDERR "--> L<$par> to void page, section $section\n"; - - } else { - ( $page, $section ) = ( $par, '' ); - ### print STDERR "--> L<$par> to page $par, void section\n"; - } - - # now, either $section or $ident is defined. the convoluted logic - # below tries to resolve L<> according to what the user specified. - # failing this, we try to find the next best thing... - my( $url, $ltext, $fid ); - - RESOLVE: { - if( defined $ident ){ - ## try to resolve $ident as an item - ( $url, $fid ) = coderef( $page, $ident ); - if( $url ){ - if( ! defined( $linktext ) ){ - $linktext = $ident; - $linktext .= " in " if $ident && $page; - $linktext .= "the $page manpage" if $page; - } - ### print STDERR "got coderef url=$url\n"; - last RESOLVE; - } - ## no luck: go for a section (auto-quoting!) - $section = $ident; - } - ## now go for a section - my $htmlsection = htmlify( $section ); - $url = page_sect( $page, $htmlsection ); - if( $url ){ - if( ! defined( $linktext ) ){ - $linktext = $section; - $linktext .= " in " if $section && $page; - $linktext .= "the $page manpage" if $page; - } - ### print STDERR "got page/section url=$url\n"; - last RESOLVE; - } - ## no luck: go for an ident - if( $section ){ - $ident = $section; - } else { - $ident = $page; - $page = undef(); - } - ( $url, $fid ) = coderef( $page, $ident ); - if( $url ){ - if( ! defined( $linktext ) ){ - $linktext = $ident; - $linktext .= " in " if $ident && $page; - $linktext .= "the $page manpage" if $page; - } - ### print STDERR "got section=>coderef url=$url\n"; - last RESOLVE; - } - - # warning; show some text. - $linktext = $opar unless defined $linktext; - warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet; - } - - # now we have a URL or just plain code - $$rstr = $linktext . '>' . $$rstr; - if( defined( $url ) ){ - $res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>'; - } else { - $res = '<em>' . process_text1( $lev, $rstr ) . '</em>'; - } - - } elsif( $func eq 'S' ){ - # S<text> - non-breaking spaces - $res = process_text1( $lev, $rstr ); - $res =~ s/ / /g; - - } elsif( $func eq 'X' ){ - # X<> - ignore - warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n" - unless $$rstr =~ s/^[^>]*>// or $Quiet; - } elsif( $func eq 'Z' ){ - # Z<> - empty - warn "$0: $Podfile: invalid Z<> in paragraph $Paragraph.\n" - unless $$rstr =~ s/^>// or $Quiet; - - } else { - my $term = pattern $closing; - while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){ - # all others: either recurse into new function or - # terminate at closing angle bracket(s) - my $pt = $1; - $pt .= $2 if !$3 && $lev == 1; - $res .= $lev == 1 ? pure_text( $pt ) : inIS_text( $pt ); - return $res if !$3 && $lev > 1; - if( $3 ){ - $res .= process_text1( $lev, $rstr, $3, closing $4 ); - } - } - if( $lev == 1 ){ - $res .= pure_text( $$rstr ); - } elsif( ! $Quiet ) { - my $snippet = substr($$rstr,0,60); - warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph: '$snippet'.\n" - - } - $res = process_text_rfc_links($res); - } - return $res; -} - -# -# go_ahead: extract text of an IS (can be nested) -# -sub go_ahead($$$){ - my( $rstr, $func, $closing ) = @_; - my $res = ''; - my @closing = ($closing); - while( $$rstr =~ - s/\A(.*?)(([BCEFILSXZ])<(<+\s+)?|@{[pattern $closing[0]]})//s ){ - $res .= $1; - unless( $3 ){ - shift @closing; - return $res unless @closing; - } else { - unshift @closing, closing $4; - } - $res .= $2; - } - unless ($Quiet) { - my $snippet = substr($$rstr,0,60); - warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph (go_ahead): '$snippet'.\n" - } - return $res; -} - -# -# emit_C - output result of C<text> -# $text is the depod-ed text -# -sub emit_C($;$$){ - my( $text, $nocode, $args ) = @_; - $args = '' unless defined $args; - my $res; - my( $url, $fid ) = coderef( undef(), $text ); - - # need HTML-safe text - my $linktext = html_escape( "$text$args" ); - - if( defined( $url ) && - (!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){ - $res = "<a href=\"$url\"><code>$linktext</code></a>"; - } elsif( 0 && $nocode ){ - $res = $linktext; - } else { - $res = "<code>$linktext</code>"; - } - return $res; -} - -# -# html_escape: make text safe for HTML -# -sub html_escape { - my $rest = $_[0]; - $rest =~ s/&/&/g; - $rest =~ s/</</g; - $rest =~ s/>/>/g; - $rest =~ s/"/"/g; - # ' is only in XHTML, not HTML4. Be conservative - #$rest =~ s/'/'/g; - return $rest; -} - - -# -# dosify - convert filenames to 8.3 -# -sub dosify { - my($str) = @_; - return lc($str) if $^O eq 'VMS'; # VMS just needs casing - if ($Is83) { - $str = lc $str; - $str =~ s/(\.\w+)/substr ($1,0,4)/ge; - $str =~ s/(\w+)/substr ($1,0,8)/ge; - } - return $str; -} - -# -# page_sect - make a URL from the text of a L<> -# -sub page_sect($$) { - my( $page, $section ) = @_; - my( $linktext, $page83, $link); # work strings - - # check if we know that this is a section in this page - if (!defined $Pages{$page} && defined $Sections{$page}) { - $section = $page; - $page = ""; - ### print STDERR "reset page='', section=$section\n"; - } - - $page83=dosify($page); - $page=$page83 if (defined $Pages{$page83}); - if ($page eq "") { - $link = "#" . anchorify( $section ); - } elsif ( $page =~ /::/ ) { - $page =~ s,::,/,g; - # Search page cache for an entry keyed under the html page name, - # then look to see what directory that page might be in. NOTE: - # this will only find one page. A better solution might be to produce - # an intermediate page that is an index to all such pages. - my $page_name = $page ; - $page_name =~ s,^.*/,,s ; - if ( defined( $Pages{ $page_name } ) && - $Pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/ - ) { - $page = $1 ; - } - else { - # NOTE: This branch assumes that all A::B pages are located in - # $Htmlroot/A/B.html . This is often incorrect, since they are - # often in $Htmlroot/lib/A/B.html or such like. Perhaps we could - # analyze the contents of %Pages and figure out where any - # cousins of A::B are, then assume that. So, if A::B isn't found, - # but A::C is found in lib/A/C.pm, then A::B is assumed to be in - # lib/A/B.pm. This is also limited, but it's an improvement. - # Maybe a hints file so that the links point to the correct places - # nonetheless? - - } - $link = "$Htmlroot/$page.html"; - $link .= "#" . anchorify( $section ) if ($section); - } elsif (!defined $Pages{$page}) { - $link = ""; - } else { - $section = anchorify( $section ) if $section ne ""; - ### print STDERR "...section=$section\n"; - - # if there is a directory by the name of the page, then assume that an - # appropriate section will exist in the subdirectory -# if ($section ne "" && $Pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) { - if ($section ne "" && $Pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) { - $link = "$Htmlroot/$1/$section.html"; - ### print STDERR "...link=$link\n"; - - # since there is no directory by the name of the page, the section will - # have to exist within a .html of the same name. thus, make sure there - # is a .pod or .pm that might become that .html - } else { - $section = "#$section" if $section; - ### print STDERR "...section=$section\n"; - - # check if there is a .pod with the page name. - # for L<Foo>, Foo.(pod|pm) is preferred to A/Foo.(pod|pm) - if ($Pages{$page} =~ /([^:]*)\.(?:pod|pm):/) { - $link = "$Htmlroot/$1.html$section"; - } else { - $link = ""; - } - } - } - - if ($link) { - # Here, we take advantage of the knowledge that $Htmlfileurl ne '' - # implies $Htmlroot eq ''. This means that the link in question - # needs a prefix of $Htmldir if it begins with '/'. The test for - # the initial '/' is done to avoid '#'-only links, and to allow - # for other kinds of links, like file:, ftp:, etc. - my $url ; - if ( $Htmlfileurl ne '' ) { - $link = "$Htmldir$link" if $link =~ m{^/}s; - $url = relativize_url( $link, $Htmlfileurl ); -# print( " b: [$link,$Htmlfileurl,$url]\n" ); - } - else { - $url = $link ; - } - return $url; - - } else { - return undef(); - } -} - -# -# relativize_url - convert an absolute URL to one relative to a base URL. -# Assumes both end in a filename. -# -sub relativize_url { - my ($dest,$source) = @_ ; - - my ($dest_volume,$dest_directory,$dest_file) = - File::Spec::Unix->splitpath( $dest ) ; - $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ) ; - - my ($source_volume,$source_directory,$source_file) = - File::Spec::Unix->splitpath( $source ) ; - $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ) ; - - my $rel_path = '' ; - if ( $dest ne '' ) { - $rel_path = File::Spec::Unix->abs2rel( $dest, $source ) ; - } - - if ( $rel_path ne '' && - substr( $rel_path, -1 ) ne '/' && - substr( $dest_file, 0, 1 ) ne '#' - ) { - $rel_path .= "/$dest_file" ; - } - else { - $rel_path .= "$dest_file" ; - } - - return $rel_path ; -} - - -# -# coderef - make URL from the text of a C<> -# -sub coderef($$){ - my( $page, $item ) = @_; - my( $url ); - - my $fid = fragment_id( $item ); - - if( defined( $page ) && $page ne "" ){ - # we have been given a $page... - $page =~ s{::}{/}g; - - Carp::confess("Undefined fragment '$item' from fragment_id() in coderef() in $Podfile") - if !defined $fid; - # Do we take it? Item could be a section! - my $base = $Items{$fid} || ""; - $base =~ s{[^/]*/}{}; - if( $base ne "$page.html" ){ - ### print STDERR "coderef( $page, $item ): items{$fid} = $Items{$fid} = $base => discard page!\n"; - $page = undef(); - } - - } else { - # no page - local items precede cached items - if( defined( $fid ) ){ - if( exists $Local_Items{$fid} ){ - $page = $Local_Items{$fid}; - } else { - $page = $Items{$fid}; - } - } - } - - # if there was a pod file that we found earlier with an appropriate - # =item directive, then create a link to that page. - if( defined $page ){ - if( $page ){ - if( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/){ - $page = $1 . '.html'; - } - my $link = "$Htmlroot/$page#" . anchorify($fid); - - # Here, we take advantage of the knowledge that $Htmlfileurl - # ne '' implies $Htmlroot eq ''. - if ( $Htmlfileurl ne '' ) { - $link = "$Htmldir$link" ; - $url = relativize_url( $link, $Htmlfileurl ) ; - } else { - $url = $link ; - } - } else { - $url = "#" . anchorify($fid); - } - - confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/; - } - return( $url, $fid ); -} - - - -# -# Adapted from Nick Ing-Simmons' PodToHtml package. -sub relative_url { - my $source_file = shift ; - my $destination_file = shift; - - my $source = URI::file->new_abs($source_file); - my $uo = URI::file->new($destination_file,$source)->abs; - return $uo->rel->as_string; -} - - -# -# finish_list - finish off any pending HTML lists. this should be called -# after the entire pod file has been read and converted. -# -sub finish_list { - if( $Listlevel ){ - warn "$0: $Podfile: unterminated list(s) at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet; - while( $Listlevel ){ - process_back(); - } - } -} - -# -# htmlify - converts a pod section specification to a suitable section -# specification for HTML. Note that we keep spaces and special characters -# except ", ? (Netscape problem) and the hyphen (writer's problem...). -# -sub htmlify { - my( $heading) = @_; - $heading =~ s/(\s+)/ /g; - $heading =~ s/\s+\Z//; - $heading =~ s/\A\s+//; - # The hyphen is a disgrace to the English language. - # $heading =~ s/[-"?]//g; - $heading =~ s/["?]//g; - $heading = lc( $heading ); - return $heading; -} - -# -# similar to htmlify, but turns non-alphanumerics into underscores -# -sub anchorify { - my ($anchor) = @_; - $anchor = htmlify($anchor); - $anchor =~ s/\W/_/g; - return $anchor; -} - -# -# depod - convert text by eliminating all interior sequences -# Note: can be called with copy or modify semantics -# -my %E2c; -$E2c{lt} = '<'; -$E2c{gt} = '>'; -$E2c{sol} = '/'; -$E2c{verbar} = '|'; -$E2c{amp} = '&'; # in Tk's pods - -sub depod1($;$$); - -sub depod($){ - my $string; - if( ref( $_[0] ) ){ - $string = ${$_[0]}; - ${$_[0]} = depod1( \$string ); - } else { - $string = $_[0]; - depod1( \$string ); - } -} - -sub depod1($;$$){ - my( $rstr, $func, $closing ) = @_; - my $res = ''; - return $res unless defined $$rstr; - if( ! defined( $func ) ){ - # skip to next begin of an interior sequence - while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?//s ){ - # recurse into its text - $res .= $1 . depod1( $rstr, $2, closing $3); - } - $res .= $$rstr; - } elsif( $func eq 'E' ){ - # E<x> - convert to character - $$rstr =~ s/^([^>]*)>//; - $res .= $E2c{$1} || ""; - } elsif( $func eq 'X' ){ - # X<> - ignore - $$rstr =~ s/^[^>]*>//; - } elsif( $func eq 'Z' ){ - # Z<> - empty - $$rstr =~ s/^>//; - } else { - # all others: either recurse into new function or - # terminate at closing angle bracket - my $term = pattern $closing; - while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){ - $res .= $1; - last unless $3; - $res .= depod1( $rstr, $3, closing $4 ); - } - ## If we're here and $2 ne '>': undelimited interior sequence. - ## Ignored, as this is called without proper indication of where we are. - ## Rely on process_text to produce diagnostics. - } - return $res; -} - -{ - my %seen; # static fragment record hash - -sub fragment_id_readable { - my $text = shift; - my $generate = shift; # optional flag - - my $orig = $text; - - # leave the words for the fragment identifier, - # change everything else to underbars. - $text =~ s/[^A-Za-z0-9_]+/_/g; # do not use \W to avoid locale dependency. - $text =~ s/_{2,}/_/g; - $text =~ s/\A_//; - $text =~ s/_\Z//; - - unless ($text) - { - # Nothing left after removing punctuation, so leave it as is - # E.g. if option is named: "=item -#" - - $text = $orig; - } - - if ($generate) { - if ( exists $seen{$text} ) { - # This already exists, make it unique - $seen{$text}++; - $text = $text . $seen{$text}; - } else { - $seen{$text} = 1; # first time seen this fragment - } - } - - $text; -}} - -my @HC; -sub fragment_id_obfuscated { # This was the old "_2d_2d__" - my $text = shift; - my $generate = shift; # optional flag - - # text? Normalize by obfuscating the fragment id to make it unique - $text =~ s/\s+/_/sg; - - $text =~ s{(\W)}{ - defined( $HC[ord($1)] ) ? $HC[ord($1)] - : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe; - $text = substr( $text, 0, 50 ); - - $text; -} - -# -# fragment_id - construct a fragment identifier from: -# a) =item text -# b) contents of C<...> -# - -sub fragment_id { - my $text = shift; - my $generate = shift; # optional flag - - $text =~ s/\s+\Z//s; - if( $text ){ - # a method or function? - return $1 if $text =~ /(\w+)\s*\(/; - return $1 if $text =~ /->\s*(\w+)\s*\(?/; - - # a variable name? - return $1 if $text =~ /^([\$\@%*]\S+)/; - - # some pattern matching operator? - return $1 if $text =~ m|^(\w+/).*/\w*$|; - - # fancy stuff... like "do { }" - return $1 if $text =~ m|^(\w+)\s*{.*}$|; - - # honour the perlfunc manpage: func [PAR[,[ ]PAR]...] - # and some funnies with ... Module ... - return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z,/& ][A-Z\d,/& ]*)?$}; - return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$}; - - return fragment_id_readable($text, $generate); - } else { - return; - } -} - -# -# make_URL_href - generate HTML href from URL -# Special treatment for CGI queries. -# -sub make_URL_href($){ - my( $url ) = @_; - if( $url !~ - s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ){ - $url = "<a href=\"$url\">$url</a>"; - } - return $url; -} - -1; diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/InputObjects.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/InputObjects.pm deleted file mode 100644 index fa5f61f9a70..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/InputObjects.pm +++ /dev/null @@ -1,941 +0,0 @@ -############################################################################# -# Pod/InputObjects.pm -- package which defines objects for input streams -# and paragraphs and commands when parsing POD docs. -# -# Copyright (C) 1996-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::InputObjects; - -use vars qw($VERSION); -$VERSION = 1.30; ## Current version of this package -require 5.005; ## requires this Perl version or later - -############################################################################# - -=head1 NAME - -Pod::InputObjects - objects representing POD input paragraphs, commands, etc. - -=head1 SYNOPSIS - - use Pod::InputObjects; - -=head1 REQUIRES - -perl5.004, Carp - -=head1 EXPORTS - -Nothing. - -=head1 DESCRIPTION - -This module defines some basic input objects used by B<Pod::Parser> when -reading and parsing POD text from an input source. The following objects -are defined: - -=over 4 - -=begin __PRIVATE__ - -=item package B<Pod::InputSource> - -An object corresponding to a source of POD input text. It is mostly a -wrapper around a filehandle or C<IO::Handle>-type object (or anything -that implements the C<getline()> method) which keeps track of some -additional information relevant to the parsing of PODs. - -=end __PRIVATE__ - -=item package B<Pod::Paragraph> - -An object corresponding to a paragraph of POD input text. It may be a -plain paragraph, a verbatim paragraph, or a command paragraph (see -L<perlpod>). - -=item package B<Pod::InteriorSequence> - -An object corresponding to an interior sequence command from the POD -input text (see L<perlpod>). - -=item package B<Pod::ParseTree> - -An object corresponding to a tree of parsed POD text. Each "node" in -a parse-tree (or I<ptree>) is either a text-string or a reference to -a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree -in the order in which they were parsed from left-to-right. - -=back - -Each of these input objects are described in further detail in the -sections which follow. - -=cut - -############################################################################# - -use strict; -#use diagnostics; -#use Carp; - -############################################################################# - -package Pod::InputSource; - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head1 B<Pod::InputSource> - -This object corresponds to an input source or stream of POD -documentation. When parsing PODs, it is necessary to associate and store -certain context information with each input source. All of this -information is kept together with the stream itself in one of these -C<Pod::InputSource> objects. Each such object is merely a wrapper around -an C<IO::Handle> object of some kind (or at least something that -implements the C<getline()> method). They have the following -methods/attributes: - -=end __PRIVATE__ - -=cut - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head2 B<new()> - - my $pod_input1 = Pod::InputSource->new(-handle => $filehandle); - my $pod_input2 = new Pod::InputSource(-handle => $filehandle, - -name => $name); - my $pod_input3 = new Pod::InputSource(-handle => \*STDIN); - my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN, - -name => "(STDIN)"); - -This is a class method that constructs a C<Pod::InputSource> object and -returns a reference to the new input source object. It takes one or more -keyword arguments in the form of a hash. The keyword C<-handle> is -required and designates the corresponding input handle. The keyword -C<-name> is optional and specifies the name associated with the input -handle (typically a file name). - -=end __PRIVATE__ - -=cut - -sub new { - ## Determine if we were called via an object-ref or a classname - my $this = shift; - my $class = ref($this) || $this; - - ## Any remaining arguments are treated as initial values for the - ## hash that is used to represent this object. Note that we default - ## certain values by specifying them *before* the arguments passed. - ## If they are in the argument list, they will override the defaults. - my $self = { -name => '(unknown)', - -handle => undef, - -was_cutting => 0, - @_ }; - - ## Bless ourselves into the desired class and perform any initialization - bless $self, $class; - return $self; -} - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head2 B<name()> - - my $filename = $pod_input->name(); - $pod_input->name($new_filename_to_use); - -This method gets/sets the name of the input source (usually a filename). -If no argument is given, it returns a string containing the name of -the input source; otherwise it sets the name of the input source to the -contents of the given argument. - -=end __PRIVATE__ - -=cut - -sub name { - (@_ > 1) and $_[0]->{'-name'} = $_[1]; - return $_[0]->{'-name'}; -} - -## allow 'filename' as an alias for 'name' -*filename = \&name; - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head2 B<handle()> - - my $handle = $pod_input->handle(); - -Returns a reference to the handle object from which input is read (the -one used to contructed this input source object). - -=end __PRIVATE__ - -=cut - -sub handle { - return $_[0]->{'-handle'}; -} - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head2 B<was_cutting()> - - print "Yes.\n" if ($pod_input->was_cutting()); - -The value of the C<cutting> state (that the B<cutting()> method would -have returned) immediately before any input was read from this input -stream. After all input from this stream has been read, the C<cutting> -state is restored to this value. - -=end __PRIVATE__ - -=cut - -sub was_cutting { - (@_ > 1) and $_[0]->{-was_cutting} = $_[1]; - return $_[0]->{-was_cutting}; -} - -##--------------------------------------------------------------------------- - -############################################################################# - -package Pod::Paragraph; - -##--------------------------------------------------------------------------- - -=head1 B<Pod::Paragraph> - -An object representing a paragraph of POD input text. -It has the following methods/attributes: - -=cut - -##--------------------------------------------------------------------------- - -=head2 Pod::Paragraph-E<gt>B<new()> - - my $pod_para1 = Pod::Paragraph->new(-text => $text); - my $pod_para2 = Pod::Paragraph->new(-name => $cmd, - -text => $text); - my $pod_para3 = new Pod::Paragraph(-text => $text); - my $pod_para4 = new Pod::Paragraph(-name => $cmd, - -text => $text); - my $pod_para5 = Pod::Paragraph->new(-name => $cmd, - -text => $text, - -file => $filename, - -line => $line_number); - -This is a class method that constructs a C<Pod::Paragraph> object and -returns a reference to the new paragraph object. It may be given one or -two keyword arguments. The C<-text> keyword indicates the corresponding -text of the POD paragraph. The C<-name> keyword indicates the name of -the corresponding POD command, such as C<head1> or C<item> (it should -I<not> contain the C<=> prefix); this is needed only if the POD -paragraph corresponds to a command paragraph. The C<-file> and C<-line> -keywords indicate the filename and line number corresponding to the -beginning of the paragraph - -=cut - -sub new { - ## Determine if we were called via an object-ref or a classname - my $this = shift; - my $class = ref($this) || $this; - - ## Any remaining arguments are treated as initial values for the - ## hash that is used to represent this object. Note that we default - ## certain values by specifying them *before* the arguments passed. - ## If they are in the argument list, they will override the defaults. - my $self = { - -name => undef, - -text => (@_ == 1) ? shift : undef, - -file => '<unknown-file>', - -line => 0, - -prefix => '=', - -separator => ' ', - -ptree => [], - @_ - }; - - ## Bless ourselves into the desired class and perform any initialization - bless $self, $class; - return $self; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_para-E<gt>B<cmd_name()> - - my $para_cmd = $pod_para->cmd_name(); - -If this paragraph is a command paragraph, then this method will return -the name of the command (I<without> any leading C<=> prefix). - -=cut - -sub cmd_name { - (@_ > 1) and $_[0]->{'-name'} = $_[1]; - return $_[0]->{'-name'}; -} - -## let name() be an alias for cmd_name() -*name = \&cmd_name; - -##--------------------------------------------------------------------------- - -=head2 $pod_para-E<gt>B<text()> - - my $para_text = $pod_para->text(); - -This method will return the corresponding text of the paragraph. - -=cut - -sub text { - (@_ > 1) and $_[0]->{'-text'} = $_[1]; - return $_[0]->{'-text'}; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_para-E<gt>B<raw_text()> - - my $raw_pod_para = $pod_para->raw_text(); - -This method will return the I<raw> text of the POD paragraph, exactly -as it appeared in the input. - -=cut - -sub raw_text { - return $_[0]->{'-text'} unless (defined $_[0]->{'-name'}); - return $_[0]->{'-prefix'} . $_[0]->{'-name'} . - $_[0]->{'-separator'} . $_[0]->{'-text'}; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_para-E<gt>B<cmd_prefix()> - - my $prefix = $pod_para->cmd_prefix(); - -If this paragraph is a command paragraph, then this method will return -the prefix used to denote the command (which should be the string "=" -or "=="). - -=cut - -sub cmd_prefix { - return $_[0]->{'-prefix'}; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_para-E<gt>B<cmd_separator()> - - my $separator = $pod_para->cmd_separator(); - -If this paragraph is a command paragraph, then this method will return -the text used to separate the command name from the rest of the -paragraph (if any). - -=cut - -sub cmd_separator { - return $_[0]->{'-separator'}; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_para-E<gt>B<parse_tree()> - - my $ptree = $pod_parser->parse_text( $pod_para->text() ); - $pod_para->parse_tree( $ptree ); - $ptree = $pod_para->parse_tree(); - -This method will get/set the corresponding parse-tree of the paragraph's text. - -=cut - -sub parse_tree { - (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; - return $_[0]->{'-ptree'}; -} - -## let ptree() be an alias for parse_tree() -*ptree = \&parse_tree; - -##--------------------------------------------------------------------------- - -=head2 $pod_para-E<gt>B<file_line()> - - my ($filename, $line_number) = $pod_para->file_line(); - my $position = $pod_para->file_line(); - -Returns the current filename and line number for the paragraph -object. If called in a list context, it returns a list of two -elements: first the filename, then the line number. If called in -a scalar context, it returns a string containing the filename, followed -by a colon (':'), followed by the line number. - -=cut - -sub file_line { - my @loc = ($_[0]->{'-file'} || '<unknown-file>', - $_[0]->{'-line'} || 0); - return (wantarray) ? @loc : join(':', @loc); -} - -##--------------------------------------------------------------------------- - -############################################################################# - -package Pod::InteriorSequence; - -##--------------------------------------------------------------------------- - -=head1 B<Pod::InteriorSequence> - -An object representing a POD interior sequence command. -It has the following methods/attributes: - -=cut - -##--------------------------------------------------------------------------- - -=head2 Pod::InteriorSequence-E<gt>B<new()> - - my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd - -ldelim => $delimiter); - my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd, - -ldelim => $delimiter); - my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd, - -ldelim => $delimiter, - -file => $filename, - -line => $line_number); - - my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree); - my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree); - -This is a class method that constructs a C<Pod::InteriorSequence> object -and returns a reference to the new interior sequence object. It should -be given two keyword arguments. The C<-ldelim> keyword indicates the -corresponding left-delimiter of the interior sequence (e.g. 'E<lt>'). -The C<-name> keyword indicates the name of the corresponding interior -sequence command, such as C<I> or C<B> or C<C>. The C<-file> and -C<-line> keywords indicate the filename and line number corresponding -to the beginning of the interior sequence. If the C<$ptree> argument is -given, it must be the last argument, and it must be either string, or -else an array-ref suitable for passing to B<Pod::ParseTree::new> (or -it may be a reference to a Pod::ParseTree object). - -=cut - -sub new { - ## Determine if we were called via an object-ref or a classname - my $this = shift; - my $class = ref($this) || $this; - - ## See if first argument has no keyword - if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) { - ## Yup - need an implicit '-name' before first parameter - unshift @_, '-name'; - } - - ## See if odd number of args - if ((@_ % 2) != 0) { - ## Yup - need an implicit '-ptree' before the last parameter - splice @_, $#_, 0, '-ptree'; - } - - ## Any remaining arguments are treated as initial values for the - ## hash that is used to represent this object. Note that we default - ## certain values by specifying them *before* the arguments passed. - ## If they are in the argument list, they will override the defaults. - my $self = { - -name => (@_ == 1) ? $_[0] : undef, - -file => '<unknown-file>', - -line => 0, - -ldelim => '<', - -rdelim => '>', - @_ - }; - - ## Initialize contents if they havent been already - my $ptree = $self->{'-ptree'} || new Pod::ParseTree(); - if ( ref $ptree =~ /^(ARRAY)?$/ ) { - ## We have an array-ref, or a normal scalar. Pass it as an - ## an argument to the ptree-constructor - $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree); - } - $self->{'-ptree'} = $ptree; - - ## Bless ourselves into the desired class and perform any initialization - bless $self, $class; - return $self; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<cmd_name()> - - my $seq_cmd = $pod_seq->cmd_name(); - -The name of the interior sequence command. - -=cut - -sub cmd_name { - (@_ > 1) and $_[0]->{'-name'} = $_[1]; - return $_[0]->{'-name'}; -} - -## let name() be an alias for cmd_name() -*name = \&cmd_name; - -##--------------------------------------------------------------------------- - -## Private subroutine to set the parent pointer of all the given -## children that are interior-sequences to be $self - -sub _set_child2parent_links { - my ($self, @children) = @_; - ## Make sure any sequences know who their parent is - for (@children) { - next unless (length and ref and ref ne 'SCALAR'); - if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or - UNIVERSAL::can($_, 'nested')) - { - $_->nested($self); - } - } -} - -## Private subroutine to unset child->parent links - -sub _unset_child2parent_links { - my $self = shift; - $self->{'-parent_sequence'} = undef; - my $ptree = $self->{'-ptree'}; - for (@$ptree) { - next unless (length and ref and ref ne 'SCALAR'); - $_->_unset_child2parent_links() - if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); - } -} - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<prepend()> - - $pod_seq->prepend($text); - $pod_seq1->prepend($pod_seq2); - -Prepends the given string or parse-tree or sequence object to the parse-tree -of this interior sequence. - -=cut - -sub prepend { - my $self = shift; - $self->{'-ptree'}->prepend(@_); - _set_child2parent_links($self, @_); - return $self; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<append()> - - $pod_seq->append($text); - $pod_seq1->append($pod_seq2); - -Appends the given string or parse-tree or sequence object to the parse-tree -of this interior sequence. - -=cut - -sub append { - my $self = shift; - $self->{'-ptree'}->append(@_); - _set_child2parent_links($self, @_); - return $self; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<nested()> - - $outer_seq = $pod_seq->nested || print "not nested"; - -If this interior sequence is nested inside of another interior -sequence, then the outer/parent sequence that contains it is -returned. Otherwise C<undef> is returned. - -=cut - -sub nested { - my $self = shift; - (@_ == 1) and $self->{'-parent_sequence'} = shift; - return $self->{'-parent_sequence'} || undef; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<raw_text()> - - my $seq_raw_text = $pod_seq->raw_text(); - -This method will return the I<raw> text of the POD interior sequence, -exactly as it appeared in the input. - -=cut - -sub raw_text { - my $self = shift; - my $text = $self->{'-name'} . $self->{'-ldelim'}; - for ( $self->{'-ptree'}->children ) { - $text .= (ref $_) ? $_->raw_text : $_; - } - $text .= $self->{'-rdelim'}; - return $text; -} - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<left_delimiter()> - - my $ldelim = $pod_seq->left_delimiter(); - -The leftmost delimiter beginning the argument text to the interior -sequence (should be "<"). - -=cut - -sub left_delimiter { - (@_ > 1) and $_[0]->{'-ldelim'} = $_[1]; - return $_[0]->{'-ldelim'}; -} - -## let ldelim() be an alias for left_delimiter() -*ldelim = \&left_delimiter; - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<right_delimiter()> - -The rightmost delimiter beginning the argument text to the interior -sequence (should be ">"). - -=cut - -sub right_delimiter { - (@_ > 1) and $_[0]->{'-rdelim'} = $_[1]; - return $_[0]->{'-rdelim'}; -} - -## let rdelim() be an alias for right_delimiter() -*rdelim = \&right_delimiter; - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<parse_tree()> - - my $ptree = $pod_parser->parse_text($paragraph_text); - $pod_seq->parse_tree( $ptree ); - $ptree = $pod_seq->parse_tree(); - -This method will get/set the corresponding parse-tree of the interior -sequence's text. - -=cut - -sub parse_tree { - (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; - return $_[0]->{'-ptree'}; -} - -## let ptree() be an alias for parse_tree() -*ptree = \&parse_tree; - -##--------------------------------------------------------------------------- - -=head2 $pod_seq-E<gt>B<file_line()> - - my ($filename, $line_number) = $pod_seq->file_line(); - my $position = $pod_seq->file_line(); - -Returns the current filename and line number for the interior sequence -object. If called in a list context, it returns a list of two -elements: first the filename, then the line number. If called in -a scalar context, it returns a string containing the filename, followed -by a colon (':'), followed by the line number. - -=cut - -sub file_line { - my @loc = ($_[0]->{'-file'} || '<unknown-file>', - $_[0]->{'-line'} || 0); - return (wantarray) ? @loc : join(':', @loc); -} - -##--------------------------------------------------------------------------- - -=head2 Pod::InteriorSequence::B<DESTROY()> - -This method performs any necessary cleanup for the interior-sequence. -If you override this method then it is B<imperative> that you invoke -the parent method from within your own method, otherwise -I<interior-sequence storage will not be reclaimed upon destruction!> - -=cut - -sub DESTROY { - ## We need to get rid of all child->parent pointers throughout the - ## tree so their reference counts will go to zero and they can be - ## garbage-collected - _unset_child2parent_links(@_); -} - -##--------------------------------------------------------------------------- - -############################################################################# - -package Pod::ParseTree; - -##--------------------------------------------------------------------------- - -=head1 B<Pod::ParseTree> - -This object corresponds to a tree of parsed POD text. As POD text is -scanned from left to right, it is parsed into an ordered list of -text-strings and B<Pod::InteriorSequence> objects (in order of -appearance). A B<Pod::ParseTree> object corresponds to this list of -strings and sequences. Each interior sequence in the parse-tree may -itself contain a parse-tree (since interior sequences may be nested). - -=cut - -##--------------------------------------------------------------------------- - -=head2 Pod::ParseTree-E<gt>B<new()> - - my $ptree1 = Pod::ParseTree->new; - my $ptree2 = new Pod::ParseTree; - my $ptree4 = Pod::ParseTree->new($array_ref); - my $ptree3 = new Pod::ParseTree($array_ref); - -This is a class method that constructs a C<Pod::Parse_tree> object and -returns a reference to the new parse-tree. If a single-argument is given, -it must be a reference to an array, and is used to initialize the root -(top) of the parse tree. - -=cut - -sub new { - ## Determine if we were called via an object-ref or a classname - my $this = shift; - my $class = ref($this) || $this; - - my $self = (@_ == 1 and ref $_[0]) ? $_[0] : []; - - ## Bless ourselves into the desired class and perform any initialization - bless $self, $class; - return $self; -} - -##--------------------------------------------------------------------------- - -=head2 $ptree-E<gt>B<top()> - - my $top_node = $ptree->top(); - $ptree->top( $top_node ); - $ptree->top( @children ); - -This method gets/sets the top node of the parse-tree. If no arguments are -given, it returns the topmost node in the tree (the root), which is also -a B<Pod::ParseTree>. If it is given a single argument that is a reference, -then the reference is assumed to a parse-tree and becomes the new top node. -Otherwise, if arguments are given, they are treated as the new list of -children for the top node. - -=cut - -sub top { - my $self = shift; - if (@_ > 0) { - @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; - } - return $self; -} - -## let parse_tree() & ptree() be aliases for the 'top' method -*parse_tree = *ptree = \⊤ - -##--------------------------------------------------------------------------- - -=head2 $ptree-E<gt>B<children()> - -This method gets/sets the children of the top node in the parse-tree. -If no arguments are given, it returns the list (array) of children -(each of which should be either a string or a B<Pod::InteriorSequence>. -Otherwise, if arguments are given, they are treated as the new list of -children for the top node. - -=cut - -sub children { - my $self = shift; - if (@_ > 0) { - @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; - } - return @{ $self }; -} - -##--------------------------------------------------------------------------- - -=head2 $ptree-E<gt>B<prepend()> - -This method prepends the given text or parse-tree to the current parse-tree. -If the first item on the parse-tree is text and the argument is also text, -then the text is prepended to the first item (not added as a separate string). -Otherwise the argument is added as a new string or parse-tree I<before> -the current one. - -=cut - -use vars qw(@ptree); ## an alias used for performance reasons - -sub prepend { - my $self = shift; - local *ptree = $self; - for (@_) { - next unless length; - if (@ptree and !(ref $ptree[0]) and !(ref $_)) { - $ptree[0] = $_ . $ptree[0]; - } - else { - unshift @ptree, $_; - } - } -} - -##--------------------------------------------------------------------------- - -=head2 $ptree-E<gt>B<append()> - -This method appends the given text or parse-tree to the current parse-tree. -If the last item on the parse-tree is text and the argument is also text, -then the text is appended to the last item (not added as a separate string). -Otherwise the argument is added as a new string or parse-tree I<after> -the current one. - -=cut - -sub append { - my $self = shift; - local *ptree = $self; - my $can_append = @ptree && !(ref $ptree[-1]); - for (@_) { - if (ref) { - push @ptree, $_; - } - elsif(!length) { - next; - } - elsif ($can_append) { - $ptree[-1] .= $_; - } - else { - push @ptree, $_; - } - } -} - -=head2 $ptree-E<gt>B<raw_text()> - - my $ptree_raw_text = $ptree->raw_text(); - -This method will return the I<raw> text of the POD parse-tree -exactly as it appeared in the input. - -=cut - -sub raw_text { - my $self = shift; - my $text = ""; - for ( @$self ) { - $text .= (ref $_) ? $_->raw_text : $_; - } - return $text; -} - -##--------------------------------------------------------------------------- - -## Private routines to set/unset child->parent links - -sub _unset_child2parent_links { - my $self = shift; - local *ptree = $self; - for (@ptree) { - next unless (defined and length and ref and ref ne 'SCALAR'); - $_->_unset_child2parent_links() - if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); - } -} - -sub _set_child2parent_links { - ## nothing to do, Pod::ParseTrees cant have parent pointers -} - -=head2 Pod::ParseTree::B<DESTROY()> - -This method performs any necessary cleanup for the parse-tree. -If you override this method then it is B<imperative> -that you invoke the parent method from within your own method, -otherwise I<parse-tree storage will not be reclaimed upon destruction!> - -=cut - -sub DESTROY { - ## We need to get rid of all child->parent pointers throughout the - ## tree so their reference counts will go to zero and they can be - ## garbage-collected - _unset_child2parent_links(@_); -} - -############################################################################# - -=head1 SEE ALSO - -See L<Pod::Parser>, L<Pod::Select> - -=head1 AUTHOR - -Please report bugs using L<http://rt.cpan.org>. - -Brad Appleton E<lt>bradapp@enteract.comE<gt> - -=cut - -1; diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/LaTeX.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/LaTeX.pm deleted file mode 100644 index 501ca7f240d..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/LaTeX.pm +++ /dev/null @@ -1,1876 +0,0 @@ -package Pod::LaTeX; - -=head1 NAME - -Pod::LaTeX - Convert Pod data to formatted Latex - -=head1 SYNOPSIS - - use Pod::LaTeX; - my $parser = Pod::LaTeX->new ( ); - - $parser->parse_from_filehandle; - - $parser->parse_from_file ('file.pod', 'file.tex'); - -=head1 DESCRIPTION - -C<Pod::LaTeX> is a module to convert documentation in the Pod format -into Latex. The L<B<pod2latex>|pod2latex> X<pod2latex> command uses -this module for translation. - -C<Pod::LaTeX> is a derived class from L<Pod::Select|Pod::Select>. - -=cut - - -use strict; -require Pod::ParseUtils; -use base qw/ Pod::Select /; - -# use Data::Dumper; # for debugging -use Carp; - -use vars qw/ $VERSION %HTML_Escapes @LatexSections /; - -$VERSION = '0.58'; - -# Definitions of =headN -> latex mapping -@LatexSections = (qw/ - chapter - section - subsection - subsubsection - paragraph - subparagraph - /); - -# Standard escape sequences converted to Latex. -# The Unicode name of each character is given in the comments. -# Complete LaTeX set added by Peter Acklam. - -%HTML_Escapes = ( - 'sol' => '\textfractionsolidus{}', # xxx - or should it be just '/' - 'verbar' => '|', - - # The stuff below is based on the information available at - # http://www.w3.org/TR/html401/sgml/entities.html - - # All characters in the range 0xA0-0xFF of the ISO 8859-1 character set. - # Several of these characters require the `textcomp' LaTeX package. - 'nbsp' => q|~|, # 0xA0 - no-break space = non-breaking space - 'iexcl' => q|\textexclamdown{}|, # 0xA1 - inverted exclamation mark - 'cent' => q|\textcent{}|, # 0xA2 - cent sign - 'pound' => q|\textsterling{}|, # 0xA3 - pound sign - 'curren' => q|\textcurrency{}|, # 0xA4 - currency sign - 'yen' => q|\textyen{}|, # 0xA5 - yen sign = yuan sign - 'brvbar' => q|\textbrokenbar{}|, # 0xA6 - broken bar = broken vertical bar - 'sect' => q|\textsection{}|, # 0xA7 - section sign - 'uml' => q|\textasciidieresis{}|, # 0xA8 - diaeresis = spacing diaeresis - 'copy' => q|\textcopyright{}|, # 0xA9 - copyright sign - 'ordf' => q|\textordfeminine{}|, # 0xAA - feminine ordinal indicator - 'laquo' => q|\guillemotleft{}|, # 0xAB - left-pointing double angle quotation mark = left pointing guillemet - 'not' => q|\textlnot{}|, # 0xAC - not sign - 'shy' => q|\-|, # 0xAD - soft hyphen = discretionary hyphen - 'reg' => q|\textregistered{}|, # 0xAE - registered sign = registered trade mark sign - 'macr' => q|\textasciimacron{}|, # 0xAF - macron = spacing macron = overline = APL overbar - 'deg' => q|\textdegree{}|, # 0xB0 - degree sign - 'plusmn' => q|\textpm{}|, # 0xB1 - plus-minus sign = plus-or-minus sign - 'sup2' => q|\texttwosuperior{}|, # 0xB2 - superscript two = superscript digit two = squared - 'sup3' => q|\textthreesuperior{}|, # 0xB3 - superscript three = superscript digit three = cubed - 'acute' => q|\textasciiacute{}|, # 0xB4 - acute accent = spacing acute - 'micro' => q|\textmu{}|, # 0xB5 - micro sign - 'para' => q|\textparagraph{}|, # 0xB6 - pilcrow sign = paragraph sign - 'middot' => q|\textperiodcentered{}|, # 0xB7 - middle dot = Georgian comma = Greek middle dot - 'cedil' => q|\c{}|, # 0xB8 - cedilla = spacing cedilla - 'sup1' => q|\textonesuperior{}|, # 0xB9 - superscript one = superscript digit one - 'ordm' => q|\textordmasculine{}|, # 0xBA - masculine ordinal indicator - 'raquo' => q|\guillemotright{}|, # 0xBB - right-pointing double angle quotation mark = right pointing guillemet - 'frac14' => q|\textonequarter{}|, # 0xBC - vulgar fraction one quarter = fraction one quarter - 'frac12' => q|\textonehalf{}|, # 0xBD - vulgar fraction one half = fraction one half - 'frac34' => q|\textthreequarters{}|, # 0xBE - vulgar fraction three quarters = fraction three quarters - 'iquest' => q|\textquestiondown{}|, # 0xBF - inverted question mark = turned question mark - 'Agrave' => q|\`A|, # 0xC0 - latin capital letter A with grave = latin capital letter A grave - 'Aacute' => q|\'A|, # 0xC1 - latin capital letter A with acute - 'Acirc' => q|\^A|, # 0xC2 - latin capital letter A with circumflex - 'Atilde' => q|\~A|, # 0xC3 - latin capital letter A with tilde - 'Auml' => q|\"A|, # 0xC4 - latin capital letter A with diaeresis - 'Aring' => q|\AA{}|, # 0xC5 - latin capital letter A with ring above = latin capital letter A ring - 'AElig' => q|\AE{}|, # 0xC6 - latin capital letter AE = latin capital ligature AE - 'Ccedil' => q|\c{C}|, # 0xC7 - latin capital letter C with cedilla - 'Egrave' => q|\`E|, # 0xC8 - latin capital letter E with grave - 'Eacute' => q|\'E|, # 0xC9 - latin capital letter E with acute - 'Ecirc' => q|\^E|, # 0xCA - latin capital letter E with circumflex - 'Euml' => q|\"E|, # 0xCB - latin capital letter E with diaeresis - 'Igrave' => q|\`I|, # 0xCC - latin capital letter I with grave - 'Iacute' => q|\'I|, # 0xCD - latin capital letter I with acute - 'Icirc' => q|\^I|, # 0xCE - latin capital letter I with circumflex - 'Iuml' => q|\"I|, # 0xCF - latin capital letter I with diaeresis - 'ETH' => q|\DH{}|, # 0xD0 - latin capital letter ETH - 'Ntilde' => q|\~N|, # 0xD1 - latin capital letter N with tilde - 'Ograve' => q|\`O|, # 0xD2 - latin capital letter O with grave - 'Oacute' => q|\'O|, # 0xD3 - latin capital letter O with acute - 'Ocirc' => q|\^O|, # 0xD4 - latin capital letter O with circumflex - 'Otilde' => q|\~O|, # 0xD5 - latin capital letter O with tilde - 'Ouml' => q|\"O|, # 0xD6 - latin capital letter O with diaeresis - 'times' => q|\texttimes{}|, # 0xD7 - multiplication sign - 'Oslash' => q|\O{}|, # 0xD8 - latin capital letter O with stroke = latin capital letter O slash - 'Ugrave' => q|\`U|, # 0xD9 - latin capital letter U with grave - 'Uacute' => q|\'U|, # 0xDA - latin capital letter U with acute - 'Ucirc' => q|\^U|, # 0xDB - latin capital letter U with circumflex - 'Uuml' => q|\"U|, # 0xDC - latin capital letter U with diaeresis - 'Yacute' => q|\'Y|, # 0xDD - latin capital letter Y with acute - 'THORN' => q|\TH{}|, # 0xDE - latin capital letter THORN - 'szlig' => q|\ss{}|, # 0xDF - latin small letter sharp s = ess-zed - 'agrave' => q|\`a|, # 0xE0 - latin small letter a with grave = latin small letter a grave - 'aacute' => q|\'a|, # 0xE1 - latin small letter a with acute - 'acirc' => q|\^a|, # 0xE2 - latin small letter a with circumflex - 'atilde' => q|\~a|, # 0xE3 - latin small letter a with tilde - 'auml' => q|\"a|, # 0xE4 - latin small letter a with diaeresis - 'aring' => q|\aa{}|, # 0xE5 - latin small letter a with ring above = latin small letter a ring - 'aelig' => q|\ae{}|, # 0xE6 - latin small letter ae = latin small ligature ae - 'ccedil' => q|\c{c}|, # 0xE7 - latin small letter c with cedilla - 'egrave' => q|\`e|, # 0xE8 - latin small letter e with grave - 'eacute' => q|\'e|, # 0xE9 - latin small letter e with acute - 'ecirc' => q|\^e|, # 0xEA - latin small letter e with circumflex - 'euml' => q|\"e|, # 0xEB - latin small letter e with diaeresis - 'igrave' => q|\`i|, # 0xEC - latin small letter i with grave - 'iacute' => q|\'i|, # 0xED - latin small letter i with acute - 'icirc' => q|\^i|, # 0xEE - latin small letter i with circumflex - 'iuml' => q|\"i|, # 0xEF - latin small letter i with diaeresis - 'eth' => q|\dh{}|, # 0xF0 - latin small letter eth - 'ntilde' => q|\~n|, # 0xF1 - latin small letter n with tilde - 'ograve' => q|\`o|, # 0xF2 - latin small letter o with grave - 'oacute' => q|\'o|, # 0xF3 - latin small letter o with acute - 'ocirc' => q|\^o|, # 0xF4 - latin small letter o with circumflex - 'otilde' => q|\~o|, # 0xF5 - latin small letter o with tilde - 'ouml' => q|\"o|, # 0xF6 - latin small letter o with diaeresis - 'divide' => q|\textdiv{}|, # 0xF7 - division sign - 'oslash' => q|\o{}|, # 0xF8 - latin small letter o with stroke, = latin small letter o slash - 'ugrave' => q|\`u|, # 0xF9 - latin small letter u with grave - 'uacute' => q|\'u|, # 0xFA - latin small letter u with acute - 'ucirc' => q|\^u|, # 0xFB - latin small letter u with circumflex - 'uuml' => q|\"u|, # 0xFC - latin small letter u with diaeresis - 'yacute' => q|\'y|, # 0xFD - latin small letter y with acute - 'thorn' => q|\th{}|, # 0xFE - latin small letter thorn - 'yuml' => q|\"y|, # 0xFF - latin small letter y with diaeresis - - # Latin Extended-B - 'fnof' => q|\textflorin{}|, # latin small f with hook = function = florin - - # Greek - 'Alpha' => q|$\mathrm{A}$|, # greek capital letter alpha - 'Beta' => q|$\mathrm{B}$|, # greek capital letter beta - 'Gamma' => q|$\Gamma$|, # greek capital letter gamma - 'Delta' => q|$\Delta$|, # greek capital letter delta - 'Epsilon' => q|$\mathrm{E}$|, # greek capital letter epsilon - 'Zeta' => q|$\mathrm{Z}$|, # greek capital letter zeta - 'Eta' => q|$\mathrm{H}$|, # greek capital letter eta - 'Theta' => q|$\Theta$|, # greek capital letter theta - 'Iota' => q|$\mathrm{I}$|, # greek capital letter iota - 'Kappa' => q|$\mathrm{K}$|, # greek capital letter kappa - 'Lambda' => q|$\Lambda$|, # greek capital letter lambda - 'Mu' => q|$\mathrm{M}$|, # greek capital letter mu - 'Nu' => q|$\mathrm{N}$|, # greek capital letter nu - 'Xi' => q|$\Xi$|, # greek capital letter xi - 'Omicron' => q|$\mathrm{O}$|, # greek capital letter omicron - 'Pi' => q|$\Pi$|, # greek capital letter pi - 'Rho' => q|$\mathrm{R}$|, # greek capital letter rho - 'Sigma' => q|$\Sigma$|, # greek capital letter sigma - 'Tau' => q|$\mathrm{T}$|, # greek capital letter tau - 'Upsilon' => q|$\Upsilon$|, # greek capital letter upsilon - 'Phi' => q|$\Phi$|, # greek capital letter phi - 'Chi' => q|$\mathrm{X}$|, # greek capital letter chi - 'Psi' => q|$\Psi$|, # greek capital letter psi - 'Omega' => q|$\Omega$|, # greek capital letter omega - - 'alpha' => q|$\alpha$|, # greek small letter alpha - 'beta' => q|$\beta$|, # greek small letter beta - 'gamma' => q|$\gamma$|, # greek small letter gamma - 'delta' => q|$\delta$|, # greek small letter delta - 'epsilon' => q|$\epsilon$|, # greek small letter epsilon - 'zeta' => q|$\zeta$|, # greek small letter zeta - 'eta' => q|$\eta$|, # greek small letter eta - 'theta' => q|$\theta$|, # greek small letter theta - 'iota' => q|$\iota$|, # greek small letter iota - 'kappa' => q|$\kappa$|, # greek small letter kappa - 'lambda' => q|$\lambda$|, # greek small letter lambda - 'mu' => q|$\mu$|, # greek small letter mu - 'nu' => q|$\nu$|, # greek small letter nu - 'xi' => q|$\xi$|, # greek small letter xi - 'omicron' => q|$o$|, # greek small letter omicron - 'pi' => q|$\pi$|, # greek small letter pi - 'rho' => q|$\rho$|, # greek small letter rho -# 'sigmaf' => q||, # greek small letter final sigma - 'sigma' => q|$\sigma$|, # greek small letter sigma - 'tau' => q|$\tau$|, # greek small letter tau - 'upsilon' => q|$\upsilon$|, # greek small letter upsilon - 'phi' => q|$\phi$|, # greek small letter phi - 'chi' => q|$\chi$|, # greek small letter chi - 'psi' => q|$\psi$|, # greek small letter psi - 'omega' => q|$\omega$|, # greek small letter omega -# 'thetasym' => q||, # greek small letter theta symbol -# 'upsih' => q||, # greek upsilon with hook symbol -# 'piv' => q||, # greek pi symbol - - # General Punctuation - 'bull' => q|\textbullet{}|, # bullet = black small circle - # bullet is NOT the same as bullet operator - 'hellip' => q|\textellipsis{}|, # horizontal ellipsis = three dot leader - 'prime' => q|\textquotesingle{}|, # prime = minutes = feet - 'Prime' => q|\textquotedbl{}|, # double prime = seconds = inches - 'oline' => q|\textasciimacron{}|, # overline = spacing overscore - 'frasl' => q|\textfractionsolidus{}|, # fraction slash - - # Letterlike Symbols - 'weierp' => q|$\wp$|, # script capital P = power set = Weierstrass p - 'image' => q|$\Re$|, # blackletter capital I = imaginary part - 'real' => q|$\Im$|, # blackletter capital R = real part symbol - 'trade' => q|\texttrademark{}|, # trade mark sign -# 'alefsym' => q||, # alef symbol = first transfinite cardinal - # alef symbol is NOT the same as hebrew letter alef, although the same - # glyph could be used to depict both characters - - # Arrows - 'larr' => q|\textleftarrow{}|, # leftwards arrow - 'uarr' => q|\textuparrow{}|, # upwards arrow - 'rarr' => q|\textrightarrow{}|, # rightwards arrow - 'darr' => q|\textdownarrow{}|, # downwards arrow - 'harr' => q|$\leftrightarrow$|, # left right arrow -# 'crarr' => q||, # downwards arrow with corner leftwards = carriage return - 'lArr' => q|$\Leftarrow$|, # leftwards double arrow - # ISO 10646 does not say that lArr is the same as the 'is implied by' - # arrow but also does not have any other character for that function. So - # lArr can be used for 'is implied by' as ISOtech suggests - 'uArr' => q|$\Uparrow$|, # upwards double arrow - 'rArr' => q|$\Rightarrow$|, # rightwards double arrow - # ISO 10646 does not say this is the 'implies' character but does not - # have another character with this function so ? rArr can be used for - # 'implies' as ISOtech suggests - 'dArr' => q|$\Downarrow$|, # downwards double arrow - 'hArr' => q|$\Leftrightarrow$|, # left right double arrow - - # Mathematical Operators. - # Some of these require the `amssymb' package. - 'forall' => q|$\forall$|, # for all - 'part' => q|$\partial$|, # partial differential - 'exist' => q|$\exists$|, # there exists - 'empty' => q|$\emptyset$|, # empty set = null set = diameter - 'nabla' => q|$\nabla$|, # nabla = backward difference - 'isin' => q|$\in$|, # element of - 'notin' => q|$\notin$|, # not an element of - 'ni' => q|$\ni$|, # contains as member - 'prod' => q|$\prod$|, # n-ary product = product sign - # prod is NOT the same character as 'greek capital letter pi' though the - # same glyph might be used for both - 'sum' => q|$\sum$|, # n-ary sumation - # sum is NOT the same character as 'greek capital letter sigma' though - # the same glyph might be used for both - 'minus' => q|$-$|, # minus sign - 'lowast' => q|$\ast$|, # asterisk operator - 'radic' => q|$\surd$|, # square root = radical sign - 'prop' => q|$\propto$|, # proportional to - 'infin' => q|$\infty$|, # infinity - 'ang' => q|$\angle$|, # angle - 'and' => q|$\wedge$|, # logical and = wedge - 'or' => q|$\vee$|, # logical or = vee - 'cap' => q|$\cap$|, # intersection = cap - 'cup' => q|$\cup$|, # union = cup - 'int' => q|$\int$|, # integral - 'there4' => q|$\therefore$|, # therefore - 'sim' => q|$\sim$|, # tilde operator = varies with = similar to - # tilde operator is NOT the same character as the tilde - 'cong' => q|$\cong$|, # approximately equal to - 'asymp' => q|$\asymp$|, # almost equal to = asymptotic to - 'ne' => q|$\neq$|, # not equal to - 'equiv' => q|$\equiv$|, # identical to - 'le' => q|$\leq$|, # less-than or equal to - 'ge' => q|$\geq$|, # greater-than or equal to - 'sub' => q|$\subset$|, # subset of - 'sup' => q|$\supset$|, # superset of - # note that nsup, 'not a superset of' is not covered by the Symbol font - # encoding and is not included. - 'nsub' => q|$\not\subset$|, # not a subset of - 'sube' => q|$\subseteq$|, # subset of or equal to - 'supe' => q|$\supseteq$|, # superset of or equal to - 'oplus' => q|$\oplus$|, # circled plus = direct sum - 'otimes' => q|$\otimes$|, # circled times = vector product - 'perp' => q|$\perp$|, # up tack = orthogonal to = perpendicular - 'sdot' => q|$\cdot$|, # dot operator - # dot operator is NOT the same character as middle dot - - # Miscellaneous Technical - 'lceil' => q|$\lceil$|, # left ceiling = apl upstile - 'rceil' => q|$\rceil$|, # right ceiling - 'lfloor' => q|$\lfloor$|, # left floor = apl downstile - 'rfloor' => q|$\rfloor$|, # right floor - 'lang' => q|$\langle$|, # left-pointing angle bracket = bra - # lang is NOT the same character as 'less than' or 'single left-pointing - # angle quotation mark' - 'rang' => q|$\rangle$|, # right-pointing angle bracket = ket - # rang is NOT the same character as 'greater than' or 'single - # right-pointing angle quotation mark' - - # Geometric Shapes - 'loz' => q|$\lozenge$|, # lozenge - - # Miscellaneous Symbols - 'spades' => q|$\spadesuit$|, # black spade suit - 'clubs' => q|$\clubsuit$|, # black club suit = shamrock - 'hearts' => q|$\heartsuit$|, # black heart suit = valentine - 'diams' => q|$\diamondsuit$|, # black diamond suit - - # C0 Controls and Basic Latin - 'quot' => q|"|, # quotation mark = APL quote ["] - 'amp' => q|\&|, # ampersand - 'lt' => q|<|, # less-than sign - 'gt' => q|>|, # greater-than sign - 'OElig' => q|\OE{}|, # latin capital ligature OE - 'oelig' => q|\oe{}|, # latin small ligature oe - 'Scaron' => q|\v{S}|, # latin capital letter S with caron - 'scaron' => q|\v{s}|, # latin small letter s with caron - 'Yuml' => q|\"Y|, # latin capital letter Y with diaeresis - 'circ' => q|\textasciicircum{}|, # modifier letter circumflex accent - 'tilde' => q|\textasciitilde{}|, # small tilde - 'ensp' => q|\phantom{n}|, # en space - 'emsp' => q|\hspace{1em}|, # em space - 'thinsp' => q|\,|, # thin space - 'zwnj' => q|{}|, # zero width non-joiner -# 'zwj' => q||, # zero width joiner -# 'lrm' => q||, # left-to-right mark -# 'rlm' => q||, # right-to-left mark - 'ndash' => q|--|, # en dash - 'mdash' => q|---|, # em dash - 'lsquo' => q|\textquoteleft{}|, # left single quotation mark - 'rsquo' => q|\textquoteright{}|, # right single quotation mark - 'sbquo' => q|\quotesinglbase{}|, # single low-9 quotation mark - 'ldquo' => q|\textquotedblleft{}|, # left double quotation mark - 'rdquo' => q|\textquotedblright{}|, # right double quotation mark - 'bdquo' => q|\quotedblbase{}|, # double low-9 quotation mark - 'dagger' => q|\textdagger{}|, # dagger - 'Dagger' => q|\textdaggerdbl{}|, # double dagger - 'permil' => q|\textperthousand{}|, # per mille sign - 'lsaquo' => q|\guilsinglleft{}|, # single left-pointing angle quotation mark - 'rsaquo' => q|\guilsinglright{}|, # single right-pointing angle quotation mark - 'euro' => q|\texteuro{}|, # euro sign -); - -=head1 OBJECT METHODS - -The following methods are provided in this module. Methods inherited -from C<Pod::Select> are not described in the public interface. - -=over 4 - -=begin __PRIVATE__ - -=item C<initialize> - -Initialise the object. This method is subclassed from C<Pod::Parser>. -The base class method is invoked. This method defines the default -behaviour of the object unless overridden by supplying arguments to -the constructor. - -Internal settings are defaulted as well as the public instance data. -Internal hash values are accessed directly (rather than through -a method) and start with an underscore. - -This method should not be invoked by the user directly. - -=end __PRIVATE__ - -=cut - - - -# - An array for nested lists - -# Arguments have already been read by this point - -sub initialize { - my $self = shift; - - # print Dumper($self); - - # Internals - $self->{_Lists} = []; # For nested lists - $self->{_suppress_all_para} = 0; # For =begin blocks - $self->{_dont_modify_any_para}=0; # For =begin blocks - $self->{_CURRENT_HEAD1} = ''; # Name of current HEAD1 section - - # Options - only initialise if not already set - - # Cause the '=head1 NAME' field to be treated specially - # The contents of the NAME paragraph will be converted - # to a section title. All subsequent =head1 will be converted - # to =head2 and down. Will not affect =head1's prior to NAME - # Assumes: 'Module - purpose' format - # Also creates a purpose field - # The name is used for Labeling of the subsequent subsections - $self->{ReplaceNAMEwithSection} = 0 - unless exists $self->{ReplaceNAMEwithSection}; - $self->{AddPreamble} = 1 # make full latex document - unless exists $self->{AddPreamble}; - $self->{StartWithNewPage} = 0 # Start new page for pod section - unless exists $self->{StartWithNewPage}; - $self->{TableOfContents} = 0 # Add table of contents - unless exists $self->{TableOfContents}; # only relevent if AddPreamble=1 - $self->{AddPostamble} = 1 # Add closing latex code at end - unless exists $self->{AddPostamble}; # effectively end{document} and index - $self->{MakeIndex} = 1 # Add index (only relevant AddPostamble - unless exists $self->{MakeIndex}; # and AddPreamble) - - $self->{UniqueLabels} = 1 # Use label unique for each pod - unless exists $self->{UniqueLabels}; # either based on the filename - # or supplied - - # Control the level of =head1. default is \section - # - $self->{Head1Level} = 1 # Offset in latex sections - unless exists $self->{Head1Level}; # 0 is chapter, 2 is subsection - - # Control at which level numbering of sections is turned off - # ie subsection becomes subsection* - # The numbering is relative to the latex sectioning commands - # and is independent of Pod heading level - # default is to number \section but not \subsection - $self->{LevelNoNum} = 2 - unless exists $self->{LevelNoNum}; - - # Label to be used as prefix to all internal section names - # If not defined will attempt to derive it from the filename - # This can not happen when running parse_from_filehandle though - # hence the ability to set the label externally - # The label could then be Pod::Parser_DESCRIPTION or somesuch - - $self->{Label} = undef # label to be used as prefix - unless exists $self->{Label}; # to all internal section names - - # These allow the caller to add arbritrary latex code to - # start and end of document. AddPreamble and AddPostamble are ignored - # if these are set. - # Also MakeIndex and TableOfContents are also ignored. - $self->{UserPreamble} = undef # User supplied start (AddPreamble =1) - unless exists $self->{Label}; - $self->{UserPostamble} = undef # Use supplied end (AddPostamble=1) - unless exists $self->{Label}; - - # Run base initialize - $self->SUPER::initialize; - -} - -=back - -=head2 Data Accessors - -The following methods are provided for accessing instance data. These -methods should be used for accessing configuration parameters rather -than assuming the object is a hash. - -Default values can be supplied by using these names as keys to a hash -of arguments when using the C<new()> constructor. - -=over 4 - -=item B<AddPreamble> - -Logical to control whether a C<latex> preamble is to be written. -If true, a valid C<latex> preamble is written before the pod data is written. -This is similar to: - - \documentclass{article} - \usepackage[T1]{fontenc} - \usepackage{textcomp} - \begin{document} - -but will be more complicated if table of contents and indexing are required. -Can be used to set or retrieve the current value. - - $add = $parser->AddPreamble(); - $parser->AddPreamble(1); - -If used in conjunction with C<AddPostamble> a full latex document will -be written that could be immediately processed by C<latex>. - -For some pod escapes it may be necessary to include the amsmath -package. This is not yet added to the preamble automatically. - -=cut - -sub AddPreamble { - my $self = shift; - if (@_) { - $self->{AddPreamble} = shift; - } - return $self->{AddPreamble}; -} - -=item B<AddPostamble> - -Logical to control whether a standard C<latex> ending is written to the output -file after the document has been processed. -In its simplest form this is simply: - - \end{document} - -but can be more complicated if a index is required. -Can be used to set or retrieve the current value. - - $add = $parser->AddPostamble(); - $parser->AddPostamble(1); - -If used in conjunction with C<AddPreaamble> a full latex document will -be written that could be immediately processed by C<latex>. - -=cut - -sub AddPostamble { - my $self = shift; - if (@_) { - $self->{AddPostamble} = shift; - } - return $self->{AddPostamble}; -} - -=item B<Head1Level> - -The C<latex> sectioning level that should be used to correspond to -a pod C<=head1> directive. This can be used, for example, to turn -a C<=head1> into a C<latex> C<subsection>. This should hold a number -corresponding to the required position in an array containing the -following elements: - - [0] chapter - [1] section - [2] subsection - [3] subsubsection - [4] paragraph - [5] subparagraph - -Can be used to set or retrieve the current value: - - $parser->Head1Level(2); - $sect = $parser->Head1Level; - -Setting this number too high can result in sections that may not be reproducible -in the expected way. For example, setting this to 4 would imply that C<=head3> -do not have a corresponding C<latex> section (C<=head1> would correspond to -a C<paragraph>). - -A check is made to ensure that the supplied value is an integer in the -range 0 to 5. - -Default is for a value of 1 (i.e. a C<section>). - -=cut - -sub Head1Level { - my $self = shift; - if (@_) { - my $arg = shift; - if ($arg =~ /^\d$/ && $arg <= $#LatexSections) { - $self->{Head1Level} = $arg; - } else { - carp "Head1Level supplied ($arg) must be integer in range 0 to ".$#LatexSections . "- Ignoring\n"; - } - } - return $self->{Head1Level}; -} - -=item B<Label> - -This is the label that is prefixed to all C<latex> label and index -entries to make them unique. In general, pods have similarly titled -sections (NAME, DESCRIPTION etc) and a C<latex> label will be multiply -defined if more than one pod document is to be included in a single -C<latex> file. To overcome this, this label is prefixed to a label -whenever a label is required (joined with an underscore) or to an -index entry (joined by an exclamation mark which is the normal index -separator). For example, C<\label{text}> becomes C<\label{Label_text}>. - -Can be used to set or retrieve the current value: - - $label = $parser->Label; - $parser->Label($label); - -This label is only used if C<UniqueLabels> is true. -Its value is set automatically from the C<NAME> field -if C<ReplaceNAMEwithSection> is true. If this is not the case -it must be set manually before starting the parse. - -Default value is C<undef>. - -=cut - -sub Label { - my $self = shift; - if (@_) { - $self->{Label} = shift; - } - return $self->{Label}; -} - -=item B<LevelNoNum> - -Control the point at which C<latex> section numbering is turned off. -For example, this can be used to make sure that C<latex> sections -are numbered but subsections are not. - -Can be used to set or retrieve the current value: - - $lev = $parser->LevelNoNum; - $parser->LevelNoNum(2); - -The argument must be an integer between 0 and 5 and is the same as the -number described in C<Head1Level> method description. The number has -nothing to do with the pod heading number, only the C<latex> sectioning. - -Default is 2. (i.e. C<latex> subsections are written as C<subsection*> -but sections are numbered). - -=cut - -sub LevelNoNum { - my $self = shift; - if (@_) { - $self->{LevelNoNum} = shift; - } - return $self->{LevelNoNum}; -} - -=item B<MakeIndex> - -Controls whether C<latex> commands for creating an index are to be inserted -into the preamble and postamble - - $makeindex = $parser->MakeIndex; - $parser->MakeIndex(0); - -Irrelevant if both C<AddPreamble> and C<AddPostamble> are false (or equivalently, -C<UserPreamble> and C<UserPostamble> are set). - -Default is for an index to be created. - -=cut - -sub MakeIndex { - my $self = shift; - if (@_) { - $self->{MakeIndex} = shift; - } - return $self->{MakeIndex}; -} - -=item B<ReplaceNAMEwithSection> - -This controls whether the C<NAME> section in the pod is to be translated -literally or converted to a slightly modified output where the section -name is the pod name rather than "NAME". - -If true, the pod segment - - =head1 NAME - - pod::name - purpose - - =head1 SYNOPSIS - -is converted to the C<latex> - - \section{pod::name\label{pod_name}\index{pod::name}} - - Purpose - - \subsection*{SYNOPSIS\label{pod_name_SYNOPSIS}% - \index{pod::name!SYNOPSIS}} - -(dependent on the value of C<Head1Level> and C<LevelNoNum>). Note that -subsequent C<head1> directives translate to subsections rather than -sections and that the labels and index now include the pod name (dependent -on the value of C<UniqueLabels>). - -The C<Label> is set from the pod name regardless of any current value -of C<Label>. - - $mod = $parser->ReplaceNAMEwithSection; - $parser->ReplaceNAMEwithSection(0); - -Default is to translate the pod literally. - -=cut - -sub ReplaceNAMEwithSection { - my $self = shift; - if (@_) { - $self->{ReplaceNAMEwithSection} = shift; - } - return $self->{ReplaceNAMEwithSection}; -} - -=item B<StartWithNewPage> - -If true, each pod translation will begin with a C<latex> -C<\clearpage>. - - $parser->StartWithNewPage(1); - $newpage = $parser->StartWithNewPage; - -Default is false. - -=cut - -sub StartWithNewPage { - my $self = shift; - if (@_) { - $self->{StartWithNewPage} = shift; - } - return $self->{StartWithNewPage}; -} - -=item B<TableOfContents> - -If true, a table of contents will be created. -Irrelevant if C<AddPreamble> is false or C<UserPreamble> -is set. - - $toc = $parser->TableOfContents; - $parser->TableOfContents(1); - -Default is false. - -=cut - -sub TableOfContents { - my $self = shift; - if (@_) { - $self->{TableOfContents} = shift; - } - return $self->{TableOfContents}; -} - -=item B<UniqueLabels> - -If true, the translator will attempt to make sure that -each C<latex> label or index entry will be uniquely identified -by prefixing the contents of C<Label>. This allows -multiple documents to be combined without clashing -common labels such as C<DESCRIPTION> and C<SYNOPSIS> - - $parser->UniqueLabels(1); - $unq = $parser->UniqueLabels; - -Default is true. - -=cut - -sub UniqueLabels { - my $self = shift; - if (@_) { - $self->{UniqueLabels} = shift; - } - return $self->{UniqueLabels}; -} - -=item B<UserPreamble> - -User supplied C<latex> preamble. Added before the pod translation -data. - -If set, the contents will be prepended to the output file before the translated -data regardless of the value of C<AddPreamble>. -C<MakeIndex> and C<TableOfContents> will also be ignored. - -=cut - -sub UserPreamble { - my $self = shift; - if (@_) { - $self->{UserPreamble} = shift; - } - return $self->{UserPreamble}; -} - -=item B<UserPostamble> - -User supplied C<latex> postamble. Added after the pod translation -data. - -If set, the contents will be prepended to the output file after the translated -data regardless of the value of C<AddPostamble>. -C<MakeIndex> will also be ignored. - -=cut - -sub UserPostamble { - my $self = shift; - if (@_) { - $self->{UserPostamble} = shift; - } - return $self->{UserPostamble}; -} - -=begin __PRIVATE__ - -=item B<Lists> - -Contains details of the currently active lists. - The array contains C<Pod::List> objects. A new C<Pod::List> -object is created each time a list is encountered and it is -pushed onto this stack. When the list context ends, it -is popped from the stack. The array will be empty if no -lists are active. - -Returns array of list information in list context -Returns array ref in scalar context - -=cut - - - -sub lists { - my $self = shift; - return @{ $self->{_Lists} } if wantarray(); - return $self->{_Lists}; -} - -=end __PRIVATE__ - -=back - -=begin __PRIVATE__ - -=head2 Subclassed methods - -The following methods override methods provided in the C<Pod::Select> -base class. See C<Pod::Parser> and C<Pod::Select> for more information -on what these methods require. - -=over 4 - -=cut - -######### END ACCESSORS ################### - -# Opening pod - -=item B<begin_pod> - -Writes the C<latex> preamble if requested. Only writes something -if AddPreamble is true. Writes a standard header unless a UserPreamble -is defined. - -=cut - -sub begin_pod { - my $self = shift; - - # Get the pod identification - # This should really come from the '=head1 NAME' paragraph - - my $infile = $self->input_file; - my $class = ref($self); - my $date = gmtime(time); - - # Comment message to say where this came from - my $comment = << "__TEX_COMMENT__"; -%% Latex generated from POD in document $infile -%% Using the perl module $class -%% Converted on $date -__TEX_COMMENT__ - - # Write the preamble - # If the caller has supplied one then we just use that - - my $preamble = ''; - - if ($self->AddPreamble) { - - if (defined $self->UserPreamble) { - - $preamble = $self->UserPreamble; - - # Add the description of where this came from - $preamble .= "\n$comment\n%% Preamble supplied by user.\n\n"; - - } else { - - # Write our own preamble - - # Code to initialise index making - # Use an array so that we can prepend comment if required - my @makeidx = ( - '\usepackage{makeidx}', - '\makeindex', - ); - - unless ($self->MakeIndex) { - foreach (@makeidx) { - $_ = '%% ' . $_; - } - } - my $makeindex = join("\n",@makeidx) . "\n"; - - # Table of contents - my $tableofcontents = '\tableofcontents'; - - $tableofcontents = '%% ' . $tableofcontents - unless $self->TableOfContents; - - # Roll our own - $preamble = << "__TEX_HEADER__"; -\\documentclass{article} -\\usepackage[T1]{fontenc} -\\usepackage{textcomp} - -$comment - -$makeindex - -\\begin{document} - -$tableofcontents - -__TEX_HEADER__ - - } - } - - # Write the header (blank if none) - $self->_output($preamble); - - # Start on new page if requested - $self->_output("\\clearpage\n") if $self->StartWithNewPage; - -} - - -=item B<end_pod> - -Write the closing C<latex> code. Only writes something if AddPostamble -is true. Writes a standard header unless a UserPostamble is defined. - -=cut - -sub end_pod { - my $self = shift; - - # End string - my $end = ''; - - # Use the user version of the postamble if defined - if ($self->AddPostamble) { - - if (defined $self->UserPostamble) { - $end = $self->UserPostamble; - - } else { - - # Check for index - my $makeindex = '\printindex'; - - $makeindex = '%% '. $makeindex unless $self->MakeIndex; - - $end = "$makeindex\n\n\\end{document}\n"; - } - } - - $self->_output($end); - -} - -=item B<command> - -Process basic pod commands. - -=cut - -sub command { - my $self = shift; - my ($command, $paragraph, $line_num, $parobj) = @_; - - # return if we dont care - return if $command eq 'pod'; - - # Store a copy of the raw text in case we are in a =for - # block and need to preserve the existing latex - my $rawpara = $paragraph; - - # Do the latex escapes - $paragraph = $self->_replace_special_chars($paragraph); - - # Interpolate pod sequences in paragraph - $paragraph = $self->interpolate($paragraph, $line_num); - $paragraph =~ s/\s+$//; - - # Replace characters that can only be done after - # interpolation of interior sequences - $paragraph = $self->_replace_special_chars_late($paragraph); - - # Now run the command - if ($command eq 'over') { - - $self->begin_list($paragraph, $line_num); - - } elsif ($command eq 'item') { - - $self->add_item($paragraph, $line_num); - - } elsif ($command eq 'back') { - - $self->end_list($line_num); - - } elsif ($command eq 'head1') { - - # Store the name of the section - $self->{_CURRENT_HEAD1} = $paragraph; - - # Print it - $self->head(1, $paragraph, $parobj); - - } elsif ($command eq 'head2') { - - $self->head(2, $paragraph, $parobj); - - } elsif ($command eq 'head3') { - - $self->head(3, $paragraph, $parobj); - - } elsif ($command eq 'head4') { - - $self->head(4, $paragraph, $parobj); - - } elsif ($command eq 'head5') { - - $self->head(5, $paragraph, $parobj); - - } elsif ($command eq 'head6') { - - $self->head(6, $paragraph, $parobj); - - } elsif ($command eq 'begin') { - - # pass through if latex - if ($paragraph =~ /^latex/i) { - # Make sure that subsequent paragraphs are not modfied before printing - $self->{_dont_modify_any_para} = 1; - - } else { - # Suppress all subsequent paragraphs unless - # it is explcitly intended for latex - $self->{_suppress_all_para} = 1; - } - - } elsif ($command eq 'for') { - - # =for latex - # some latex - - # With =for we will get the text for the full paragraph - # as well as the format name. - # We do not get an additional paragraph later on. The next - # paragraph is not governed by the =for - - # The first line contains the format and the rest is the - # raw code. - my ($format, $chunk) = split(/\n/, $rawpara, 2); - - # If we have got some latex code print it out immediately - # unmodified. Else do nothing. - if ($format =~ /^latex/i) { - # Make sure that next paragraph is not modfied before printing - $self->_output( $chunk ); - - } - - } elsif ($command eq 'end') { - - # Reset suppression - $self->{_suppress_all_para} = 0; - $self->{_dont_modify_any_para} = 0; - - } elsif ($command eq 'pod') { - - # Do nothing - - } else { - carp "Command $command not recognised at line $line_num\n"; - } - -} - -=item B<verbatim> - -Verbatim text - -=cut - -sub verbatim { - my $self = shift; - my ($paragraph, $line_num, $parobj) = @_; - - # Expand paragraph unless in =begin block - if ($self->{_dont_modify_any_para}) { - # Just print as is - $self->_output($paragraph); - - } else { - - return if $paragraph =~ /^\s+$/; - - # Clean trailing space - $paragraph =~ s/\s+$//; - - # Clean tabs. Routine taken from Tabs.pm - # by David Muir Sharnoff muir@idiom.com, - # slightly modified by hsmyers@sdragons.com 10/22/01 - my @l = split("\n",$paragraph); - foreach (@l) { - 1 while s/(^|\n)([^\t\n]*)(\t+)/ - $1. $2 . (" " x - (8 * length($3) - - (length($2) % 8))) - /sex; - } - $paragraph = join("\n",@l); - # End of change. - - - - $self->_output('\begin{verbatim}' . "\n$paragraph\n". '\end{verbatim}'."\n"); - } -} - -=item B<textblock> - -Plain text paragraph. - -=cut - -sub textblock { - my $self = shift; - my ($paragraph, $line_num, $parobj) = @_; - - # print Dumper($self); - - # Expand paragraph unless in =begin block - if ($self->{_dont_modify_any_para}) { - # Just print as is - $self->_output($paragraph); - - return; - } - - - # Escape latex special characters - $paragraph = $self->_replace_special_chars($paragraph); - - # Interpolate interior sequences - my $expansion = $self->interpolate($paragraph, $line_num); - $expansion =~ s/\s+$//; - - # Escape special characters that can not be done earlier - $expansion = $self->_replace_special_chars_late($expansion); - - # If we are replacing 'head1 NAME' with a section - # we need to look in the paragraph and rewrite things - # Need to make sure this is called only on the first paragraph - # following 'head1 NAME' and not on subsequent paragraphs that may be - # present. - if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection()) { - - # Strip white space from start and end - $paragraph =~ s/^\s+//; - $paragraph =~ s/\s$//; - - # Split the string into 2 parts - my ($name, $purpose) = split(/\s+-\s+/, $expansion,2); - - # Now prevent this from triggering until a new head1 NAME is set - $self->{_CURRENT_HEAD1} = '_NAME'; - - # Might want to clear the Label() before doing this (CHECK) - - # Print the heading - $self->head(1, $name, $parobj); - - # Set the labeling in case we want unique names later - $self->Label( $self->_create_label( $name, 1 ) ); - - # Raise the Head1Level by one so that subsequent =head1 appear - # as subsections of the main name section unless we are already - # at maximum [Head1Level() could check this itself - CHECK] - $self->Head1Level( $self->Head1Level() + 1) - unless $self->Head1Level == $#LatexSections; - - # Now write out the new latex paragraph - $purpose = ucfirst($purpose); - $self->_output("\n\n$purpose\n\n"); - - } else { - # Just write the output - $self->_output("\n\n$expansion\n\n"); - } - -} - -=item B<interior_sequence> - -Interior sequence expansion - -=cut - -sub interior_sequence { - my $self = shift; - - my ($seq_command, $seq_argument, $pod_seq) = @_; - - if ($seq_command eq 'B') { - return "\\textbf{$seq_argument}"; - - } elsif ($seq_command eq 'I') { - return "\\textit{$seq_argument}"; - - } elsif ($seq_command eq 'E') { - - # If it is simply a number - if ($seq_argument =~ /^\d+$/) { - return chr($seq_argument); - # Look up escape in hash table - } elsif (exists $HTML_Escapes{$seq_argument}) { - return $HTML_Escapes{$seq_argument}; - - } else { - my ($file, $line) = $pod_seq->file_line(); - warn "Escape sequence $seq_argument not recognised at line $line of file $file\n"; - return; - } - - } elsif ($seq_command eq 'Z') { - - # Zero width space - return '{}'; - - } elsif ($seq_command eq 'C') { - return "\\texttt{$seq_argument}"; - - } elsif ($seq_command eq 'F') { - return "\\emph{$seq_argument}"; - - } elsif ($seq_command eq 'S') { - # non breakable spaces - my $nbsp = '~'; - - $seq_argument =~ s/\s/$nbsp/g; - return $seq_argument; - - } elsif ($seq_command eq 'L') { - my $link = new Pod::Hyperlink($seq_argument); - - # undef on failure - unless (defined $link) { - carp $@; - return; - } - - # Handle internal links differently - my $type = $link->type; - my $page = $link->page; - - if ($type eq 'section' && $page eq '') { - # Use internal latex reference - my $node = $link->node; - - # Convert to a label - $node = $self->_create_label($node); - - return "\\S\\ref{$node}"; - - } else { - # Use default markup for external references - # (although Starlink would use \xlabel) - my $markup = $link->markup; - my ($file, $line) = $pod_seq->file_line(); - - return $self->interpolate($link->markup, $line); - } - - - - } elsif ($seq_command eq 'P') { - # Special markup for Pod::Hyperlink - # Replace :: with / - but not sure if I want to do this - # any more. - my $link = $seq_argument; - $link =~ s|::|/|g; - - my $ref = "\\emph{$seq_argument}"; - return $ref; - - } elsif ($seq_command eq 'Q') { - # Special markup for Pod::Hyperlink - return "\\textsf{$seq_argument}"; - - } elsif ($seq_command eq 'X') { - # Index entries - - # use \index command - # I will let '!' go through for now - # not sure how sub categories are handled in X<> - my $index = $self->_create_index($seq_argument); - return "\\index{$index}\n"; - - } else { - carp "Unknown sequence $seq_command<$seq_argument>"; - } - -} - -=back - -=head2 List Methods - -Methods used to handle lists. - -=over 4 - -=item B<begin_list> - -Called when a new list is found (via the C<over> directive). -Creates a new C<Pod::List> object and stores it on the -list stack. - - $parser->begin_list($indent, $line_num); - -=cut - -sub begin_list { - my $self = shift; - my $indent = shift; - my $line_num = shift; - - # Indicate that a list should be started for the next item - # need to do this to work out the type of list - push ( @{$self->lists}, new Pod::List(-indent => $indent, - -start => $line_num, - -file => $self->input_file, - ) - ); - -} - -=item B<end_list> - -Called when the end of a list is found (the C<back> directive). -Pops the C<Pod::List> object off the stack of lists and writes -the C<latex> code required to close a list. - - $parser->end_list($line_num); - -=cut - -sub end_list { - my $self = shift; - my $line_num = shift; - - unless (defined $self->lists->[-1]) { - my $file = $self->input_file; - warn "No list is active at line $line_num (file=$file). Missing =over?\n"; - return; - } - - # What to write depends on list type - my $type = $self->lists->[-1]->type; - - # Dont write anything if the list type is not set - # iomplying that a list was created but no entries were - # placed in it (eg because of a =begin/=end combination) - $self->_output("\\end{$type}\n") - if (defined $type && length($type) > 0); - - # Clear list - pop(@{ $self->lists}); - -} - -=item B<add_item> - -Add items to the list. The first time an item is encountered -(determined from the state of the current C<Pod::List> object) -the type of list is determined (ordered, unnumbered or description) -and the relevant latex code issued. - - $parser->add_item($paragraph, $line_num); - -=cut - -sub add_item { - my $self = shift; - my $paragraph = shift; - my $line_num = shift; - - unless (defined $self->lists->[-1]) { - my $file = $self->input_file; - warn "List has already ended by line $line_num of file $file. Missing =over?\n"; - # Replace special chars -# $paragraph = $self->_replace_special_chars($paragraph); - $self->_output("$paragraph\n\n"); - return; - } - - # If paragraphs printing is turned off via =begin/=end or whatver - # simply return immediately - return if $self->{_suppress_all_para}; - - # Check to see whether we are starting a new lists - if (scalar($self->lists->[-1]->item) == 0) { - - # Examine the paragraph to determine what type of list - # we have - $paragraph =~ s/\s+$//; - $paragraph =~ s/^\s+//; - - my $type; - if (substr($paragraph, 0,1) eq '*') { - $type = 'itemize'; - } elsif ($paragraph =~ /^\d/) { - $type = 'enumerate'; - } else { - $type = 'description'; - } - $self->lists->[-1]->type($type); - - $self->_output("\\begin{$type}\n"); - - } - - my $type = $self->lists->[-1]->type; - - if ($type eq 'description') { - # Handle long items - long items do not wrap - # If the string is longer than 40 characters we split - # it into a real item header and some bold text. - my $maxlen = 40; - my ($hunk1, $hunk2) = $self->_split_delimited( $paragraph, $maxlen ); - - # Print the first hunk - $self->_output("\n\\item[{$hunk1}] "); - - # and the second hunk if it is defined - if ($hunk2) { - $self->_output("\\textbf{$hunk2}"); - } else { - # Not there so make sure we have a new line - $self->_output("\\mbox{}"); - } - - } else { - # If the item was '* Something' or '\d+ something' we still need to write - # out the something. Also allow 1) and 1. - my $extra_info = $paragraph; - $extra_info =~ s/^(\*|\d+[\.\)]?)\s*//; - $self->_output("\n\\item $extra_info"); - } - - # Store the item name in the object. Required so that - # we can tell if the list is new or not - $self->lists->[-1]->item($paragraph); - -} - -=back - -=head2 Methods for headings - -=over 4 - -=item B<head> - -Print a heading of the required level. - - $parser->head($level, $paragraph, $parobj); - -The first argument is the pod heading level. The second argument -is the contents of the heading. The 3rd argument is a Pod::Paragraph -object so that the line number can be extracted. - -=cut - -sub head { - my $self = shift; - my $num = shift; - my $paragraph = shift; - my $parobj = shift; - - # If we are replace 'head1 NAME' with a section - # we return immediately if we get it - return - if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection()); - - # Create a label - my $label = $self->_create_label($paragraph); - - # Create an index entry - my $index = $self->_create_index($paragraph); - - # Work out position in the above array taking into account - # that =head1 is equivalent to $self->Head1Level - - my $level = $self->Head1Level() - 1 + $num; - - # Warn if heading to large - if ($num > $#LatexSections) { - my $line = $parobj->file_line; - my $file = $self->input_file; - warn "Heading level too large ($level) for LaTeX at line $line of file $file\n"; - $level = $#LatexSections; - } - - # Check to see whether section should be unnumbered - my $star = ($level >= $self->LevelNoNum ? '*' : ''); - - # Section - $self->_output("\\" .$LatexSections[$level] .$star ."{$paragraph\\label{".$label ."}\\index{".$index."}}\n"); - -} - - -=back - -=end __PRIVATE__ - -=begin __PRIVATE__ - -=head2 Internal methods - -Internal routines are described in this section. They do not form part of the -public interface. All private methods start with an underscore. - -=over 4 - -=item B<_output> - -Output text to the output filehandle. This method must be always be called -to output parsed text. - - $parser->_output($text); - -Does not write anything if a =begin is active that should be -ignored. - -=cut - -sub _output { - my $self = shift; - my $text = shift; - - print { $self->output_handle } $text - unless $self->{_suppress_all_para}; - -} - - -=item B<_replace_special_chars> - -Subroutine to replace characters that are special in C<latex> -with the escaped forms - - $escaped = $parser->_replace_special_chars($paragraph); - -Need to call this routine before interior_sequences are munged but not -if verbatim. It must be called before interpolation of interior -sequences so that curly brackets and special latex characters inserted -during interpolation are not themselves escaped. This means that < and -> can not be modified here since the text still contains interior -sequences. - -Special characters and the C<latex> equivalents are: - - } \} - { \{ - _ \_ - $ \$ - % \% - & \& - \ $\backslash$ - ^ \^{} - ~ \~{} - # \# - -=cut - -sub _replace_special_chars { - my $self = shift; - my $paragraph = shift; - - # Replace a \ with $\backslash$ - # This is made more complicated because the dollars will be escaped - # by the subsequent replacement. Easiest to add \backslash - # now and then add the dollars - $paragraph =~ s/\\/\\backslash/g; - - # Must be done after escape of \ since this command adds latex escapes - # Replace characters that can be escaped - $paragraph =~ s/([\$\#&%_{}])/\\$1/g; - - # Replace ^ characters with \^{} so that $^F works okay - $paragraph =~ s/(\^)/\\$1\{\}/g; - - # Replace tilde (~) with \texttt{\~{}} - $paragraph =~ s/~/\\texttt\{\\~\{\}\}/g; - - # Now add the dollars around each \backslash - $paragraph =~ s/(\\backslash)/\$$1\$/g; - return $paragraph; -} - -=item B<_replace_special_chars_late> - -Replace special characters that can not be replaced before interior -sequence interpolation. See C<_replace_special_chars> for a routine -to replace special characters prior to interpolation of interior -sequences. - -Does the following transformation: - - < $<$ - > $>$ - | $|$ - - -=cut - -sub _replace_special_chars_late { - my $self = shift; - my $paragraph = shift; - - # < and > - $paragraph =~ s/(<|>)/\$$1\$/g; - - # Replace | with $|$ - $paragraph =~ s'\|'$|$'g; - - - return $paragraph; -} - - -=item B<_create_label> - -Return a string that can be used as an internal reference -in a C<latex> document (i.e. accepted by the C<\label> command) - - $label = $parser->_create_label($string) - -If UniqueLabels is true returns a label prefixed by Label() -This can be suppressed with an optional second argument. - - $label = $parser->_create_label($string, $suppress); - -If a second argument is supplied (of any value including undef) -the Label() is never prefixed. This means that this routine can -be called to create a Label() without prefixing a previous setting. - -=cut - -sub _create_label { - my $self = shift; - my $paragraph = shift; - my $suppress = (@_ ? 1 : 0 ); - - # Remove latex commands - $paragraph = $self->_clean_latex_commands($paragraph); - - # Remove non alphanumerics from the label and replace with underscores - # want to protect '-' though so use negated character classes - $paragraph =~ s/[^-:\w]/_/g; - - # Multiple underscores will look unsightly so remove repeats - # This will also have the advantage of tidying up the end and - # start of string - $paragraph =~ s/_+/_/g; - - # If required need to make sure that the label is unique - # since it is possible to have multiple pods in a single - # document - if (!$suppress && $self->UniqueLabels() && defined $self->Label) { - $paragraph = $self->Label() .'_'. $paragraph; - } - - return $paragraph; -} - - -=item B<_create_index> - -Similar to C<_create_label> except an index entry is created. -If C<UniqueLabels> is true, the index entry is prefixed by -the current C<Label> and an exclamation mark. - - $ind = $parser->_create_index($paragraph); - -An exclamation mark is used by C<makeindex> to generate -sub-entries in an index. - -=cut - -sub _create_index { - my $self = shift; - my $paragraph = shift; - my $suppress = (@_ ? 1 : 0 ); - - # Remove latex commands - $paragraph = $self->_clean_latex_commands($paragraph); - - # If required need to make sure that the index entry is unique - # since it is possible to have multiple pods in a single - # document - if (!$suppress && $self->UniqueLabels() && defined $self->Label) { - $paragraph = $self->Label() .'!'. $paragraph; - } - - # Need to replace _ with space - $paragraph =~ s/_/ /g; - - return $paragraph; - -} - -=item B<_clean_latex_commands> - -Removes latex commands from text. The latex command is assumed to be of the -form C<\command{ text }>. "C<text>" is retained - - $clean = $parser->_clean_latex_commands($text); - -=cut - -sub _clean_latex_commands { - my $self = shift; - my $paragraph = shift; - - # Remove latex commands of the form \text{ } - # and replace with the contents of the { } - # need to make this non-greedy so that it can handle - # "\text{a} and \text2{b}" - # without converting it to - # "a} and \text2{b" - # This match will still get into trouble if \} is present - # This is not vital since the subsequent replacement of non-alphanumeric - # characters will tidy it up anyway - $paragraph =~ s/\\\w+{(.*?)}/$1/g; - - return $paragraph -} - -=item B<_split_delimited> - -Split the supplied string into two parts at approximately the -specified word boundary. Special care is made to make sure that it -does not split in the middle of some curly brackets. - -e.g. "this text is \textbf{very bold}" would not be split into -"this text is \textbf{very" and " bold". - - ($hunk1, $hunk2) = $self->_split_delimited( $para, $length); - -The length indicates the maximum length of hunk1. - -=cut - -# initially Supplied by hsmyers@sdragons.com -# 10/25/01, utility to split \hbox -# busting lines. Reformatted by TimJ to match module style. -sub _split_delimited { - my $self = shift; - my $input = shift; - my $limit = shift; - - # Return immediately if already small - return ($input, '') if length($input) < $limit; - - my @output; - my $s = ''; - my $t = ''; - my $depth = 0; - my $token; - - $input =~ s/\n/ /gm; - $input .= ' '; - foreach ( split ( //, $input ) ) { - $token .= $_; - if (/\{/) { - $depth++; - } elsif ( /}/ ) { - $depth--; - } elsif ( / / and $depth == 0) { - push @output, $token if ( $token and $token ne ' ' ); - $token = ''; - } - } - - foreach (@output) { - if (length($s) < $limit) { - $s .= $_; - } else { - $t .= $_; - } - } - - # Tidy up - $s =~ s/\s+$//; - $t =~ s/\s+$//; - return ($s,$t); -} - -=back - -=end __PRIVATE__ - -=head1 NOTES - -Compatible with C<latex2e> only. Can not be used with C<latex> v2.09 -or earlier. - -A subclass of C<Pod::Select> so that specific pod sections can be -converted to C<latex> by using the C<select> method. - -Some HTML escapes are missing and many have not been tested. - -=head1 SEE ALSO - -L<Pod::Parser>, L<Pod::Select>, L<pod2latex> - -=head1 AUTHORS - -Tim Jenness E<lt>tjenness@cpan.orgE<gt> - -Bug fixes and improvements have been received from: Simon Cozens -E<lt>simon@cozens.netE<gt>, Mark A. Hershberger -E<lt>mah@everybody.orgE<gt>, Marcel Grunauer -E<lt>marcel@codewerk.comE<gt>, Hugh S Myers -E<lt>hsmyers@sdragons.comE<gt>, Peter J Acklam -E<lt>jacklam@math.uio.noE<gt>, Sudhi Herle E<lt>sudhi@herle.netE<gt>, -Ariel Scolnicov E<lt>ariels@compugen.co.ilE<gt>, -Adriano Rodrigues Ferreira E<lt>ferreira@triang.com.brE<gt> and -R. de Vries E<lt>r.de.vries@dutchspace.nlE<gt>. - - -=head1 COPYRIGHT - -Copyright (C) 2000-2004 Tim Jenness. All Rights Reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=begin __PRIVATE__ - -=head1 REVISION - -$Id: LaTeX.pm,v 1.19 2004/12/30 01:40:44 timj Exp $ - -=end __PRIVATE__ - -=cut - -1; diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Man.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Man.pm deleted file mode 100644 index 451ecc80f03..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Man.pm +++ /dev/null @@ -1,1701 +0,0 @@ -# Pod::Man -- Convert POD data to formatted *roff input. -# $Id: Man.pm,v 2.16 2007-11-29 01:35:53 eagle Exp $ -# -# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 -# Russ Allbery <rra@stanford.edu> -# Substantial contributions by Sean Burke <sburke@cpan.org> -# -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This module translates POD documentation into *roff markup using the man -# macro set, and is intended for converting POD documents written as Unix -# manual pages to manual pages that can be read by the man(1) command. It is -# a replacement for the pod2man command distributed with versions of Perl -# prior to 5.6. -# -# Perl core hackers, please note that this module is also separately -# maintained outside of the Perl core as part of the podlators. Please send -# me any patches at the address above in addition to sending them to the -# standard Perl mailing lists. - -############################################################################## -# Modules and declarations -############################################################################## - -package Pod::Man; - -require 5.005; - -use strict; -use subs qw(makespace); -use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); - -use Carp qw(croak); -use Pod::Simple (); -use POSIX qw(strftime); - -@ISA = qw(Pod::Simple); - -# Don't use the CVS revision as the version, since this module is also in Perl -# core and too many things could munge CVS magic revision strings. This -# number should ideally be the same as the CVS revision in podlators, however. -$VERSION = '2.16'; - -# Set the debugging level. If someone has inserted a debug function into this -# class already, use that. Otherwise, use any Pod::Simple debug function -# that's defined, and failing that, define a debug level of 10. -BEGIN { - my $parent = defined (&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG : undef; - unless (defined &DEBUG) { - *DEBUG = $parent || sub () { 10 }; - } -} - -# Import the ASCII constant from Pod::Simple. This is true iff we're in an -# ASCII-based universe (including such things as ISO 8859-1 and UTF-8), and is -# generally only false for EBCDIC. -BEGIN { *ASCII = \&Pod::Simple::ASCII } - -# Pretty-print a data structure. Only used for debugging. -BEGIN { *pretty = \&Pod::Simple::pretty } - -############################################################################## -# Object initialization -############################################################################## - -# Initialize the object and set various Pod::Simple options that we need. -# Here, we also process any additional options passed to the constructor or -# set up defaults if none were given. Note that all internal object keys are -# in all-caps, reserving all lower-case object keys for Pod::Simple and user -# arguments. -sub new { - my $class = shift; - my $self = $class->SUPER::new; - - # Tell Pod::Simple to handle S<> by automatically inserting . - $self->nbsp_for_S (1); - - # Tell Pod::Simple to keep whitespace whenever possible. - if ($self->can ('preserve_whitespace')) { - $self->preserve_whitespace (1); - } else { - $self->fullstop_space_harden (1); - } - - # The =for and =begin targets that we accept. - $self->accept_targets (qw/man MAN roff ROFF/); - - # Ensure that contiguous blocks of code are merged together. Otherwise, - # some of the guesswork heuristics don't work right. - $self->merge_text (1); - - # Pod::Simple doesn't do anything useful with our arguments, but we want - # to put them in our object as hash keys and values. This could cause - # problems if we ever clash with Pod::Simple's own internal class - # variables. - %$self = (%$self, @_); - - # Initialize various other internal constants based on our arguments. - $self->init_fonts; - $self->init_quotes; - $self->init_page; - - # For right now, default to turning on all of the magic. - $$self{MAGIC_CPP} = 1; - $$self{MAGIC_EMDASH} = 1; - $$self{MAGIC_FUNC} = 1; - $$self{MAGIC_MANREF} = 1; - $$self{MAGIC_SMALLCAPS} = 1; - $$self{MAGIC_VARS} = 1; - - return $self; -} - -# Translate a font string into an escape. -sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] } - -# Determine which fonts the user wishes to use and store them in the object. -# Regular, italic, bold, and bold-italic are constants, but the fixed width -# fonts may be set by the user. Sets the internal hash key FONTS which is -# used to map our internal font escapes to actual *roff sequences later. -sub init_fonts { - my ($self) = @_; - - # Figure out the fixed-width font. If user-supplied, make sure that they - # are the right length. - for (qw/fixed fixedbold fixeditalic fixedbolditalic/) { - my $font = $$self{$_}; - if (defined ($font) && (length ($font) < 1 || length ($font) > 2)) { - croak qq(roff font should be 1 or 2 chars, not "$font"); - } - } - - # Set the default fonts. We can't be sure portably across different - # implementations what fixed bold-italic may be called (if it's even - # available), so default to just bold. - $$self{fixed} ||= 'CW'; - $$self{fixedbold} ||= 'CB'; - $$self{fixeditalic} ||= 'CI'; - $$self{fixedbolditalic} ||= 'CB'; - - # Set up a table of font escapes. First number is fixed-width, second is - # bold, third is italic. - $$self{FONTS} = { '000' => '\fR', '001' => '\fI', - '010' => '\fB', '011' => '\f(BI', - '100' => toescape ($$self{fixed}), - '101' => toescape ($$self{fixeditalic}), - '110' => toescape ($$self{fixedbold}), - '111' => toescape ($$self{fixedbolditalic}) }; -} - -# Initialize the quotes that we'll be using for C<> text. This requires some -# special handling, both to parse the user parameter if given and to make sure -# that the quotes will be safe against *roff. Sets the internal hash keys -# LQUOTE and RQUOTE. -sub init_quotes { - my ($self) = (@_); - - $$self{quotes} ||= '"'; - if ($$self{quotes} eq 'none') { - $$self{LQUOTE} = $$self{RQUOTE} = ''; - } elsif (length ($$self{quotes}) == 1) { - $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes}; - } elsif ($$self{quotes} =~ /^(.)(.)$/ - || $$self{quotes} =~ /^(..)(..)$/) { - $$self{LQUOTE} = $1; - $$self{RQUOTE} = $2; - } else { - croak(qq(Invalid quote specification "$$self{quotes}")) - } - - # Double the first quote; note that this should not be s///g as two double - # quotes is represented in *roff as three double quotes, not four. Weird, - # I know. - $$self{LQUOTE} =~ s/\"/\"\"/; - $$self{RQUOTE} =~ s/\"/\"\"/; -} - -# Initialize the page title information and indentation from our arguments. -sub init_page { - my ($self) = @_; - - # We used to try first to get the version number from a local binary, but - # we shouldn't need that any more. Get the version from the running Perl. - # Work a little magic to handle subversions correctly under both the - # pre-5.6 and the post-5.6 version numbering schemes. - my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); - $version[2] ||= 0; - $version[2] *= 10 ** (3 - length $version[2]); - for (@version) { $_ += 0 } - my $version = join ('.', @version); - - # Set the defaults for page titles and indentation if the user didn't - # override anything. - $$self{center} = 'User Contributed Perl Documentation' - unless defined $$self{center}; - $$self{release} = 'perl v' . $version - unless defined $$self{release}; - $$self{indent} = 4 - unless defined $$self{indent}; - - # Double quotes in things that will be quoted. - for (qw/center release/) { - $$self{$_} =~ s/\"/\"\"/g if $$self{$_}; - } -} - -############################################################################## -# Core parsing -############################################################################## - -# This is the glue that connects the code below with Pod::Simple itself. The -# goal is to convert the event stream coming from the POD parser into method -# calls to handlers once the complete content of a tag has been seen. Each -# paragraph or POD command will have textual content associated with it, and -# as soon as all of a paragraph or POD command has been seen, that content -# will be passed in to the corresponding method for handling that type of -# object. The exceptions are handlers for lists, which have opening tag -# handlers and closing tag handlers that will be called right away. -# -# The internal hash key PENDING is used to store the contents of a tag until -# all of it has been seen. It holds a stack of open tags, each one -# represented by a tuple of the attributes hash for the tag, formatting -# options for the tag (which are inherited), and the contents of the tag. - -# Add a block of text to the contents of the current node, formatting it -# according to the current formatting instructions as we do. -sub _handle_text { - my ($self, $text) = @_; - DEBUG > 3 and print "== $text\n"; - my $tag = $$self{PENDING}[-1]; - $$tag[2] .= $self->format_text ($$tag[1], $text); -} - -# Given an element name, get the corresponding method name. -sub method_for_element { - my ($self, $element) = @_; - $element =~ tr/-/_/; - $element =~ tr/A-Z/a-z/; - $element =~ tr/_a-z0-9//cd; - return $element; -} - -# Handle the start of a new element. If cmd_element is defined, assume that -# we need to collect the entire tree for this element before passing it to the -# element method, and create a new tree into which we'll collect blocks of -# text and nested elements. Otherwise, if start_element is defined, call it. -sub _handle_element_start { - my ($self, $element, $attrs) = @_; - DEBUG > 3 and print "++ $element (<", join ('> <', %$attrs), ">)\n"; - my $method = $self->method_for_element ($element); - - # If we have a command handler, we need to accumulate the contents of the - # tag before calling it. Turn off IN_NAME for any command other than - # <Para> so that IN_NAME isn't still set for the first heading after the - # NAME heading. - if ($self->can ("cmd_$method")) { - DEBUG > 2 and print "<$element> starts saving a tag\n"; - $$self{IN_NAME} = 0 if ($element ne 'Para'); - - # How we're going to format embedded text blocks depends on the tag - # and also depends on our parent tags. Thankfully, inside tags that - # turn off guesswork and reformatting, nothing else can turn it back - # on, so this can be strictly inherited. - my $formatting = $$self{PENDING}[-1][1]; - $formatting = $self->formatting ($formatting, $element); - push (@{ $$self{PENDING} }, [ $attrs, $formatting, '' ]); - DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n"; - } elsif ($self->can ("start_$method")) { - my $method = 'start_' . $method; - $self->$method ($attrs, ''); - } else { - DEBUG > 2 and print "No $method start method, skipping\n"; - } -} - -# Handle the end of an element. If we had a cmd_ method for this element, -# this is where we pass along the tree that we built. Otherwise, if we have -# an end_ method for the element, call that. -sub _handle_element_end { - my ($self, $element) = @_; - DEBUG > 3 and print "-- $element\n"; - my $method = $self->method_for_element ($element); - - # If we have a command handler, pull off the pending text and pass it to - # the handler along with the saved attribute hash. - if ($self->can ("cmd_$method")) { - DEBUG > 2 and print "</$element> stops saving a tag\n"; - my $tag = pop @{ $$self{PENDING} }; - DEBUG > 4 and print "Popped: [", pretty ($tag), "]\n"; - DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n"; - my $method = 'cmd_' . $method; - my $text = $self->$method ($$tag[0], $$tag[2]); - if (defined $text) { - if (@{ $$self{PENDING} } > 1) { - $$self{PENDING}[-1][2] .= $text; - } else { - $self->output ($text); - } - } - } elsif ($self->can ("end_$method")) { - my $method = 'end_' . $method; - $self->$method (); - } else { - DEBUG > 2 and print "No $method end method, skipping\n"; - } -} - -############################################################################## -# General formatting -############################################################################## - -# Return formatting instructions for a new block. Takes the current -# formatting and the new element. Formatting inherits negatively, in the -# sense that if the parent has turned off guesswork, all child elements should -# leave it off. We therefore return a copy of the same formatting -# instructions but possibly with more things turned off depending on the -# element. -sub formatting { - my ($self, $current, $element) = @_; - my %options; - if ($current) { - %options = %$current; - } else { - %options = (guesswork => 1, cleanup => 1, convert => 1); - } - if ($element eq 'Data') { - $options{guesswork} = 0; - $options{cleanup} = 0; - $options{convert} = 0; - } elsif ($element eq 'X') { - $options{guesswork} = 0; - $options{cleanup} = 0; - } elsif ($element eq 'Verbatim' || $element eq 'C') { - $options{guesswork} = 0; - $options{literal} = 1; - } - return \%options; -} - -# Format a text block. Takes a hash of formatting options and the text to -# format. Currently, the only formatting options are guesswork, cleanup, and -# convert, all of which are boolean. -sub format_text { - my ($self, $options, $text) = @_; - my $guesswork = $$options{guesswork} && !$$self{IN_NAME}; - my $cleanup = $$options{cleanup}; - my $convert = $$options{convert}; - my $literal = $$options{literal}; - - # Normally we do character translation, but we won't even do that in - # <Data> blocks. - if ($convert) { - if (ASCII) { - $text =~ s/(\\|[^\x00-\x7F])/$ESCAPES{ord ($1)} || "X"/eg; - } else { - $text =~ s/(\\)/$ESCAPES{ord ($1)} || "X"/eg; - } - } - - # Cleanup just tidies up a few things, telling *roff that the hyphens are - # hard and putting a bit of space between consecutive underscores. - if ($cleanup) { - $text =~ s/-/\\-/g; - $text =~ s/_(?=_)/_\\|/g; - } - - # Ensure that *roff doesn't convert literal quotes to UTF-8 single quotes, - # but don't mess up our accept escapes. - if ($literal) { - $text =~ s/(?<!\\\*)\'/\\*\(Aq/g; - $text =~ s/(?<!\\\*)\`/\\\`/g; - } - - # If guesswork is asked for, do that. This involves more substantial - # formatting based on various heuristics that may only be appropriate for - # particular documents. - if ($guesswork) { - $text = $self->guesswork ($text); - } - - return $text; -} - -# Handles C<> text, deciding whether to put \*C` around it or not. This is a -# whole bunch of messy heuristics to try to avoid overquoting, originally from -# Barrie Slaymaker. This largely duplicates similar code in Pod::Text. -sub quote_literal { - my $self = shift; - local $_ = shift; - - # A regex that matches the portion of a variable reference that's the - # array or hash index, separated out just because we want to use it in - # several places in the following regex. - my $index = '(?: \[.*\] | \{.*\} )?'; - - # Check for things that we don't want to quote, and if we find any of - # them, return the string with just a font change and no quoting. - m{ - ^\s* - (?: - ( [\'\`\"] ) .* \1 # already quoted - | \\\*\(Aq .* \\\*\(Aq # quoted and escaped - | \\?\` .* ( \' | \\\*\(Aq ) # `quoted' - | \$+ [\#^]? \S $index # special ($^Foo, $") - | [\$\@%&*]+ \#? [:\'\w]+ $index # plain var or func - | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call - | [-+]? ( \d[\d.]* | \.\d+ ) (?: [eE][-+]?\d+ )? # a number - | 0x [a-fA-F\d]+ # a hex constant - ) - \s*\z - }xso and return '\f(FS' . $_ . '\f(FE'; - - # If we didn't return, go ahead and quote the text. - return '\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"; -} - -# Takes a text block to perform guesswork on. Returns the text block with -# formatting codes added. This is the code that marks up various Perl -# constructs and things commonly used in man pages without requiring the user -# to add any explicit markup, and is applied to all non-literal text. We're -# guaranteed that the text we're applying guesswork to does not contain any -# *roff formatting codes. Note that the inserted font sequences must be -# treated later with mapfonts or textmapfonts. -# -# This method is very fragile, both in the regular expressions it uses and in -# the ordering of those modifications. Care and testing is required when -# modifying it. -sub guesswork { - my $self = shift; - local $_ = shift; - DEBUG > 5 and print " Guesswork called on [$_]\n"; - - # By the time we reach this point, all hypens will be escaped by adding a - # backslash. We want to undo that escaping if they're part of regular - # words and there's only a single dash, since that's a real hyphen that - # *roff gets to consider a possible break point. Make sure that a dash - # after the first character of a word stays non-breaking, however. - # - # Note that this is not user-controllable; we pretty much have to do this - # transformation or *roff will mangle the output in unacceptable ways. - s{ - ( (?:\G|^|\s) [\(\"]* [a-zA-Z] ) ( \\- )? - ( (?: [a-zA-Z\']+ \\-)+ ) - ( [a-zA-Z\']+ ) (?= [\)\".?!,;:]* (?:\s|\Z|\\\ ) ) - \b - } { - my ($prefix, $hyphen, $main, $suffix) = ($1, $2, $3, $4); - $hyphen ||= ''; - $main =~ s/\\-/-/g; - $prefix . $hyphen . $main . $suffix; - }egx; - - # Translate "--" into a real em-dash if it's used like one. This means - # that it's either surrounded by whitespace, it follows a regular word, or - # it occurs between two regular words. - if ($$self{MAGIC_EMDASH}) { - s{ (\s) \\-\\- (\s) } { $1 . '\*(--' . $2 }egx; - s{ (\b[a-zA-Z]+) \\-\\- (\s|\Z|[a-zA-Z]+\b) } { $1 . '\*(--' . $2 }egx; - } - - # Make words in all-caps a little bit smaller; they look better that way. - # However, we don't want to change Perl code (like @ARGV), nor do we want - # to fix the MIME in MIME-Version since it looks weird with the - # full-height V. - # - # We change only a string of all caps (2) either at the beginning of the - # line or following regular punctuation (like quotes) or whitespace (1), - # and followed by either similar punctuation, an em-dash, or the end of - # the line (3). - if ($$self{MAGIC_SMALLCAPS}) { - s{ - ( ^ | [\s\(\"\'\`\[\{<>] | \\\ ) # (1) - ( [A-Z] [A-Z] (?: [/A-Z+:\d_\$&] | \\- )* ) # (2) - (?= [\s>\}\]\(\)\'\".?!,;] | \\*\(-- | \\\ | $ ) # (3) - } { - $1 . '\s-1' . $2 . '\s0' - }egx; - } - - # Note that from this point forward, we have to adjust for \s-1 and \s-0 - # strings inserted around things that we've made small-caps if later - # transforms should work on those strings. - - # Italize functions in the form func(), including functions that are in - # all capitals, but don't italize if there's anything between the parens. - # The function must start with an alphabetic character or underscore and - # then consist of word characters or colons. - if ($$self{MAGIC_FUNC}) { - s{ - ( \b | \\s-1 ) - ( [A-Za-z_] ([:\w] | \\s-?[01])+ \(\) ) - } { - $1 . '\f(IS' . $2 . '\f(IE' - }egx; - } - - # Change references to manual pages to put the page name in italics but - # the number in the regular font, with a thin space between the name and - # the number. Only recognize func(n) where func starts with an alphabetic - # character or underscore and contains only word characters, periods (for - # configuration file man pages), or colons, and n is a single digit, - # optionally followed by some number of lowercase letters. Note that this - # does not recognize man page references like perl(l) or socket(3SOCKET). - if ($$self{MAGIC_MANREF}) { - s{ - ( \b | \\s-1 ) - ( [A-Za-z_] (?:[.:\w] | \\- | \\s-?[01])+ ) - ( \( \d [a-z]* \) ) - } { - $1 . '\f(IS' . $2 . '\f(IE\|' . $3 - }egx; - } - - # Convert simple Perl variable references to a fixed-width font. Be - # careful not to convert functions, though; there are too many subtleties - # with them to want to perform this transformation. - if ($$self{MAGIC_VARS}) { - s{ - ( ^ | \s+ ) - ( [\$\@%] [\w:]+ ) - (?! \( ) - } { - $1 . '\f(FS' . $2 . '\f(FE' - }egx; - } - - # Fix up double quotes. Unfortunately, we miss this transformation if the - # quoted text contains any code with formatting codes and there's not much - # we can effectively do about that, which makes it somewhat unclear if - # this is really a good idea. - s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx; - - # Make C++ into \*(C+, which is a squinched version. - if ($$self{MAGIC_CPP}) { - s{ \b C\+\+ } {\\*\(C+}gx; - } - - # Done. - DEBUG > 5 and print " Guesswork returning [$_]\n"; - return $_; -} - -############################################################################## -# Output -############################################################################## - -# When building up the *roff code, we don't use real *roff fonts. Instead, we -# embed font codes of the form \f(<font>[SE] where <font> is one of B, I, or -# F, S stands for start, and E stands for end. This method turns these into -# the right start and end codes. -# -# We add this level of complexity because the old pod2man didn't get code like -# B<someI<thing> else> right; after I<> it switched back to normal text rather -# than bold. We take care of this by using variables that state whether bold, -# italic, or fixed are turned on as a combined pointer to our current font -# sequence, and set each to the number of current nestings of start tags for -# that font. -# -# \fP changes to the previous font, but only one previous font is kept. We -# don't know what the outside level font is; normally it's R, but if we're -# inside a heading it could be something else. So arrange things so that the -# outside font is always the "previous" font and end with \fP instead of \fR. -# Idea from Zack Weinberg. -sub mapfonts { - my ($self, $text) = @_; - my ($fixed, $bold, $italic) = (0, 0, 0); - my %magic = (F => \$fixed, B => \$bold, I => \$italic); - my $last = '\fR'; - $text =~ s< - \\f\((.)(.) - > < - my $sequence = ''; - my $f; - if ($last ne '\fR') { $sequence = '\fP' } - ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; - $f = $$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) }; - if ($f eq $last) { - ''; - } else { - if ($f ne '\fR') { $sequence .= $f } - $last = $f; - $sequence; - } - >gxe; - return $text; -} - -# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU -# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather -# than R, presumably because \f(CW doesn't actually do a font change. To work -# around this, use a separate textmapfonts for text blocks where the default -# font is always R and only use the smart mapfonts for headings. -sub textmapfonts { - my ($self, $text) = @_; - my ($fixed, $bold, $italic) = (0, 0, 0); - my %magic = (F => \$fixed, B => \$bold, I => \$italic); - $text =~ s< - \\f\((.)(.) - > < - ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; - $$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) }; - >gxe; - return $text; -} - -# Given a command and a single argument that may or may not contain double -# quotes, handle double-quote formatting for it. If there are no double -# quotes, just return the command followed by the argument in double quotes. -# If there are double quotes, use an if statement to test for nroff, and for -# nroff output the command followed by the argument in double quotes with -# embedded double quotes doubled. For other formatters, remap paired double -# quotes to LQUOTE and RQUOTE. -sub switchquotes { - my ($self, $command, $text, $extra) = @_; - $text =~ s/\\\*\([LR]\"/\"/g; - - # We also have to deal with \*C` and \*C', which are used to add the - # quotes around C<> text, since they may expand to " and if they do this - # confuses the .SH macros and the like no end. Expand them ourselves. - # Also separate troff from nroff if there are any fixed-width fonts in use - # to work around problems with Solaris nroff. - my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/); - my $fixedpat = join '|', @{ $$self{FONTS} }{'100', '101', '110', '111'}; - $fixedpat =~ s/\\/\\\\/g; - $fixedpat =~ s/\(/\\\(/g; - if ($text =~ m/\"/ || $text =~ m/$fixedpat/) { - $text =~ s/\"/\"\"/g; - my $nroff = $text; - my $troff = $text; - $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; - if ($c_is_quote and $text =~ m/\\\*\(C[\'\`]/) { - $nroff =~ s/\\\*\(C\`/$$self{LQUOTE}/g; - $nroff =~ s/\\\*\(C\'/$$self{RQUOTE}/g; - $troff =~ s/\\\*\(C[\'\`]//g; - } - $nroff = qq("$nroff") . ($extra ? " $extra" : ''); - $troff = qq("$troff") . ($extra ? " $extra" : ''); - - # Work around the Solaris nroff bug where \f(CW\fP leaves the font set - # to Roman rather than the actual previous font when used in headings. - # troff output may still be broken, but at least we can fix nroff by - # just switching the font changes to the non-fixed versions. - $nroff =~ s/\Q$$self{FONTS}{100}\E(.*)\\f[PR]/$1/g; - $nroff =~ s/\Q$$self{FONTS}{101}\E(.*)\\f([PR])/\\fI$1\\f$2/g; - $nroff =~ s/\Q$$self{FONTS}{110}\E(.*)\\f([PR])/\\fB$1\\f$2/g; - $nroff =~ s/\Q$$self{FONTS}{111}\E(.*)\\f([PR])/\\f\(BI$1\\f$2/g; - - # Now finally output the command. Bother with .ie only if the nroff - # and troff output aren't the same. - if ($nroff ne $troff) { - return ".ie n $command $nroff\n.el $command $troff\n"; - } else { - return "$command $nroff\n"; - } - } else { - $text = qq("$text") . ($extra ? " $extra" : ''); - return "$command $text\n"; - } -} - -# Protect leading quotes and periods against interpretation as commands. Also -# protect anything starting with a backslash, since it could expand or hide -# something that *roff would interpret as a command. This is overkill, but -# it's much simpler than trying to parse *roff here. -sub protect { - my ($self, $text) = @_; - $text =~ s/^([.\'\\])/\\&$1/mg; - return $text; -} - -# Make vertical whitespace if NEEDSPACE is set, appropriate to the indentation -# level the situation. This function is needed since in *roff one has to -# create vertical whitespace after paragraphs and between some things, but -# other macros create their own whitespace. Also close out a sequence of -# repeated =items, since calling makespace means we're about to begin the item -# body. -sub makespace { - my ($self) = @_; - $self->output (".PD\n") if $$self{ITEMS} > 1; - $$self{ITEMS} = 0; - $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n") - if $$self{NEEDSPACE}; -} - -# Output any pending index entries, and optionally an index entry given as an -# argument. Support multiple index entries in X<> separated by slashes, and -# strip special escapes from index entries. -sub outindex { - my ($self, $section, $index) = @_; - my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} }; - return unless ($section || @entries); - - # We're about to output all pending entries, so clear our pending queue. - $$self{INDEX} = []; - - # Build the output. Regular index entries are marked Xref, and headings - # pass in their own section. Undo some *roff formatting on headings. - my @output; - if (@entries) { - push @output, [ 'Xref', join (' ', @entries) ]; - } - if ($section) { - $index =~ s/\\-/-/g; - $index =~ s/\\(?:s-?\d|.\(..|.)//g; - push @output, [ $section, $index ]; - } - - # Print out the .IX commands. - for (@output) { - my ($type, $entry) = @$_; - $entry =~ s/\"/\"\"/g; - $self->output (".IX $type " . '"' . $entry . '"' . "\n"); - } -} - -# Output some text, without any additional changes. -sub output { - my ($self, @text) = @_; - print { $$self{output_fh} } @text; -} - -############################################################################## -# Document initialization -############################################################################## - -# Handle the start of the document. Here we handle empty documents, as well -# as setting up our basic macros in a preamble and building the page title. -sub start_document { - my ($self, $attrs) = @_; - if ($$attrs{contentless} && !$$self{ALWAYS_EMIT_SOMETHING}) { - DEBUG and print "Document is contentless\n"; - $$self{CONTENTLESS} = 1; - return; - } - - # Determine information for the preamble and then output it. - my ($name, $section); - if (defined $$self{name}) { - $name = $$self{name}; - $section = $$self{section} || 1; - } else { - ($name, $section) = $self->devise_title; - } - my $date = $$self{date} || $self->devise_date; - $self->preamble ($name, $section, $date) - unless $self->bare_output or DEBUG > 9; - - # Initialize a few per-document variables. - $$self{INDENT} = 0; # Current indentation level. - $$self{INDENTS} = []; # Stack of indentations. - $$self{INDEX} = []; # Index keys waiting to be printed. - $$self{IN_NAME} = 0; # Whether processing the NAME section. - $$self{ITEMS} = 0; # The number of consecutive =items. - $$self{ITEMTYPES} = []; # Stack of =item types, one per list. - $$self{SHIFTWAIT} = 0; # Whether there is a shift waiting. - $$self{SHIFTS} = []; # Stack of .RS shifts. - $$self{PENDING} = [[]]; # Pending output. -} - -# Handle the end of the document. This does nothing but print out a final -# comment at the end of the document under debugging. -sub end_document { - my ($self) = @_; - return if $self->bare_output; - return if ($$self{CONTENTLESS} && !$$self{ALWAYS_EMIT_SOMETHING}); - $self->output (q(.\" [End document]) . "\n") if DEBUG; -} - -# Try to figure out the name and section from the file name and return them as -# a list, returning an empty name and section 1 if we can't find any better -# information. Uses File::Basename and File::Spec as necessary. -sub devise_title { - my ($self) = @_; - my $name = $self->source_filename || ''; - my $section = $$self{section} || 1; - $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i); - $name =~ s/\.p(od|[lm])\z//i; - - # If the section isn't 3, then the name defaults to just the basename of - # the file. Otherwise, assume we're dealing with a module. We want to - # figure out the full module name from the path to the file, but we don't - # want to include too much of the path into the module name. Lose - # anything up to the first off: - # - # */lib/*perl*/ standard or site_perl module - # */*perl*/lib/ from -Dprefix=/opt/perl - # */*perl*/ random module hierarchy - # - # which works. Also strip off a leading site, site_perl, or vendor_perl - # component, any OS-specific component, and any version number component, - # and strip off an initial component of "lib" or "blib/lib" since that's - # what ExtUtils::MakeMaker creates. splitdir requires at least File::Spec - # 0.8. - if ($section !~ /^3/) { - require File::Basename; - $name = uc File::Basename::basename ($name); - } else { - require File::Spec; - my ($volume, $dirs, $file) = File::Spec->splitpath ($name); - my @dirs = File::Spec->splitdir ($dirs); - my $cut = 0; - my $i; - for ($i = 0; $i < @dirs; $i++) { - if ($dirs[$i] =~ /perl/) { - $cut = $i + 1; - $cut++ if ($dirs[$i + 1] && $dirs[$i + 1] eq 'lib'); - last; - } - } - if ($cut > 0) { - splice (@dirs, 0, $cut); - shift @dirs if ($dirs[0] =~ /^(site|vendor)(_perl)?$/); - shift @dirs if ($dirs[0] =~ /^[\d.]+$/); - shift @dirs if ($dirs[0] =~ /^(.*-$^O|$^O-.*|$^O)$/); - } - shift @dirs if $dirs[0] eq 'lib'; - splice (@dirs, 0, 2) if ($dirs[0] eq 'blib' && $dirs[1] eq 'lib'); - - # Remove empty directories when building the module name; they - # occur too easily on Unix by doubling slashes. - $name = join ('::', (grep { $_ ? $_ : () } @dirs), $file); - } - return ($name, $section); -} - -# Determine the modification date and return that, properly formatted in ISO -# format. If we can't get the modification date of the input, instead use the -# current time. Pod::Simple returns a completely unuseful stringified file -# handle as the source_filename for input from a file handle, so we have to -# deal with that as well. -sub devise_date { - my ($self) = @_; - my $input = $self->source_filename; - my $time; - if ($input) { - $time = (stat $input)[9] || time; - } else { - $time = time; - } - return strftime ('%Y-%m-%d', localtime $time); -} - -# Print out the preamble and the title. The meaning of the arguments to .TH -# unfortunately vary by system; some systems consider the fourth argument to -# be a "source" and others use it as a version number. Generally it's just -# presented as the left-side footer, though, so it doesn't matter too much if -# a particular system gives it another interpretation. -# -# The order of date and release used to be reversed in older versions of this -# module, but this order is correct for both Solaris and Linux. -sub preamble { - my ($self, $name, $section, $date) = @_; - my $preamble = $self->preamble_template; - - # Build the index line and make sure that it will be syntactically valid. - my $index = "$name $section"; - $index =~ s/\"/\"\"/g; - - # If name or section contain spaces, quote them (section really never - # should, but we may as well be cautious). - for ($name, $section) { - if (/\s/) { - s/\"/\"\"/g; - $_ = '"' . $_ . '"'; - } - } - - # Double quotes in date, since it will be quoted. - $date =~ s/\"/\"\"/g; - - # Substitute into the preamble the configuration options. - $preamble =~ s/\@CFONT\@/$$self{fixed}/; - $preamble =~ s/\@LQUOTE\@/$$self{LQUOTE}/; - $preamble =~ s/\@RQUOTE\@/$$self{RQUOTE}/; - chomp $preamble; - - # Get the version information. - my $version = $self->version_report; - - # Finally output everything. - $self->output (<<"----END OF HEADER----"); -.\\" Automatically generated by $version -.\\" -.\\" Standard preamble: -.\\" ======================================================================== -$preamble -.\\" ======================================================================== -.\\" -.IX Title "$index" -.TH $name $section "$date" "$$self{release}" "$$self{center}" -.\\" For nroff, turn off justification. Always turn off hyphenation; it makes -.\\" way too many mistakes in technical documents. -.if n .ad l -.nh -----END OF HEADER---- - $self->output (".\\\" [End of preamble]\n") if DEBUG; -} - -############################################################################## -# Text blocks -############################################################################## - -# Handle a basic block of text. The only tricky part of this is if this is -# the first paragraph of text after an =over, in which case we have to change -# indentations for *roff. -sub cmd_para { - my ($self, $attrs, $text) = @_; - my $line = $$attrs{start_line}; - - # Output the paragraph. We also have to handle =over without =item. If - # there's an =over without =item, SHIFTWAIT will be set, and we need to - # handle creation of the indent here. Add the shift to SHIFTS so that it - # will be cleaned up on =back. - $self->makespace; - if ($$self{SHIFTWAIT}) { - $self->output (".RS $$self{INDENT}\n"); - push (@{ $$self{SHIFTS} }, $$self{INDENT}); - $$self{SHIFTWAIT} = 0; - } - - # Add the line number for debugging, but not in the NAME section just in - # case the comment would confuse apropos. - $self->output (".\\\" [At source line $line]\n") - if defined ($line) && DEBUG && !$$self{IN_NAME}; - - # Force exactly one newline at the end and strip unwanted trailing - # whitespace at the end. - $text =~ s/\s*$/\n/; - - # Output the paragraph. - $self->output ($self->protect ($self->textmapfonts ($text))); - $self->outindex; - $$self{NEEDSPACE} = 1; - return ''; -} - -# Handle a verbatim paragraph. Put a null token at the beginning of each line -# to protect against commands and wrap in .Vb/.Ve (which we define in our -# prelude). -sub cmd_verbatim { - my ($self, $attrs, $text) = @_; - - # Ignore an empty verbatim paragraph. - return unless $text =~ /\S/; - - # Force exactly one newline at the end and strip unwanted trailing - # whitespace at the end. - $text =~ s/\s*$/\n/; - - # Get a count of the number of lines before the first blank line, which - # we'll pass to .Vb as its parameter. This tells *roff to keep that many - # lines together. We don't want to tell *roff to keep huge blocks - # together. - my @lines = split (/\n/, $text); - my $unbroken = 0; - for (@lines) { - last if /^\s*$/; - $unbroken++; - } - $unbroken = 10 if ($unbroken > 12 && !$$self{MAGIC_VNOPAGEBREAK_LIMIT}); - - # Prepend a null token to each line. - $text =~ s/^/\\&/gm; - - # Output the results. - $self->makespace; - $self->output (".Vb $unbroken\n$text.Ve\n"); - $$self{NEEDSPACE} = 1; - return ''; -} - -# Handle literal text (produced by =for and similar constructs). Just output -# it with the minimum of changes. -sub cmd_data { - my ($self, $attrs, $text) = @_; - $text =~ s/^\n+//; - $text =~ s/\n{0,2}$/\n/; - $self->output ($text); - return ''; -} - -############################################################################## -# Headings -############################################################################## - -# Common code for all headings. This is called before the actual heading is -# output. It returns the cleaned up heading text (putting the heading all on -# one line) and may do other things, like closing bad =item blocks. -sub heading_common { - my ($self, $text, $line) = @_; - $text =~ s/\s+$//; - $text =~ s/\s*\n\s*/ /g; - - # This should never happen; it means that we have a heading after =item - # without an intervening =back. But just in case, handle it anyway. - if ($$self{ITEMS} > 1) { - $$self{ITEMS} = 0; - $self->output (".PD\n"); - } - - # Output the current source line. - $self->output ( ".\\\" [At source line $line]\n" ) - if defined ($line) && DEBUG; - return $text; -} - -# First level heading. We can't output .IX in the NAME section due to a bug -# in some versions of catman, so don't output a .IX for that section. .SH -# already uses small caps, so remove \s0 and \s-1. Maintain IN_NAME as -# appropriate. -sub cmd_head1 { - my ($self, $attrs, $text) = @_; - $text =~ s/\\s-?\d//g; - $text = $self->heading_common ($text, $$attrs{start_line}); - my $isname = ($text eq 'NAME' || $text =~ /\(NAME\)/); - $self->output ($self->switchquotes ('.SH', $self->mapfonts ($text))); - $self->outindex ('Header', $text) unless $isname; - $$self{NEEDSPACE} = 0; - $$self{IN_NAME} = $isname; - return ''; -} - -# Second level heading. -sub cmd_head2 { - my ($self, $attrs, $text) = @_; - $text = $self->heading_common ($text, $$attrs{start_line}); - $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($text))); - $self->outindex ('Subsection', $text); - $$self{NEEDSPACE} = 0; - return ''; -} - -# Third level heading. *roff doesn't have this concept, so just put the -# heading in italics as a normal paragraph. -sub cmd_head3 { - my ($self, $attrs, $text) = @_; - $text = $self->heading_common ($text, $$attrs{start_line}); - $self->makespace; - $self->output ($self->textmapfonts ('\f(IS' . $text . '\f(IE') . "\n"); - $self->outindex ('Subsection', $text); - $$self{NEEDSPACE} = 1; - return ''; -} - -# Fourth level heading. *roff doesn't have this concept, so just put the -# heading as a normal paragraph. -sub cmd_head4 { - my ($self, $attrs, $text) = @_; - $text = $self->heading_common ($text, $$attrs{start_line}); - $self->makespace; - $self->output ($self->textmapfonts ($text) . "\n"); - $self->outindex ('Subsection', $text); - $$self{NEEDSPACE} = 1; - return ''; -} - -############################################################################## -# Formatting codes -############################################################################## - -# All of the formatting codes that aren't handled internally by the parser, -# other than L<> and X<>. -sub cmd_b { return '\f(BS' . $_[2] . '\f(BE' } -sub cmd_i { return '\f(IS' . $_[2] . '\f(IE' } -sub cmd_f { return '\f(IS' . $_[2] . '\f(IE' } -sub cmd_c { return $_[0]->quote_literal ($_[2]) } - -# Index entries are just added to the pending entries. -sub cmd_x { - my ($self, $attrs, $text) = @_; - push (@{ $$self{INDEX} }, $text); - return ''; -} - -# Links reduce to the text that we're given, wrapped in angle brackets if it's -# a URL. -sub cmd_l { - my ($self, $attrs, $text) = @_; - return $$attrs{type} eq 'url' ? "<$text>" : $text; -} - -############################################################################## -# List handling -############################################################################## - -# Handle the beginning of an =over block. Takes the type of the block as the -# first argument, and then the attr hash. This is called by the handlers for -# the four different types of lists (bullet, number, text, and block). -sub over_common_start { - my ($self, $type, $attrs) = @_; - my $line = $$attrs{start_line}; - my $indent = $$attrs{indent}; - DEBUG > 3 and print " Starting =over $type (line $line, indent ", - ($indent || '?'), "\n"; - - # Find the indentation level. - unless (defined ($indent) && $indent =~ /^[-+]?\d{1,4}\s*$/) { - $indent = $$self{indent}; - } - - # If we've gotten multiple indentations in a row, we need to emit the - # pending indentation for the last level that we saw and haven't acted on - # yet. SHIFTS is the stack of indentations that we've actually emitted - # code for. - if (@{ $$self{SHIFTS} } < @{ $$self{INDENTS} }) { - $self->output (".RS $$self{INDENT}\n"); - push (@{ $$self{SHIFTS} }, $$self{INDENT}); - } - - # Now, do record-keeping. INDENTS is a stack of indentations that we've - # seen so far, and INDENT is the current level of indentation. ITEMTYPES - # is a stack of list types that we've seen. - push (@{ $$self{INDENTS} }, $$self{INDENT}); - push (@{ $$self{ITEMTYPES} }, $type); - $$self{INDENT} = $indent + 0; - $$self{SHIFTWAIT} = 1; -} - -# End an =over block. Takes no options other than the class pointer. -# Normally, once we close a block and therefore remove something from INDENTS, -# INDENTS will now be longer than SHIFTS, indicating that we also need to emit -# *roff code to close the indent. This isn't *always* true, depending on the -# circumstance. If we're still inside an indentation, we need to emit another -# .RE and then a new .RS to unconfuse *roff. -sub over_common_end { - my ($self) = @_; - DEBUG > 3 and print " Ending =over\n"; - $$self{INDENT} = pop @{ $$self{INDENTS} }; - pop @{ $$self{ITEMTYPES} }; - - # If we emitted code for that indentation, end it. - if (@{ $$self{SHIFTS} } > @{ $$self{INDENTS} }) { - $self->output (".RE\n"); - pop @{ $$self{SHIFTS} }; - } - - # If we're still in an indentation, *roff will have now lost track of the - # right depth of that indentation, so fix that. - if (@{ $$self{INDENTS} } > 0) { - $self->output (".RE\n"); - $self->output (".RS $$self{INDENT}\n"); - } - $$self{NEEDSPACE} = 1; - $$self{SHIFTWAIT} = 0; -} - -# Dispatch the start and end calls as appropriate. -sub start_over_bullet { my $s = shift; $s->over_common_start ('bullet', @_) } -sub start_over_number { my $s = shift; $s->over_common_start ('number', @_) } -sub start_over_text { my $s = shift; $s->over_common_start ('text', @_) } -sub start_over_block { my $s = shift; $s->over_common_start ('block', @_) } -sub end_over_bullet { $_[0]->over_common_end } -sub end_over_number { $_[0]->over_common_end } -sub end_over_text { $_[0]->over_common_end } -sub end_over_block { $_[0]->over_common_end } - -# The common handler for all item commands. Takes the type of the item, the -# attributes, and then the text of the item. -# -# Emit an index entry for anything that's interesting, but don't emit index -# entries for things like bullets and numbers. Newlines in an item title are -# turned into spaces since *roff can't handle them embedded. -sub item_common { - my ($self, $type, $attrs, $text) = @_; - my $line = $$attrs{start_line}; - DEBUG > 3 and print " $type item (line $line): $text\n"; - - # Clean up the text. We want to end up with two variables, one ($text) - # which contains any body text after taking out the item portion, and - # another ($item) which contains the actual item text. - $text =~ s/\s+$//; - my ($item, $index); - if ($type eq 'bullet') { - $item = "\\\(bu"; - $text =~ s/\n*$/\n/; - } elsif ($type eq 'number') { - $item = $$attrs{number} . '.'; - } else { - $item = $text; - $item =~ s/\s*\n\s*/ /g; - $text = ''; - $index = $item if ($item =~ /\w/); - } - - # Take care of the indentation. If shifts and indents are equal, close - # the top shift, since we're about to create an indentation with .IP. - # Also output .PD 0 to turn off spacing between items if this item is - # directly following another one. We only have to do that once for a - # whole chain of items so do it for the second item in the change. Note - # that makespace is what undoes this. - if (@{ $$self{SHIFTS} } == @{ $$self{INDENTS} }) { - $self->output (".RE\n"); - pop @{ $$self{SHIFTS} }; - } - $self->output (".PD 0\n") if ($$self{ITEMS} == 1); - - # Now, output the item tag itself. - $item = $self->textmapfonts ($item); - $self->output ($self->switchquotes ('.IP', $item, $$self{INDENT})); - $$self{NEEDSPACE} = 0; - $$self{ITEMS}++; - $$self{SHIFTWAIT} = 0; - - # If body text for this item was included, go ahead and output that now. - if ($text) { - $text =~ s/\s*$/\n/; - $self->makespace; - $self->output ($self->protect ($self->textmapfonts ($text))); - $$self{NEEDSPACE} = 1; - } - $self->outindex ($index ? ('Item', $index) : ()); -} - -# Dispatch the item commands to the appropriate place. -sub cmd_item_bullet { my $self = shift; $self->item_common ('bullet', @_) } -sub cmd_item_number { my $self = shift; $self->item_common ('number', @_) } -sub cmd_item_text { my $self = shift; $self->item_common ('text', @_) } -sub cmd_item_block { my $self = shift; $self->item_common ('block', @_) } - -############################################################################## -# Backward compatibility -############################################################################## - -# Reset the underlying Pod::Simple object between calls to parse_from_file so -# that the same object can be reused to convert multiple pages. -sub parse_from_file { - my $self = shift; - $self->reinit; - - # Fake the old cutting option to Pod::Parser. This fiddings with internal - # Pod::Simple state and is quite ugly; we need a better approach. - if (ref ($_[0]) eq 'HASH') { - my $opts = shift @_; - if (defined ($$opts{-cutting}) && !$$opts{-cutting}) { - $$self{in_pod} = 1; - $$self{last_was_blank} = 1; - } - } - - # Do the work. - my $retval = $self->SUPER::parse_from_file (@_); - - # Flush output, since Pod::Simple doesn't do this. Ideally we should also - # close the file descriptor if we had to open one, but we can't easily - # figure this out. - my $fh = $self->output_fh (); - my $oldfh = select $fh; - my $oldflush = $|; - $| = 1; - print $fh ''; - $| = $oldflush; - select $oldfh; - return $retval; -} - -# Pod::Simple failed to provide this backward compatibility function, so -# implement it ourselves. File handles are one of the inputs that -# parse_from_file supports. -sub parse_from_filehandle { - my $self = shift; - $self->parse_from_file (@_); -} - -############################################################################## -# Translation tables -############################################################################## - -# The following table is adapted from Tom Christiansen's pod2man. It assumes -# that the standard preamble has already been printed, since that's what -# defines all of the accent marks. We really want to do something better than -# this when *roff actually supports other character sets itself, since these -# results are pretty poor. -# -# This only works in an ASCII world. What to do in a non-ASCII world is very -# unclear. -@ESCAPES{0xA0 .. 0xFF} = ( - "\\ ", undef, undef, undef, undef, undef, undef, undef, - undef, undef, undef, undef, undef, "\\%", undef, undef, - - undef, undef, undef, undef, undef, undef, undef, undef, - undef, undef, undef, undef, undef, undef, undef, undef, - - "A\\*`", "A\\*'", "A\\*^", "A\\*~", "A\\*:", "A\\*o", "\\*(AE", "C\\*,", - "E\\*`", "E\\*'", "E\\*^", "E\\*:", "I\\*`", "I\\*'", "I\\*^", "I\\*:", - - "\\*(D-", "N\\*~", "O\\*`", "O\\*'", "O\\*^", "O\\*~", "O\\*:", undef, - "O\\*/", "U\\*`", "U\\*'", "U\\*^", "U\\*:", "Y\\*'", "\\*(Th", "\\*8", - - "a\\*`", "a\\*'", "a\\*^", "a\\*~", "a\\*:", "a\\*o", "\\*(ae", "c\\*,", - "e\\*`", "e\\*'", "e\\*^", "e\\*:", "i\\*`", "i\\*'", "i\\*^", "i\\*:", - - "\\*(d-", "n\\*~", "o\\*`", "o\\*'", "o\\*^", "o\\*~", "o\\*:", undef, - "o\\*/" , "u\\*`", "u\\*'", "u\\*^", "u\\*:", "y\\*'", "\\*(th", "y\\*:", -) if ASCII; - -# Make sure that at least this works even outside of ASCII. -$ESCAPES{ord("\\")} = "\\e"; - -############################################################################## -# Premable -############################################################################## - -# The following is the static preamble which starts all *roff output we -# generate. It's completely static except for the font to use as a -# fixed-width font, which is designed by @CFONT@, and the left and right -# quotes to use for C<> text, designated by @LQOUTE@ and @RQUOTE@. -sub preamble_template { - return <<'----END OF PREAMBLE----'; -.de Sh \" Subsection heading -.br -.if t .Sp -.ne 5 -.PP -\fB\\$1\fR -.PP -.. -.de Sp \" Vertical space (when we can't use .PP) -.if t .sp .5v -.if n .sp -.. -.de Vb \" Begin verbatim text -.ft @CFONT@ -.nf -.ne \\$1 -.. -.de Ve \" End verbatim text -.ft R -.fi -.. -.\" Set up some character translations and predefined strings. \*(-- will -.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left -.\" double quote, and \*(R" will give a right double quote. \*(C+ will -.\" give a nicer C++. Capital omega is used to do unbreakable dashes and -.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, -.\" nothing in troff, for use with C<>. -.tr \(*W- -.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' -.ie n \{\ -. ds -- \(*W- -. ds PI pi -. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch -. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch -. ds L" "" -. ds R" "" -. ds C` @LQUOTE@ -. ds C' @RQUOTE@ -'br\} -.el\{\ -. ds -- \|\(em\| -. ds PI \(*p -. ds L" `` -. ds R" '' -'br\} -.\" -.\" Escape single quotes in literal strings from groff's Unicode transform. -.ie \n(.g .ds Aq \(aq -.el .ds Aq ' -.\" -.\" If the F register is turned on, we'll generate index entries on stderr for -.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index -.\" entries marked with X<> in POD. Of course, you'll have to process the -.\" output yourself in some meaningful fashion. -.ie \nF \{\ -. de IX -. tm Index:\\$1\t\\n%\t"\\$2" -.. -. nr % 0 -. rr F -.\} -.el \{\ -. de IX -.. -.\} -.\" -.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). -.\" Fear. Run. Save yourself. No user-serviceable parts. -. \" fudge factors for nroff and troff -.if n \{\ -. ds #H 0 -. ds #V .8m -. ds #F .3m -. ds #[ \f1 -. ds #] \fP -.\} -.if t \{\ -. ds #H ((1u-(\\\\n(.fu%2u))*.13m) -. ds #V .6m -. ds #F 0 -. ds #[ \& -. ds #] \& -.\} -. \" simple accents for nroff and troff -.if n \{\ -. ds ' \& -. ds ` \& -. ds ^ \& -. ds , \& -. ds ~ ~ -. ds / -.\} -.if t \{\ -. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" -. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' -. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' -. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' -. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' -. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' -.\} -. \" troff and (daisy-wheel) nroff accents -.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' -.ds 8 \h'\*(#H'\(*b\h'-\*(#H' -.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] -.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' -.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' -.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] -.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] -.ds ae a\h'-(\w'a'u*4/10)'e -.ds Ae A\h'-(\w'A'u*4/10)'E -. \" corrections for vroff -.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' -.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' -. \" for low resolution devices (crt and lpr) -.if \n(.H>23 .if \n(.V>19 \ -\{\ -. ds : e -. ds 8 ss -. ds o a -. ds d- d\h'-1'\(ga -. ds D- D\h'-1'\(hy -. ds th \o'bp' -. ds Th \o'LP' -. ds ae ae -. ds Ae AE -.\} -.rm #[ #] #H #V #F C -----END OF PREAMBLE---- -#`# for cperl-mode -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Man - Convert POD data to formatted *roff input - -=head1 SYNOPSIS - - use Pod::Man; - my $parser = Pod::Man->new (release => $VERSION, section => 8); - - # Read POD from STDIN and write to STDOUT. - $parser->parse_file (\*STDIN); - - # Read POD from file.pod and write to file.1. - $parser->parse_from_file ('file.pod', 'file.1'); - -=head1 DESCRIPTION - -Pod::Man is a module to convert documentation in the POD format (the -preferred language for documenting Perl) into *roff input using the man -macro set. The resulting *roff code is suitable for display on a terminal -using L<nroff(1)>, normally via L<man(1)>, or printing using L<troff(1)>. -It is conventionally invoked using the driver script B<pod2man>, but it can -also be used directly. - -As a derived class from Pod::Simple, Pod::Man supports the same methods and -interfaces. See L<Pod::Simple> for all the details. - -new() can take options, in the form of key/value pairs that control the -behavior of the parser. See below for details. - -If no options are given, Pod::Man uses the name of the input file with any -trailing C<.pod>, C<.pm>, or C<.pl> stripped as the man page title, to -section 1 unless the file ended in C<.pm> in which case it defaults to -section 3, to a centered title of "User Contributed Perl Documentation", to -a centered footer of the Perl version it is run with, and to a left-hand -footer of the modification date of its input (or the current date if given -STDIN for input). - -Pod::Man assumes that your *roff formatters have a fixed-width font named -CW. If yours is called something else (like CR), use the C<fixed> option to -specify it. This generally only matters for troff output for printing. -Similarly, you can set the fonts used for bold, italic, and bold italic -fixed-width output. - -Besides the obvious pod conversions, Pod::Man also takes care of formatting -func(), func(3), and simple variable references like $foo or @bar so you -don't have to use code escapes for them; complex expressions like -C<$fred{'stuff'}> will still need to be escaped, though. It also translates -dashes that aren't used as hyphens into en dashes, makes long dashes--like -this--into proper em dashes, fixes "paired quotes," makes C++ look right, -puts a little space between double underbars, makes ALLCAPS a teeny bit -smaller in B<troff>, and escapes stuff that *roff treats as special so that -you don't have to. - -The recognized options to new() are as follows. All options take a single -argument. - -=over 4 - -=item center - -Sets the centered page header to use instead of "User Contributed Perl -Documentation". - -=item date - -Sets the left-hand footer. By default, the modification date of the input -file will be used, or the current date if stat() can't find that file (the -case if the input is from STDIN), and the date will be formatted as -YYYY-MM-DD. - -=item fixed - -The fixed-width font to use for vertabim text and code. Defaults to CW. -Some systems may want CR instead. Only matters for B<troff> output. - -=item fixedbold - -Bold version of the fixed-width font. Defaults to CB. Only matters for -B<troff> output. - -=item fixeditalic - -Italic version of the fixed-width font (actually, something of a misnomer, -since most fixed-width fonts only have an oblique version, not an italic -version). Defaults to CI. Only matters for B<troff> output. - -=item fixedbolditalic - -Bold italic (probably actually oblique) version of the fixed-width font. -Pod::Man doesn't assume you have this, and defaults to CB. Some systems -(such as Solaris) have this font available as CX. Only matters for B<troff> -output. - -=item name - -Set the name of the manual page. Without this option, the manual name is -set to the uppercased base name of the file being converted unless the -manual section is 3, in which case the path is parsed to see if it is a Perl -module path. If it is, a path like C<.../lib/Pod/Man.pm> is converted into -a name like C<Pod::Man>. This option, if given, overrides any automatic -determination of the name. - -=item quotes - -Sets the quote marks used to surround CE<lt>> text. If the value is a -single character, it is used as both the left and right quote; if it is two -characters, the first character is used as the left quote and the second as -the right quoted; and if it is four characters, the first two are used as -the left quote and the second two as the right quote. - -This may also be set to the special value C<none>, in which case no quote -marks are added around CE<lt>> text (but the font is still changed for troff -output). - -=item release - -Set the centered footer. By default, this is the version of Perl you run -Pod::Man under. Note that some system an macro sets assume that the -centered footer will be a modification date and will prepend something like -"Last modified: "; if this is the case, you may want to set C<release> to -the last modified date and C<date> to the version number. - -=item section - -Set the section for the C<.TH> macro. The standard section numbering -convention is to use 1 for user commands, 2 for system calls, 3 for -functions, 4 for devices, 5 for file formats, 6 for games, 7 for -miscellaneous information, and 8 for administrator commands. There is a lot -of variation here, however; some systems (like Solaris) use 4 for file -formats, 5 for miscellaneous information, and 7 for devices. Still others -use 1m instead of 8, or some mix of both. About the only section numbers -that are reliably consistent are 1, 2, and 3. - -By default, section 1 will be used unless the file ends in .pm in which case -section 3 will be selected. - -=back - -The standard Pod::Simple method parse_file() takes one argument naming the -POD file to read from. By default, the output is sent to STDOUT, but this -can be changed with the output_fd() method. - -The standard Pod::Simple method parse_from_file() takes up to two -arguments, the first being the input file to read POD from and the second -being the file to write the formatted output to. - -You can also call parse_lines() to parse an array of lines or -parse_string_document() to parse a document already in memory. To put the -output into a string instead of a file handle, call the output_string() -method. See L<Pod::Simple> for the specific details. - -=head1 DIAGNOSTICS - -=over 4 - -=item roff font should be 1 or 2 chars, not "%s" - -(F) You specified a *roff font (using C<fixed>, C<fixedbold>, etc.) that -wasn't either one or two characters. Pod::Man doesn't support *roff fonts -longer than two characters, although some *roff extensions do (the canonical -versions of B<nroff> and B<troff> don't either). - -=item Invalid quote specification "%s" - -(F) The quote specification given (the quotes option to the constructor) was -invalid. A quote specification must be one, two, or four characters long. - -=back - -=head1 BUGS - -Eight-bit input data isn't handled at all well at present. The correct -approach would be to map EE<lt>E<gt> escapes to the appropriate UTF-8 -characters and then do a translation pass on the output according to the -user-specified output character set. Unfortunately, we can't send eight-bit -data directly to the output unless the user says this is okay, since some -vendor *roff implementations can't handle eight-bit data. If the *roff -implementation can, however, that's far superior to the current hacked -characters that only work under troff. - -There is currently no way to turn off the guesswork that tries to format -unmarked text appropriately, and sometimes it isn't wanted (particularly -when using POD to document something other than Perl). Most of the work -towards fixing this has now been done, however, and all that's still needed -is a user interface. - -The NAME section should be recognized specially and index entries emitted -for everything in that section. This would have to be deferred until the -next section, since extraneous things in NAME tends to confuse various man -page processors. Currently, no index entries are emitted for anything in -NAME. - -Pod::Man doesn't handle font names longer than two characters. Neither do -most B<troff> implementations, but GNU troff does as an extension. It would -be nice to support as an option for those who want to use it. - -The preamble added to each output file is rather verbose, and most of it -is only necessary in the presence of non-ASCII characters. It would -ideally be nice if all of those definitions were only output if needed, -perhaps on the fly as the characters are used. - -Pod::Man is excessively slow. - -=head1 CAVEATS - -The handling of hyphens and em dashes is somewhat fragile, and one may get -the wrong one under some circumstances. This should only matter for -B<troff> output. - -When and whether to use small caps is somewhat tricky, and Pod::Man doesn't -necessarily get it right. - -Converting neutral double quotes to properly matched double quotes doesn't -work unless there are no formatting codes between the quote marks. This -only matters for troff output. - -=head1 AUTHOR - -Russ Allbery <rra@stanford.edu>, based I<very> heavily on the original -B<pod2man> by Tom Christiansen <tchrist@mox.perl.com>. The modifications to -work with Pod::Simple instead of Pod::Parser were originally contributed by -Sean Burke (but I've since hacked them beyond recognition and all bugs are -mine). - -=head1 COPYRIGHT AND LICENSE - -Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 -by Russ Allbery <rra@stanford.edu>. - -This program is free software; you may redistribute it and/or modify it -under the same terms as Perl itself. - -=head1 SEE ALSO - -L<Pod::Simple>, L<perlpod(1)>, L<pod2man(1)>, L<nroff(1)>, L<troff(1)>, -L<man(1)>, L<man(7)> - -Ossanna, Joseph F., and Brian W. Kernighan. "Troff User's Manual," -Computing Science Technical Report No. 54, AT&T Bell Laboratories. This is -the best documentation of standard B<nroff> and B<troff>. At the time of -this writing, it's available at -L<http://www.cs.bell-labs.com/cm/cs/cstr.html>. - -The man page documenting the man macro set may be L<man(5)> instead of -L<man(7)> on your system. Also, please see L<pod2man(1)> for extensive -documentation on writing manual pages if you've not done it before and -aren't familiar with the conventions. - -The current version of this module is always available from its web site at -L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the -Perl core distribution as of 5.6.0. - -=cut diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/ParseLink.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/ParseLink.pm deleted file mode 100644 index 7e4153da3d0..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/ParseLink.pm +++ /dev/null @@ -1,184 +0,0 @@ -# Pod::ParseLink -- Parse an L<> formatting code in POD text. -# $Id: ParseLink.pm,v 1.6 2002/07/15 05:46:00 eagle Exp $ -# -# Copyright 2001 by Russ Allbery <rra@stanford.edu> -# -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This module implements parsing of the text of an L<> formatting code as -# defined in perlpodspec. It should be suitable for any POD formatter. It -# exports only one function, parselink(), which returns the five-item parse -# defined in perlpodspec. -# -# Perl core hackers, please note that this module is also separately -# maintained outside of the Perl core as part of the podlators. Please send -# me any patches at the address above in addition to sending them to the -# standard Perl mailing lists. - -############################################################################## -# Modules and declarations -############################################################################## - -package Pod::ParseLink; - -require 5.004; - -use strict; -use vars qw(@EXPORT @ISA $VERSION); - -use Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(parselink); - -# Don't use the CVS revision as the version, since this module is also in Perl -# core and too many things could munge CVS magic revision strings. This -# number should ideally be the same as the CVS revision in podlators, however. -$VERSION = 1.06; - - -############################################################################## -# Implementation -############################################################################## - -# Parse the name and section portion of a link into a name and section. -sub _parse_section { - my ($link) = @_; - $link =~ s/^\s+//; - $link =~ s/\s+$//; - - # If the whole link is enclosed in quotes, interpret it all as a section - # even if it contains a slash. - return (undef, $1) if ($link =~ /^"\s*(.*?)\s*"$/); - - # Split into page and section on slash, and then clean up quoting in the - # section. If there is no section and the name contains spaces, also - # guess that it's an old section link. - my ($page, $section) = split (/\s*\/\s*/, $link, 2); - $section =~ s/^"\s*(.*?)\s*"$/$1/ if $section; - if ($page && $page =~ / / && !defined ($section)) { - $section = $page; - $page = undef; - } else { - $page = undef unless $page; - $section = undef unless $section; - } - return ($page, $section); -} - -# Infer link text from the page and section. -sub _infer_text { - my ($page, $section) = @_; - my $inferred; - if ($page && !$section) { - $inferred = $page; - } elsif (!$page && $section) { - $inferred = '"' . $section . '"'; - } elsif ($page && $section) { - $inferred = '"' . $section . '" in ' . $page; - } - return $inferred; -} - -# Given the contents of an L<> formatting code, parse it into the link text, -# the possibly inferred link text, the name or URL, the section, and the type -# of link (pod, man, or url). -sub parselink { - my ($link) = @_; - $link =~ s/\s+/ /g; - if ($link =~ /\A\w+:[^:\s]\S*\Z/) { - return (undef, $link, $link, undef, 'url'); - } else { - my $text; - if ($link =~ /\|/) { - ($text, $link) = split (/\|/, $link, 2); - } - my ($name, $section) = _parse_section ($link); - my $inferred = $text || _infer_text ($name, $section); - my $type = ($name && $name =~ /\(\S*\)/) ? 'man' : 'pod'; - return ($text, $inferred, $name, $section, $type); - } -} - - -############################################################################## -# Module return value and documentation -############################################################################## - -# Ensure we evaluate to true. -1; -__END__ - -=head1 NAME - -Pod::ParseLink - Parse an LE<lt>E<gt> formatting code in POD text - -=head1 SYNOPSIS - - use Pod::ParseLink; - my ($text, $inferred, $name, $section, $type) = parselink ($link); - -=head1 DESCRIPTION - -This module only provides a single function, parselink(), which takes the -text of an LE<lt>E<gt> formatting code and parses it. It returns the anchor -text for the link (if any was given), the anchor text possibly inferred from -the name and section, the name or URL, the section if any, and the type of -link. The type will be one of 'url', 'pod', or 'man', indicating a URL, a -link to a POD page, or a link to a Unix manual page. - -Parsing is implemented per L<perlpodspec>. For backward compatibility, -links where there is no section and name contains spaces, or links where the -entirety of the link (except for the anchor text if given) is enclosed in -double-quotes are interpreted as links to a section (LE<lt>/sectionE<gt>). - -The inferred anchor text is implemented per L<perlpodspec>: - - L<name> => L<name|name> - L</section> => L<"section"|/section> - L<name/section> => L<"section" in name|name/section> - -The name may contain embedded EE<lt>E<gt> and ZE<lt>E<gt> formatting codes, -and the section, anchor text, and inferred anchor text may contain any -formatting codes. Any double quotes around the section are removed as part -of the parsing, as is any leading or trailing whitespace. - -If the text of the LE<lt>E<gt> escape is entirely enclosed in double quotes, -it's interpreted as a link to a section for backwards compatibility. - -No attempt is made to resolve formatting codes. This must be done after -calling parselink (since EE<lt>E<gt> formatting codes can be used to escape -characters that would otherwise be significant to the parser and resolving -them before parsing would result in an incorrect parse of a formatting code -like: - - L<verticalE<verbar>barE<sol>slash> - -which should be interpreted as a link to the C<vertical|bar/slash> POD page -and not as a link to the C<slash> section of the C<bar> POD page with an -anchor text of C<vertical>. Note that not only the anchor text will need to -have formatting codes expanded, but so will the target of the link (to deal -with EE<lt>E<gt> and ZE<lt>E<gt> formatting codes), and special handling of -the section may be necessary depending on whether the translator wants to -consider markup in sections to be significant when resolving links. See -L<perlpodspec> for more information. - -=head1 SEE ALSO - -L<Pod::Parser> - -The current version of this module is always available from its web site at -L<http://www.eyrie.org/~eagle/software/podlators/>. - -=head1 AUTHOR - -Russ Allbery <rra@stanford.edu>. - -=head1 COPYRIGHT AND LICENSE - -Copyright 2001 by Russ Allbery <rra@stanford.edu>. - -This program is free software; you may redistribute it and/or modify it -under the same terms as Perl itself. - -=cut diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/ParseUtils.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/ParseUtils.pm deleted file mode 100644 index 13d66ab8d20..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/ParseUtils.pm +++ /dev/null @@ -1,854 +0,0 @@ -############################################################################# -# Pod/ParseUtils.pm -- helpers for POD parsing and conversion -# -# Copyright (C) 1999-2000 by Marek Rouchal. 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::ParseUtils; - -use vars qw($VERSION); -$VERSION = 1.35; ## Current version of this package -require 5.005; ## requires this Perl version or later - -=head1 NAME - -Pod::ParseUtils - helpers for POD parsing and conversion - -=head1 SYNOPSIS - - use Pod::ParseUtils; - - my $list = new Pod::List; - my $link = Pod::Hyperlink->new('Pod::Parser'); - -=head1 DESCRIPTION - -B<Pod::ParseUtils> contains a few object-oriented helper packages for -POD parsing and processing (i.e. in POD formatters and translators). - -=cut - -#----------------------------------------------------------------------------- -# Pod::List -# -# class to hold POD list info (=over, =item, =back) -#----------------------------------------------------------------------------- - -package Pod::List; - -use Carp; - -=head2 Pod::List - -B<Pod::List> can be used to hold information about POD lists -(written as =over ... =item ... =back) for further processing. -The following methods are available: - -=over 4 - -=item Pod::List-E<gt>new() - -Create a new list object. Properties may be specified through a hash -reference like this: - - my $list = Pod::List->new({ -start => $., -indent => 4 }); - -See the individual methods/properties for details. - -=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; - $self->{-file} ||= 'unknown'; - $self->{-start} ||= 'unknown'; - $self->{-indent} ||= 4; # perlpod: "should be the default" - $self->{_items} = []; - $self->{-type} ||= ''; -} - -=item $list-E<gt>file() - -Without argument, retrieves the file name the list is in. This must -have been set before by either specifying B<-file> in the B<new()> -method or by calling the B<file()> method with a scalar argument. - -=cut - -# The POD file name the list appears in -sub file { - return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; -} - -=item $list-E<gt>start() - -Without argument, retrieves the line number where the list started. -This must have been set before by either specifying B<-start> in the -B<new()> method or by calling the B<start()> method with a scalar -argument. - -=cut - -# The line in the file the node appears -sub start { - return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start}; -} - -=item $list-E<gt>indent() - -Without argument, retrieves the indent level of the list as specified -in C<=over n>. This must have been set before by either specifying -B<-indent> in the B<new()> method or by calling the B<indent()> method -with a scalar argument. - -=cut - -# indent level -sub indent { - return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent}; -} - -=item $list-E<gt>type() - -Without argument, retrieves the list type, which can be an arbitrary value, -e.g. C<OL>, C<UL>, ... when thinking the HTML way. -This must have been set before by either specifying -B<-type> in the B<new()> method or by calling the B<type()> method -with a scalar argument. - -=cut - -# The type of the list (UL, OL, ...) -sub type { - return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type}; -} - -=item $list-E<gt>rx() - -Without argument, retrieves a regular expression for simplifying the -individual item strings once the list type has been determined. Usage: -E.g. when converting to HTML, one might strip the leading number in -an ordered list as C<E<lt>OLE<gt>> already prints numbers itself. -This must have been set before by either specifying -B<-rx> in the B<new()> method or by calling the B<rx()> method -with a scalar argument. - -=cut - -# The regular expression to simplify the items -sub rx { - return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx}; -} - -=item $list-E<gt>item() - -Without argument, retrieves the array of the items in this list. -The items may be represented by any scalar. -If an argument has been given, it is pushed on the list of items. - -=cut - -# The individual =items of this list -sub item { - my ($self,$item) = @_; - if(defined $item) { - push(@{$self->{_items}}, $item); - return $item; - } - else { - return @{$self->{_items}}; - } -} - -=item $list-E<gt>parent() - -Without argument, retrieves information about the parent holding this -list, which is represented as an arbitrary scalar. -This must have been set before by either specifying -B<-parent> in the B<new()> method or by calling the B<parent()> method -with a scalar argument. - -=cut - -# possibility for parsers/translators to store information about the -# lists's parent object -sub parent { - return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent}; -} - -=item $list-E<gt>tag() - -Without argument, retrieves information about the list tag, which can be -any scalar. -This must have been set before by either specifying -B<-tag> in the B<new()> method or by calling the B<tag()> method -with a scalar argument. - -=back - -=cut - -# possibility for parsers/translators to store information about the -# list's object -sub tag { - return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag}; -} - -#----------------------------------------------------------------------------- -# Pod::Hyperlink -# -# class to manipulate POD hyperlinks (L<>) -#----------------------------------------------------------------------------- - -package Pod::Hyperlink; - -=head2 Pod::Hyperlink - -B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage: - - my $link = Pod::Hyperlink->new('alternative text|page/"section in page"'); - -The B<Pod::Hyperlink> class is mainly designed to parse the contents of the -C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the -different parts of a POD hyperlink for further processing. It can also be -used to construct hyperlinks. - -=over 4 - -=item Pod::Hyperlink-E<gt>new() - -The B<new()> method can either be passed a set of key/value pairs or a single -scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object -of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a -failure, the error message is stored in C<$@>. - -=cut - -use Carp; - -sub new { - my $this = shift; - my $class = ref($this) || $this; - my $self = +{}; - bless $self, $class; - $self->initialize(); - if(defined $_[0]) { - if(ref($_[0])) { - # called with a list of parameters - %$self = %{$_[0]}; - $self->_construct_text(); - } - else { - # called with L<> contents - return undef unless($self->parse($_[0])); - } - } - return $self; -} - -sub initialize { - my $self = shift; - $self->{-line} ||= 'undef'; - $self->{-file} ||= 'undef'; - $self->{-page} ||= ''; - $self->{-node} ||= ''; - $self->{-alttext} ||= ''; - $self->{-type} ||= 'undef'; - $self->{_warnings} = []; -} - -=item $link-E<gt>parse($string) - -This method can be used to (re)parse a (new) hyperlink, i.e. the contents -of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object. -Warnings are stored in the B<warnings> property. -E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point -to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage -section can simply be dropped. - -=cut - -sub parse { - my $self = shift; - local($_) = $_[0]; - # syntax check the link and extract destination - my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0); - - $self->{_warnings} = []; - - # collapse newlines with whitespace - s/\s*\n+\s*/ /g; - - # strip leading/trailing whitespace - if(s/^[\s\n]+//) { - $self->warning("ignoring leading whitespace in link"); - } - if(s/[\s\n]+$//) { - $self->warning("ignoring trailing whitespace in link"); - } - unless(length($_)) { - _invalid_link("empty link"); - return undef; - } - - ## Check for different possibilities. This is tedious and error-prone - # we match all possibilities (alttext, page, section/item) - #warn "DEBUG: link=$_\n"; - - # only page - # problem: a lot of people use (), or (1) or the like to indicate - # man page sections. But this collides with L<func()> that is supposed - # to point to an internal funtion... - my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)'; - # page name only - if(m!^($page_rx)$!o) { - $page = $1; - $type = 'page'; - } - # alttext, page and "section" - elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$!o) { - ($alttext, $page, $node) = ($1, $2, $3); - $type = 'section'; - $quoted = 1; #... therefore | and / are allowed - } - # alttext and page - elsif(m!^(.*?)\s*[|]\s*($page_rx)$!o) { - ($alttext, $page) = ($1, $2); - $type = 'page'; - } - # alttext and "section" - elsif(m!^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$!) { - ($alttext, $node) = ($1,$2); - $type = 'section'; - $quoted = 1; - } - # page and "section" - elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) { - ($page, $node) = ($1, $2); - $type = 'section'; - $quoted = 1; - } - # page and item - elsif(m!^($page_rx)\s*/\s*(.+)$!o) { - ($page, $node) = ($1, $2); - $type = 'item'; - } - # only "section" - elsif(m!^/?"(.+)"$!) { - $node = $1; - $type = 'section'; - $quoted = 1; - } - # only item - elsif(m!^\s*/(.+)$!) { - $node = $1; - $type = 'item'; - } - - # non-standard: Hyperlink with alt-text - doesn't remove protocol prefix, maybe it should? - elsif(m!^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $!ix) { - ($alttext,$node) = ($1,$2); - $type = 'hyperlink'; - } - - # non-standard: Hyperlink - elsif(m!^(\w+:[^:\s]\S*)$!i) { - $node = $1; - $type = 'hyperlink'; - } - # alttext, page and item - elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$!o) { - ($alttext, $page, $node) = ($1, $2, $3); - $type = 'item'; - } - # alttext and item - elsif(m!^(.*?)\s*[|]\s*/(.+)$!) { - ($alttext, $node) = ($1,$2); - } - # must be an item or a "malformed" section (without "") - else { - $node = $_; - $type = 'item'; - } - # collapse whitespace in nodes - $node =~ s/\s+/ /gs; - - # empty alternative text expands to node name - if(defined $alttext) { - if(!length($alttext)) { - $alttext = $node | $page; - } - } - else { - $alttext = ''; - } - - if($page =~ /[(]\w*[)]$/) { - $self->warning("(section) in '$page' deprecated"); - } - if(!$quoted && $node =~ m:[|/]: && $type ne 'hyperlink') { - $self->warning("node '$node' contains non-escaped | or /"); - } - if($alttext =~ m:[|/]:) { - $self->warning("alternative text '$node' contains non-escaped | or /"); - } - $self->{-page} = $page; - $self->{-node} = $node; - $self->{-alttext} = $alttext; - #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n"; - $self->{-type} = $type; - $self->_construct_text(); - 1; -} - -sub _construct_text { - my $self = shift; - my $alttext = $self->alttext(); - my $type = $self->type(); - my $section = $self->node(); - my $page = $self->page(); - my $page_ext = ''; - $page =~ s/([(]\w*[)])$// && ($page_ext = $1); - if($alttext) { - $self->{_text} = $alttext; - } - elsif($type eq 'hyperlink') { - $self->{_text} = $section; - } - else { - $self->{_text} = ($section || '') . - (($page && $section) ? ' in ' : '') . - "$page$page_ext"; - } - # for being marked up later - # use the non-standard markers P<> and Q<>, so that the resulting - # text can be parsed by the translators. It's their job to put - # the correct hypertext around the linktext - if($alttext) { - $self->{_markup} = "Q<$alttext>"; - } - elsif($type eq 'hyperlink') { - $self->{_markup} = "Q<$section>"; - } - else { - $self->{_markup} = (!$section ? '' : "Q<$section>") . - ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : ''); - } -} - -=item $link-E<gt>markup($string) - -Set/retrieve the textual value of the link. This string contains special -markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the -translator's interior sequence expansion engine to the -formatter-specific code to highlight/activate the hyperlink. The details -have to be implemented in the translator. - -=cut - -#' retrieve/set markuped text -sub markup { - return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup}; -} - -=item $link-E<gt>text() - -This method returns the textual representation of the hyperlink as above, -but without markers (read only). Depending on the link type this is one of -the following alternatives (the + and * denote the portions of the text -that are marked up): - - +perl+ L<perl> - *$|* in +perlvar+ L<perlvar/$|> - *OPTIONS* in +perldoc+ L<perldoc/"OPTIONS"> - *DESCRIPTION* L<"DESCRIPTION"> - -=cut - -# The complete link's text -sub text { - $_[0]->{_text}; -} - -=item $link-E<gt>warning() - -After parsing, this method returns any warnings encountered during the -parsing process. - -=cut - -# Set/retrieve warnings -sub warning { - my $self = shift; - if(@_) { - push(@{$self->{_warnings}}, @_); - return @_; - } - return @{$self->{_warnings}}; -} - -=item $link-E<gt>file() - -=item $link-E<gt>line() - -Just simple slots for storing information about the line and the file -the link was encountered in. Has to be filled in manually. - -=cut - -# The line in the file the link appears -sub line { - return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line}; -} - -# The POD file name the link appears in -sub file { - return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; -} - -=item $link-E<gt>page() - -This method sets or returns the POD page this link points to. - -=cut - -# The POD page the link appears on -sub page { - if (@_ > 1) { - $_[0]->{-page} = $_[1]; - $_[0]->_construct_text(); - } - $_[0]->{-page}; -} - -=item $link-E<gt>node() - -As above, but the destination node text of the link. - -=cut - -# The link destination -sub node { - if (@_ > 1) { - $_[0]->{-node} = $_[1]; - $_[0]->_construct_text(); - } - $_[0]->{-node}; -} - -=item $link-E<gt>alttext() - -Sets or returns an alternative text specified in the link. - -=cut - -# Potential alternative text -sub alttext { - if (@_ > 1) { - $_[0]->{-alttext} = $_[1]; - $_[0]->_construct_text(); - } - $_[0]->{-alttext}; -} - -=item $link-E<gt>type() - -The node type, either C<section> or C<item>. As an unofficial type, -there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>> - -=cut - -# The type: item or headn -sub type { - return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type}; -} - -=item $link-E<gt>link() - -Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>. - -=back - -=cut - -# The link itself -sub link { - my $self = shift; - my $link = $self->page() || ''; - if($self->node()) { - my $node = $self->node(); - $text =~ s/\|/E<verbar>/g; - $text =~ s:/:E<sol>:g; - if($self->type() eq 'section') { - $link .= ($link ? '/' : '') . '"' . $node . '"'; - } - elsif($self->type() eq 'hyperlink') { - $link = $self->node(); - } - else { # item - $link .= '/' . $node; - } - } - if($self->alttext()) { - my $text = $self->alttext(); - $text =~ s/\|/E<verbar>/g; - $text =~ s:/:E<sol>:g; - $link = "$text|$link"; - } - $link; -} - -sub _invalid_link { - my ($msg) = @_; - # this sets @_ - #eval { die "$msg\n" }; - #chomp $@; - $@ = $msg; # this seems to work, too! - undef; -} - -#----------------------------------------------------------------------------- -# Pod::Cache -# -# class to hold POD page details -#----------------------------------------------------------------------------- - -package Pod::Cache; - -=head2 Pod::Cache - -B<Pod::Cache> holds information about a set of POD documents, -especially the nodes for hyperlinks. -The following methods are available: - -=over 4 - -=item Pod::Cache-E<gt>new() - -Create a new cache object. This object can hold an arbitrary number of -POD documents of class Pod::Cache::Item. - -=cut - -sub new { - my $this = shift; - my $class = ref($this) || $this; - my $self = []; - bless $self, $class; - return $self; -} - -=item $cache-E<gt>item() - -Add a new item to the cache. Without arguments, this method returns a -list of all cache elements. - -=cut - -sub item { - my ($self,%param) = @_; - if(%param) { - my $item = Pod::Cache::Item->new(%param); - push(@$self, $item); - return $item; - } - else { - return @{$self}; - } -} - -=item $cache-E<gt>find_page($name) - -Look for a POD document named C<$name> in the cache. Returns the -reference to the corresponding Pod::Cache::Item object or undef if -not found. - -=back - -=cut - -sub find_page { - my ($self,$page) = @_; - foreach(@$self) { - if($_->page() eq $page) { - return $_; - } - } - undef; -} - -package Pod::Cache::Item; - -=head2 Pod::Cache::Item - -B<Pod::Cache::Item> holds information about individual POD documents, -that can be grouped in a Pod::Cache object. -It is intended to hold information about the hyperlink nodes of POD -documents. -The following methods are available: - -=over 4 - -=item Pod::Cache::Item-E<gt>new() - -Create a new object. - -=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; - $self->{-nodes} = [] unless(defined $self->{-nodes}); -} - -=item $cacheitem-E<gt>page() - -Set/retrieve the POD document name (e.g. "Pod::Parser"). - -=cut - -# The POD page -sub page { - return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page}; -} - -=item $cacheitem-E<gt>description() - -Set/retrieve the POD short description as found in the C<=head1 NAME> -section. - -=cut - -# The POD description, taken out of NAME if present -sub description { - return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description}; -} - -=item $cacheitem-E<gt>path() - -Set/retrieve the POD file storage path. - -=cut - -# The file path -sub path { - return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path}; -} - -=item $cacheitem-E<gt>file() - -Set/retrieve the POD file name. - -=cut - -# The POD file name -sub file { - return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; -} - -=item $cacheitem-E<gt>nodes() - -Add a node (or a list of nodes) to the document's node list. Note that -the order is kept, i.e. start with the first node and end with the last. -If no argument is given, the current list of nodes is returned in the -same order the nodes have been added. -A node can be any scalar, but usually is a pair of node string and -unique id for the C<find_node> method to work correctly. - -=cut - -# The POD nodes -sub nodes { - my ($self,@nodes) = @_; - if(@nodes) { - push(@{$self->{-nodes}}, @nodes); - return @nodes; - } - else { - return @{$self->{-nodes}}; - } -} - -=item $cacheitem-E<gt>find_node($name) - -Look for a node or index entry named C<$name> in the object. -Returns the unique id of the node (i.e. the second element of the array -stored in the node array) or undef if not found. - -=cut - -sub find_node { - my ($self,$node) = @_; - my @search; - push(@search, @{$self->{-nodes}}) if($self->{-nodes}); - push(@search, @{$self->{-idx}}) if($self->{-idx}); - foreach(@search) { - if($_->[0] eq $node) { - return $_->[1]; # id - } - } - undef; -} - -=item $cacheitem-E<gt>idx() - -Add an index entry (or a list of them) to the document's index list. Note that -the order is kept, i.e. start with the first node and end with the last. -If no argument is given, the current list of index entries is returned in the -same order the entries have been added. -An index entry can be any scalar, but usually is a pair of string and -unique id. - -=back - -=cut - -# The POD index entries -sub idx { - my ($self,@idx) = @_; - if(@idx) { - push(@{$self->{-idx}}, @idx); - return @idx; - } - else { - return @{$self->{-idx}}; - } -} - -=head1 AUTHOR - -Please report bugs using L<http://rt.cpan.org>. - -Marek Rouchal E<lt>marekr@cpan.orgE<gt>, borrowing -a lot of things from L<pod2man> and L<pod2roff> as well as other POD -processing tools by Tom Christiansen, Brad Appleton and Russ Allbery. - -=head1 SEE ALSO - -L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>, -L<pod2html> - -=cut - -1; diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Parser.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Parser.pm deleted file mode 100644 index d242a516af0..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Parser.pm +++ /dev/null @@ -1,1810 +0,0 @@ -############################################################################# -# Pod/Parser.pm -- package which defines a base class for parsing POD docs. -# -# Copyright (C) 1996-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::Parser; - -use vars qw($VERSION); -$VERSION = 1.35; ## Current version of this package -require 5.005; ## requires this Perl version or later - -############################################################################# - -=head1 NAME - -Pod::Parser - base class for creating POD filters and translators - -=head1 SYNOPSIS - - use Pod::Parser; - - package MyParser; - @ISA = qw(Pod::Parser); - - sub command { - my ($parser, $command, $paragraph, $line_num) = @_; - ## Interpret the command and its text; sample actions might be: - if ($command eq 'head1') { ... } - elsif ($command eq 'head2') { ... } - ## ... other commands and their actions - my $out_fh = $parser->output_handle(); - my $expansion = $parser->interpolate($paragraph, $line_num); - print $out_fh $expansion; - } - - sub verbatim { - my ($parser, $paragraph, $line_num) = @_; - ## Format verbatim paragraph; sample actions might be: - my $out_fh = $parser->output_handle(); - print $out_fh $paragraph; - } - - sub textblock { - my ($parser, $paragraph, $line_num) = @_; - ## Translate/Format this block of text; sample actions might be: - my $out_fh = $parser->output_handle(); - my $expansion = $parser->interpolate($paragraph, $line_num); - print $out_fh $expansion; - } - - sub interior_sequence { - my ($parser, $seq_command, $seq_argument) = @_; - ## Expand an interior sequence; sample actions might be: - return "*$seq_argument*" if ($seq_command eq 'B'); - return "`$seq_argument'" if ($seq_command eq 'C'); - return "_${seq_argument}_'" if ($seq_command eq 'I'); - ## ... other sequence commands and their resulting text - } - - package main; - - ## Create a parser object and have it parse file whose name was - ## given on the command-line (use STDIN if no files were given). - $parser = new MyParser(); - $parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0); - for (@ARGV) { $parser->parse_from_file($_); } - -=head1 REQUIRES - -perl5.005, Pod::InputObjects, Exporter, Symbol, Carp - -=head1 EXPORTS - -Nothing. - -=head1 DESCRIPTION - -B<Pod::Parser> is a base class for creating POD filters and translators. -It handles most of the effort involved with parsing the POD sections -from an input stream, leaving subclasses free to be concerned only with -performing the actual translation of text. - -B<Pod::Parser> parses PODs, and makes method calls to handle the various -components of the POD. Subclasses of B<Pod::Parser> override these methods -to translate the POD into whatever output format they desire. - -=head1 QUICK OVERVIEW - -To create a POD filter for translating POD documentation into some other -format, you create a subclass of B<Pod::Parser> which typically overrides -just the base class implementation for the following methods: - -=over 2 - -=item * - -B<command()> - -=item * - -B<verbatim()> - -=item * - -B<textblock()> - -=item * - -B<interior_sequence()> - -=back - -You may also want to override the B<begin_input()> and B<end_input()> -methods for your subclass (to perform any needed per-file and/or -per-document initialization or cleanup). - -If you need to perform any preprocesssing of input before it is parsed -you may want to override one or more of B<preprocess_line()> and/or -B<preprocess_paragraph()>. - -Sometimes it may be necessary to make more than one pass over the input -files. If this is the case you have several options. You can make the -first pass using B<Pod::Parser> and override your methods to store the -intermediate results in memory somewhere for the B<end_pod()> method to -process. You could use B<Pod::Parser> for several passes with an -appropriate state variable to control the operation for each pass. If -your input source can't be reset to start at the beginning, you can -store it in some other structure as a string or an array and have that -structure implement a B<getline()> method (which is all that -B<parse_from_filehandle()> uses to read input). - -Feel free to add any member data fields you need to keep track of things -like current font, indentation, horizontal or vertical position, or -whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA"> -to avoid name collisions. - -For the most part, the B<Pod::Parser> base class should be able to -do most of the input parsing for you and leave you free to worry about -how to interpret the commands and translate the result. - -Note that all we have described here in this quick overview is the -simplest most straightforward use of B<Pod::Parser> to do stream-based -parsing. It is also possible to use the B<Pod::Parser::parse_text> function -to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">. - -=head1 PARSING OPTIONS - -A I<parse-option> is simply a named option of B<Pod::Parser> with a -value that corresponds to a certain specified behavior. These various -behaviors of B<Pod::Parser> may be enabled/disabled by setting -or unsetting one or more I<parse-options> using the B<parseopts()> method. -The set of currently accepted parse-options is as follows: - -=over 3 - -=item B<-want_nonPODs> (default: unset) - -Normally (by default) B<Pod::Parser> will only provide access to -the POD sections of the input. Input paragraphs that are not part -of the POD-format documentation are not made available to the caller -(not even using B<preprocess_paragraph()>). Setting this option to a -non-empty, non-zero value will allow B<preprocess_paragraph()> to see -non-POD sections of the input as well as POD sections. The B<cutting()> -method can be used to determine if the corresponding paragraph is a POD -paragraph, or some other input paragraph. - -=item B<-process_cut_cmd> (default: unset) - -Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive -by itself and does not pass it on to the caller for processing. Setting -this option to a non-empty, non-zero value will cause B<Pod::Parser> to -pass the C<=cut> directive to the caller just like any other POD command -(and hence it may be processed by the B<command()> method). - -B<Pod::Parser> will still interpret the C<=cut> directive to mean that -"cutting mode" has been (re)entered, but the caller will get a chance -to capture the actual C<=cut> paragraph itself for whatever purpose -it desires. - -=item B<-warnings> (default: unset) - -Normally (by default) B<Pod::Parser> recognizes a bare minimum of -pod syntax errors and warnings and issues diagnostic messages -for errors, but not for warnings. (Use B<Pod::Checker> to do more -thorough checking of POD syntax.) Setting this option to a non-empty, -non-zero value will cause B<Pod::Parser> to issue diagnostics for -the few warnings it recognizes as well as the errors. - -=back - -Please see L<"parseopts()"> for a complete description of the interface -for the setting and unsetting of parse-options. - -=cut - -############################################################################# - -use vars qw(@ISA); -use strict; -#use diagnostics; -use Pod::InputObjects; -use Carp; -use Exporter; -BEGIN { - if ($] < 5.6) { - require Symbol; - import Symbol; - } -} -@ISA = qw(Exporter); - -## These "variables" are used as local "glob aliases" for performance -use vars qw(%myData %myOpts @input_stack); - -############################################################################# - -=head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES - -B<Pod::Parser> provides several methods which most subclasses will probably -want to override. These methods are as follows: - -=cut - -##--------------------------------------------------------------------------- - -=head1 B<command()> - - $parser->command($cmd,$text,$line_num,$pod_para); - -This method should be overridden by subclasses to take the appropriate -action when a POD command paragraph (denoted by a line beginning with -"=") is encountered. When such a POD directive is seen in the input, -this method is called and is passed: - -=over 3 - -=item C<$cmd> - -the name of the command for this POD paragraph - -=item C<$text> - -the paragraph text for the given POD paragraph command. - -=item C<$line_num> - -the line-number of the beginning of the paragraph - -=item C<$pod_para> - -a reference to a C<Pod::Paragraph> object which contains further -information about the paragraph command (see L<Pod::InputObjects> -for details). - -=back - -B<Note> that this method I<is> called for C<=pod> paragraphs. - -The base class implementation of this method simply treats the raw POD -command as normal block of paragraph text (invoking the B<textblock()> -method with the command paragraph). - -=cut - -sub command { - my ($self, $cmd, $text, $line_num, $pod_para) = @_; - ## Just treat this like a textblock - $self->textblock($pod_para->raw_text(), $line_num, $pod_para); -} - -##--------------------------------------------------------------------------- - -=head1 B<verbatim()> - - $parser->verbatim($text,$line_num,$pod_para); - -This method may be overridden by subclasses to take the appropriate -action when a block of verbatim text is encountered. It is passed the -following parameters: - -=over 3 - -=item C<$text> - -the block of text for the verbatim paragraph - -=item C<$line_num> - -the line-number of the beginning of the paragraph - -=item C<$pod_para> - -a reference to a C<Pod::Paragraph> object which contains further -information about the paragraph (see L<Pod::InputObjects> -for details). - -=back - -The base class implementation of this method simply prints the textblock -(unmodified) to the output filehandle. - -=cut - -sub verbatim { - my ($self, $text, $line_num, $pod_para) = @_; - my $out_fh = $self->{_OUTPUT}; - print $out_fh $text; -} - -##--------------------------------------------------------------------------- - -=head1 B<textblock()> - - $parser->textblock($text,$line_num,$pod_para); - -This method may be overridden by subclasses to take the appropriate -action when a normal block of POD text is encountered (although the base -class method will usually do what you want). It is passed the following -parameters: - -=over 3 - -=item C<$text> - -the block of text for the a POD paragraph - -=item C<$line_num> - -the line-number of the beginning of the paragraph - -=item C<$pod_para> - -a reference to a C<Pod::Paragraph> object which contains further -information about the paragraph (see L<Pod::InputObjects> -for details). - -=back - -In order to process interior sequences, subclasses implementations of -this method will probably want to invoke either B<interpolate()> or -B<parse_text()>, passing it the text block C<$text>, and the corresponding -line number in C<$line_num>, and then perform any desired processing upon -the returned result. - -The base class implementation of this method simply prints the text block -as it occurred in the input stream). - -=cut - -sub textblock { - my ($self, $text, $line_num, $pod_para) = @_; - my $out_fh = $self->{_OUTPUT}; - print $out_fh $self->interpolate($text, $line_num); -} - -##--------------------------------------------------------------------------- - -=head1 B<interior_sequence()> - - $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq); - -This method should be overridden by subclasses to take the appropriate -action when an interior sequence is encountered. An interior sequence is -an embedded command within a block of text which appears as a command -name (usually a single uppercase character) followed immediately by a -string of text which is enclosed in angle brackets. This method is -passed the sequence command C<$seq_cmd> and the corresponding text -C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior -sequence that occurs in the string that it is passed. It should return -the desired text string to be used in place of the interior sequence. -The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence> -object which contains further information about the interior sequence. -Please see L<Pod::InputObjects> for details if you need to access this -additional information. - -Subclass implementations of this method may wish to invoke the -B<nested()> method of C<$pod_seq> to see if it is nested inside -some other interior-sequence (and if so, which kind). - -The base class implementation of the B<interior_sequence()> method -simply returns the raw text of the interior sequence (as it occurred -in the input) to the caller. - -=cut - -sub interior_sequence { - my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_; - ## Just return the raw text of the interior sequence - return $pod_seq->raw_text(); -} - -############################################################################# - -=head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES - -B<Pod::Parser> provides several methods which subclasses may want to override -to perform any special pre/post-processing. These methods do I<not> have to -be overridden, but it may be useful for subclasses to take advantage of them. - -=cut - -##--------------------------------------------------------------------------- - -=head1 B<new()> - - my $parser = Pod::Parser->new(); - -This is the constructor for B<Pod::Parser> and its subclasses. You -I<do not> need to override this method! It is capable of constructing -subclass objects as well as base class objects, provided you use -any of the following constructor invocation styles: - - my $parser1 = MyParser->new(); - my $parser2 = new MyParser(); - my $parser3 = $parser2->new(); - -where C<MyParser> is some subclass of B<Pod::Parser>. - -Using the syntax C<MyParser::new()> to invoke the constructor is I<not> -recommended, but if you insist on being able to do this, then the -subclass I<will> need to override the B<new()> constructor method. If -you do override the constructor, you I<must> be sure to invoke the -B<initialize()> method of the newly blessed object. - -Using any of the above invocations, the first argument to the -constructor is always the corresponding package name (or object -reference). No other arguments are required, but if desired, an -associative array (or hash-table) my be passed to the B<new()> -constructor, as in: - - my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 ); - my $parser2 = new MyParser( -myflag => 1 ); - -All arguments passed to the B<new()> constructor will be treated as -key/value pairs in a hash-table. The newly constructed object will be -initialized by copying the contents of the given hash-table (which may -have been empty). The B<new()> constructor for this class and all of its -subclasses returns a blessed reference to the initialized object (hash-table). - -=cut - -sub new { - ## Determine if we were called via an object-ref or a classname - my $this = shift; - my $class = ref($this) || $this; - ## Any remaining arguments are treated as initial values for the - ## hash that is used to represent this object. - my %params = @_; - my $self = { %params }; - ## Bless ourselves into the desired class and perform any initialization - bless $self, $class; - $self->initialize(); - return $self; -} - -##--------------------------------------------------------------------------- - -=head1 B<initialize()> - - $parser->initialize(); - -This method performs any necessary object initialization. It takes no -arguments (other than the object instance of course, which is typically -copied to a local variable named C<$self>). If subclasses override this -method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>. - -=cut - -sub initialize { - #my $self = shift; - #return; -} - -##--------------------------------------------------------------------------- - -=head1 B<begin_pod()> - - $parser->begin_pod(); - -This method is invoked at the beginning of processing for each POD -document that is encountered in the input. Subclasses should override -this method to perform any per-document initialization. - -=cut - -sub begin_pod { - #my $self = shift; - #return; -} - -##--------------------------------------------------------------------------- - -=head1 B<begin_input()> - - $parser->begin_input(); - -This method is invoked by B<parse_from_filehandle()> immediately I<before> -processing input from a filehandle. The base class implementation does -nothing, however, subclasses may override it to perform any per-file -initializations. - -Note that if multiple files are parsed for a single POD document -(perhaps the result of some future C<=include> directive) this method -is invoked for every file that is parsed. If you wish to perform certain -initializations once per document, then you should use B<begin_pod()>. - -=cut - -sub begin_input { - #my $self = shift; - #return; -} - -##--------------------------------------------------------------------------- - -=head1 B<end_input()> - - $parser->end_input(); - -This method is invoked by B<parse_from_filehandle()> immediately I<after> -processing input from a filehandle. The base class implementation does -nothing, however, subclasses may override it to perform any per-file -cleanup actions. - -Please note that if multiple files are parsed for a single POD document -(perhaps the result of some kind of C<=include> directive) this method -is invoked for every file that is parsed. If you wish to perform certain -cleanup actions once per document, then you should use B<end_pod()>. - -=cut - -sub end_input { - #my $self = shift; - #return; -} - -##--------------------------------------------------------------------------- - -=head1 B<end_pod()> - - $parser->end_pod(); - -This method is invoked at the end of processing for each POD document -that is encountered in the input. Subclasses should override this method -to perform any per-document finalization. - -=cut - -sub end_pod { - #my $self = shift; - #return; -} - -##--------------------------------------------------------------------------- - -=head1 B<preprocess_line()> - - $textline = $parser->preprocess_line($text, $line_num); - -This method should be overridden by subclasses that wish to perform -any kind of preprocessing for each I<line> of input (I<before> it has -been determined whether or not it is part of a POD paragraph). The -parameter C<$text> is the input line; and the parameter C<$line_num> is -the line number of the corresponding text line. - -The value returned should correspond to the new text to use in its -place. If the empty string or an undefined value is returned then no -further processing will be performed for this line. - -Please note that the B<preprocess_line()> method is invoked I<before> -the B<preprocess_paragraph()> method. After all (possibly preprocessed) -lines in a paragraph have been assembled together and it has been -determined that the paragraph is part of the POD documentation from one -of the selected sections, then B<preprocess_paragraph()> is invoked. - -The base class implementation of this method returns the given text. - -=cut - -sub preprocess_line { - my ($self, $text, $line_num) = @_; - return $text; -} - -##--------------------------------------------------------------------------- - -=head1 B<preprocess_paragraph()> - - $textblock = $parser->preprocess_paragraph($text, $line_num); - -This method should be overridden by subclasses that wish to perform any -kind of preprocessing for each block (paragraph) of POD documentation -that appears in the input stream. The parameter C<$text> is the POD -paragraph from the input file; and the parameter C<$line_num> is the -line number for the beginning of the corresponding paragraph. - -The value returned should correspond to the new text to use in its -place If the empty string is returned or an undefined value is -returned, then the given C<$text> is ignored (not processed). - -This method is invoked after gathering up all the lines in a paragraph -and after determining the cutting state of the paragraph, -but before trying to further parse or interpret them. After -B<preprocess_paragraph()> returns, the current cutting state (which -is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates -to true then input text (including the given C<$text>) is cut (not -processed) until the next POD directive is encountered. - -Please note that the B<preprocess_line()> method is invoked I<before> -the B<preprocess_paragraph()> method. After all (possibly preprocessed) -lines in a paragraph have been assembled together and either it has been -determined that the paragraph is part of the POD documentation from one -of the selected sections or the C<-want_nonPODs> option is true, -then B<preprocess_paragraph()> is invoked. - -The base class implementation of this method returns the given text. - -=cut - -sub preprocess_paragraph { - my ($self, $text, $line_num) = @_; - return $text; -} - -############################################################################# - -=head1 METHODS FOR PARSING AND PROCESSING - -B<Pod::Parser> provides several methods to process input text. These -methods typically won't need to be overridden (and in some cases they -can't be overridden), but subclasses may want to invoke them to exploit -their functionality. - -=cut - -##--------------------------------------------------------------------------- - -=head1 B<parse_text()> - - $ptree1 = $parser->parse_text($text, $line_num); - $ptree2 = $parser->parse_text({%opts}, $text, $line_num); - $ptree3 = $parser->parse_text(\%opts, $text, $line_num); - -This method is useful if you need to perform your own interpolation -of interior sequences and can't rely upon B<interpolate> to expand -them in simple bottom-up order. - -The parameter C<$text> is a string or block of text to be parsed -for interior sequences; and the parameter C<$line_num> is the -line number corresponding to the beginning of C<$text>. - -B<parse_text()> will parse the given text into a parse-tree of "nodes." -and interior-sequences. Each "node" in the parse tree is either a -text-string, or a B<Pod::InteriorSequence>. The result returned is a -parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects> -for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>. - -If desired, an optional hash-ref may be specified as the first argument -to customize certain aspects of the parse-tree that is created and -returned. The set of recognized option keywords are: - -=over 3 - -=item B<-expand_seq> =E<gt> I<code-ref>|I<method-name> - -Normally, the parse-tree returned by B<parse_text()> will contain an -unexpanded C<Pod::InteriorSequence> object for each interior-sequence -encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand" -every interior-sequence it sees by invoking the referenced function -(or named method of the parser object) and using the return value as the -expanded result. - -If a subroutine reference was given, it is invoked as: - - &$code_ref( $parser, $sequence ) - -and if a method-name was given, it is invoked as: - - $parser->method_name( $sequence ) - -where C<$parser> is a reference to the parser object, and C<$sequence> -is a reference to the interior-sequence object. -[I<NOTE>: If the B<interior_sequence()> method is specified, then it is -invoked according to the interface specified in L<"interior_sequence()">]. - -=item B<-expand_text> =E<gt> I<code-ref>|I<method-name> - -Normally, the parse-tree returned by B<parse_text()> will contain a -text-string for each contiguous sequence of characters outside of an -interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to -"preprocess" every such text-string it sees by invoking the referenced -function (or named method of the parser object) and using the return value -as the preprocessed (or "expanded") result. [Note that if the result is -an interior-sequence, then it will I<not> be expanded as specified by the -B<-expand_seq> option; Any such recursive expansion needs to be handled by -the specified callback routine.] - -If a subroutine reference was given, it is invoked as: - - &$code_ref( $parser, $text, $ptree_node ) - -and if a method-name was given, it is invoked as: - - $parser->method_name( $text, $ptree_node ) - -where C<$parser> is a reference to the parser object, C<$text> is the -text-string encountered, and C<$ptree_node> is a reference to the current -node in the parse-tree (usually an interior-sequence object or else the -top-level node of the parse-tree). - -=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name> - -Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an -argument to the referenced subroutine (or named method of the parser -object) and return the result instead of the parse-tree object. - -If a subroutine reference was given, it is invoked as: - - &$code_ref( $parser, $ptree ) - -and if a method-name was given, it is invoked as: - - $parser->method_name( $ptree ) - -where C<$parser> is a reference to the parser object, and C<$ptree> -is a reference to the parse-tree object. - -=back - -=cut - -sub parse_text { - my $self = shift; - local $_ = ''; - - ## Get options and set any defaults - my %opts = (ref $_[0]) ? %{ shift() } : (); - my $expand_seq = $opts{'-expand_seq'} || undef; - my $expand_text = $opts{'-expand_text'} || undef; - my $expand_ptree = $opts{'-expand_ptree'} || undef; - - my $text = shift; - my $line = shift; - my $file = $self->input_file(); - my $cmd = ""; - - ## Convert method calls into closures, for our convenience - my $xseq_sub = $expand_seq; - my $xtext_sub = $expand_text; - my $xptree_sub = $expand_ptree; - if (defined $expand_seq and $expand_seq eq 'interior_sequence') { - ## If 'interior_sequence' is the method to use, we have to pass - ## more than just the sequence object, we also need to pass the - ## sequence name and text. - $xseq_sub = sub { - my ($self, $iseq) = @_; - my $args = join("", $iseq->parse_tree->children); - return $self->interior_sequence($iseq->name, $args, $iseq); - }; - } - ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) }; - ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) }; - ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) }; - - ## Keep track of the "current" interior sequence, and maintain a stack - ## of "in progress" sequences. - ## - ## NOTE that we push our own "accumulator" at the very beginning of the - ## stack. It's really a parse-tree, not a sequence; but it implements - ## the methods we need so we can use it to gather-up all the sequences - ## and strings we parse. Thus, by the end of our parsing, it should be - ## the only thing left on our stack and all we have to do is return it! - ## - my $seq = Pod::ParseTree->new(); - my @seq_stack = ($seq); - my ($ldelim, $rdelim) = ('', ''); - - ## Iterate over all sequence starts text (NOTE: split with - ## capturing parens keeps the delimiters) - $_ = $text; - my @tokens = split /([A-Z]<(?:<+\s)?)/; - while ( @tokens ) { - $_ = shift @tokens; - ## Look for the beginning of a sequence - if ( /^([A-Z])(<(?:<+\s)?)$/ ) { - ## Push a new sequence onto the stack of those "in-progress" - my $ldelim_orig; - ($cmd, $ldelim_orig) = ($1, $2); - ($ldelim = $ldelim_orig) =~ s/\s+$//; - ($rdelim = $ldelim) =~ tr/</>/; - $seq = Pod::InteriorSequence->new( - -name => $cmd, - -ldelim => $ldelim_orig, -rdelim => $rdelim, - -file => $file, -line => $line - ); - (@seq_stack > 1) and $seq->nested($seq_stack[-1]); - push @seq_stack, $seq; - } - ## Look for sequence ending - elsif ( @seq_stack > 1 ) { - ## Make sure we match the right kind of closing delimiter - my ($seq_end, $post_seq) = ("", ""); - if ( ($ldelim eq '<' and /\A(.*?)(>)/s) - or /\A(.*?)(\s+$rdelim)/s ) - { - ## Found end-of-sequence, capture the interior and the - ## closing the delimiter, and put the rest back on the - ## token-list - $post_seq = substr($_, length($1) + length($2)); - ($_, $seq_end) = ($1, $2); - (length $post_seq) and unshift @tokens, $post_seq; - } - if (length) { - ## In the middle of a sequence, append this text to it, and - ## dont forget to "expand" it if that's what the caller wanted - $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); - $_ .= $seq_end; - } - if (length $seq_end) { - ## End of current sequence, record terminating delimiter - $seq->rdelim($seq_end); - ## Pop it off the stack of "in progress" sequences - pop @seq_stack; - ## Append result to its parent in current parse tree - $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) - : $seq); - ## Remember the current cmd-name and left-delimiter - if(@seq_stack > 1) { - $cmd = $seq_stack[-1]->name; - $ldelim = $seq_stack[-1]->ldelim; - $rdelim = $seq_stack[-1]->rdelim; - } else { - $cmd = $ldelim = $rdelim = ''; - } - } - } - elsif (length) { - ## In the middle of a sequence, append this text to it, and - ## dont forget to "expand" it if that's what the caller wanted - $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); - } - ## Keep track of line count - $line += s/\r*\n//; - ## Remember the "current" sequence - $seq = $seq_stack[-1]; - } - - ## Handle unterminated sequences - my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef; - while (@seq_stack > 1) { - ($cmd, $file, $line) = ($seq->name, $seq->file_line); - $ldelim = $seq->ldelim; - ($rdelim = $ldelim) =~ tr/</>/; - $rdelim =~ s/^(\S+)(\s*)$/$2$1/; - pop @seq_stack; - my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}". - " at line $line in file $file\n"; - (ref $errorsub) and &{$errorsub}($errmsg) - or (defined $errorsub) and $self->$errorsub($errmsg) - or warn($errmsg); - $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq); - $seq = $seq_stack[-1]; - } - - ## Return the resulting parse-tree - my $ptree = (pop @seq_stack)->parse_tree; - return $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree; -} - -##--------------------------------------------------------------------------- - -=head1 B<interpolate()> - - $textblock = $parser->interpolate($text, $line_num); - -This method translates all text (including any embedded interior sequences) -in the given text string C<$text> and returns the interpolated result. The -parameter C<$line_num> is the line number corresponding to the beginning -of C<$text>. - -B<interpolate()> merely invokes a private method to recursively expand -nested interior sequences in bottom-up order (innermost sequences are -expanded first). If there is a need to expand nested sequences in -some alternate order, use B<parse_text> instead. - -=cut - -sub interpolate { - my($self, $text, $line_num) = @_; - my %parse_opts = ( -expand_seq => 'interior_sequence' ); - my $ptree = $self->parse_text( \%parse_opts, $text, $line_num ); - return join "", $ptree->children(); -} - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head1 B<parse_paragraph()> - - $parser->parse_paragraph($text, $line_num); - -This method takes the text of a POD paragraph to be processed, along -with its corresponding line number, and invokes the appropriate method -(one of B<command()>, B<verbatim()>, or B<textblock()>). - -For performance reasons, this method is invoked directly without any -dynamic lookup; Hence subclasses may I<not> override it! - -=end __PRIVATE__ - -=cut - -sub parse_paragraph { - my ($self, $text, $line_num) = @_; - local *myData = $self; ## alias to avoid deref-ing overhead - local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options - local $_; - - ## See if we want to preprocess nonPOD paragraphs as well as POD ones. - my $wantNonPods = $myOpts{'-want_nonPODs'}; - - ## Update cutting status - $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/; - - ## Perform any desired preprocessing if we wanted it this early - $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num); - - ## Ignore up until next POD directive if we are cutting - return if $myData{_CUTTING}; - - ## Now we know this is block of text in a POD section! - - ##----------------------------------------------------------------- - ## This is a hook (hack ;-) for Pod::Select to do its thing without - ## having to override methods, but also without Pod::Parser assuming - ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS - ## field exists then we assume there is an is_selected() method for - ## us to invoke (calling $self->can('is_selected') could verify this - ## but that is more overhead than I want to incur) - ##----------------------------------------------------------------- - - ## Ignore this block if it isnt in one of the selected sections - if (exists $myData{_SELECTED_SECTIONS}) { - $self->is_selected($text) or return ($myData{_CUTTING} = 1); - } - - ## If we havent already, perform any desired preprocessing and - ## then re-check the "cutting" state - unless ($wantNonPods) { - $text = $self->preprocess_paragraph($text, $line_num); - return 1 unless ((defined $text) and (length $text)); - return 1 if ($myData{_CUTTING}); - } - - ## Look for one of the three types of paragraphs - my ($pfx, $cmd, $arg, $sep) = ('', '', '', ''); - my $pod_para = undef; - if ($text =~ /^(={1,2})(?=\S)/) { - ## Looks like a command paragraph. Capture the command prefix used - ## ("=" or "=="), as well as the command-name, its paragraph text, - ## and whatever sequence of characters was used to separate them - $pfx = $1; - $_ = substr($text, length $pfx); - ($cmd, $sep, $text) = split /(\s+)/, $_, 2; - ## If this is a "cut" directive then we dont need to do anything - ## except return to "cutting" mode. - if ($cmd eq 'cut') { - $myData{_CUTTING} = 1; - return unless $myOpts{'-process_cut_cmd'}; - } - } - ## Save the attributes indicating how the command was specified. - $pod_para = new Pod::Paragraph( - -name => $cmd, - -text => $text, - -prefix => $pfx, - -separator => $sep, - -file => $myData{_INFILE}, - -line => $line_num - ); - # ## Invoke appropriate callbacks - # if (exists $myData{_CALLBACKS}) { - # ## Look through the callback list, invoke callbacks, - # ## then see if we need to do the default actions - # ## (invoke_callbacks will return true if we do). - # return 1 unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para); - # } - if (length $cmd) { - ## A command paragraph - $self->command($cmd, $text, $line_num, $pod_para); - } - elsif ($text =~ /^\s+/) { - ## Indented text - must be a verbatim paragraph - $self->verbatim($text, $line_num, $pod_para); - } - else { - ## Looks like an ordinary block of text - $self->textblock($text, $line_num, $pod_para); - } - return 1; -} - -##--------------------------------------------------------------------------- - -=head1 B<parse_from_filehandle()> - - $parser->parse_from_filehandle($in_fh,$out_fh); - -This method takes an input filehandle (which is assumed to already be -opened for reading) and reads the entire input stream looking for blocks -(paragraphs) of POD documentation to be processed. If no first argument -is given the default input filehandle C<STDIN> is used. - -The C<$in_fh> parameter may be any object that provides a B<getline()> -method to retrieve a single line of input text (hence, an appropriate -wrapper object could be used to parse PODs from a single string or an -array of strings). - -Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled -into paragraphs or "blocks" (which are separated by lines containing -nothing but whitespace). For each block of POD documentation -encountered it will invoke a method to parse the given paragraph. - -If a second argument is given then it should correspond to a filehandle where -output should be sent (otherwise the default output filehandle is -C<STDOUT> if no output filehandle is currently in use). - -B<NOTE:> For performance reasons, this method caches the input stream at -the top of the stack in a local variable. Any attempts by clients to -change the stack contents during processing when in the midst executing -of this method I<will not affect> the input stream used by the current -invocation of this method. - -This method does I<not> usually need to be overridden by subclasses. - -=cut - -sub parse_from_filehandle { - my $self = shift; - my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : (); - my ($in_fh, $out_fh) = @_; - $in_fh = \*STDIN unless ($in_fh); - local *myData = $self; ## alias to avoid deref-ing overhead - local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options - local $_; - - ## Put this stream at the top of the stack and do beginning-of-input - ## processing. NOTE that $in_fh might be reset during this process. - my $topstream = $self->_push_input_stream($in_fh, $out_fh); - (exists $opts{-cutting}) and $self->cutting( $opts{-cutting} ); - - ## Initialize line/paragraph - my ($textline, $paragraph) = ('', ''); - my ($nlines, $plines) = (0, 0); - - ## Use <$fh> instead of $fh->getline where possible (for speed) - $_ = ref $in_fh; - my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/ or tied $in_fh); - - ## Read paragraphs line-by-line - while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) { - $textline = $self->preprocess_line($textline, ++$nlines); - next unless ((defined $textline) && (length $textline)); - - if ((! length $paragraph) && ($textline =~ /^==/)) { - ## '==' denotes a one-line command paragraph - $paragraph = $textline; - $plines = 1; - $textline = ''; - } else { - ## Append this line to the current paragraph - $paragraph .= $textline; - ++$plines; - } - - ## See if this line is blank and ends the current paragraph. - ## If it isnt, then keep iterating until it is. - next unless (($textline =~ /^([^\S\r\n]*)[\r\n]*$/) - && (length $paragraph)); - - ## Issue a warning about any non-empty blank lines - if (length($1) > 0 and $myOpts{'-warnings'} and ! $myData{_CUTTING}) { - my $errorsub = $self->errorsub(); - my $file = $self->input_file(); - my $errmsg = "*** WARNING: line containing nothing but whitespace". - " in paragraph at line $nlines in file $file\n"; - (ref $errorsub) and &{$errorsub}($errmsg) - or (defined $errorsub) and $self->$errorsub($errmsg) - or warn($errmsg); - } - - ## Now process the paragraph - parse_paragraph($self, $paragraph, ($nlines - $plines) + 1); - $paragraph = ''; - $plines = 0; - } - ## Dont forget about the last paragraph in the file - if (length $paragraph) { - parse_paragraph($self, $paragraph, ($nlines - $plines) + 1) - } - - ## Now pop the input stream off the top of the input stack. - $self->_pop_input_stream(); -} - -##--------------------------------------------------------------------------- - -=head1 B<parse_from_file()> - - $parser->parse_from_file($filename,$outfile); - -This method takes a filename and does the following: - -=over 2 - -=item * - -opens the input and output files for reading -(creating the appropriate filehandles) - -=item * - -invokes the B<parse_from_filehandle()> method passing it the -corresponding input and output filehandles. - -=item * - -closes the input and output files. - -=back - -If the special input filename "-" or "<&STDIN" is given then the STDIN -filehandle is used for input (and no open or close is performed). If no -input filename is specified then "-" is implied. - -If a second argument is given then it should be the name of the desired -output file. If the special output filename "-" or ">&STDOUT" is given -then the STDOUT filehandle is used for output (and no open or close is -performed). If the special output filename ">&STDERR" is given then the -STDERR filehandle is used for output (and no open or close is -performed). If no output filehandle is currently in use and no output -filename is specified, then "-" is implied. -Alternatively, an L<IO::String> object is also accepted as an output -file handle. - -This method does I<not> usually need to be overridden by subclasses. - -=cut - -sub parse_from_file { - my $self = shift; - my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : (); - my ($infile, $outfile) = @_; - my ($in_fh, $out_fh); - if ($] < 5.006) { - ($in_fh, $out_fh) = (gensym(), gensym()); - } - my ($close_input, $close_output) = (0, 0); - local *myData = $self; - local *_; - - ## Is $infile a filename or a (possibly implied) filehandle - if (defined $infile && ref $infile) { - if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) { - croak "Input from $1 reference not supported!\n"; - } - ## Must be a filehandle-ref (or else assume its a ref to an object - ## that supports the common IO read operations). - $myData{_INFILE} = ${$infile}; - $in_fh = $infile; - } - elsif (!defined($infile) || !length($infile) || ($infile eq '-') - || ($infile =~ /^<&(?:STDIN|0)$/i)) - { - ## Not a filename, just a string implying STDIN - $infile ||= '-'; - $myData{_INFILE} = "<standard input>"; - $in_fh = \*STDIN; - } - else { - ## We have a filename, open it for reading - $myData{_INFILE} = $infile; - open($in_fh, "< $infile") or - croak "Can't open $infile for reading: $!\n"; - $close_input = 1; - } - - ## NOTE: we need to be *very* careful when "defaulting" the output - ## file. We only want to use a default if this is the beginning of - ## the entire document (but *not* if this is an included file). We - ## determine this by seeing if the input stream stack has been set-up - ## already - - ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref? - if (ref $outfile) { - ## we need to check for ref() first, as other checks involve reading - if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) { - croak "Output to $1 reference not supported!\n"; - } - elsif (ref($outfile) eq 'SCALAR') { -# # NOTE: IO::String isn't a part of the perl distribution, -# # so probably we shouldn't support this case... -# require IO::String; -# $myData{_OUTFILE} = "$outfile"; -# $out_fh = IO::String->new($outfile); - croak "Output to SCALAR reference not supported!\n"; - } - else { - ## Must be a filehandle-ref (or else assume its a ref to an - ## object that supports the common IO write operations). - $myData{_OUTFILE} = ${$outfile}; - $out_fh = $outfile; - } - } - elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-') - || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) - { - if (defined $myData{_TOP_STREAM}) { - $out_fh = $myData{_OUTPUT}; - } - else { - ## Not a filename, just a string implying STDOUT - $outfile ||= '-'; - $myData{_OUTFILE} = "<standard output>"; - $out_fh = \*STDOUT; - } - } - elsif ($outfile =~ /^>&(STDERR|2)$/i) { - ## Not a filename, just a string implying STDERR - $myData{_OUTFILE} = "<standard error>"; - $out_fh = \*STDERR; - } - else { - ## We have a filename, open it for writing - $myData{_OUTFILE} = $outfile; - (-d $outfile) and croak "$outfile is a directory, not POD input!\n"; - open($out_fh, "> $outfile") or - croak "Can't open $outfile for writing: $!\n"; - $close_output = 1; - } - - ## Whew! That was a lot of work to set up reasonably/robust behavior - ## in the case of a non-filename for reading and writing. Now we just - ## have to parse the input and close the handles when we're finished. - $self->parse_from_filehandle(\%opts, $in_fh, $out_fh); - - $close_input and - close($in_fh) || croak "Can't close $infile after reading: $!\n"; - $close_output and - close($out_fh) || croak "Can't close $outfile after writing: $!\n"; -} - -############################################################################# - -=head1 ACCESSOR METHODS - -Clients of B<Pod::Parser> should use the following methods to access -instance data fields: - -=cut - -##--------------------------------------------------------------------------- - -=head1 B<errorsub()> - - $parser->errorsub("method_name"); - $parser->errorsub(\&warn_user); - $parser->errorsub(sub { print STDERR, @_ }); - -Specifies the method or subroutine to use when printing error messages -about POD syntax. The supplied method/subroutine I<must> return TRUE upon -successful printing of the message. If C<undef> is given, then the B<warn> -builtin is used to issue error messages (this is the default behavior). - - my $errorsub = $parser->errorsub() - my $errmsg = "This is an error message!\n" - (ref $errorsub) and &{$errorsub}($errmsg) - or (defined $errorsub) and $parser->$errorsub($errmsg) - or warn($errmsg); - -Returns a method name, or else a reference to the user-supplied subroutine -used to print error messages. Returns C<undef> if the B<warn> builtin -is used to issue error messages (this is the default behavior). - -=cut - -sub errorsub { - return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB}; -} - -##--------------------------------------------------------------------------- - -=head1 B<cutting()> - - $boolean = $parser->cutting(); - -Returns the current C<cutting> state: a boolean-valued scalar which -evaluates to true if text from the input file is currently being "cut" -(meaning it is I<not> considered part of the POD document). - - $parser->cutting($boolean); - -Sets the current C<cutting> state to the given value and returns the -result. - -=cut - -sub cutting { - return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING}; -} - -##--------------------------------------------------------------------------- - -##--------------------------------------------------------------------------- - -=head1 B<parseopts()> - -When invoked with no additional arguments, B<parseopts> returns a hashtable -of all the current parsing options. - - ## See if we are parsing non-POD sections as well as POD ones - my %opts = $parser->parseopts(); - $opts{'-want_nonPODs}' and print "-want_nonPODs\n"; - -When invoked using a single string, B<parseopts> treats the string as the -name of a parse-option and returns its corresponding value if it exists -(returns C<undef> if it doesn't). - - ## Did we ask to see '=cut' paragraphs? - my $want_cut = $parser->parseopts('-process_cut_cmd'); - $want_cut and print "-process_cut_cmd\n"; - -When invoked with multiple arguments, B<parseopts> treats them as -key/value pairs and the specified parse-option names are set to the -given values. Any unspecified parse-options are unaffected. - - ## Set them back to the default - $parser->parseopts(-warnings => 0); - -When passed a single hash-ref, B<parseopts> uses that hash to completely -reset the existing parse-options, all previous parse-option values -are lost. - - ## Reset all options to default - $parser->parseopts( { } ); - -See L<"PARSING OPTIONS"> for more information on the name and meaning of each -parse-option currently recognized. - -=cut - -sub parseopts { - local *myData = shift; - local *myOpts = ($myData{_PARSEOPTS} ||= {}); - return %myOpts if (@_ == 0); - if (@_ == 1) { - local $_ = shift; - return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_}; - } - my @newOpts = (%myOpts, @_); - $myData{_PARSEOPTS} = { @newOpts }; -} - -##--------------------------------------------------------------------------- - -=head1 B<output_file()> - - $fname = $parser->output_file(); - -Returns the name of the output file being written. - -=cut - -sub output_file { - return $_[0]->{_OUTFILE}; -} - -##--------------------------------------------------------------------------- - -=head1 B<output_handle()> - - $fhandle = $parser->output_handle(); - -Returns the output filehandle object. - -=cut - -sub output_handle { - return $_[0]->{_OUTPUT}; -} - -##--------------------------------------------------------------------------- - -=head1 B<input_file()> - - $fname = $parser->input_file(); - -Returns the name of the input file being read. - -=cut - -sub input_file { - return $_[0]->{_INFILE}; -} - -##--------------------------------------------------------------------------- - -=head1 B<input_handle()> - - $fhandle = $parser->input_handle(); - -Returns the current input filehandle object. - -=cut - -sub input_handle { - return $_[0]->{_INPUT}; -} - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head1 B<input_streams()> - - $listref = $parser->input_streams(); - -Returns a reference to an array which corresponds to the stack of all -the input streams that are currently in the middle of being parsed. - -While parsing an input stream, it is possible to invoke -B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input -stream and then return to parsing the previous input stream. Each input -stream to be parsed is pushed onto the end of this input stack -before any of its input is read. The input stream that is currently -being parsed is always at the end (or top) of the input stack. When an -input stream has been exhausted, it is popped off the end of the -input stack. - -Each element on this input stack is a reference to C<Pod::InputSource> -object. Please see L<Pod::InputObjects> for more details. - -This method might be invoked when printing diagnostic messages, for example, -to obtain the name and line number of the all input files that are currently -being processed. - -=end __PRIVATE__ - -=cut - -sub input_streams { - return $_[0]->{_INPUT_STREAMS}; -} - -##--------------------------------------------------------------------------- - -=begin __PRIVATE__ - -=head1 B<top_stream()> - - $hashref = $parser->top_stream(); - -Returns a reference to the hash-table that represents the element -that is currently at the top (end) of the input stream stack -(see L<"input_streams()">). The return value will be the C<undef> -if the input stack is empty. - -This method might be used when printing diagnostic messages, for example, -to obtain the name and line number of the current input file. - -=end __PRIVATE__ - -=cut - -sub top_stream { - return $_[0]->{_TOP_STREAM} || undef; -} - -############################################################################# - -=head1 PRIVATE METHODS AND DATA - -B<Pod::Parser> makes use of several internal methods and data fields -which clients should not need to see or use. For the sake of avoiding -name collisions for client data and methods, these methods and fields -are briefly discussed here. Determined hackers may obtain further -information about them by reading the B<Pod::Parser> source code. - -Private data fields are stored in the hash-object whose reference is -returned by the B<new()> constructor for this class. The names of all -private methods and data-fields used by B<Pod::Parser> begin with a -prefix of "_" and match the regular expression C</^_\w+$/>. - -=cut - -##--------------------------------------------------------------------------- - -=begin _PRIVATE_ - -=head1 B<_push_input_stream()> - - $hashref = $parser->_push_input_stream($in_fh,$out_fh); - -This method will push the given input stream on the input stack and -perform any necessary beginning-of-document or beginning-of-file -processing. The argument C<$in_fh> is the input stream filehandle to -push, and C<$out_fh> is the corresponding output filehandle to use (if -it is not given or is undefined, then the current output stream is used, -which defaults to standard output if it doesnt exist yet). - -The value returned will be reference to the hash-table that represents -the new top of the input stream stack. I<Please Note> that it is -possible for this method to use default values for the input and output -file handles. If this happens, you will need to look at the C<INPUT> -and C<OUTPUT> instance data members to determine their new values. - -=end _PRIVATE_ - -=cut - -sub _push_input_stream { - my ($self, $in_fh, $out_fh) = @_; - local *myData = $self; - - ## Initialize stuff for the entire document if this is *not* - ## an included file. - ## - ## NOTE: we need to be *very* careful when "defaulting" the output - ## filehandle. We only want to use a default value if this is the - ## beginning of the entire document (but *not* if this is an included - ## file). - unless (defined $myData{_TOP_STREAM}) { - $out_fh = \*STDOUT unless (defined $out_fh); - $myData{_CUTTING} = 1; ## current "cutting" state - $myData{_INPUT_STREAMS} = []; ## stack of all input streams - } - - ## Initialize input indicators - $myData{_OUTFILE} = '(unknown)' unless (defined $myData{_OUTFILE}); - $myData{_OUTPUT} = $out_fh if (defined $out_fh); - $in_fh = \*STDIN unless (defined $in_fh); - $myData{_INFILE} = '(unknown)' unless (defined $myData{_INFILE}); - $myData{_INPUT} = $in_fh; - my $input_top = $myData{_TOP_STREAM} - = new Pod::InputSource( - -name => $myData{_INFILE}, - -handle => $in_fh, - -was_cutting => $myData{_CUTTING} - ); - local *input_stack = $myData{_INPUT_STREAMS}; - push(@input_stack, $input_top); - - ## Perform beginning-of-document and/or beginning-of-input processing - $self->begin_pod() if (@input_stack == 1); - $self->begin_input(); - - return $input_top; -} - -##--------------------------------------------------------------------------- - -=begin _PRIVATE_ - -=head1 B<_pop_input_stream()> - - $hashref = $parser->_pop_input_stream(); - -This takes no arguments. It will perform any necessary end-of-file or -end-of-document processing and then pop the current input stream from -the top of the input stack. - -The value returned will be reference to the hash-table that represents -the new top of the input stream stack. - -=end _PRIVATE_ - -=cut - -sub _pop_input_stream { - my ($self) = @_; - local *myData = $self; - local *input_stack = $myData{_INPUT_STREAMS}; - - ## Perform end-of-input and/or end-of-document processing - $self->end_input() if (@input_stack > 0); - $self->end_pod() if (@input_stack == 1); - - ## Restore cutting state to whatever it was before we started - ## parsing this file. - my $old_top = pop(@input_stack); - $myData{_CUTTING} = $old_top->was_cutting(); - - ## Dont forget to reset the input indicators - my $input_top = undef; - if (@input_stack > 0) { - $input_top = $myData{_TOP_STREAM} = $input_stack[-1]; - $myData{_INFILE} = $input_top->name(); - $myData{_INPUT} = $input_top->handle(); - } else { - delete $myData{_TOP_STREAM}; - delete $myData{_INPUT_STREAMS}; - } - - return $input_top; -} - -############################################################################# - -=head1 TREE-BASED PARSING - -If straightforward stream-based parsing wont meet your needs (as is -likely the case for tasks such as translating PODs into structured -markup languages like HTML and XML) then you may need to take the -tree-based approach. Rather than doing everything in one pass and -calling the B<interpolate()> method to expand sequences into text, it -may be desirable to instead create a parse-tree using the B<parse_text()> -method to return a tree-like structure which may contain an ordered -list of children (each of which may be a text-string, or a similar -tree-like structure). - -Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and -to the objects described in L<Pod::InputObjects>. The former describes -the gory details and parameters for how to customize and extend the -parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides -several objects that may all be used interchangeably as parse-trees. The -most obvious one is the B<Pod::ParseTree> object. It defines the basic -interface and functionality that all things trying to be a POD parse-tree -should do. A B<Pod::ParseTree> is defined such that each "node" may be a -text-string, or a reference to another parse-tree. Each B<Pod::Paragraph> -object and each B<Pod::InteriorSequence> object also supports the basic -parse-tree interface. - -The B<parse_text()> method takes a given paragraph of text, and -returns a parse-tree that contains one or more children, each of which -may be a text-string, or an InteriorSequence object. There are also -callback-options that may be passed to B<parse_text()> to customize -the way it expands or transforms interior-sequences, as well as the -returned result. These callbacks can be used to create a parse-tree -with custom-made objects (which may or may not support the parse-tree -interface, depending on how you choose to do it). - -If you wish to turn an entire POD document into a parse-tree, that process -is fairly straightforward. The B<parse_text()> method is the key to doing -this successfully. Every paragraph-callback (i.e. the polymorphic methods -for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes -a B<Pod::Paragraph> object as an argument. Each paragraph object has a -B<parse_tree()> method that can be used to get or set a corresponding -parse-tree. So for each of those paragraph-callback methods, simply call -B<parse_text()> with the options you desire, and then use the returned -parse-tree to assign to the given paragraph object. - -That gives you a parse-tree for each paragraph - so now all you need is -an ordered list of paragraphs. You can maintain that yourself as a data -element in the object/hash. The most straightforward way would be simply -to use an array-ref, with the desired set of custom "options" for each -invocation of B<parse_text>. Let's assume the desired option-set is -given by the hash C<%options>. Then we might do something like the -following: - - package MyPodParserTree; - - @ISA = qw( Pod::Parser ); - - ... - - sub begin_pod { - my $self = shift; - $self->{'-paragraphs'} = []; ## initialize paragraph list - } - - sub command { - my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; - my $ptree = $parser->parse_text({%options}, $paragraph, ...); - $pod_para->parse_tree( $ptree ); - push @{ $self->{'-paragraphs'} }, $pod_para; - } - - sub verbatim { - my ($parser, $paragraph, $line_num, $pod_para) = @_; - push @{ $self->{'-paragraphs'} }, $pod_para; - } - - sub textblock { - my ($parser, $paragraph, $line_num, $pod_para) = @_; - my $ptree = $parser->parse_text({%options}, $paragraph, ...); - $pod_para->parse_tree( $ptree ); - push @{ $self->{'-paragraphs'} }, $pod_para; - } - - ... - - package main; - ... - my $parser = new MyPodParserTree(...); - $parser->parse_from_file(...); - my $paragraphs_ref = $parser->{'-paragraphs'}; - -Of course, in this module-author's humble opinion, I'd be more inclined to -use the existing B<Pod::ParseTree> object than a simple array. That way -everything in it, paragraphs and sequences, all respond to the same core -interface for all parse-tree nodes. The result would look something like: - - package MyPodParserTree2; - - ... - - sub begin_pod { - my $self = shift; - $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree - } - - sub parse_tree { - ## convenience method to get/set the parse-tree for the entire POD - (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; - return $_[0]->{'-ptree'}; - } - - sub command { - my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; - my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...); - $pod_para->parse_tree( $ptree ); - $parser->parse_tree()->append( $pod_para ); - } - - sub verbatim { - my ($parser, $paragraph, $line_num, $pod_para) = @_; - $parser->parse_tree()->append( $pod_para ); - } - - sub textblock { - my ($parser, $paragraph, $line_num, $pod_para) = @_; - my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...); - $pod_para->parse_tree( $ptree ); - $parser->parse_tree()->append( $pod_para ); - } - - ... - - package main; - ... - my $parser = new MyPodParserTree2(...); - $parser->parse_from_file(...); - my $ptree = $parser->parse_tree; - ... - -Now you have the entire POD document as one great big parse-tree. You -can even use the B<-expand_seq> option to B<parse_text> to insert -whole different kinds of objects. Just don't expect B<Pod::Parser> -to know what to do with them after that. That will need to be in your -code. Or, alternatively, you can insert any object you like so long as -it conforms to the B<Pod::ParseTree> interface. - -One could use this to create subclasses of B<Pod::Paragraphs> and -B<Pod::InteriorSequences> for specific commands (or to create your own -custom node-types in the parse-tree) and add some kind of B<emit()> -method to each custom node/subclass object in the tree. Then all you'd -need to do is recursively walk the tree in the desired order, processing -the children (most likely from left to right) by formatting them if -they are text-strings, or by calling their B<emit()> method if they -are objects/references. - -=head1 CAVEATS - -Please note that POD has the notion of "paragraphs": this is something -starting I<after> a blank (read: empty) line, with the single exception -of the file start, which is also starting a paragraph. That means that -especially a command (e.g. C<=head1>) I<must> be preceded with a blank -line; C<__END__> is I<not> a blank line. - -=head1 SEE ALSO - -L<Pod::InputObjects>, L<Pod::Select> - -B<Pod::InputObjects> defines POD input objects corresponding to -command paragraphs, parse-trees, and interior-sequences. - -B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability -to selectively include and/or exclude sections of a POD document from being -translated based upon the current heading, subheading, subsubheading, etc. - -=for __PRIVATE__ -B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users -the ability the employ I<callback functions> instead of, or in addition -to, overriding methods of the base class. - -=for __PRIVATE__ -B<Pod::Select> and B<Pod::Callbacks> do not override any -methods nor do they define any new methods with the same name. Because -of this, they may I<both> be used (in combination) as a base class of -the same subclass in order to combine their functionality without -causing any namespace clashes due to multiple inheritance. - -=head1 AUTHOR - -Please report bugs using L<http://rt.cpan.org>. - -Brad Appleton E<lt>bradapp@enteract.comE<gt> - -Based on code for B<Pod::Text> written by -Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> - -=cut - -1; -# vim: ts=4 sw=4 et diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc.pm deleted file mode 100644 index 9ed66e80917..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc.pm +++ /dev/null @@ -1,1828 +0,0 @@ - -require 5; -use 5.006; # we use some open(X, "<", $y) syntax -package Pod::Perldoc; -use strict; -use warnings; -use Config '%Config'; - -use Fcntl; # for sysopen -use File::Spec::Functions qw(catfile catdir splitdir); - -use vars qw($VERSION @Pagers $Bindir $Pod2man - $Temp_Files_Created $Temp_File_Lifetime -); -$VERSION = '3.14_04'; -#.......................................................................... - -BEGIN { # Make a DEBUG constant very first thing... - unless(defined &DEBUG) { - if(($ENV{'PERLDOCDEBUG'} || '') =~ m/^(\d+)/) { # untaint - eval("sub DEBUG () {$1}"); - die "WHAT? Couldn't eval-up a DEBUG constant!? $@" if $@; - } else { - *DEBUG = sub () {0}; - } - } -} - -use Pod::Perldoc::GetOptsOO; # uses the DEBUG. - -#.......................................................................... - -sub TRUE () {1} -sub FALSE () {return} - -BEGIN { - *IS_VMS = $^O eq 'VMS' ? \&TRUE : \&FALSE unless defined &IS_VMS; - *IS_MSWin32 = $^O eq 'MSWin32' ? \&TRUE : \&FALSE unless defined &IS_MSWin32; - *IS_Dos = $^O eq 'dos' ? \&TRUE : \&FALSE unless defined &IS_Dos; - *IS_OS2 = $^O eq 'os2' ? \&TRUE : \&FALSE unless defined &IS_OS2; - *IS_Cygwin = $^O eq 'cygwin' ? \&TRUE : \&FALSE unless defined &IS_Cygwin; - *IS_Linux = $^O eq 'linux' ? \&TRUE : \&FALSE unless defined &IS_Linux; - *IS_HPUX = $^O =~ m/hpux/ ? \&TRUE : \&FALSE unless defined &IS_HPUX; -} - -$Temp_File_Lifetime ||= 60 * 60 * 24 * 5; - # If it's older than five days, it's quite unlikely - # that anyone's still looking at it!! - # (Currently used only by the MSWin cleanup routine) - - -#.......................................................................... -{ my $pager = $Config{'pager'}; - push @Pagers, $pager if -x (split /\s+/, $pager)[0] or IS_VMS; -} -$Bindir = $Config{'scriptdirexp'}; -$Pod2man = "pod2man" . ( $Config{'versiononly'} ? $Config{'version'} : '' ); - -# End of class-init stuff -# -########################################################################### -# -# Option accessors... - -foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdUL}) { - no strict 'refs'; - *$subname = do{ use strict 'refs'; sub () { shift->_elem($subname, @_) } }; -} - -# And these are so that GetOptsOO knows they take options: -sub opt_f_with { shift->_elem('opt_f', @_) } -sub opt_q_with { shift->_elem('opt_q', @_) } -sub opt_d_with { shift->_elem('opt_d', @_) } -sub opt_L_with { shift->_elem('opt_L', @_) } - -sub opt_w_with { # Specify an option for the formatter subclass - my($self, $value) = @_; - if($value =~ m/^([-_a-zA-Z][-_a-zA-Z0-9]*)(?:[=\:](.*?))?$/s) { - my $option = $1; - my $option_value = defined($2) ? $2 : "TRUE"; - $option =~ tr/\-/_/s; # tolerate "foo-bar" for "foo_bar" - $self->add_formatter_option( $option, $option_value ); - } else { - warn "\"$value\" isn't a good formatter option name. I'm ignoring it!\n"; - } - return; -} - -sub opt_M_with { # specify formatter class name(s) - my($self, $classes) = @_; - return unless defined $classes and length $classes; - DEBUG > 4 and print "Considering new formatter classes -M$classes\n"; - my @classes_to_add; - foreach my $classname (split m/[,;]+/s, $classes) { - next unless $classname =~ m/\S/; - if( $classname =~ m/^(\w+(::\w+)+)$/s ) { - # A mildly restrictive concept of what modulenames are valid. - push @classes_to_add, $1; # untaint - } else { - warn "\"$classname\" isn't a valid classname. Ignoring.\n"; - } - } - - unshift @{ $self->{'formatter_classes'} }, @classes_to_add; - - DEBUG > 3 and print( - "Adding @classes_to_add to the list of formatter classes, " - . "making them @{ $self->{'formatter_classes'} }.\n" - ); - - return; -} - -sub opt_V { # report version and exit - print join '', - "Perldoc v$VERSION, under perl v$] for $^O", - - (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) - ? (" (win32 build ", &Win32::BuildNumber(), ")") : (), - - (chr(65) eq 'A') ? () : " (non-ASCII)", - - "\n", - ; - exit; -} - -sub opt_t { # choose plaintext as output format - my $self = shift; - $self->opt_o_with('text') if @_ and $_[0]; - return $self->_elem('opt_t', @_); -} - -sub opt_u { # choose raw pod as output format - my $self = shift; - $self->opt_o_with('pod') if @_ and $_[0]; - return $self->_elem('opt_u', @_); -} - -sub opt_n_with { - # choose man as the output format, and specify the proggy to run - my $self = shift; - $self->opt_o_with('man') if @_ and $_[0]; - $self->_elem('opt_n', @_); -} - -sub opt_o_with { # "o" for output format - my($self, $rest) = @_; - return unless defined $rest and length $rest; - if($rest =~ m/^(\w+)$/s) { - $rest = $1; #untaint - } else { - warn "\"$rest\" isn't a valid output format. Skipping.\n"; - return; - } - - $self->aside("Noting \"$rest\" as desired output format...\n"); - - # Figure out what class(es) that could actually mean... - - my @classes; - foreach my $prefix ("Pod::Perldoc::To", "Pod::Simple::", "Pod::") { - # Messy but smart: - foreach my $stem ( - $rest, # Yes, try it first with the given capitalization - "\L$rest", "\L\u$rest", "\U$rest" # And then try variations - - ) { - push @classes, $prefix . $stem; - #print "Considering $prefix$stem\n"; - } - - # Tidier, but misses too much: - #push @classes, $prefix . ucfirst(lc($rest)); - } - $self->opt_M_with( join ";", @classes ); - return; -} - -########################################################################### -# % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % - -sub run { # to be called by the "perldoc" executable - my $class = shift; - if(DEBUG > 3) { - print "Parameters to $class\->run:\n"; - my @x = @_; - while(@x) { - $x[1] = '<undef>' unless defined $x[1]; - $x[1] = "@{$x[1]}" if ref( $x[1] ) eq 'ARRAY'; - print " [$x[0]] => [$x[1]]\n"; - splice @x,0,2; - } - print "\n"; - } - return $class -> new(@_) -> process() || 0; -} - -# % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % -########################################################################### - -sub new { # yeah, nothing fancy - my $class = shift; - my $new = bless {@_}, (ref($class) || $class); - DEBUG > 1 and print "New $class object $new\n"; - $new->init(); - $new; -} - -#.......................................................................... - -sub aside { # If we're in -v or DEBUG mode, say this. - my $self = shift; - if( DEBUG or $self->opt_v ) { - my $out = join( '', - DEBUG ? do { - my $callsub = (caller(1))[3]; - my $package = quotemeta(__PACKAGE__ . '::'); - $callsub =~ s/^$package/'/os; - # the o is justified, as $package really won't change. - $callsub . ": "; - } : '', - @_, - ); - if(DEBUG) { print $out } else { print STDERR $out } - } - return; -} - -#.......................................................................... - -sub usage { - my $self = shift; - warn "@_\n" if @_; - - # Erase evidence of previous errors (if any), so exit status is simple. - $! = 0; - - die <<EOF; -perldoc [options] PageName|ModuleName|ProgramName... -perldoc [options] -f BuiltinFunction -perldoc [options] -q FAQRegex - -Options: - -h Display this help message - -V report version - -r Recursive search (slow) - -i Ignore case - -t Display pod using pod2text instead of pod2man and nroff - (-t is the default on win32 unless -n is specified) - -u Display unformatted pod text - -m Display module's file in its entirety - -n Specify replacement for nroff - -l Display the module's file name - -F Arguments are file names, not modules - -v Verbosely describe what's going on - -T Send output to STDOUT without any pager - -d output_filename_to_send_to - -o output_format_name - -M FormatterModuleNameToUse - -w formatter_option:option_value - -L translation_code Choose doc translation (if any) - -X use index if present (looks for pod.idx at $Config{archlib}) - -q Search the text of questions (not answers) in perlfaq[1-9] - -PageName|ModuleName... - is the name of a piece of documentation that you want to look at. You - may either give a descriptive name of the page (as in the case of - `perlfunc') the name of a module, either like `Term::Info' or like - `Term/Info', or the name of a program, like `perldoc'. - -BuiltinFunction - is the name of a perl function. Will extract documentation from - `perlfunc'. - -FAQRegex - is a regex. Will search perlfaq[1-9] for and extract any - questions that match. - -Any switches in the PERLDOC environment variable will be used before the -command line arguments. The optional pod index file contains a list of -filenames, one per line. - [Perldoc v$VERSION] -EOF - -} - -#.......................................................................... - -sub usage_brief { - my $me = $0; # Editing $0 is unportable - - $me =~ s,.*[/\\],,; # get basename - - die <<"EOUSAGE"; -Usage: $me [-h] [-V] [-r] [-i] [-v] [-t] [-u] [-m] [-n nroffer_program] [-l] [-T] [-d output_filename] [-o output_format] [-M FormatterModuleNameToUse] [-w formatter_option:option_value] [-L translation_code] [-F] [-X] PageName|ModuleName|ProgramName - $me -f PerlFunc - $me -q FAQKeywords - -The -h option prints more help. Also try "perldoc perldoc" to get -acquainted with the system. [Perldoc v$VERSION] -EOUSAGE - -} - -#.......................................................................... - -sub pagers { @{ shift->{'pagers'} } } - -#.......................................................................... - -sub _elem { # handy scalar meta-accessor: shift->_elem("foo", @_) - if(@_ > 2) { return $_[0]{ $_[1] } = $_[2] } - else { return $_[0]{ $_[1] } } -} -#.......................................................................... -########################################################################### -# -# Init formatter switches, and start it off with __bindir and all that -# other stuff that ToMan.pm needs. -# - -sub init { - my $self = shift; - - # Make sure creat()s are neither too much nor too little - eval { umask(0077) }; # doubtless someone has no mask - - $self->{'args'} ||= \@ARGV; - $self->{'found'} ||= []; - $self->{'temp_file_list'} ||= []; - - - $self->{'target'} = undef; - - $self->init_formatter_class_list; - - $self->{'pagers' } = [@Pagers] unless exists $self->{'pagers'}; - $self->{'bindir' } = $Bindir unless exists $self->{'bindir'}; - $self->{'pod2man'} = $Pod2man unless exists $self->{'pod2man'}; - - push @{ $self->{'formatter_switches'} = [] }, ( - # Yeah, we could use a hashref, but maybe there's some class where options - # have to be ordered; so we'll use an arrayref. - - [ '__bindir' => $self->{'bindir' } ], - [ '__pod2man' => $self->{'pod2man'} ], - ); - - DEBUG > 3 and printf "Formatter switches now: [%s]\n", - join ' ', map "[@$_]", @{ $self->{'formatter_switches'} }; - - $self->{'translators'} = []; - $self->{'extra_search_dirs'} = []; - - return; -} - -#.......................................................................... - -sub init_formatter_class_list { - my $self = shift; - $self->{'formatter_classes'} ||= []; - - # Remember, no switches have been read yet, when - # we've started this routine. - - $self->opt_M_with('Pod::Perldoc::ToPod'); # the always-there fallthru - $self->opt_o_with('text'); - $self->opt_o_with('man') unless IS_MSWin32 || IS_Dos - || !($ENV{TERM} && ( - ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i - )); - - return; -} - -#.......................................................................... - -sub process { - # if this ever returns, its retval will be used for exit(RETVAL) - - my $self = shift; - DEBUG > 1 and print " Beginning process.\n"; - DEBUG > 1 and print " Args: @{$self->{'args'}}\n\n"; - if(DEBUG > 3) { - print "Object contents:\n"; - my @x = %$self; - while(@x) { - $x[1] = '<undef>' unless defined $x[1]; - $x[1] = "@{$x[1]}" if ref( $x[1] ) eq 'ARRAY'; - print " [$x[0]] => [$x[1]]\n"; - splice @x,0,2; - } - print "\n"; - } - - # TODO: make it deal with being invoked as various different things - # such as perlfaq". - - return $self->usage_brief unless @{ $self->{'args'} }; - $self->pagers_guessing; - $self->options_reading; - $self->aside(sprintf "$0 => %s v%s\n", ref($self), $self->VERSION); - $self->drop_privs_maybe; - $self->options_processing; - - # Hm, we have @pages and @found, but we only really act on one - # file per call, with the exception of the opt_q hack, and with - # -l things - - $self->aside("\n"); - - my @pages; - $self->{'pages'} = \@pages; - if( $self->opt_f) { @pages = ("perlfunc") } - elsif( $self->opt_q) { @pages = ("perlfaq1" .. "perlfaq9") } - else { @pages = @{$self->{'args'}}; - # @pages = __FILE__ - # if @pages == 1 and $pages[0] eq 'perldoc'; - } - - return $self->usage_brief unless @pages; - - $self->find_good_formatter_class(); - $self->formatter_sanity_check(); - - $self->maybe_diddle_INC(); - # for when we're apparently in a module or extension directory - - my @found = $self->grand_search_init(\@pages); - exit (IS_VMS ? 98962 : 1) unless @found; - - if ($self->opt_l) { - DEBUG and print "We're in -l mode, so byebye after this:\n"; - print join("\n", @found), "\n"; - return; - } - - $self->tweak_found_pathnames(\@found); - $self->assert_closing_stdout; - return $self->page_module_file(@found) if $self->opt_m; - DEBUG > 2 and print "Found: [@found]\n"; - - return $self->render_and_page(\@found); -} - -#.......................................................................... -{ - -my( %class_seen, %class_loaded ); -sub find_good_formatter_class { - my $self = $_[0]; - my @class_list = @{ $self->{'formatter_classes'} || [] }; - die "WHAT? Nothing in the formatter class list!?" unless @class_list; - - my $good_class_found; - foreach my $c (@class_list) { - DEBUG > 4 and print "Trying to load $c...\n"; - if($class_loaded{$c}) { - DEBUG > 4 and print "OK, the already-loaded $c it is!\n"; - $good_class_found = $c; - last; - } - - if($class_seen{$c}) { - DEBUG > 4 and print - "I've tried $c before, and it's no good. Skipping.\n"; - next; - } - - $class_seen{$c} = 1; - - if( $c->can('parse_from_file') ) { - DEBUG > 4 and print - "Interesting, the formatter class $c is already loaded!\n"; - - } elsif( - (IS_VMS or IS_MSWin32 or IS_Dos or IS_OS2) - # the alway case-insensitive fs's - and $class_seen{lc("~$c")}++ - ) { - DEBUG > 4 and print - "We already used something quite like \"\L$c\E\", so no point using $c\n"; - # This avoids redefining the package. - } else { - DEBUG > 4 and print "Trying to eval 'require $c'...\n"; - - local $^W = $^W; - if(DEBUG() or $self->opt_v) { - # feh, let 'em see it - } else { - $^W = 0; - # The average user just has no reason to be seeing - # $^W-suppressable warnings from the the require! - } - - eval "require $c"; - if($@) { - DEBUG > 4 and print "Couldn't load $c: $!\n"; - next; - } - } - - if( $c->can('parse_from_file') ) { - DEBUG > 4 and print "Settling on $c\n"; - my $v = $c->VERSION; - $v = ( defined $v and length $v ) ? " version $v" : ''; - $self->aside("Formatter class $c$v successfully loaded!\n"); - $good_class_found = $c; - last; - } else { - DEBUG > 4 and print "Class $c isn't a formatter?! Skipping.\n"; - } - } - - die "Can't find any loadable formatter class in @class_list?!\nAborting" - unless $good_class_found; - - $self->{'formatter_class'} = $good_class_found; - $self->aside("Will format with the class $good_class_found\n"); - - return; -} - -} -#.......................................................................... - -sub formatter_sanity_check { - my $self = shift; - my $formatter_class = $self->{'formatter_class'} - || die "NO FORMATTER CLASS YET!?"; - - if(!$self->opt_T # so -T can FORCE sending to STDOUT - and $formatter_class->can('is_pageable') - and !$formatter_class->is_pageable - and !$formatter_class->can('page_for_perldoc') - ) { - my $ext = - ($formatter_class->can('output_extension') - && $formatter_class->output_extension - ) || ''; - $ext = ".$ext" if length $ext; - - die - "When using Perldoc to format with $formatter_class, you have to\n" - . "specify -T or -dsomefile$ext\n" - . "See `perldoc perldoc' for more information on those switches.\n" - ; - } -} - -#.......................................................................... - -sub render_and_page { - my($self, $found_list) = @_; - - $self->maybe_generate_dynamic_pod($found_list); - - my($out, $formatter) = $self->render_findings($found_list); - - if($self->opt_d) { - printf "Perldoc (%s) output saved to %s\n", - $self->{'formatter_class'} || ref($self), - $out; - print "But notice that it's 0 bytes long!\n" unless -s $out; - - - } elsif( # Allow the formatter to "page" itself, if it wants. - $formatter->can('page_for_perldoc') - and do { - $self->aside("Going to call $formatter\->page_for_perldoc(\"$out\")\n"); - if( $formatter->page_for_perldoc($out, $self) ) { - $self->aside("page_for_perldoc returned true, so NOT paging with $self.\n"); - 1; - } else { - $self->aside("page_for_perldoc returned false, so paging with $self instead.\n"); - ''; - } - } - ) { - # Do nothing, since the formatter has "paged" it for itself. - - } else { - # Page it normally (internally) - - if( -s $out ) { # Usual case: - $self->page($out, $self->{'output_to_stdout'}, $self->pagers); - - } else { - # Odd case: - $self->aside("Skipping $out (from $$found_list[0] " - . "via $$self{'formatter_class'}) as it is 0-length.\n"); - - push @{ $self->{'temp_file_list'} }, $out; - $self->unlink_if_temp_file($out); - } - } - - $self->after_rendering(); # any extra cleanup or whatever - - return; -} - -#.......................................................................... - -sub options_reading { - my $self = shift; - - if( defined $ENV{"PERLDOC"} and length $ENV{"PERLDOC"} ) { - require Text::ParseWords; - $self->aside("Noting env PERLDOC setting of $ENV{'PERLDOC'}\n"); - # Yes, appends to the beginning - unshift @{ $self->{'args'} }, - Text::ParseWords::shellwords( $ENV{"PERLDOC"} ) - ; - DEBUG > 1 and print " Args now: @{$self->{'args'}}\n\n"; - } else { - DEBUG > 1 and print " Okay, no PERLDOC setting in ENV.\n"; - } - - DEBUG > 1 - and print " Args right before switch processing: @{$self->{'args'}}\n"; - - Pod::Perldoc::GetOptsOO::getopts( $self, $self->{'args'}, 'YES' ) - or return $self->usage; - - DEBUG > 1 - and print " Args after switch processing: @{$self->{'args'}}\n"; - - return $self->usage if $self->opt_h; - - return; -} - -#.......................................................................... - -sub options_processing { - my $self = shift; - - if ($self->opt_X) { - my $podidx = "$Config{'archlib'}/pod.idx"; - $podidx = "" unless -f $podidx && -r _ && -M _ <= 7; - $self->{'podidx'} = $podidx; - } - - $self->{'output_to_stdout'} = 1 if $self->opt_T or ! -t STDOUT; - - $self->options_sanity; - - $self->opt_n("nroff") unless $self->opt_n; - $self->add_formatter_option( '__nroffer' => $self->opt_n ); - - # Adjust for using translation packages - $self->add_translator($self->opt_L) if $self->opt_L; - - return; -} - -#.......................................................................... - -sub options_sanity { - my $self = shift; - - # The opts-counting stuff interacts quite badly with - # the $ENV{"PERLDOC"} stuff. I.e., if I have $ENV{"PERLDOC"} - # set to -t, and I specify -u on the command line, I don't want - # to be hectored at that -u and -t don't make sense together. - - #my $opts = grep $_ && 1, # yes, the count of the set ones - # $self->opt_t, $self->opt_u, $self->opt_m, $self->opt_l - #; - # - #$self->usage("only one of -t, -u, -m or -l") if $opts > 1; - - - # Any sanity-checking need doing here? - - # But does not make sense to set either -f or -q in $ENV{"PERLDOC"} - if( $self->opt_f or $self->opt_q ) { - $self->usage("Only one of -f -or -q") if $self->opt_f and $self->opt_q; - warn - "Perldoc is only really meant for reading one word at a time.\n", - "So these parameters are being ignored: ", - join(' ', @{$self->{'args'}}), - "\n" - if @{$self->{'args'}} - } - return; -} - -#.......................................................................... - -sub grand_search_init { - my($self, $pages, @found) = @_; - - foreach (@$pages) { - if ($self->{'podidx'} && open(PODIDX, $self->{'podidx'})) { - my $searchfor = catfile split '::', $_; - $self->aside( "Searching for '$searchfor' in $self->{'podidx'}\n" ); - local $_; - while (<PODIDX>) { - chomp; - push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i; - } - close(PODIDX) or die "Can't close $$self{'podidx'}: $!"; - next; - } - - $self->aside( "Searching for $_\n" ); - - if ($self->opt_F) { - next unless -r; - push @found, $_ if $self->opt_m or $self->containspod($_); - next; - } - - my @searchdirs; - - # prepend extra search directories (including language specific) - push @searchdirs, @{ $self->{'extra_search_dirs'} }; - - # We must look both in @INC for library modules and in $bindir - # for executables, like h2xs or perldoc itself. - push @searchdirs, ($self->{'bindir'}, @INC); - unless ($self->opt_m) { - if (IS_VMS) { - my($i,$trn); - for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) { - push(@searchdirs,$trn); - } - push(@searchdirs,'perl_root:[lib.pod]') # installed pods - } - else { - push(@searchdirs, grep(-d, split($Config{path_sep}, - $ENV{'PATH'}))); - } - } - my @files = $self->searchfor(0,$_,@searchdirs); - if (@files) { - $self->aside( "Found as @files\n" ); - } - else { - # no match, try recursive search - @searchdirs = grep(!/^\.\z/s,@INC); - @files= $self->searchfor(1,$_,@searchdirs) if $self->opt_r; - if (@files) { - $self->aside( "Loosely found as @files\n" ); - } - else { - print STDERR "No " . - ($self->opt_m ? "module" : "documentation") . " found for \"$_\".\n"; - if ( @{ $self->{'found'} } ) { - print STDERR "However, try\n"; - for my $dir (@{ $self->{'found'} }) { - opendir(DIR, $dir) or die "opendir $dir: $!"; - while (my $file = readdir(DIR)) { - next if ($file =~ /^\./s); - $file =~ s/\.(pm|pod)\z//; # XXX: badfs - print STDERR "\tperldoc $_\::$file\n"; - } - closedir(DIR) or die "closedir $dir: $!"; - } - } - } - } - push(@found,@files); - } - return @found; -} - -#.......................................................................... - -sub maybe_generate_dynamic_pod { - my($self, $found_things) = @_; - my @dynamic_pod; - - $self->search_perlfunc($found_things, \@dynamic_pod) if $self->opt_f; - - $self->search_perlfaqs($found_things, \@dynamic_pod) if $self->opt_q; - - if( ! $self->opt_f and ! $self->opt_q ) { - DEBUG > 4 and print "That's a non-dynamic pod search.\n"; - } elsif ( @dynamic_pod ) { - $self->aside("Hm, I found some Pod from that search!\n"); - my ($buffd, $buffer) = $self->new_tempfile('pod', 'dyn'); - - push @{ $self->{'temp_file_list'} }, $buffer; - # I.e., it MIGHT be deleted at the end. - - my $in_list = $self->opt_f; - - print $buffd "=over 8\n\n" if $in_list; - print $buffd @dynamic_pod or die "Can't print $buffer: $!"; - print $buffd "=back\n" if $in_list; - - close $buffd or die "Can't close $buffer: $!"; - - @$found_things = $buffer; - # Yes, so found_things never has more than one thing in - # it, by time we leave here - - $self->add_formatter_option('__filter_nroff' => 1); - - } else { - @$found_things = (); - $self->aside("I found no Pod from that search!\n"); - } - - return; -} - -#.......................................................................... - -sub add_formatter_option { # $self->add_formatter_option('key' => 'value'); - my $self = shift; - push @{ $self->{'formatter_switches'} }, [ @_ ] if @_; - - DEBUG > 3 and printf "Formatter switches now: [%s]\n", - join ' ', map "[@$_]", @{ $self->{'formatter_switches'} }; - - return; -} - -#......................................................................... - -sub new_translator { # $tr = $self->new_translator($lang); - my $self = shift; - my $lang = shift; - - my $pack = 'POD2::' . uc($lang); - eval "require $pack"; - if ( !$@ && $pack->can('new') ) { - return $pack->new(); - } - - eval { require POD2::Base }; - return if $@; - - return POD2::Base->new({ lang => $lang }); -} - -#......................................................................... - -sub add_translator { # $self->add_translator($lang); - my $self = shift; - for my $lang (@_) { - my $tr = $self->new_translator($lang); - if ( defined $tr ) { - push @{ $self->{'translators'} }, $tr; - push @{ $self->{'extra_search_dirs'} }, $tr->pod_dirs; - - $self->aside( "translator for '$lang' loaded\n" ); - } else { - # non-installed or bad translator package - warn "Perldoc cannot load translator package for '$lang': ignored\n"; - } - - } - return; -} - -#.......................................................................... - -sub search_perlfunc { - my($self, $found_things, $pod) = @_; - - DEBUG > 2 and print "Search: @$found_things\n"; - - my $perlfunc = shift @$found_things; - open(PFUNC, "<", $perlfunc) # "Funk is its own reward" - or die("Can't open $perlfunc: $!"); - - # Functions like -r, -e, etc. are listed under `-X'. - my $search_re = ($self->opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) - ? '(?:I<)?-X' : quotemeta($self->opt_f) ; - - DEBUG > 2 and - print "Going to perlfunc-scan for $search_re in $perlfunc\n"; - - my $re = 'Alphabetical Listing of Perl Functions'; - if ( $self->opt_L ) { - my $tr = $self->{'translators'}->[0]; - $re = $tr->search_perlfunc_re if $tr->can('search_perlfunc_re'); - } - - # Skip introduction - local $_; - while (<PFUNC>) { - last if /^=head2 $re/; - } - - # Look for our function - my $found = 0; - my $inlist = 0; - while (<PFUNC>) { # "The Mothership Connection is here!" - if ( m/^=item\s+$search_re\b/ ) { - $found = 1; - } - elsif (/^=item/) { - last if $found > 1 and not $inlist; - } - next unless $found; - if (/^=over/) { - ++$inlist; - } - elsif (/^=back/) { - --$inlist; - } - push @$pod, $_; - ++$found if /^\w/; # found descriptive text - } - if (!@$pod) { - die sprintf - "No documentation for perl function `%s' found\n", - $self->opt_f - ; - } - close PFUNC or die "Can't open $perlfunc: $!"; - - return; -} - -#.......................................................................... - -sub search_perlfaqs { - my( $self, $found_things, $pod) = @_; - - my $found = 0; - my %found_in; - my $search_key = $self->opt_q; - - my $rx = eval { qr/$search_key/ } - or die <<EOD; -Invalid regular expression '$search_key' given as -q pattern: -$@ -Did you mean \\Q$search_key ? - -EOD - - local $_; - foreach my $file (@$found_things) { - die "invalid file spec: $!" if $file =~ /[<>|]/; - open(INFAQ, "<", $file) # XXX 5.6ism - or die "Can't read-open $file: $!\nAborting"; - while (<INFAQ>) { - if ( m/^=head2\s+.*(?:$search_key)/i ) { - $found = 1; - push @$pod, "=head1 Found in $file\n\n" unless $found_in{$file}++; - } - elsif (/^=head[12]/) { - $found = 0; - } - next unless $found; - push @$pod, $_; - } - close(INFAQ); - } - die("No documentation for perl FAQ keyword `$search_key' found\n") - unless @$pod; - - return; -} - - -#.......................................................................... - -sub render_findings { - # Return the filename to open - - my($self, $found_things) = @_; - - my $formatter_class = $self->{'formatter_class'} - || die "No formatter class set!?"; - my $formatter = $formatter_class->can('new') - ? $formatter_class->new - : $formatter_class - ; - - if(! @$found_things) { - die "Nothing found?!"; - # should have been caught before here - } elsif(@$found_things > 1) { - warn - "Perldoc is only really meant for reading one document at a time.\n", - "So these parameters are being ignored: ", - join(' ', @$found_things[1 .. $#$found_things] ), - "\n" - } - - my $file = $found_things->[0]; - - DEBUG > 3 and printf "Formatter switches now: [%s]\n", - join ' ', map "[@$_]", @{ $self->{'formatter_switches'} }; - - # Set formatter options: - if( ref $formatter ) { - foreach my $f (@{ $self->{'formatter_switches'} || [] }) { - my($switch, $value, $silent_fail) = @$f; - if( $formatter->can($switch) ) { - eval { $formatter->$switch( defined($value) ? $value : () ) }; - warn "Got an error when setting $formatter_class\->$switch:\n$@\n" - if $@; - } else { - if( $silent_fail or $switch =~ m/^__/s ) { - DEBUG > 2 and print "Formatter $formatter_class doesn't support $switch\n"; - } else { - warn "$formatter_class doesn't recognize the $switch switch.\n"; - } - } - } - } - - $self->{'output_is_binary'} = - $formatter->can('write_with_binmode') && $formatter->write_with_binmode; - - my ($out_fh, $out) = $self->new_output_file( - ( $formatter->can('output_extension') && $formatter->output_extension ) - || undef, - $self->useful_filename_bit, - ); - - # Now, finally, do the formatting! - { - local $^W = $^W; - if(DEBUG() or $self->opt_v) { - # feh, let 'em see it - } else { - $^W = 0; - # The average user just has no reason to be seeing - # $^W-suppressable warnings from the formatting! - } - - eval { $formatter->parse_from_file( $file, $out_fh ) }; - } - - warn "Error while formatting with $formatter_class:\n $@\n" if $@; - DEBUG > 2 and print "Back from formatting with $formatter_class\n"; - - close $out_fh - or warn "Can't close $out: $!\n(Did $formatter already close it?)"; - sleep 0; sleep 0; sleep 0; - # Give the system a few timeslices to meditate on the fact - # that the output file does in fact exist and is closed. - - $self->unlink_if_temp_file($file); - - unless( -s $out ) { - if( $formatter->can( 'if_zero_length' ) ) { - # Basically this is just a hook for Pod::Simple::Checker; since - # what other class could /happily/ format an input file with Pod - # as a 0-length output file? - $formatter->if_zero_length( $file, $out, $out_fh ); - } else { - warn "Got a 0-length file from $$found_things[0] via $formatter_class!?\n" - } - } - - DEBUG and print "Finished writing to $out.\n"; - return($out, $formatter) if wantarray; - return $out; -} - -#.......................................................................... - -sub unlink_if_temp_file { - # Unlink the specified file IFF it's in the list of temp files. - # Really only used in the case of -f / -q things when we can - # throw away the dynamically generated source pod file once - # we've formatted it. - # - my($self, $file) = @_; - return unless defined $file and length $file; - - my $temp_file_list = $self->{'temp_file_list'} || return; - if(grep $_ eq $file, @$temp_file_list) { - $self->aside("Unlinking $file\n"); - unlink($file) or warn "Odd, couldn't unlink $file: $!"; - } else { - DEBUG > 1 and print "$file isn't a temp file, so not unlinking.\n"; - } - return; -} - -#.......................................................................... - -sub MSWin_temp_cleanup { - - # Nothing particularly MSWin-specific in here, but I don't know if any - # other OS needs its temp dir policed like MSWin does! - - my $self = shift; - - my $tempdir = $ENV{'TEMP'}; - return unless defined $tempdir and length $tempdir - and -e $tempdir and -d _ and -w _; - - $self->aside( - "Considering whether any old files of mine in $tempdir need unlinking.\n" - ); - - opendir(TMPDIR, $tempdir) || return; - my @to_unlink; - - my $limit = time() - $Temp_File_Lifetime; - - DEBUG > 5 and printf "Looking for things pre-dating %s (%x)\n", - ($limit) x 2; - - my $filespec; - - while(defined($filespec = readdir(TMPDIR))) { - if( - $filespec =~ m{^perldoc_[a-zA-Z0-9]+_T([a-fA-F0-9]{7,})_[a-fA-F0-9]{3,}}s - ) { - if( hex($1) < $limit ) { - push @to_unlink, "$tempdir/$filespec"; - $self->aside( "Will unlink my old temp file $to_unlink[-1]\n" ); - } else { - DEBUG > 5 and - printf " $tempdir/$filespec is too recent (after %x)\n", $limit; - } - } else { - DEBUG > 5 and - print " $tempdir/$filespec doesn't look like a perldoc temp file.\n"; - } - } - closedir(TMPDIR); - $self->aside(sprintf "Unlinked %s items of mine in %s\n", - scalar(unlink(@to_unlink)), - $tempdir - ); - return; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . - -sub MSWin_perldoc_tempfile { - my($self, $suffix, $infix) = @_; - - my $tempdir = $ENV{'TEMP'}; - return unless defined $tempdir and length $tempdir - and -e $tempdir and -d _ and -w _; - - my $spec; - - do { - $spec = sprintf "%s\\perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup - # Yes, we embed the create-time in the filename! - $tempdir, - $infix || 'x', - time(), - $$, - defined( &Win32::GetTickCount ) - ? (Win32::GetTickCount() & 0xff) - : int(rand 256) - # Under MSWin, $$ values get reused quickly! So if we ran - # perldoc foo and then perldoc bar before there was time for - # time() to increment time."_$$" would likely be the same - # for each process! So we tack on the tick count's lower - # bits (or, in a pinch, rand) - , - $suffix || 'txt'; - ; - } while( -e $spec ); - - my $counter = 0; - - while($counter < 50) { - my $fh; - # If we are running before perl5.6.0, we can't autovivify - if ($] < 5.006) { - require Symbol; - $fh = Symbol::gensym(); - } - DEBUG > 3 and print "About to try making temp file $spec\n"; - return($fh, $spec) if open($fh, ">", $spec); # XXX 5.6ism - $self->aside("Can't create temp file $spec: $!\n"); - } - - $self->aside("Giving up on making a temp file!\n"); - die "Can't make a tempfile!?"; -} - -#.......................................................................... - - -sub after_rendering { - my $self = $_[0]; - $self->after_rendering_VMS if IS_VMS; - $self->after_rendering_MSWin32 if IS_MSWin32; - $self->after_rendering_Dos if IS_Dos; - $self->after_rendering_OS2 if IS_OS2; - return; -} - -sub after_rendering_VMS { return } -sub after_rendering_Dos { return } -sub after_rendering_OS2 { return } - -sub after_rendering_MSWin32 { - shift->MSWin_temp_cleanup() if $Temp_Files_Created; -} - -#.......................................................................... -# : : : : : : : : : -#.......................................................................... - - -sub minus_f_nocase { # i.e., do like -f, but without regard to case - - my($self, $dir, $file) = @_; - my $path = catfile($dir,$file); - return $path if -f $path and -r _; - - if(!$self->opt_i - or IS_VMS or IS_MSWin32 - or IS_Dos or IS_OS2 - ) { - # On a case-forgiving file system, or if case is important, - # that is it, all we can do. - warn "Ignored $path: unreadable\n" if -f _; - return ''; - } - - local *DIR; - my @p = ($dir); - my($p,$cip); - foreach $p (splitdir $file){ - my $try = catfile @p, $p; - $self->aside("Scrutinizing $try...\n"); - stat $try; - if (-d _) { - push @p, $p; - if ( $p eq $self->{'target'} ) { - my $tmp_path = catfile @p; - my $path_f = 0; - for (@{ $self->{'found'} }) { - $path_f = 1 if $_ eq $tmp_path; - } - push (@{ $self->{'found'} }, $tmp_path) unless $path_f; - $self->aside( "Found as $tmp_path but directory\n" ); - } - } - elsif (-f _ && -r _) { - return $try; - } - elsif (-f _) { - warn "Ignored $try: unreadable\n"; - } - elsif (-d catdir(@p)) { # at least we see the containing directory! - my $found = 0; - my $lcp = lc $p; - my $p_dirspec = catdir(@p); - opendir DIR, $p_dirspec or die "opendir $p_dirspec: $!"; - while(defined( $cip = readdir(DIR) )) { - if (lc $cip eq $lcp){ - $found++; - last; # XXX stop at the first? what if there's others? - } - } - closedir DIR or die "closedir $p_dirspec: $!"; - return "" unless $found; - - push @p, $cip; - my $p_filespec = catfile(@p); - return $p_filespec if -f $p_filespec and -r _; - warn "Ignored $p_filespec: unreadable\n" if -f _; - } - } - return ""; -} - -#.......................................................................... - -sub pagers_guessing { - my $self = shift; - - my @pagers; - push @pagers, $self->pagers; - $self->{'pagers'} = \@pagers; - - if (IS_MSWin32) { - push @pagers, qw( more< less notepad ); - unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; - } - elsif (IS_VMS) { - push @pagers, qw( most more less type/page ); - } - elsif (IS_Dos) { - push @pagers, qw( less.exe more.com< ); - unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; - } - else { - if (IS_OS2) { - unshift @pagers, 'less', 'cmd /c more <'; - } - push @pagers, qw( more less pg view cat ); - unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; - } - - if (IS_Cygwin) { - if (($pagers[0] eq 'less') || ($pagers[0] eq '/usr/bin/less')) { - unshift @pagers, '/usr/bin/less -isrR'; - } - } - - unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER}; - - return; -} - -#.......................................................................... - -sub page_module_file { - my($self, @found) = @_; - - # Security note: - # Don't ever just pass this off to anything like MSWin's "start.exe", - # since we might be calling on a .pl file, and we wouldn't want that - # to actually /execute/ the file that we just want to page thru! - # Also a consideration if one were to use a web browser as a pager; - # doing so could trigger the browser's MIME mapping for whatever - # it thinks .pm/.pl/whatever is. Probably just a (useless and - # annoying) "Save as..." dialog, but potentially executing the file - # in question -- particularly in the case of MSIE and it's, ahem, - # occasionally hazy distinction between OS-local extension - # associations, and browser-specific MIME mappings. - - if ($self->{'output_to_stdout'}) { - $self->aside("Sending unpaged output to STDOUT.\n"); - local $_; - my $any_error = 0; - foreach my $output (@found) { - unless( open(TMP, "<", $output) ) { # XXX 5.6ism - warn("Can't open $output: $!"); - $any_error = 1; - next; - } - while (<TMP>) { - print or die "Can't print to stdout: $!"; - } - close TMP or die "Can't close while $output: $!"; - $self->unlink_if_temp_file($output); - } - return $any_error; # successful - } - - foreach my $pager ( $self->pagers ) { - $self->aside("About to try calling $pager @found\n"); - if (system($pager, @found) == 0) { - $self->aside("Yay, it worked.\n"); - return 0; - } - $self->aside("That didn't work.\n"); - - # Odd -- when it fails, under Win32, this seems to neither - # return with a fail nor return with a success!! - # That's discouraging! - } - - $self->aside( - sprintf "Can't manage to find a way to page [%s] via pagers [%s]\n", - join(' ', @found), - join(' ', $self->pagers), - ); - - if (IS_VMS) { - DEBUG > 1 and print "Bailing out in a VMSish way.\n"; - eval q{ - use vmsish qw(status exit); - exit $?; - 1; - } or die; - } - - return 1; - # i.e., an UNSUCCESSFUL return value! -} - -#.......................................................................... - -sub check_file { - my($self, $dir, $file) = @_; - - unless( ref $self ) { - # Should never get called: - $Carp::Verbose = 1; - require Carp; - Carp::croak( join '', - "Crazy ", __PACKAGE__, " error:\n", - "check_file must be an object_method!\n", - "Aborting" - ); - } - - if(length $dir and not -d $dir) { - DEBUG > 3 and print " No dir $dir -- skipping.\n"; - return ""; - } - - if ($self->opt_m) { - return $self->minus_f_nocase($dir,$file); - } - - else { - my $path = $self->minus_f_nocase($dir,$file); - if( length $path and $self->containspod($path) ) { - DEBUG > 3 and print - " The file $path indeed looks promising!\n"; - return $path; - } - } - DEBUG > 3 and print " No good: $file in $dir\n"; - - return ""; -} - -#.......................................................................... - -sub containspod { - my($self, $file, $readit) = @_; - return 1 if !$readit && $file =~ /\.pod\z/i; - - - # Under cygwin the /usr/bin/perl is legal executable, but - # you cannot open a file with that name. It must be spelled - # out as "/usr/bin/perl.exe". - # - # The following if-case under cygwin prevents error - # - # $ perldoc perl - # Cannot open /usr/bin/perl: no such file or directory - # - # This would work though - # - # $ perldoc perl.pod - - if ( IS_Cygwin and -x $file and -f "$file.exe" ) - { - warn "Cygwin $file.exe search skipped\n" if DEBUG or $self->opt_v; - return 0; - } - - local($_); - open(TEST,"<", $file) or die "Can't open $file: $!"; # XXX 5.6ism - while (<TEST>) { - if (/^=head/) { - close(TEST) or die "Can't close $file: $!"; - return 1; - } - } - close(TEST) or die "Can't close $file: $!"; - return 0; -} - -#.......................................................................... - -sub maybe_diddle_INC { - my $self = shift; - - # Does this look like a module or extension directory? - - if (-f "Makefile.PL" || -f "Build.PL") { - - # Add "." and "lib" to @INC (if they exist) - eval q{ use lib qw(. lib); 1; } or die; - - # don't add if superuser - if ($< && $> && -d "blib") { # don't be looking too hard now! - eval q{ use blib; 1 }; - warn $@ if $@ && $self->opt_v; - } - } - - return; -} - -#.......................................................................... - -sub new_output_file { - my $self = shift; - my $outspec = $self->opt_d; # Yes, -d overrides all else! - # So don't call this twice per format-job! - - return $self->new_tempfile(@_) unless defined $outspec and length $outspec; - - # Otherwise open a write-handle on opt_d!f - - my $fh; - # If we are running before perl5.6.0, we can't autovivify - if ($] < 5.006) { - require Symbol; - $fh = Symbol::gensym(); - } - DEBUG > 3 and print "About to try writing to specified output file $outspec\n"; - die "Can't write-open $outspec: $!" - unless open($fh, ">", $outspec); # XXX 5.6ism - - DEBUG > 3 and print "Successfully opened $outspec\n"; - binmode($fh) if $self->{'output_is_binary'}; - return($fh, $outspec); -} - -#.......................................................................... - -sub useful_filename_bit { - # This tries to provide a meaningful bit of text to do with the query, - # such as can be used in naming the file -- since if we're going to be - # opening windows on temp files (as a "pager" may well do!) then it's - # better if the temp file's name (which may well be used as the window - # title) isn't ALL just random garbage! - # In other words "perldoc_LWPSimple_2371981429" is a better temp file - # name than "perldoc_2371981429". So this routine is what tries to - # provide the "LWPSimple" bit. - # - my $self = shift; - my $pages = $self->{'pages'} || return undef; - return undef unless @$pages; - - my $chunk = $pages->[0]; - return undef unless defined $chunk; - $chunk =~ s/:://g; - $chunk =~ s/\.\w+$//g; # strip any extension - if( $chunk =~ m/([^\#\\:\/\$]+)$/s ) { # get basename, if it's a file - $chunk = $1; - } else { - return undef; - } - $chunk =~ s/[^a-zA-Z0-9]+//g; # leave ONLY a-zA-Z0-9 things! - $chunk = substr($chunk, -10) if length($chunk) > 10; - return $chunk; -} - -#.......................................................................... - -sub new_tempfile { # $self->new_tempfile( [$suffix, [$infix] ] ) - my $self = shift; - - ++$Temp_Files_Created; - - if( IS_MSWin32 ) { - my @out = $self->MSWin_perldoc_tempfile(@_); - return @out if @out; - # otherwise fall thru to the normal stuff below... - } - - require File::Temp; - return File::Temp::tempfile(UNLINK => 1); -} - -#.......................................................................... - -sub page { # apply a pager to the output file - my ($self, $output, $output_to_stdout, @pagers) = @_; - if ($output_to_stdout) { - $self->aside("Sending unpaged output to STDOUT.\n"); - open(TMP, "<", $output) or die "Can't open $output: $!"; # XXX 5.6ism - local $_; - while (<TMP>) { - print or die "Can't print to stdout: $!"; - } - close TMP or die "Can't close while $output: $!"; - $self->unlink_if_temp_file($output); - } else { - # On VMS, quoting prevents logical expansion, and temp files with no - # extension get the wrong default extension (such as .LIS for TYPE) - - $output = VMS::Filespec::rmsexpand($output, '.') if IS_VMS; - - $output =~ s{/}{\\}g if IS_MSWin32 || IS_Dos; - # Altho "/" under MSWin is in theory good as a pathsep, - # many many corners of the OS don't like it. So we - # have to force it to be "\" to make everyone happy. - - foreach my $pager (@pagers) { - $self->aside("About to try calling $pager $output\n"); - if (IS_VMS) { - last if system("$pager $output") == 0; - } else { - last if system("$pager \"$output\"") == 0; - } - } - } - return; -} - -#.......................................................................... - -sub searchfor { - my($self, $recurse,$s,@dirs) = @_; - $s =~ s!::!/!g; - $s = VMS::Filespec::unixify($s) if IS_VMS; - return $s if -f $s && $self->containspod($s); - $self->aside( "Looking for $s in @dirs\n" ); - my $ret; - my $i; - my $dir; - $self->{'target'} = (splitdir $s)[-1]; # XXX: why not use File::Basename? - for ($i=0; $i<@dirs; $i++) { - $dir = $dirs[$i]; - next unless -d $dir; - ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if IS_VMS; - if ( (! $self->opt_m && ( $ret = $self->check_file($dir,"$s.pod"))) - or ( $ret = $self->check_file($dir,"$s.pm")) - or ( $ret = $self->check_file($dir,$s)) - or ( IS_VMS and - $ret = $self->check_file($dir,"$s.com")) - or ( IS_OS2 and - $ret = $self->check_file($dir,"$s.cmd")) - or ( (IS_MSWin32 or IS_Dos or IS_OS2) and - $ret = $self->check_file($dir,"$s.bat")) - or ( $ret = $self->check_file("$dir/pod","$s.pod")) - or ( $ret = $self->check_file("$dir/pod",$s)) - or ( $ret = $self->check_file("$dir/pods","$s.pod")) - or ( $ret = $self->check_file("$dir/pods",$s)) - ) { - DEBUG > 1 and print " Found $ret\n"; - return $ret; - } - - if ($recurse) { - opendir(D,$dir) or die "Can't opendir $dir: $!"; - my @newdirs = map catfile($dir, $_), grep { - not /^\.\.?\z/s and - not /^auto\z/s and # save time! don't search auto dirs - -d catfile($dir, $_) - } readdir D; - closedir(D) or die "Can't closedir $dir: $!"; - next unless @newdirs; - # what a wicked map! - @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if IS_VMS; - $self->aside( "Also looking in @newdirs\n" ); - push(@dirs,@newdirs); - } - } - return (); -} - -#.......................................................................... -{ - my $already_asserted; - sub assert_closing_stdout { - my $self = shift; - - return if $already_asserted; - - eval q~ END { close(STDOUT) || die "Can't close STDOUT: $!" } ~; - # What for? to let the pager know that nothing more will come? - - die $@ if $@; - $already_asserted = 1; - return; - } -} - -#.......................................................................... - -sub tweak_found_pathnames { - my($self, $found) = @_; - if (IS_MSWin32) { - foreach (@$found) { s,/,\\,g } - } - return; -} - -#.......................................................................... -# : : : : : : : : : -#.......................................................................... - -sub am_taint_checking { - my $self = shift; - die "NO ENVIRONMENT?!?!" unless keys %ENV; # reset iterator along the way - my($k,$v) = each %ENV; - return is_tainted($v); -} - -#.......................................................................... - -sub is_tainted { # just a function - my $arg = shift; - my $nada = substr($arg, 0, 0); # zero-length! - local $@; # preserve the caller's version of $@ - eval { eval "# $nada" }; - return length($@) != 0; -} - -#.......................................................................... - -sub drop_privs_maybe { - my $self = shift; - - # Attempt to drop privs if we should be tainting and aren't - if (!(IS_VMS || IS_MSWin32 || IS_Dos - || IS_OS2 - ) - && ($> == 0 || $< == 0) - && !$self->am_taint_checking() - ) { - my $id = eval { getpwnam("nobody") }; - $id = eval { getpwnam("nouser") } unless defined $id; - $id = -2 unless defined $id; - # - # According to Stevens' APUE and various - # (BSD, Solaris, HP-UX) man pages, setting - # the real uid first and effective uid second - # is the way to go if one wants to drop privileges, - # because if one changes into an effective uid of - # non-zero, one cannot change the real uid any more. - # - # Actually, it gets even messier. There is - # a third uid, called the saved uid, and as - # long as that is zero, one can get back to - # uid of zero. Setting the real-effective *twice* - # helps in *most* systems (FreeBSD and Solaris) - # but apparently in HP-UX even this doesn't help: - # the saved uid stays zero (apparently the only way - # in HP-UX to change saved uid is to call setuid() - # when the effective uid is zero). - # - eval { - $< = $id; # real uid - $> = $id; # effective uid - $< = $id; # real uid - $> = $id; # effective uid - }; - if( !$@ && $< && $> ) { - DEBUG and print "OK, I dropped privileges.\n"; - } elsif( $self->opt_U ) { - DEBUG and print "Couldn't drop privileges, but in -U mode, so feh." - } else { - DEBUG and print "Hm, couldn't drop privileges. Ah well.\n"; - # We used to die here; but that seemed pointless. - } - } - return; -} - -#.......................................................................... - -1; - -__END__ - -# See "perldoc perldoc" for basic details. -# -# Perldoc -- look up a piece of documentation in .pod format that -# is embedded in the perl installation tree. -# -#~~~~~~ -# -# See ChangeLog in CPAN dist for Pod::Perldoc for later notes. -# -# Version 3.01: Sun Nov 10 21:38:09 MST 2002 -# Sean M. Burke <sburke@cpan.org> -# Massive refactoring and code-tidying. -# Now it's a module(-family)! -# Formatter-specific stuff pulled out into Pod::Perldoc::To(Whatever).pm -# Added -T, -d, -o, -M, -w. -# Added some improved MSWin funk. -# -#~~~~~~ -# -# Version 2.05: Sat Oct 12 16:09:00 CEST 2002 -# Hugo van der Sanden <hv@crypt.org> -# Made -U the default, based on patch from Simon Cozens -# Version 2.04: Sun Aug 18 13:27:12 BST 2002 -# Randy W. Sims <RandyS@ThePierianSpring.org> -# allow -n to enable nroff under Win32 -# Version 2.03: Sun Apr 23 16:56:34 BST 2000 -# Hugo van der Sanden <hv@crypt.org> -# don't die when 'use blib' fails -# Version 2.02: Mon Mar 13 18:03:04 MST 2000 -# Tom Christiansen <tchrist@perl.com> -# Added -U insecurity option -# Version 2.01: Sat Mar 11 15:22:33 MST 2000 -# Tom Christiansen <tchrist@perl.com>, querulously. -# Security and correctness patches. -# What a twisted bit of distasteful spaghetti code. -# Version 2.0: ???? -# -#~~~~~~ -# -# Version 1.15: Tue Aug 24 01:50:20 EST 1999 -# Charles Wilson <cwilson@ece.gatech.edu> -# changed /pod/ directory to /pods/ for cygwin -# to support cygwin/win32 -# Version 1.14: Wed Jul 15 01:50:20 EST 1998 -# Robin Barker <rmb1@cise.npl.co.uk> -# -strict, -w cleanups -# Version 1.13: Fri Feb 27 16:20:50 EST 1997 -# Gurusamy Sarathy <gsar@activestate.com> -# -doc tweaks for -F and -X options -# Version 1.12: Sat Apr 12 22:41:09 EST 1997 -# Gurusamy Sarathy <gsar@activestate.com> -# -various fixes for win32 -# Version 1.11: Tue Dec 26 09:54:33 EST 1995 -# Kenneth Albanowski <kjahds@kjahds.com> -# -added Charles Bailey's further VMS patches, and -u switch -# -added -t switch, with pod2text support -# -# Version 1.10: Thu Nov 9 07:23:47 EST 1995 -# Kenneth Albanowski <kjahds@kjahds.com> -# -added VMS support -# -added better error recognition (on no found pages, just exit. On -# missing nroff/pod2man, just display raw pod.) -# -added recursive/case-insensitive matching (thanks, Andreas). This -# slows things down a bit, unfortunately. Give a precise name, and -# it'll run faster. -# -# Version 1.01: Tue May 30 14:47:34 EDT 1995 -# Andy Dougherty <doughera@lafcol.lafayette.edu> -# -added pod documentation. -# -added PATH searching. -# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod -# and friends. -# -#~~~~~~~ -# -# TODO: -# -# Cache the directories read during sloppy match -# (To disk, or just in-memory?) -# -# Backport this to perl 5.005? -# -# Implement at least part of the "perlman" interface described -# in Programming Perl 3e? diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/BaseTo.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/BaseTo.pm deleted file mode 100644 index 6ca2a8c7e54..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/BaseTo.pm +++ /dev/null @@ -1,28 +0,0 @@ - -require 5; -package Pod::Perldoc::BaseTo; -use strict; -use warnings; - -sub is_pageable { '' } -sub write_with_binmode { 1 } - -sub output_extension { 'txt' } # override in subclass! - -# sub new { my $self = shift; ... } -# sub parse_from_file( my($class, $in, $out) = ...; ... } - -#sub new { return bless {}, ref($_[0]) || $_[0] } - -sub _perldoc_elem { - my($self, $name) = splice @_,0,2; - if(@_) { - $self->{$name} = $_[0]; - } else { - $self->{$name}; - } -} - - -1; - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/GetOptsOO.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/GetOptsOO.pm deleted file mode 100644 index b29aeb10906..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/GetOptsOO.pm +++ /dev/null @@ -1,106 +0,0 @@ - -require 5; -package Pod::Perldoc::GetOptsOO; -use strict; - -# Rather like Getopt::Std's getopts -# Call Pod::Perldoc::GetOptsOO::getopts($object, \@ARGV, $truth) -# Given -n, if there's a opt_n_with, it'll call $object->opt_n_with( ARGUMENT ) -# (e.g., "-n foo" => $object->opt_n_with('foo'). Ditto "-nfoo") -# Otherwise (given -n) if there's an opt_n, we'll call it $object->opt_n($truth) -# (Truth defaults to 1) -# Otherwise we try calling $object->handle_unknown_option('n') -# (and we increment the error count by the return value of it) -# If there's no handle_unknown_option, then we just warn, and then increment -# the error counter -# -# The return value of Pod::Perldoc::GetOptsOO::getopts is true if no errors, -# otherwise it's false. -# -## sburke@cpan.org 2002-10-31 - -BEGIN { # Make a DEBUG constant ASAP - *DEBUG = defined( &Pod::Perldoc::DEBUG ) - ? \&Pod::Perldoc::DEBUG - : sub(){10}; -} - - -sub getopts { - my($target, $args, $truth) = @_; - - $args ||= \@ARGV; - - $target->aside( - "Starting switch processing. Scanning arguments [@$args]\n" - ) if $target->can('aside'); - - return unless @$args; - - $truth = 1 unless @_ > 2; - - DEBUG > 3 and print " Truth is $truth\n"; - - - my $error_count = 0; - - while( @$args and ($_ = $args->[0]) =~ m/^-(.)(.*)/s ) { - my($first,$rest) = ($1,$2); - if ($_ eq '--') { # early exit if "--" - shift @$args; - last; - } - my $method = "opt_${first}_with"; - if( $target->can($method) ) { # it's argumental - if($rest eq '') { # like -f bar - shift @$args; - warn "Option $first needs a following argument!\n" unless @$args; - $rest = shift @$args; - } else { # like -fbar (== -f bar) - shift @$args; - } - - DEBUG > 3 and print " $method => $rest\n"; - $target->$method( $rest ); - - # Otherwise, it's not argumental... - } else { - - if( $target->can( $method = "opt_$first" ) ) { - DEBUG > 3 and print " $method is true ($truth)\n"; - $target->$method( $truth ); - - # Otherwise it's an unknown option... - - } elsif( $target->can('handle_unknown_option') ) { - DEBUG > 3 - and print " calling handle_unknown_option('$first')\n"; - - $error_count += ( - $target->handle_unknown_option( $first ) || 0 - ); - - } else { - ++$error_count; - warn "Unknown option: $first\n"; - } - - if($rest eq '') { # like -f - shift @$args - } else { # like -fbar (== -f -bar ) - DEBUG > 2 and print " Setting args->[0] to \"-$rest\"\n"; - $args->[0] = "-$rest"; - } - } - } - - - $target->aside( - "Ending switch processing. Args are [@$args] with $error_count errors.\n" - ) if $target->can('aside'); - - $error_count == 0; -} - -1; - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToChecker.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToChecker.pm deleted file mode 100644 index c60290d6502..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToChecker.pm +++ /dev/null @@ -1,72 +0,0 @@ - -require 5; -package Pod::Perldoc::ToChecker; -use strict; -use warnings; -use vars qw(@ISA); - -# Pick our superclass... -# -eval 'require Pod::Simple::Checker'; -if($@) { - require Pod::Checker; - @ISA = ('Pod::Checker'); -} else { - @ISA = ('Pod::Simple::Checker'); -} - -sub is_pageable { 1 } -sub write_with_binmode { 0 } -sub output_extension { 'txt' } - -sub if_zero_length { - my( $self, $file, $tmp, $tmpfd ) = @_; - print "No Pod errors in $file\n"; -} - - -1; - -__END__ - -=head1 NAME - -Pod::Perldoc::ToChecker - let Perldoc check Pod for errors - -=head1 SYNOPSIS - - % perldoc -o checker SomeFile.pod - No Pod errors in SomeFile.pod - (or an error report) - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to use -Pod::Simple::Checker as a "formatter" class (or if that is -not available, then Pod::Checker), to check for errors in a given -Pod file. - -This is actually a Pod::Simple::Checker (or Pod::Checker) subclass, and -inherits all its options. - -=head1 SEE ALSO - -L<Pod::Simple::Checker>, L<Pod::Simple>, L<Pod::Checker>, L<Pod::Perldoc> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToMan.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToMan.pm deleted file mode 100644 index 43191222376..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToMan.pm +++ /dev/null @@ -1,187 +0,0 @@ - -require 5; -package Pod::Perldoc::ToMan; -use strict; -use warnings; - -# This class is unlike ToText.pm et al, because we're NOT paging thru -# the output in our particular format -- we make the output and -# then we run nroff (or whatever) on it, and then page thru the -# (plaintext) output of THAT! - -use base qw(Pod::Perldoc::BaseTo); -sub is_pageable { 1 } -sub write_with_binmode { 0 } -sub output_extension { 'txt' } - -sub __filter_nroff { shift->_perldoc_elem('__filter_nroff' , @_) } -sub __nroffer { shift->_perldoc_elem('__nroffer' , @_) } -sub __bindir { shift->_perldoc_elem('__bindir' , @_) } -sub __pod2man { shift->_perldoc_elem('__pod2man' , @_) } -sub __output_file { shift->_perldoc_elem('__output_file' , @_) } - -sub center { shift->_perldoc_elem('center' , @_) } -sub date { shift->_perldoc_elem('date' , @_) } -sub fixed { shift->_perldoc_elem('fixed' , @_) } -sub fixedbold { shift->_perldoc_elem('fixedbold' , @_) } -sub fixeditalic { shift->_perldoc_elem('fixeditalic' , @_) } -sub fixedbolditalic { shift->_perldoc_elem('fixedbolditalic', @_) } -sub quotes { shift->_perldoc_elem('quotes' , @_) } -sub release { shift->_perldoc_elem('release' , @_) } -sub section { shift->_perldoc_elem('section' , @_) } - -sub new { return bless {}, ref($_[0]) || $_[0] } - -use File::Spec::Functions qw(catfile); - -sub parse_from_file { - my $self = shift; - my($file, $outfh) = @_; - - my $render = $self->{'__nroffer'} || die "no nroffer set!?"; - - # turn the switches into CLIs - my $switches = join ' ', - map qq{"--$_=$self->{$_}"}, - grep !m/^_/s, - keys %$self - ; - - my $pod2man = - catfile( - ($self->{'__bindir'} || die "no bindir set?!" ), - ($self->{'__pod2man'} || die "no pod2man set?!" ), - ) - ; - unless(-e $pod2man) { - # This is rarely needed, I think. - $pod2man = $self->{'__pod2man'} || die "no pod2man set?!"; - die "Can't find a pod2man?! (". $self->{'__pod2man'} .")\nAborting" - unless -e $pod2man; - } - - my $command = "$pod2man $switches --lax $file | $render -man"; - # no temp file, just a pipe! - - # Thanks to Brendan O'Dea for contributing the following block - if(Pod::Perldoc::IS_Linux and -t STDOUT - and my ($cols) = `stty -a` =~ m/\bcolumns\s+(\d+)/ - ) { - my $c = $cols * 39 / 40; - $cols = $c > $cols - 2 ? $c : $cols -2; - $command .= ' -rLL=' . (int $c) . 'n' if $cols > 80; - } - - if(Pod::Perldoc::IS_Cygwin) { - $command .= ' -c'; - } - - # I hear persistent reports that adding a -c switch to $render - # solves many people's problems. But I also hear that some mans - # don't have a -c switch, so that unconditionally adding it here - # would presumably be a Bad Thing -- sburke@cpan.org - - $command .= " | col -x" if Pod::Perldoc::IS_HPUX; - - defined(&Pod::Perldoc::DEBUG) - and Pod::Perldoc::DEBUG() - and print "About to run $command\n"; - ; - - my $rslt = `$command`; - - my $err; - - if( $self->{'__filter_nroff'} ) { - defined(&Pod::Perldoc::DEBUG) - and &Pod::Perldoc::DEBUG() - and print "filter_nroff is set, so filtering...\n"; - $rslt = $self->___Do_filter_nroff($rslt); - } else { - defined(&Pod::Perldoc::DEBUG) - and Pod::Perldoc::DEBUG() - and print "filter_nroff isn't set, so not filtering.\n"; - } - - if (($err = $?)) { - defined(&Pod::Perldoc::DEBUG) - and Pod::Perldoc::DEBUG() - and print "Nonzero exit ($?) while running $command.\n", - "Falling back to Pod::Perldoc::ToPod\n ", - ; - # A desperate fallthru: - require Pod::Perldoc::ToPod; - return Pod::Perldoc::ToPod->new->parse_from_file(@_); - - } else { - print $outfh $rslt - or die "Can't print to $$self{__output_file}: $!"; - } - - return; -} - - -sub ___Do_filter_nroff { - my $self = shift; - my @data = split /\n{2,}/, shift; - - shift @data while @data and $data[0] !~ /\S/; # Go to header - shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header - pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like - # 28/Jan/99 perl 5.005, patch 53 1 - join "\n\n", @data; -} - -1; - -__END__ - -=head1 NAME - -Pod::Perldoc::ToMan - let Perldoc render Pod as man pages - -=head1 SYNOPSIS - - perldoc -o man Some::Modulename - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to use -Pod::Man and C<nroff> for reading Pod pages. - -The following options are supported: center, date, fixed, fixedbold, -fixeditalic, fixedbolditalic, quotes, release, section - -(Those options are explained in L<Pod::Man>.) - -For example: - - perldoc -o man -w center:Pod Some::Modulename - -=head1 CAVEAT - -This module may change to use a different pod-to-nroff formatter class -in the future, and this may change what options are supported. - -=head1 SEE ALSO - -L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToNroff> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002,3,4 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToNroff.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToNroff.pm deleted file mode 100644 index d0568605068..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToNroff.pm +++ /dev/null @@ -1,100 +0,0 @@ - -require 5; -package Pod::Perldoc::ToNroff; -use strict; -use warnings; - -# This is unlike ToMan.pm in that it emits the raw nroff source! - -use base qw(Pod::Perldoc::BaseTo); - -sub is_pageable { 1 } # well, if you ask for it... -sub write_with_binmode { 0 } -sub output_extension { 'man' } - -use Pod::Man (); - -sub center { shift->_perldoc_elem('center' , @_) } -sub date { shift->_perldoc_elem('date' , @_) } -sub fixed { shift->_perldoc_elem('fixed' , @_) } -sub fixedbold { shift->_perldoc_elem('fixedbold' , @_) } -sub fixeditalic { shift->_perldoc_elem('fixeditalic' , @_) } -sub fixedbolditalic { shift->_perldoc_elem('fixedbolditalic', @_) } -sub quotes { shift->_perldoc_elem('quotes' , @_) } -sub release { shift->_perldoc_elem('release' , @_) } -sub section { shift->_perldoc_elem('section' , @_) } - -sub new { return bless {}, ref($_[0]) || $_[0] } - -sub parse_from_file { - my $self = shift; - my $file = $_[0]; - - my @options = - map {; $_, $self->{$_} } - grep !m/^_/s, - keys %$self - ; - - defined(&Pod::Perldoc::DEBUG) - and Pod::Perldoc::DEBUG() - and print "About to call new Pod::Man ", - $Pod::Man::VERSION ? "(v$Pod::Man::VERSION) " : '', - "with options: ", - @options ? "[@options]" : "(nil)", "\n"; - ; - - Pod::Man->new(@options)->parse_from_file(@_); -} - -1; -__END__ - -=head1 NAME - -Pod::Perldoc::ToNroff - let Perldoc convert Pod to nroff - -=head1 SYNOPSIS - - perldoc -o nroff -d something.3 Some::Modulename - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to use -Pod::Man as a formatter class. - -The following options are supported: center, date, fixed, fixedbold, -fixeditalic, fixedbolditalic, quotes, release, section - -Those options are explained in L<Pod::Man>. - -For example: - - perldoc -o nroff -w center:Pod -d something.3 Some::Modulename - -=head1 CAVEAT - -This module may change to use a different pod-to-nroff formatter class -in the future, and this may change what options are supported. - -=head1 SEE ALSO - -L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToMan> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToPod.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToPod.pm deleted file mode 100644 index bccbfcadbd6..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToPod.pm +++ /dev/null @@ -1,90 +0,0 @@ - -# This class is just a hack to act as a "formatter" for -# actually unformatted Pod. -# -# Note that this isn't the same as just passing thru whatever -# we're given -- we pass thru only the pod source, and suppress -# the Perl code (or whatever non-pod stuff is in the source file). - - -require 5; -package Pod::Perldoc::ToPod; -use strict; -use warnings; - -use base qw(Pod::Perldoc::BaseTo); -sub is_pageable { 1 } -sub write_with_binmode { 0 } -sub output_extension { 'pod' } - -sub new { return bless {}, ref($_[0]) || $_[0] } - -sub parse_from_file { - my( $self, $in, $outfh ) = @_; - - open(IN, "<", $in) or die "Can't read-open $in: $!\nAborting"; - - my $cut_mode = 1; - - # A hack for finding things between =foo and =cut, inclusive - local $_; - while (<IN>) { - if( m/^=(\w+)/s ) { - if($cut_mode = ($1 eq 'cut')) { - print $outfh "\n=cut\n\n"; - # Pass thru the =cut line with some harmless - # (and occasionally helpful) padding - } - } - next if $cut_mode; - print $outfh $_ or die "Can't print to $outfh: $!"; - } - - close IN or die "Can't close $in: $!"; - return; -} - -1; -__END__ - -=head1 NAME - -Pod::Perldoc::ToPod - let Perldoc render Pod as ... Pod! - -=head1 SYNOPSIS - - perldoc -opod Some::Modulename - -(That's currently the same as the following:) - - perldoc -u Some::Modulename - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to display Pod source as -itself! Pretty Zen, huh? - -Currently this class works by just filtering out the non-Pod stuff from -a given input file. - -=head1 SEE ALSO - -L<Pod::Perldoc> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToRtf.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToRtf.pm deleted file mode 100644 index 25e609e313a..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToRtf.pm +++ /dev/null @@ -1,85 +0,0 @@ - -require 5; -package Pod::Perldoc::ToRtf; -use strict; -use warnings; -use vars qw($VERSION); - -use base qw( Pod::Simple::RTF ); - -$VERSION # so that ->VERSION is happy -# stop CPAN from seeing this - = -$Pod::Simple::RTF::VERSION; - - -sub is_pageable { 0 } -sub write_with_binmode { 0 } -sub output_extension { 'rtf' } - -sub page_for_perldoc { - my($self, $tempfile, $perldoc) = @_; - return unless $perldoc->IS_MSWin32; - - my $rtf_pager = $ENV{'RTFREADER'} || 'write.exe'; - - $perldoc->aside( "About to launch <\"$rtf_pager\" \"$tempfile\">\n" ); - - return 1 if system( qq{"$rtf_pager"}, qq{"$tempfile"} ) == 0; - return 0; -} - -1; -__END__ - -=head1 NAME - -Pod::Perldoc::ToRtf - let Perldoc render Pod as RTF - -=head1 SYNOPSIS - - perldoc -o rtf Some::Modulename - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to use -Pod::Simple::RTF as a formatter class. - -This is actually a Pod::Simple::RTF subclass, and inherits -all its options. - -You have to have Pod::Simple::RTF installed (from the Pod::Simple dist), -or this module won't work. - -If Perldoc is running under MSWin and uses this class as a formatter, -the output will be opened with F<write.exe> or whatever program is -specified in the environment variable C<RTFREADER>. For example, to -specify that RTF files should be opened the same as they are when you -double-click them, you would do C<set RTFREADER=start.exe> in your -F<autoexec.bat>. - -Handy tip: put C<set PERLDOC=-ortf> in your F<autoexec.bat> -and that will set this class as the default formatter to run when -you do C<perldoc whatever>. - -=head1 SEE ALSO - -L<Pod::Simple::RTF>, L<Pod::Simple>, L<Pod::Perldoc> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToText.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToText.pm deleted file mode 100644 index 2eb9e0644ac..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToText.pm +++ /dev/null @@ -1,91 +0,0 @@ - -require 5; -package Pod::Perldoc::ToText; -use strict; -use warnings; - -use base qw(Pod::Perldoc::BaseTo); - -sub is_pageable { 1 } -sub write_with_binmode { 0 } -sub output_extension { 'txt' } - -use Pod::Text (); - -sub alt { shift->_perldoc_elem('alt' , @_) } -sub indent { shift->_perldoc_elem('indent' , @_) } -sub loose { shift->_perldoc_elem('loose' , @_) } -sub quotes { shift->_perldoc_elem('quotes' , @_) } -sub sentence { shift->_perldoc_elem('sentence', @_) } -sub width { shift->_perldoc_elem('width' , @_) } - -sub new { return bless {}, ref($_[0]) || $_[0] } - -sub parse_from_file { - my $self = shift; - - my @options = - map {; $_, $self->{$_} } - grep !m/^_/s, - keys %$self - ; - - defined(&Pod::Perldoc::DEBUG) - and Pod::Perldoc::DEBUG() - and print "About to call new Pod::Text ", - $Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '', - "with options: ", - @options ? "[@options]" : "(nil)", "\n"; - ; - - Pod::Text->new(@options)->parse_from_file(@_); -} - -1; - -=head1 NAME - -Pod::Perldoc::ToText - let Perldoc render Pod as plaintext - -=head1 SYNOPSIS - - perldoc -o text Some::Modulename - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to use -Pod::Text as a formatter class. - -It supports the following options, which are explained in -L<Pod::Text>: alt, indent, loose, quotes, sentence, width - -For example: - - perldoc -o text -w indent:5 Some::Modulename - -=head1 CAVEAT - -This module may change to use a different text formatter class in the -future, and this may change what options are supported. - -=head1 SEE ALSO - -L<Pod::Text>, L<Pod::Perldoc> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToTk.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToTk.pm deleted file mode 100644 index 39459629503..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToTk.pm +++ /dev/null @@ -1,129 +0,0 @@ - -require 5; -package Pod::Perldoc::ToTk; -use strict; -use warnings; - -use base qw(Pod::Perldoc::BaseTo); - -sub is_pageable { 1 } -sub write_with_binmode { 0 } -sub output_extension { 'txt' } # doesn't matter -sub if_zero_length { } # because it will be 0-length! -sub new { return bless {}, ref($_[0]) || $_[0] } - -# TODO: document these and their meanings... -sub tree { shift->_perldoc_elem('tree' , @_) } -sub tk_opt { shift->_perldoc_elem('tk_opt' , @_) } -sub forky { shift->_perldoc_elem('forky' , @_) } - -use Pod::Perldoc (); -use File::Spec::Functions qw(catfile); - -use Tk; -die join '', __PACKAGE__, " doesn't work nice with Tk.pm verison $Tk::VERSION" - if $Tk::VERSION eq '800.003'; - -BEGIN { eval { require Tk::FcyEntry; }; }; -use Tk::Pod; - -# The following was adapted from "tkpod" in the Tk-Pod dist. - -sub parse_from_file { - - my($self, $Input_File) = @_; - if($self->{'forky'}) { - return if fork; # i.e., parent process returns - } - - $Input_File =~ s{\\}{/}g - if Pod::Perldoc::IS_MSWin32 or Pod::Perldoc::IS_Dos - # and maybe OS/2 - ; - - my($tk_opt, $tree); - $tree = $self->{'tree' }; - $tk_opt = $self->{'tk_opt'}; - - #require Tk::ErrorDialog; - - # Add 'Tk' subdirectories to search path so, e.g., - # 'Scrolled' will find doc in 'Tk/Scrolled' - - if( $tk_opt ) { - push @INC, grep -d $_, map catfile($_,'Tk'), @INC; - } - - my $mw = MainWindow->new(); - #eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug'; - $mw->withdraw; - - # CDE use Font Settings if available - my $ufont = $mw->optionGet('userFont','UserFont'); # fixed width - my $sfont = $mw->optionGet('systemFont','SystemFont'); # proportional - if (defined($ufont) and defined($sfont)) { - foreach ($ufont, $sfont) { s/:$//; }; - $mw->optionAdd('*Font', $sfont); - $mw->optionAdd('*Entry.Font', $ufont); - $mw->optionAdd('*Text.Font', $ufont); - } - - $mw->optionAdd('*Menu.tearOff', $Tk::platform ne 'MSWin32' ? 1 : 0); - - $mw->Pod( - '-file' => $Input_File, - (($Tk::Pod::VERSION >= 4) ? ('-tree' => $tree) : ()) - )->focusNext; - - # xxx dirty but it works. A simple $mw->destroy if $mw->children - # does not work because Tk::ErrorDialogs could be created. - # (they are withdrawn after Ok instead of destory'ed I guess) - - if ($mw->children) { - $mw->repeat(1000, sub { - # ErrorDialog is withdrawn not deleted :-( - foreach ($mw->children) { - return if "$_" =~ /^Tk::Pod/ # ->isa('Tk::Pod') - } - $mw->destroy; - }); - } else { - $mw->destroy; - } - #$mw->WidgetDump; - MainLoop(); - - exit if $self->{'forky'}; # we were the child! so exit now! - return; -} - -1; -__END__ - - -=head1 NAME - -Pod::Perldoc::ToTk - let Perldoc use Tk::Pod to render Pod - -=head1 SYNOPSIS - - perldoc -o tk Some::Modulename & - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to use -Tk::Pod as a formatter class. - -You have to have installed Tk::Pod first, or this class won't load. - -=head1 SEE ALSO - -L<Tk::Pod>, L<Pod::Perldoc> - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org>, with significant portions copied from -F<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al. - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToXml.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToXml.pm deleted file mode 100644 index dd0d15cc10b..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Perldoc/ToXml.pm +++ /dev/null @@ -1,63 +0,0 @@ - -require 5; -package Pod::Perldoc::ToXml; -use strict; -use warnings; -use vars qw($VERSION); - -use base qw( Pod::Simple::XMLOutStream ); - -$VERSION # so that ->VERSION is happy -# stop CPAN from seeing this - = -$Pod::Simple::XMLOutStream::VERSION; - - -sub is_pageable { 0 } -sub write_with_binmode { 0 } -sub output_extension { 'xml' } - -1; -__END__ - -=head1 NAME - -Pod::Perldoc::ToXml - let Perldoc render Pod as XML - -=head1 SYNOPSIS - - perldoc -o xml -d out.xml Some::Modulename - -=head1 DESCRIPTION - -This is a "plug-in" class that allows Perldoc to use -Pod::Simple::XMLOutStream as a formatter class. - -This is actually a Pod::Simple::XMLOutStream subclass, and inherits -all its options. - -You have to have installed Pod::Simple::XMLOutStream (from the Pod::Simple -dist), or this class won't work. - - -=head1 SEE ALSO - -L<Pod::Simple::XMLOutStream>, L<Pod::Simple>, L<Pod::Perldoc> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/PlainText.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/PlainText.pm deleted file mode 100644 index ec56608ff20..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/PlainText.pm +++ /dev/null @@ -1,722 +0,0 @@ -# Pod::PlainText -- Convert POD data to formatted ASCII text. -# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $ -# -# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu> -# -# This program is free software; you can redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This module is intended to be a replacement for Pod::Text, and attempts to -# match its output except for some specific circumstances where other -# decisions seemed to produce better output. It uses Pod::Parser and is -# designed to be very easy to subclass. - -############################################################################ -# Modules and declarations -############################################################################ - -package Pod::PlainText; - -require 5.005; - -use Carp qw(carp croak); -use Pod::Select (); - -use strict; -use vars qw(@ISA %ESCAPES $VERSION); - -# We inherit from Pod::Select instead of Pod::Parser so that we can be used -# by Pod::Usage. -@ISA = qw(Pod::Select); - -$VERSION = '2.02'; - - -############################################################################ -# Table of supported E<> escapes -############################################################################ - -# This table is taken near verbatim from Pod::PlainText in Pod::Parser, -# which got it near verbatim from the original Pod::Text. It is therefore -# credited to Tom Christiansen, and I'm glad I didn't have to write it. :) -%ESCAPES = ( - 'amp' => '&', # ampersand - 'lt' => '<', # left chevron, less-than - 'gt' => '>', # right chevron, greater-than - 'quot' => '"', # double quote - - "Aacute" => "\xC1", # capital A, acute accent - "aacute" => "\xE1", # small a, acute accent - "Acirc" => "\xC2", # capital A, circumflex accent - "acirc" => "\xE2", # small a, circumflex accent - "AElig" => "\xC6", # capital AE diphthong (ligature) - "aelig" => "\xE6", # small ae diphthong (ligature) - "Agrave" => "\xC0", # capital A, grave accent - "agrave" => "\xE0", # small a, grave accent - "Aring" => "\xC5", # capital A, ring - "aring" => "\xE5", # small a, ring - "Atilde" => "\xC3", # capital A, tilde - "atilde" => "\xE3", # small a, tilde - "Auml" => "\xC4", # capital A, dieresis or umlaut mark - "auml" => "\xE4", # small a, dieresis or umlaut mark - "Ccedil" => "\xC7", # capital C, cedilla - "ccedil" => "\xE7", # small c, cedilla - "Eacute" => "\xC9", # capital E, acute accent - "eacute" => "\xE9", # small e, acute accent - "Ecirc" => "\xCA", # capital E, circumflex accent - "ecirc" => "\xEA", # small e, circumflex accent - "Egrave" => "\xC8", # capital E, grave accent - "egrave" => "\xE8", # small e, grave accent - "ETH" => "\xD0", # capital Eth, Icelandic - "eth" => "\xF0", # small eth, Icelandic - "Euml" => "\xCB", # capital E, dieresis or umlaut mark - "euml" => "\xEB", # small e, dieresis or umlaut mark - "Iacute" => "\xCD", # capital I, acute accent - "iacute" => "\xED", # small i, acute accent - "Icirc" => "\xCE", # capital I, circumflex accent - "icirc" => "\xEE", # small i, circumflex accent - "Igrave" => "\xCD", # capital I, grave accent - "igrave" => "\xED", # small i, grave accent - "Iuml" => "\xCF", # capital I, dieresis or umlaut mark - "iuml" => "\xEF", # small i, dieresis or umlaut mark - "Ntilde" => "\xD1", # capital N, tilde - "ntilde" => "\xF1", # small n, tilde - "Oacute" => "\xD3", # capital O, acute accent - "oacute" => "\xF3", # small o, acute accent - "Ocirc" => "\xD4", # capital O, circumflex accent - "ocirc" => "\xF4", # small o, circumflex accent - "Ograve" => "\xD2", # capital O, grave accent - "ograve" => "\xF2", # small o, grave accent - "Oslash" => "\xD8", # capital O, slash - "oslash" => "\xF8", # small o, slash - "Otilde" => "\xD5", # capital O, tilde - "otilde" => "\xF5", # small o, tilde - "Ouml" => "\xD6", # capital O, dieresis or umlaut mark - "ouml" => "\xF6", # small o, dieresis or umlaut mark - "szlig" => "\xDF", # small sharp s, German (sz ligature) - "THORN" => "\xDE", # capital THORN, Icelandic - "thorn" => "\xFE", # small thorn, Icelandic - "Uacute" => "\xDA", # capital U, acute accent - "uacute" => "\xFA", # small u, acute accent - "Ucirc" => "\xDB", # capital U, circumflex accent - "ucirc" => "\xFB", # small u, circumflex accent - "Ugrave" => "\xD9", # capital U, grave accent - "ugrave" => "\xF9", # small u, grave accent - "Uuml" => "\xDC", # capital U, dieresis or umlaut mark - "uuml" => "\xFC", # small u, dieresis or umlaut mark - "Yacute" => "\xDD", # capital Y, acute accent - "yacute" => "\xFD", # small y, acute accent - "yuml" => "\xFF", # small y, dieresis or umlaut mark - - "lchevron" => "\xAB", # left chevron (double less than) - "rchevron" => "\xBB", # right chevron (double greater than) -); - - -############################################################################ -# Initialization -############################################################################ - -# Initialize the object. Must be sure to call our parent initializer. -sub initialize { - my $self = shift; - - $$self{alt} = 0 unless defined $$self{alt}; - $$self{indent} = 4 unless defined $$self{indent}; - $$self{loose} = 0 unless defined $$self{loose}; - $$self{sentence} = 0 unless defined $$self{sentence}; - $$self{width} = 76 unless defined $$self{width}; - - $$self{INDENTS} = []; # Stack of indentations. - $$self{MARGIN} = $$self{indent}; # Current left margin in spaces. - - $self->SUPER::initialize; -} - - -############################################################################ -# Core overrides -############################################################################ - -# Called for each command paragraph. Gets the command, the associated -# paragraph, the line number, and a Pod::Paragraph object. Just dispatches -# the command to a method named the same as the command. =cut is handled -# internally by Pod::Parser. -sub command { - my $self = shift; - my $command = shift; - return if $command eq 'pod'; - return if ($$self{EXCLUDE} && $command ne 'end'); - $self->item ("\n") if defined $$self{ITEM}; - $command = 'cmd_' . $command; - $self->$command (@_); -} - -# Called for a verbatim paragraph. Gets the paragraph, the line number, and -# a Pod::Paragraph object. Just output it verbatim, but with tabs converted -# to spaces. -sub verbatim { - my $self = shift; - return if $$self{EXCLUDE}; - $self->item if defined $$self{ITEM}; - local $_ = shift; - return if /^\s*$/; - s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme; - $self->output ($_); -} - -# Called for a regular text block. Gets the paragraph, the line number, and -# a Pod::Paragraph object. Perform interpolation and output the results. -sub textblock { - my $self = shift; - return if $$self{EXCLUDE}; - $self->output ($_[0]), return if $$self{VERBATIM}; - local $_ = shift; - my $line = shift; - - # Perform a little magic to collapse multiple L<> references. This is - # here mostly for backwards-compatibility. We'll just rewrite the whole - # thing into actual text at this part, bypassing the whole internal - # sequence parsing thing. - s{ - ( - L< # A link of the form L</something>. - / - ( - [:\w]+ # The item has to be a simple word... - (\(\))? # ...or simple function. - ) - > - ( - ,?\s+(and\s+)? # Allow lots of them, conjuncted. - L< - / - ( - [:\w]+ - (\(\))? - ) - > - )+ - ) - } { - local $_ = $1; - s%L</([^>]+)>%$1%g; - my @items = split /(?:,?\s+(?:and\s+)?)/; - my $string = "the "; - my $i; - for ($i = 0; $i < @items; $i++) { - $string .= $items[$i]; - $string .= ", " if @items > 2 && $i != $#items; - $string .= " and " if ($i == $#items - 1); - } - $string .= " entries elsewhere in this document"; - $string; - }gex; - - # Now actually interpolate and output the paragraph. - $_ = $self->interpolate ($_, $line); - s/\s+$/\n/; - if (defined $$self{ITEM}) { - $self->item ($_ . "\n"); - } else { - $self->output ($self->reformat ($_ . "\n")); - } -} - -# Called for an interior sequence. Gets the command, argument, and a -# Pod::InteriorSequence object and is expected to return the resulting text. -# Calls code, bold, italic, file, and link to handle those types of -# sequences, and handles S<>, E<>, X<>, and Z<> directly. -sub interior_sequence { - my $self = shift; - my $command = shift; - local $_ = shift; - return '' if ($command eq 'X' || $command eq 'Z'); - - # Expand escapes into the actual character now, carping if invalid. - if ($command eq 'E') { - return $ESCAPES{$_} if defined $ESCAPES{$_}; - carp "Unknown escape: E<$_>"; - return "E<$_>"; - } - - # For all the other sequences, empty content produces no output. - return if $_ eq ''; - - # For S<>, compress all internal whitespace and then map spaces to \01. - # When we output the text, we'll map this back. - if ($command eq 'S') { - s/\s{2,}/ /g; - tr/ /\01/; - return $_; - } - - # Anything else needs to get dispatched to another method. - if ($command eq 'B') { return $self->seq_b ($_) } - elsif ($command eq 'C') { return $self->seq_c ($_) } - elsif ($command eq 'F') { return $self->seq_f ($_) } - elsif ($command eq 'I') { return $self->seq_i ($_) } - elsif ($command eq 'L') { return $self->seq_l ($_) } - else { carp "Unknown sequence $command<$_>" } -} - -# Called for each paragraph that's actually part of the POD. We take -# advantage of this opportunity to untabify the input. -sub preprocess_paragraph { - my $self = shift; - local $_ = shift; - 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me; - $_; -} - - -############################################################################ -# Command paragraphs -############################################################################ - -# All command paragraphs take the paragraph and the line number. - -# First level heading. -sub cmd_head1 { - my $self = shift; - local $_ = shift; - s/\s+$//; - $_ = $self->interpolate ($_, shift); - if ($$self{alt}) { - $self->output ("\n==== $_ ====\n\n"); - } else { - $_ .= "\n" if $$self{loose}; - $self->output ($_ . "\n"); - } -} - -# Second level heading. -sub cmd_head2 { - my $self = shift; - local $_ = shift; - s/\s+$//; - $_ = $self->interpolate ($_, shift); - if ($$self{alt}) { - $self->output ("\n== $_ ==\n\n"); - } else { - $self->output (' ' x ($$self{indent} / 2) . $_ . "\n\n"); - } -} - -# third level heading - not strictly perlpodspec compliant -sub cmd_head3 { - my $self = shift; - local $_ = shift; - s/\s+$//; - $_ = $self->interpolate ($_, shift); - if ($$self{alt}) { - $self->output ("\n= $_ =\n"); - } else { - $self->output (' ' x ($$self{indent}) . $_ . "\n"); - } -} - -# fourth level heading - not strictly perlpodspec compliant -# just like head3 -*cmd_head4 = \&cmd_head3; - -# Start a list. -sub cmd_over { - my $self = shift; - local $_ = shift; - unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} } - push (@{ $$self{INDENTS} }, $$self{MARGIN}); - $$self{MARGIN} += ($_ + 0); -} - -# End a list. -sub cmd_back { - my $self = shift; - $$self{MARGIN} = pop @{ $$self{INDENTS} }; - unless (defined $$self{MARGIN}) { - carp "Unmatched =back"; - $$self{MARGIN} = $$self{indent}; - } -} - -# An individual list item. -sub cmd_item { - my $self = shift; - if (defined $$self{ITEM}) { $self->item } - local $_ = shift; - s/\s+$//; - $$self{ITEM} = $self->interpolate ($_); -} - -# Begin a block for a particular translator. Setting VERBATIM triggers -# special handling in textblock(). -sub cmd_begin { - my $self = shift; - local $_ = shift; - my ($kind) = /^(\S+)/ or return; - if ($kind eq 'text') { - $$self{VERBATIM} = 1; - } else { - $$self{EXCLUDE} = 1; - } -} - -# End a block for a particular translator. We assume that all =begin/=end -# pairs are properly closed. -sub cmd_end { - my $self = shift; - $$self{EXCLUDE} = 0; - $$self{VERBATIM} = 0; -} - -# One paragraph for a particular translator. Ignore it unless it's intended -# for text, in which case we treat it as a verbatim text block. -sub cmd_for { - my $self = shift; - local $_ = shift; - my $line = shift; - return unless s/^text\b[ \t]*\n?//; - $self->verbatim ($_, $line); -} - - -############################################################################ -# Interior sequences -############################################################################ - -# The simple formatting ones. These are here mostly so that subclasses can -# override them and do more complicated things. -sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] } -sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" } -sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] } -sub seq_i { return '*' . $_[1] . '*' } - -# The complicated one. Handle links. Since this is plain text, we can't -# actually make any real links, so this is all to figure out what text we -# print out. -sub seq_l { - my $self = shift; - local $_ = shift; - - # Smash whitespace in case we were split across multiple lines. - s/\s+/ /g; - - # If we were given any explicit text, just output it. - if (/^([^|]+)\|/) { return $1 } - - # Okay, leading and trailing whitespace isn't important; get rid of it. - s/^\s+//; - s/\s+$//; - - # Default to using the whole content of the link entry as a section - # name. Note that L<manpage/> forces a manpage interpretation, as does - # something looking like L<manpage(section)>. The latter is an - # enhancement over the original Pod::Text. - my ($manpage, $section) = ('', $_); - if (/^(?:https?|ftp|news):/) { - # a URL - return $_; - } elsif (/^"\s*(.*?)\s*"$/) { - $section = '"' . $1 . '"'; - } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) { - ($manpage, $section) = ($_, ''); - } elsif (m%/%) { - ($manpage, $section) = split (/\s*\/\s*/, $_, 2); - } - - my $text = ''; - # Now build the actual output text. - if (!length $section) { - $text = "the $manpage manpage" if length $manpage; - } elsif ($section =~ /^[:\w]+(?:\(\))?/) { - $text .= 'the ' . $section . ' entry'; - $text .= (length $manpage) ? " in the $manpage manpage" - : " elsewhere in this document"; - } else { - $section =~ s/^\"\s*//; - $section =~ s/\s*\"$//; - $text .= 'the section on "' . $section . '"'; - $text .= " in the $manpage manpage" if length $manpage; - } - $text; -} - - -############################################################################ -# List handling -############################################################################ - -# This method is called whenever an =item command is complete (in other -# words, we've seen its associated paragraph or know for certain that it -# doesn't have one). It gets the paragraph associated with the item as an -# argument. If that argument is empty, just output the item tag; if it -# contains a newline, output the item tag followed by the newline. -# Otherwise, see if there's enough room for us to output the item tag in the -# margin of the text or if we have to put it on a separate line. -sub item { - my $self = shift; - local $_ = shift; - my $tag = $$self{ITEM}; - unless (defined $tag) { - carp "item called without tag"; - return; - } - undef $$self{ITEM}; - my $indent = $$self{INDENTS}[-1]; - unless (defined $indent) { $indent = $$self{indent} } - my $space = ' ' x $indent; - $space =~ s/^ /:/ if $$self{alt}; - if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) { - my $margin = $$self{MARGIN}; - $$self{MARGIN} = $indent; - my $output = $self->reformat ($tag); - $output =~ s/\n*$/\n/; - $self->output ($output); - $$self{MARGIN} = $margin; - $self->output ($self->reformat ($_)) if /\S/; - } else { - $_ = $self->reformat ($_); - s/^ /:/ if ($$self{alt} && $indent > 0); - my $tagspace = ' ' x length $tag; - s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item"; - $self->output ($_); - } -} - - -############################################################################ -# Output formatting -############################################################################ - -# Wrap a line, indenting by the current left margin. We can't use -# Text::Wrap because it plays games with tabs. We can't use formline, even -# though we'd really like to, because it screws up non-printing characters. -# So we have to do the wrapping ourselves. -sub wrap { - my $self = shift; - local $_ = shift; - my $output = ''; - my $spaces = ' ' x $$self{MARGIN}; - my $width = $$self{width} - $$self{MARGIN}; - while (length > $width) { - if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) { - $output .= $spaces . $1 . "\n"; - } else { - last; - } - } - $output .= $spaces . $_; - $output =~ s/\s+$/\n\n/; - $output; -} - -# Reformat a paragraph of text for the current margin. Takes the text to -# reformat and returns the formatted text. -sub reformat { - my $self = shift; - local $_ = shift; - - # If we're trying to preserve two spaces after sentences, do some - # munging to support that. Otherwise, smash all repeated whitespace. - if ($$self{sentence}) { - s/ +$//mg; - s/\.\n/. \n/g; - s/\n/ /g; - s/ +/ /g; - } else { - s/\s+/ /g; - } - $self->wrap ($_); -} - -# Output text to the output device. -sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] } - - -############################################################################ -# Backwards compatibility -############################################################################ - -# The old Pod::Text module did everything in a pod2text() function. This -# tries to provide the same interface for legacy applications. -sub pod2text { - my @args; - - # This is really ugly; I hate doing option parsing in the middle of a - # module. But the old Pod::Text module supported passing flags to its - # entry function, so handle -a and -<number>. - while ($_[0] =~ /^-/) { - my $flag = shift; - if ($flag eq '-a') { push (@args, alt => 1) } - elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) } - else { - unshift (@_, $flag); - last; - } - } - - # Now that we know what arguments we're using, create the parser. - my $parser = Pod::PlainText->new (@args); - - # If two arguments were given, the second argument is going to be a file - # handle. That means we want to call parse_from_filehandle(), which - # means we need to turn the first argument into a file handle. Magic - # open will handle the <&STDIN case automagically. - if (defined $_[1]) { - local *IN; - unless (open (IN, $_[0])) { - croak ("Can't open $_[0] for reading: $!\n"); - return; - } - $_[0] = \*IN; - return $parser->parse_from_filehandle (@_); - } else { - return $parser->parse_from_file (@_); - } -} - - -############################################################################ -# Module return value and documentation -############################################################################ - -1; -__END__ - -=head1 NAME - -Pod::PlainText - Convert POD data to formatted ASCII text - -=head1 SYNOPSIS - - use Pod::PlainText; - my $parser = Pod::PlainText->new (sentence => 0, width => 78); - - # Read POD from STDIN and write to STDOUT. - $parser->parse_from_filehandle; - - # Read POD from file.pod and write to file.txt. - $parser->parse_from_file ('file.pod', 'file.txt'); - -=head1 DESCRIPTION - -Pod::PlainText is a module that can convert documentation in the POD format (the -preferred language for documenting Perl) into formatted ASCII. It uses no -special formatting controls or codes whatsoever, and its output is therefore -suitable for nearly any device. - -As a derived class from Pod::Parser, Pod::PlainText supports the same methods and -interfaces. See L<Pod::Parser> for all the details; briefly, one creates a -new parser with C<Pod::PlainText-E<gt>new()> and then calls either -parse_from_filehandle() or parse_from_file(). - -new() can take options, in the form of key/value pairs, that control the -behavior of the parser. The currently recognized options are: - -=over 4 - -=item alt - -If set to a true value, selects an alternate output format that, among other -things, uses a different heading style and marks C<=item> entries with a -colon in the left margin. Defaults to false. - -=item indent - -The number of spaces to indent regular text, and the default indentation for -C<=over> blocks. Defaults to 4. - -=item loose - -If set to a true value, a blank line is printed after a C<=head1> heading. -If set to false (the default), no blank line is printed after C<=head1>, -although one is still printed after C<=head2>. This is the default because -it's the expected formatting for manual pages; if you're formatting -arbitrary text documents, setting this to true may result in more pleasing -output. - -=item sentence - -If set to a true value, Pod::PlainText will assume that each sentence ends in two -spaces, and will try to preserve that spacing. If set to false, all -consecutive whitespace in non-verbatim paragraphs is compressed into a -single space. Defaults to true. - -=item width - -The column at which to wrap text on the right-hand side. Defaults to 76. - -=back - -The standard Pod::Parser method parse_from_filehandle() takes up to two -arguments, the first being the file handle to read POD from and the second -being the file handle to write the formatted output to. The first defaults -to STDIN if not given, and the second defaults to STDOUT. The method -parse_from_file() is almost identical, except that its two arguments are the -input and output disk files instead. See L<Pod::Parser> for the specific -details. - -=head1 DIAGNOSTICS - -=over 4 - -=item Bizarre space in item - -(W) Something has gone wrong in internal C<=item> processing. This message -indicates a bug in Pod::PlainText; you should never see it. - -=item Can't open %s for reading: %s - -(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface -and the input file it was given could not be opened. - -=item Unknown escape: %s - -(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::PlainText didn't -know about. - -=item Unknown sequence: %s - -(W) The POD source contained a non-standard internal sequence (something of -the form C<XE<lt>E<gt>>) that Pod::PlainText didn't know about. - -=item Unmatched =back - -(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an -C<=over> command. - -=back - -=head1 RESTRICTIONS - -Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on -output, due to an internal implementation detail. - -=head1 NOTES - -This is a replacement for an earlier Pod::Text module written by Tom -Christiansen. It has a revamped interface, since it now uses Pod::Parser, -but an interface roughly compatible with the old Pod::Text::pod2text() -function is still available. Please change to the new calling convention, -though. - -The original Pod::Text contained code to do formatting via termcap -sequences, although it wasn't turned on by default and it was problematic to -get it to work at all. This rewrite doesn't even try to do that, but a -subclass of it does. Look for L<Pod::Text::Termcap|Pod::Text::Termcap>. - -=head1 SEE ALSO - -L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>, -pod2text(1) - -=head1 AUTHOR - -Please report bugs using L<http://rt.cpan.org>. - -Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the -original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and -its conversion to Pod::Parser by Brad Appleton -E<lt>bradapp@enteract.comE<gt>. - -=cut diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Plainer.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Plainer.pm deleted file mode 100644 index 373e8d090af..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Plainer.pm +++ /dev/null @@ -1,69 +0,0 @@ -package Pod::Plainer; -use strict; -use Pod::Parser; -our @ISA = qw(Pod::Parser); -our $VERSION = '0.01'; - -our %E = qw( < lt > gt ); - -sub escape_ltgt { - (undef, my $text) = @_; - $text =~ s/([<>])/E<$E{$1}>/g; - $text -} - -sub simple_delimiters { - (undef, my $seq) = @_; - $seq -> left_delimiter( '<' ); - $seq -> right_delimiter( '>' ); - $seq; -} - -sub textblock { - my($parser,$text,$line) = @_; - print {$parser->output_handle()} - $parser->parse_text( - { -expand_text => q(escape_ltgt), - -expand_seq => q(simple_delimiters) }, - $text, $line ) -> raw_text(); -} - -1; - -__END__ - -=head1 NAME - -Pod::Plainer - Perl extension for converting Pod to old style Pod. - -=head1 SYNOPSIS - - use Pod::Plainer; - - my $parser = Pod::Plainer -> new (); - $parser -> parse_from_filehandle(\*STDIN); - -=head1 DESCRIPTION - -Pod::Plainer uses Pod::Parser which takes Pod with the (new) -'CE<lt>E<lt> .. E<gt>E<gt>' constructs -and returns the old(er) style with just 'CE<lt>E<gt>'; -'<' and '>' are replaced by 'EE<lt>ltE<gt>' and 'EE<lt>gtE<gt>'. - -This can be used to pre-process Pod before using tools which do not -recognise the new style Pods. - -=head2 EXPORT - -None by default. - -=head1 AUTHOR - -Robin Barker, rmb1@cise.npl.co.uk - -=head1 SEE ALSO - -See L<Pod::Parser>. - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Select.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Select.pm deleted file mode 100644 index 321a68ab0d6..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Select.pm +++ /dev/null @@ -1,754 +0,0 @@ -############################################################################# -# Pod/Select.pm -- function to select portions of POD docs -# -# Copyright (C) 1996-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::Select; - -use vars qw($VERSION); -$VERSION = 1.35; ## Current version of this package -require 5.005; ## requires this Perl version or later - -############################################################################# - -=head1 NAME - -Pod::Select, podselect() - extract selected sections of POD from input - -=head1 SYNOPSIS - - use Pod::Select; - - ## Select all the POD sections for each file in @filelist - ## and print the result on standard output. - podselect(@filelist); - - ## Same as above, but write to tmp.out - podselect({-output => "tmp.out"}, @filelist): - - ## Select from the given filelist, only those POD sections that are - ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS. - podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist): - - ## Select the "DESCRIPTION" section of the PODs from STDIN and write - ## the result to STDERR. - podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN); - -or - - use Pod::Select; - - ## Create a parser object for selecting POD sections from the input - $parser = new Pod::Select(); - - ## Select all the POD sections for each file in @filelist - ## and print the result to tmp.out. - $parser->parse_from_file("<&STDIN", "tmp.out"); - - ## Select from the given filelist, only those POD sections that are - ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS. - $parser->select("NAME|SYNOPSIS", "OPTIONS"); - for (@filelist) { $parser->parse_from_file($_); } - - ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from - ## STDIN and write the result to STDERR. - $parser->select("DESCRIPTION"); - $parser->add_selection("SEE ALSO"); - $parser->parse_from_filehandle(\*STDIN, \*STDERR); - -=head1 REQUIRES - -perl5.005, Pod::Parser, Exporter, Carp - -=head1 EXPORTS - -podselect() - -=head1 DESCRIPTION - -B<podselect()> is a function which will extract specified sections of -pod documentation from an input stream. This ability is provided by the -B<Pod::Select> module which is a subclass of B<Pod::Parser>. -B<Pod::Select> provides a method named B<select()> to specify the set of -POD sections to select for processing/printing. B<podselect()> merely -creates a B<Pod::Select> object and then invokes the B<podselect()> -followed by B<parse_from_file()>. - -=head1 SECTION SPECIFICATIONS - -B<podselect()> and B<Pod::Select::select()> may be given one or more -"section specifications" to restrict the text processed to only the -desired set of sections and their corresponding subsections. A section -specification is a string containing one or more Perl-style regular -expressions separated by forward slashes ("/"). If you need to use a -forward slash literally within a section title you can escape it with a -backslash ("\/"). - -The formal syntax of a section specification is: - -=over 4 - -=item * - -I<head1-title-regex>/I<head2-title-regex>/... - -=back - -Any omitted or empty regular expressions will default to ".*". -Please note that each regular expression given is implicitly -anchored by adding "^" and "$" to the beginning and end. Also, if a -given regular expression starts with a "!" character, then the -expression is I<negated> (so C<!foo> would match anything I<except> -C<foo>). - -Some example section specifications follow. - -=over 4 - -=item * - -Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections: - -C<NAME|SYNOPSIS> - -=item * - -Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION> -section: - -C<DESCRIPTION/Question|Answer> - -=item * - -Match the C<Comments> subsection of I<all> sections: - -C</Comments> - -=item * - -Match all subsections of C<DESCRIPTION> I<except> for C<Comments>: - -C<DESCRIPTION/!Comments> - -=item * - -Match the C<DESCRIPTION> section but do I<not> match any of its subsections: - -C<DESCRIPTION/!.+> - -=item * - -Match all top level sections but none of their subsections: - -C</!.+> - -=back - -=begin _NOT_IMPLEMENTED_ - -=head1 RANGE SPECIFICATIONS - -B<podselect()> and B<Pod::Select::select()> may be given one or more -"range specifications" to restrict the text processed to only the -desired ranges of paragraphs in the desired set of sections. A range -specification is a string containing a single Perl-style regular -expression (a regex), or else two Perl-style regular expressions -(regexs) separated by a ".." (Perl's "range" operator is ".."). -The regexs in a range specification are delimited by forward slashes -("/"). If you need to use a forward slash literally within a regex you -can escape it with a backslash ("\/"). - -The formal syntax of a range specification is: - -=over 4 - -=item * - -/I<start-range-regex>/[../I<end-range-regex>/] - -=back - -Where each the item inside square brackets (the ".." followed by the -end-range-regex) is optional. Each "range-regex" is of the form: - - =cmd-expr text-expr - -Where I<cmd-expr> is intended to match the name of one or more POD -commands, and I<text-expr> is intended to match the paragraph text for -the command. If a range-regex is supposed to match a POD command, then -the first character of the regex (the one after the initial '/') -absolutely I<must> be a single '=' character; it may not be anything -else (not even a regex meta-character) if it is supposed to match -against the name of a POD command. - -If no I<=cmd-expr> is given then the text-expr will be matched against -plain textblocks unless it is preceded by a space, in which case it is -matched against verbatim text-blocks. If no I<text-expr> is given then -only the command-portion of the paragraph is matched against. - -Note that these two expressions are each implicitly anchored. This -means that when matching against the command-name, there will be an -implicit '^' and '$' around the given I<=cmd-expr>; and when matching -against the paragraph text there will be an implicit '\A' and '\Z' -around the given I<text-expr>. - -Unlike with section-specs, the '!' character does I<not> have any special -meaning (negation or otherwise) at the beginning of a range-spec! - -Some example range specifications follow. - -=over 4 - -=item -Match all C<=for html> paragraphs: - -C</=for html/> - -=item -Match all paragraphs between C<=begin html> and C<=end html> -(note that this will I<not> work correctly if such sections -are nested): - -C</=begin html/../=end html/> - -=item -Match all paragraphs between the given C<=item> name until the end of the -current section: - -C</=item mine/../=head\d/> - -=item -Match all paragraphs between the given C<=item> until the next item, or -until the end of the itemized list (note that this will I<not> work as -desired if the item contains an itemized list nested within it): - -C</=item mine/../=(item|back)/> - -=back - -=end _NOT_IMPLEMENTED_ - -=cut - -############################################################################# - -use strict; -#use diagnostics; -use Carp; -use Pod::Parser 1.04; -use vars qw(@ISA @EXPORT $MAX_HEADING_LEVEL); - -@ISA = qw(Pod::Parser); -@EXPORT = qw(&podselect); - -## Maximum number of heading levels supported for '=headN' directives -*MAX_HEADING_LEVEL = \3; - -############################################################################# - -=head1 OBJECT METHODS - -The following methods are provided in this module. Each one takes a -reference to the object itself as an implicit first parameter. - -=cut - -##--------------------------------------------------------------------------- - -## =begin _PRIVATE_ -## -## =head1 B<_init_headings()> -## -## Initialize the current set of active section headings. -## -## =cut -## -## =end _PRIVATE_ - -use vars qw(%myData @section_headings); - -sub _init_headings { - my $self = shift; - local *myData = $self; - - ## Initialize current section heading titles if necessary - unless (defined $myData{_SECTION_HEADINGS}) { - local *section_headings = $myData{_SECTION_HEADINGS} = []; - for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { - $section_headings[$i] = ''; - } - } -} - -##--------------------------------------------------------------------------- - -=head1 B<curr_headings()> - - ($head1, $head2, $head3, ...) = $parser->curr_headings(); - $head1 = $parser->curr_headings(1); - -This method returns a list of the currently active section headings and -subheadings in the document being parsed. The list of headings returned -corresponds to the most recently parsed paragraph of the input. - -If an argument is given, it must correspond to the desired section -heading number, in which case only the specified section heading is -returned. If there is no current section heading at the specified -level, then C<undef> is returned. - -=cut - -sub curr_headings { - my $self = shift; - $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS}); - my @headings = @{ $self->{_SECTION_HEADINGS} }; - return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings; -} - -##--------------------------------------------------------------------------- - -=head1 B<select()> - - $parser->select($section_spec1,$section_spec2,...); - -This method is used to select the particular sections and subsections of -POD documentation that are to be printed and/or processed. The existing -set of selected sections is I<replaced> with the given set of sections. -See B<add_selection()> for adding to the current set of selected -sections. - -Each of the C<$section_spec> arguments should be a section specification -as described in L<"SECTION SPECIFICATIONS">. The section specifications -are parsed by this method and the resulting regular expressions are -stored in the invoking object. - -If no C<$section_spec> arguments are given, then the existing set of -selected sections is cleared out (which means C<all> sections will be -processed). - -This method should I<not> normally be overridden by subclasses. - -=cut - -use vars qw(@selected_sections); - -sub select { - my $self = shift; - my @sections = @_; - local *myData = $self; - local $_; - -### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?) - - ##--------------------------------------------------------------------- - ## The following is a blatant hack for backward compatibility, and for - ## implementing add_selection(). If the *first* *argument* is the - ## string "+", then the remaining section specifications are *added* - ## to the current set of selections; otherwise the given section - ## specifications will *replace* the current set of selections. - ## - ## This should probably be fixed someday, but for the present time, - ## it seems incredibly unlikely that "+" would ever correspond to - ## a legitimate section heading - ##--------------------------------------------------------------------- - my $add = ($sections[0] eq "+") ? shift(@sections) : ""; - - ## Reset the set of sections to use - unless (@sections > 0) { - delete $myData{_SELECTED_SECTIONS} unless ($add); - return; - } - $myData{_SELECTED_SECTIONS} = [] - unless ($add && exists $myData{_SELECTED_SECTIONS}); - local *selected_sections = $myData{_SELECTED_SECTIONS}; - - ## Compile each spec - my $spec; - for $spec (@sections) { - if ( defined($_ = &_compile_section_spec($spec)) ) { - ## Store them in our sections array - push(@selected_sections, $_); - } - else { - carp "Ignoring section spec \"$spec\"!\n"; - } - } -} - -##--------------------------------------------------------------------------- - -=head1 B<add_selection()> - - $parser->add_selection($section_spec1,$section_spec2,...); - -This method is used to add to the currently selected sections and -subsections of POD documentation that are to be printed and/or -processed. See <select()> for replacing the currently selected sections. - -Each of the C<$section_spec> arguments should be a section specification -as described in L<"SECTION SPECIFICATIONS">. The section specifications -are parsed by this method and the resulting regular expressions are -stored in the invoking object. - -This method should I<not> normally be overridden by subclasses. - -=cut - -sub add_selection { - my $self = shift; - $self->select("+", @_); -} - -##--------------------------------------------------------------------------- - -=head1 B<clear_selections()> - - $parser->clear_selections(); - -This method takes no arguments, it has the exact same effect as invoking -<select()> with no arguments. - -=cut - -sub clear_selections { - my $self = shift; - $self->select(); -} - -##--------------------------------------------------------------------------- - -=head1 B<match_section()> - - $boolean = $parser->match_section($heading1,$heading2,...); - -Returns a value of true if the given section and subsection heading -titles match any of the currently selected section specifications in -effect from prior calls to B<select()> and B<add_selection()> (or if -there are no explictly selected/deselected sections). - -The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of -the corresponding sections, subsections, etc. to try and match. If -C<$headingN> is omitted then it defaults to the current corresponding -section heading title in the input. - -This method should I<not> normally be overridden by subclasses. - -=cut - -sub match_section { - my $self = shift; - my (@headings) = @_; - local *myData = $self; - - ## Return true if no restrictions were explicitly specified - my $selections = (exists $myData{_SELECTED_SECTIONS}) - ? $myData{_SELECTED_SECTIONS} : undef; - return 1 unless ((defined $selections) && (@{$selections} > 0)); - - ## Default any unspecified sections to the current one - my @current_headings = $self->curr_headings(); - for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { - (defined $headings[$i]) or $headings[$i] = $current_headings[$i]; - } - - ## Look for a match against the specified section expressions - my ($section_spec, $regex, $negated, $match); - for $section_spec ( @{$selections} ) { - ##------------------------------------------------------ - ## Each portion of this spec must match in order for - ## the spec to be matched. So we will start with a - ## match-value of 'true' and logically 'and' it with - ## the results of matching a given element of the spec. - ##------------------------------------------------------ - $match = 1; - for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { - $regex = $section_spec->[$i]; - $negated = ($regex =~ s/^\!//); - $match &= ($negated ? ($headings[$i] !~ /${regex}/) - : ($headings[$i] =~ /${regex}/)); - last unless ($match); - } - return 1 if ($match); - } - return 0; ## no match -} - -##--------------------------------------------------------------------------- - -=head1 B<is_selected()> - - $boolean = $parser->is_selected($paragraph); - -This method is used to determine if the block of text given in -C<$paragraph> falls within the currently selected set of POD sections -and subsections to be printed or processed. This method is also -responsible for keeping track of the current input section and -subsections. It is assumed that C<$paragraph> is the most recently read -(but not yet processed) input paragraph. - -The value returned will be true if the C<$paragraph> and the rest of the -text in the same section as C<$paragraph> should be selected (included) -for processing; otherwise a false value is returned. - -=cut - -sub is_selected { - my ($self, $paragraph) = @_; - local $_; - local *myData = $self; - - $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS}); - - ## Keep track of current sections levels and headings - $_ = $paragraph; - if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/) - { - ## This is a section heading command - my ($level, $heading) = ($2, $3); - $level = 1 + (length($1) / 3) if ((! length $level) || (length $1)); - ## Reset the current section heading at this level - $myData{_SECTION_HEADINGS}->[$level - 1] = $heading; - ## Reset subsection headings of this one to empty - for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) { - $myData{_SECTION_HEADINGS}->[$i] = ''; - } - } - - return $self->match_section(); -} - -############################################################################# - -=head1 EXPORTED FUNCTIONS - -The following functions are exported by this module. Please note that -these are functions (not methods) and therefore C<do not> take an -implicit first argument. - -=cut - -##--------------------------------------------------------------------------- - -=head1 B<podselect()> - - podselect(\%options,@filelist); - -B<podselect> will print the raw (untranslated) POD paragraphs of all -POD sections in the given input files specified by C<@filelist> -according to the given options. - -If any argument to B<podselect> is a reference to a hash -(associative array) then the values with the following keys are -processed as follows: - -=over 4 - -=item B<-output> - -A string corresponding to the desired output file (or ">&STDOUT" -or ">&STDERR"). The default is to use standard output. - -=item B<-sections> - -A reference to an array of sections specifications (as described in -L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD -sections and subsections to be selected from input. If no section -specifications are given, then all sections of the PODs are used. - -=begin _NOT_IMPLEMENTED_ - -=item B<-ranges> - -A reference to an array of range specifications (as described in -L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD -paragraphs to be selected from the desired input sections. If no range -specifications are given, then all paragraphs of the desired sections -are used. - -=end _NOT_IMPLEMENTED_ - -=back - -All other arguments should correspond to the names of input files -containing POD sections. A file name of "-" or "<&STDIN" will -be interpreted to mean standard input (which is the default if no -filenames are given). - -=cut - -sub podselect { - my(@argv) = @_; - my %defaults = (); - my $pod_parser = new Pod::Select(%defaults); - my $num_inputs = 0; - my $output = ">&STDOUT"; - my %opts; - local $_; - for (@argv) { - if (ref($_)) { - next unless (ref($_) eq 'HASH'); - %opts = (%defaults, %{$_}); - - ##------------------------------------------------------------- - ## Need this for backward compatibility since we formerly used - ## options that were all uppercase words rather than ones that - ## looked like Unix command-line options. - ## to be uppercase keywords) - ##------------------------------------------------------------- - %opts = map { - my ($key, $val) = (lc $_, $opts{$_}); - $key =~ s/^(?=\w)/-/; - $key =~ /^-se[cl]/ and $key = '-sections'; - #! $key eq '-range' and $key .= 's'; - ($key => $val); - } (keys %opts); - - ## Process the options - (exists $opts{'-output'}) and $output = $opts{'-output'}; - - ## Select the desired sections - $pod_parser->select(@{ $opts{'-sections'} }) - if ( (defined $opts{'-sections'}) - && ((ref $opts{'-sections'}) eq 'ARRAY') ); - - #! ## Select the desired paragraph ranges - #! $pod_parser->select(@{ $opts{'-ranges'} }) - #! if ( (defined $opts{'-ranges'}) - #! && ((ref $opts{'-ranges'}) eq 'ARRAY') ); - } - else { - $pod_parser->parse_from_file($_, $output); - ++$num_inputs; - } - } - $pod_parser->parse_from_file("-") unless ($num_inputs > 0); -} - -############################################################################# - -=head1 PRIVATE METHODS AND DATA - -B<Pod::Select> makes uses a number of internal methods and data fields -which clients should not need to see or use. For the sake of avoiding -name collisions with client data and methods, these methods and fields -are briefly discussed here. Determined hackers may obtain further -information about them by reading the B<Pod::Select> source code. - -Private data fields are stored in the hash-object whose reference is -returned by the B<new()> constructor for this class. The names of all -private methods and data-fields used by B<Pod::Select> begin with a -prefix of "_" and match the regular expression C</^_\w+$/>. - -=cut - -##--------------------------------------------------------------------------- - -=begin _PRIVATE_ - -=head1 B<_compile_section_spec()> - - $listref = $parser->_compile_section_spec($section_spec); - -This function (note it is a function and I<not> a method) takes a -section specification (as described in L<"SECTION SPECIFICATIONS">) -given in C<$section_sepc>, and compiles it into a list of regular -expressions. If C<$section_spec> has no syntax errors, then a reference -to the list (array) of corresponding regular expressions is returned; -otherwise C<undef> is returned and an error message is printed (using -B<carp>) for each invalid regex. - -=end _PRIVATE_ - -=cut - -sub _compile_section_spec { - my ($section_spec) = @_; - my (@regexs, $negated); - - ## Compile the spec into a list of regexs - local $_ = $section_spec; - s|\\\\|\001|g; ## handle escaped backward slashes - s|\\/|\002|g; ## handle escaped forward slashes - - ## Parse the regexs for the heading titles - @regexs = split('/', $_, $MAX_HEADING_LEVEL); - - ## Set default regex for ommitted levels - for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { - $regexs[$i] = '.*' unless ((defined $regexs[$i]) - && (length $regexs[$i])); - } - ## Modify the regexs as needed and validate their syntax - my $bad_regexs = 0; - for (@regexs) { - $_ .= '.+' if ($_ eq '!'); - s|\001|\\\\|g; ## restore escaped backward slashes - s|\002|\\/|g; ## restore escaped forward slashes - $negated = s/^\!//; ## check for negation - eval "/$_/"; ## check regex syntax - if ($@) { - ++$bad_regexs; - carp "Bad regular expression /$_/ in \"$section_spec\": $@\n"; - } - else { - ## Add the forward and rear anchors (and put the negator back) - $_ = '^' . $_ unless (/^\^/); - $_ = $_ . '$' unless (/\$$/); - $_ = '!' . $_ if ($negated); - } - } - return (! $bad_regexs) ? [ @regexs ] : undef; -} - -##--------------------------------------------------------------------------- - -=begin _PRIVATE_ - -=head2 $self->{_SECTION_HEADINGS} - -A reference to an array of the current section heading titles for each -heading level (note that the first heading level title is at index 0). - -=end _PRIVATE_ - -=cut - -##--------------------------------------------------------------------------- - -=begin _PRIVATE_ - -=head2 $self->{_SELECTED_SECTIONS} - -A reference to an array of references to arrays. Each subarray is a list -of anchored regular expressions (preceded by a "!" if the expression is to -be negated). The index of the expression in the subarray should correspond -to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}> -that it is to be matched against. - -=end _PRIVATE_ - -=cut - -############################################################################# - -=head1 SEE ALSO - -L<Pod::Parser> - -=head1 AUTHOR - -Please report bugs using L<http://rt.cpan.org>. - -Brad Appleton E<lt>bradapp@enteract.comE<gt> - -Based on code for B<pod2text> written by -Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> - -=cut - -1; -# vim: ts=4 sw=4 et diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple.pm deleted file mode 100644 index 6beacaa1c80..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple.pm +++ /dev/null @@ -1,1520 +0,0 @@ - -require 5; -package Pod::Simple; -use strict; -use Carp (); -BEGIN { *DEBUG = sub () {0} unless defined &DEBUG } -use integer; -use Pod::Escapes 1.03 (); -use Pod::Simple::LinkSection (); -use Pod::Simple::BlackBox (); -#use utf8; - -use vars qw( - $VERSION @ISA - @Known_formatting_codes @Known_directives - %Known_formatting_codes %Known_directives - $NL -); - -@ISA = ('Pod::Simple::BlackBox'); -$VERSION = '3.05'; - -@Known_formatting_codes = qw(I B C L E F S X Z); -%Known_formatting_codes = map(($_=>1), @Known_formatting_codes); -@Known_directives = qw(head1 head2 head3 head4 item over back); -%Known_directives = map(($_=>'Plain'), @Known_directives); -$NL = $/ unless defined $NL; - -#----------------------------------------------------------------------------- -# Set up some constants: - -BEGIN { - if(defined &ASCII) { } - elsif(chr(65) eq 'A') { *ASCII = sub () {1} } - else { *ASCII = sub () {''} } - - unless(defined &MANY_LINES) { *MANY_LINES = sub () {20} } - DEBUG > 4 and print "MANY_LINES is ", MANY_LINES(), "\n"; - unless(MANY_LINES() >= 1) { - die "MANY_LINES is too small (", MANY_LINES(), ")!\nAborting"; - } - if(defined &UNICODE) { } - elsif($] >= 5.008) { *UNICODE = sub() {1} } - else { *UNICODE = sub() {''} } -} -if(DEBUG > 2) { - print "# We are ", ASCII ? '' : 'not ', "in ASCII-land\n"; - print "# We are under a Unicode-safe Perl.\n"; -} - -# Design note: -# This is a parser for Pod. It is not a parser for the set of Pod-like -# languages which happens to contain Pod -- it is just for Pod, plus possibly -# some extensions. - -# @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ -#@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -__PACKAGE__->_accessorize( - 'nbsp_for_S', # Whether to map S<...>'s to \xA0 characters - 'source_filename', # Filename of the source, for use in warnings - 'source_dead', # Whether to consider this parser's source dead - - 'output_fh', # The filehandle we're writing to, if applicable. - # Used only in some derived classes. - - 'hide_line_numbers', # For some dumping subclasses: whether to pointedly - # suppress the start_line attribute - - 'line_count', # the current line number - 'pod_para_count', # count of pod paragraphs seen so far - - 'no_whining', # whether to suppress whining - 'no_errata_section', # whether to suppress the errata section - 'complain_stderr', # whether to complain to stderr - - 'doc_has_started', # whether we've fired the open-Document event yet - - 'bare_output', # For some subclasses: whether to prepend - # header-code and postpend footer-code - - 'fullstop_space_harden', # Whether to turn ". " into ".[nbsp] "; - - 'nix_X_codes', # whether to ignore X<...> codes - 'merge_text', # whether to avoid breaking a single piece of - # text up into several events - - 'preserve_whitespace', # whether to try to keep whitespace as-is - - 'content_seen', # whether we've seen any real Pod content - 'errors_seen', # TODO: document. whether we've seen any errors (fatal or not) - - 'codes_in_verbatim', # for PseudoPod extensions - - 'code_handler', # coderef to call when a code (non-pod) line is seen - 'cut_handler', # coderef to call when a =cut line is seen - #Called like: - # $code_handler->($line, $self->{'line_count'}, $self) if $code_handler; - # $cut_handler->($line, $self->{'line_count'}, $self) if $cut_handler; - -); - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub any_errata_seen { # good for using as an exit() value... - return shift->{'errors_seen'} || 0; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# Pull in some functions that, for some reason, I expect to see here too: -BEGIN { - *pretty = \&Pod::Simple::BlackBox::pretty; - *stringify_lol = \&Pod::Simple::BlackBox::stringify_lol; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub version_report { - my $class = ref($_[0]) || $_[0]; - if($class eq __PACKAGE__) { - return "$class $VERSION"; - } else { - my $v = $class->VERSION; - return "$class $v (" . __PACKAGE__ . " $VERSION)"; - } -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -#sub curr_open { # read-only list accessor -# return @{ $_[0]{'curr_open'} || return() }; -#} -#sub _curr_open_listref { $_[0]{'curr_open'} ||= [] } - - -sub output_string { - # Works by faking out output_fh. Simplifies our code. - # - my $this = shift; - return $this->{'output_string'} unless @_; # GET. - - require Pod::Simple::TiedOutFH; - my $x = (defined($_[0]) and ref($_[0])) ? $_[0] : \( $_[0] ); - $$x = '' unless defined $$x; - DEBUG > 4 and print "# Output string set to $x ($$x)\n"; - $this->{'output_fh'} = Pod::Simple::TiedOutFH->handle_on($_[0]); - return - $this->{'output_string'} = $_[0]; - #${ ${ $this->{'output_fh'} } }; -} - -sub abandon_output_string { $_[0]->abandon_output_fh; delete $_[0]{'output_string'} } -sub abandon_output_fh { $_[0]->output_fh(undef) } -# These don't delete the string or close the FH -- they just delete our -# references to it/them. -# TODO: document these - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub new { - # takes no parameters - my $class = ref($_[0]) || $_[0]; - #Carp::croak(__PACKAGE__ . " is a virtual base class -- see perldoc " - # . __PACKAGE__ ); - return bless { - 'accept_codes' => { map( ($_=>$_), @Known_formatting_codes ) }, - 'accept_directives' => { %Known_directives }, - 'accept_targets' => {}, - }, $class; -} - - - -# TODO: an option for whether to interpolate E<...>'s, or just resolve to codes. - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _handle_element_start { # OVERRIDE IN DERIVED CLASS - my($self, $element_name, $attr_hash_r) = @_; - return; -} - -sub _handle_element_end { # OVERRIDE IN DERIVED CLASS - my($self, $element_name) = @_; - return; -} - -sub _handle_text { # OVERRIDE IN DERIVED CLASS - my($self, $text) = @_; - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# -# And now directives (not targets) - -sub accept_directive_as_verbatim { shift->_accept_directives('Verbatim', @_) } -sub accept_directive_as_data { shift->_accept_directives('Data', @_) } -sub accept_directive_as_processed { shift->_accept_directives('Plain', @_) } - -sub _accept_directives { - my($this, $type) = splice @_,0,2; - foreach my $d (@_) { - next unless defined $d and length $d; - Carp::croak "\"$d\" isn't a valid directive name" - unless $d =~ m/^[a-zA-Z][a-zA-Z0-9]*$/s; - Carp::croak "\"$d\" is already a reserved Pod directive name" - if exists $Known_directives{$d}; - $this->{'accept_directives'}{$d} = $type; - DEBUG > 2 and print "Learning to accept \"=$d\" as directive of type $type\n"; - } - DEBUG > 6 and print "$this\'s accept_directives : ", - pretty($this->{'accept_directives'}), "\n"; - - return sort keys %{ $this->{'accept_directives'} } if wantarray; - return; -} - -#-------------------------------------------------------------------------- -# TODO: document these: - -sub unaccept_directive { shift->unaccept_directives(@_) }; - -sub unaccept_directives { - my $this = shift; - foreach my $d (@_) { - next unless defined $d and length $d; - Carp::croak "\"$d\" isn't a valid directive name" - unless $d =~ m/^[a-zA-Z][a-zA-Z0-9]*$/s; - Carp::croak "But you must accept \"$d\" directives -- it's a builtin!" - if exists $Known_directives{$d}; - delete $this->{'accept_directives'}{$d}; - DEBUG > 2 and print "OK, won't accept \"=$d\" as directive.\n"; - } - return sort keys %{ $this->{'accept_directives'} } if wantarray; - return -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# -# And now targets (not directives) - -sub accept_target { shift->accept_targets(@_) } # alias -sub accept_target_as_text { shift->accept_targets_as_text(@_) } # alias - - -sub accept_targets { shift->_accept_targets('1', @_) } - -sub accept_targets_as_text { shift->_accept_targets('force_resolve', @_) } - # forces them to be processed, even when there's no ":". - -sub _accept_targets { - my($this, $type) = splice @_,0,2; - foreach my $t (@_) { - next unless defined $t and length $t; - # TODO: enforce some limitations on what a target name can be? - $this->{'accept_targets'}{$t} = $type; - DEBUG > 2 and print "Learning to accept \"$t\" as target of type $type\n"; - } - return sort keys %{ $this->{'accept_targets'} } if wantarray; - return; -} - -#-------------------------------------------------------------------------- -sub unaccept_target { shift->unaccept_targets(@_) } - -sub unaccept_targets { - my $this = shift; - foreach my $t (@_) { - next unless defined $t and length $t; - # TODO: enforce some limitations on what a target name can be? - delete $this->{'accept_targets'}{$t}; - DEBUG > 2 and print "OK, won't accept \"$t\" as target.\n"; - } - return sort keys %{ $this->{'accept_targets'} } if wantarray; - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# -# And now codes (not targets or directives) - -sub accept_code { shift->accept_codes(@_) } # alias - -sub accept_codes { # Add some codes - my $this = shift; - - foreach my $new_code (@_) { - next unless defined $new_code and length $new_code; - if(ASCII) { - # A good-enough check that it's good as an XML Name symbol: - Carp::croak "\"$new_code\" isn't a valid element name" - if $new_code =~ - m/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/ - # Characters under 0x80 that aren't legal in an XML Name. - or $new_code =~ m/^[-\.0-9]/s - or $new_code =~ m/:[-\.0-9]/s; - # The legal under-0x80 Name characters that - # an XML Name still can't start with. - } - - $this->{'accept_codes'}{$new_code} = $new_code; - - # Yes, map to itself -- just so that when we - # see "=extend W [whatever] thatelementname", we say that W maps - # to whatever $this->{accept_codes}{thatelementname} is, - # i.e., "thatelementname". Then when we go re-mapping, - # a "W" in the treelet turns into "thatelementname". We only - # remap once. - # If we say we accept "W", then a "W" in the treelet simply turns - # into "W". - } - - return; -} - -#-------------------------------------------------------------------------- -sub unaccept_code { shift->unaccept_codes(@_) } - -sub unaccept_codes { # remove some codes - my $this = shift; - - foreach my $new_code (@_) { - next unless defined $new_code and length $new_code; - if(ASCII) { - # A good-enough check that it's good as an XML Name symbol: - Carp::croak "\"$new_code\" isn't a valid element name" - if $new_code =~ - m/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/ - # Characters under 0x80 that aren't legal in an XML Name. - or $new_code =~ m/^[-\.0-9]/s - or $new_code =~ m/:[-\.0-9]/s; - # The legal under-0x80 Name characters that - # an XML Name still can't start with. - } - - Carp::croak "But you must accept \"$new_code\" codes -- it's a builtin!" - if grep $new_code eq $_, @Known_formatting_codes; - - delete $this->{'accept_codes'}{$new_code}; - - DEBUG > 2 and print "OK, won't accept the code $new_code<...>.\n"; - } - - return; -} - - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub parse_string_document { - my $self = shift; - my @lines; - foreach my $line_group (@_) { - next unless defined $line_group and length $line_group; - pos($line_group) = 0; - while($line_group =~ - m/([^\n\r]*)((?:\r?\n)?)/g - ) { - #print(">> $1\n"), - $self->parse_lines($1) - if length($1) or length($2) - or pos($line_group) != length($line_group); - # I.e., unless it's a zero-length "empty line" at the very - # end of "foo\nbar\n" (i.e., between the \n and the EOS). - } - } - $self->parse_lines(undef); # to signal EOF - return $self; -} - -sub _init_fh_source { - my($self, $source) = @_; - - #DEBUG > 1 and print "Declaring $source as :raw for starters\n"; - #$self->_apply_binmode($source, ':raw'); - #binmode($source, ":raw"); - - return; -} - -#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. -# - -sub parse_file { - my($self, $source) = (@_); - - if(!defined $source) { - Carp::croak("Can't use empty-string as a source for parse_file"); - } elsif(ref(\$source) eq 'GLOB') { - $self->{'source_filename'} = '' . ($source); - } elsif(ref $source) { - $self->{'source_filename'} = '' . ($source); - } elsif(!length $source) { - Carp::croak("Can't use empty-string as a source for parse_file"); - } else { - { - local *PODSOURCE; - open(PODSOURCE, "<$source") || Carp::croak("Can't open $source: $!"); - $self->{'source_filename'} = $source; - $source = *PODSOURCE{IO}; - } - $self->_init_fh_source($source); - } - # By here, $source is a FH. - - $self->{'source_fh'} = $source; - - my($i, @lines); - until( $self->{'source_dead'} ) { - splice @lines; - for($i = MANY_LINES; $i--;) { # read those many lines at a time - local $/ = $NL; - push @lines, scalar(<$source>); # readline - last unless defined $lines[-1]; - # but pass thru the undef, which will set source_dead to true - } - $self->parse_lines(@lines); - } - delete($self->{'source_fh'}); # so it can be GC'd - return $self; -} - -#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. - -sub parse_from_file { - # An emulation of Pod::Parser's interface, for the sake of Perldoc. - # Basically just a wrapper around parse_file. - - my($self, $source, $to) = @_; - $self = $self->new unless ref($self); # so we tolerate being a class method - - if(!defined $source) { $source = *STDIN{IO} - } elsif(ref(\$source) eq 'GLOB') { # stet - } elsif(ref($source) ) { # stet - } elsif(!length $source - or $source eq '-' or $source =~ m/^<&(STDIN|0)$/i - ) { - $source = *STDIN{IO}; - } - - if(!defined $to) { $self->output_fh( *STDOUT{IO} ); - } elsif(ref(\$to) eq 'GLOB') { $self->output_fh( $to ); - } elsif(ref($to)) { $self->output_fh( $to ); - } elsif(!length $to - or $to eq '-' or $to =~ m/^>&?(?:STDOUT|1)$/i - ) { - $self->output_fh( *STDOUT{IO} ); - } else { - require Symbol; - my $out_fh = Symbol::gensym(); - DEBUG and print "Write-opening to $to\n"; - open($out_fh, ">$to") or Carp::croak "Can't write-open $to: $!"; - binmode($out_fh) - if $self->can('write_with_binmode') and $self->write_with_binmode; - $self->output_fh($out_fh); - } - - return $self->parse_file($source); -} - -#----------------------------------------------------------------------------- - -sub whine { - #my($self,$line,$complaint) = @_; - my $self = shift(@_); - ++$self->{'errors_seen'}; - if($self->{'no_whining'}) { - DEBUG > 9 and print "Discarding complaint (at line $_[0]) $_[1]\n because no_whining is on.\n"; - return; - } - return $self->_complain_warn(@_) if $self->{'complain_stderr'}; - return $self->_complain_errata(@_); -} - -sub scream { # like whine, but not suppressable - #my($self,$line,$complaint) = @_; - my $self = shift(@_); - ++$self->{'errors_seen'}; - return $self->_complain_warn(@_) if $self->{'complain_stderr'}; - return $self->_complain_errata(@_); -} - -sub _complain_warn { - my($self,$line,$complaint) = @_; - return printf STDERR "%s around line %s: %s\n", - $self->{'source_filename'} || 'Pod input', $line, $complaint; -} - -sub _complain_errata { - my($self,$line,$complaint) = @_; - if( $self->{'no_errata_section'} ) { - DEBUG > 9 and print "Discarding erratum (at line $line) $complaint\n because no_errata_section is on.\n"; - } else { - DEBUG > 9 and print "Queuing erratum (at line $line) $complaint\n"; - push @{$self->{'errata'}{$line}}, $complaint - # for a report to be generated later! - } - return 1; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _get_initial_item_type { - # A hack-wrapper here for when you have like "=over\n\n=item 456\n\n" - my($self, $para) = @_; - return $para->[1]{'~type'} if $para->[1]{'~type'}; - - return $para->[1]{'~type'} = 'text' - if join("\n", @{$para}[2 .. $#$para]) =~ m/^\s*(\d+)\.?\s*$/s and $1 ne '1'; - # Else fall thru to the general case: - return $self->_get_item_type($para); -} - - - -sub _get_item_type { # mutates the item!! - my($self, $para) = @_; - return $para->[1]{'~type'} if $para->[1]{'~type'}; - - - # Otherwise we haven't yet been to this node. Maybe alter it... - - my $content = join "\n", @{$para}[2 .. $#$para]; - - if($content =~ m/^\s*\*\s*$/s or $content =~ m/^\s*$/s) { - # Like: "=item *", "=item * ", "=item" - splice @$para, 2; # so it ends up just being ['=item', { attrhash } ] - $para->[1]{'~orig_content'} = $content; - return $para->[1]{'~type'} = 'bullet'; - - } elsif($content =~ m/^\s*\*\s+(.+)/s) { # tolerance - - # Like: "=item * Foo bar baz"; - $para->[1]{'~orig_content'} = $content; - $para->[1]{'~_freaky_para_hack'} = $1; - DEBUG > 2 and print " Tolerating $$para[2] as =item *\\n\\n$1\n"; - splice @$para, 2; # so it ends up just being ['=item', { attrhash } ] - return $para->[1]{'~type'} = 'bullet'; - - } elsif($content =~ m/^\s*(\d+)\.?\s*$/s) { - # Like: "=item 1.", "=item 123412" - - $para->[1]{'~orig_content'} = $content; - $para->[1]{'number'} = $1; # Yes, stores the number there! - - splice @$para, 2; # so it ends up just being ['=item', { attrhash } ] - return $para->[1]{'~type'} = 'number'; - - } else { - # It's anything else. - return $para->[1]{'~type'} = 'text'; - - } -} - -#----------------------------------------------------------------------------- - -sub _make_treelet { - my $self = shift; # and ($para, $start_line) - my $treelet; - if(!@_) { - return ['']; - } if(ref $_[0] and ref $_[0][0] and $_[0][0][0] eq '~Top') { - # Hack so we can pass in fake-o pre-cooked paragraphs: - # just have the first line be a reference to a ['~Top', {}, ...] - # We use this feechure in gen_errata and stuff. - - DEBUG and print "Applying precooked treelet hack to $_[0][0]\n"; - $treelet = $_[0][0]; - splice @$treelet, 0, 2; # lop the top off - return $treelet; - } else { - $treelet = $self->_treelet_from_formatting_codes(@_); - } - - if( $self->_remap_sequences($treelet) ) { - $self->_treat_Zs($treelet); # Might as well nix these first - $self->_treat_Ls($treelet); # L has to precede E and S - $self->_treat_Es($treelet); - $self->_treat_Ss($treelet); # S has to come after E - - $self->_wrap_up($treelet); # Nix X's and merge texties - - } else { - DEBUG and print "Formatless treelet gets fast-tracked.\n"; - # Very common case! - } - - splice @$treelet, 0, 2; # lop the top off - - return $treelet; -} - -#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. - -sub _wrap_up { - my($self, @stack) = @_; - my $nixx = $self->{'nix_X_codes'}; - my $merge = $self->{'merge_text' }; - return unless $nixx or $merge; - - DEBUG > 2 and print "\nStarting _wrap_up traversal.\n", - $merge ? (" Merge mode on\n") : (), - $nixx ? (" Nix-X mode on\n") : (), - ; - - - my($i, $treelet); - while($treelet = shift @stack) { - DEBUG > 3 and print " Considering children of this $treelet->[0] node...\n"; - for($i = 2; $i < @$treelet; ++$i) { # iterate over children - DEBUG > 3 and print " Considering child at $i ", pretty($treelet->[$i]), "\n"; - if($nixx and ref $treelet->[$i] and $treelet->[$i][0] eq 'X') { - DEBUG > 3 and print " Nixing X node at $i\n"; - splice(@$treelet, $i, 1); # just nix this node (and its descendants) - # no need to back-update the counter just yet - redo; - - } elsif($merge and $i != 2 and # non-initial - !ref $treelet->[$i] and !ref $treelet->[$i - 1] - ) { - DEBUG > 3 and print " Merging ", $i-1, - ":[$treelet->[$i-1]] and $i\:[$treelet->[$i]]\n"; - $treelet->[$i-1] .= ( splice(@$treelet, $i, 1) )[0]; - DEBUG > 4 and print " Now: ", $i-1, ":[$treelet->[$i-1]]\n"; - --$i; - next; - # since we just pulled the possibly last node out from under - # ourselves, we can't just redo() - - } elsif( ref $treelet->[$i] ) { - DEBUG > 4 and print " Enqueuing ", pretty($treelet->[$i]), " for traversal.\n"; - push @stack, $treelet->[$i]; - - if($treelet->[$i][0] eq 'L') { - my $thing; - foreach my $attrname ('section', 'to') { - if(defined($thing = $treelet->[$i][1]{$attrname}) and ref $thing) { - unshift @stack, $thing; - DEBUG > 4 and print " +Enqueuing ", - pretty( $treelet->[$i][1]{$attrname} ), - " as an attribute value to tweak.\n"; - } - } - } - } - } - } - DEBUG > 2 and print "End of _wrap_up traversal.\n\n"; - - return; -} - -#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. - -sub _remap_sequences { - my($self,@stack) = @_; - - if(@stack == 1 and @{ $stack[0] } == 3 and !ref $stack[0][2]) { - # VERY common case: abort it. - DEBUG and print "Skipping _remap_sequences: formatless treelet.\n"; - return 0; - } - - my $map = ($self->{'accept_codes'} || die "NO accept_codes in $self?!?"); - - my $start_line = $stack[0][1]{'start_line'}; - DEBUG > 2 and printf - "\nAbout to start _remap_sequences on treelet from line %s.\n", - $start_line || '[?]' - ; - DEBUG > 3 and print " Map: ", - join('; ', map "$_=" . ( - ref($map->{$_}) ? join(",", @{$map->{$_}}) : $map->{$_} - ), - sort keys %$map ), - ("B~C~E~F~I~L~S~X~Z" eq join '~', sort keys %$map) - ? " (all normal)\n" : "\n" - ; - - # A recursive algorithm implemented iteratively! Whee! - - my($is, $was, $i, $treelet); # scratch - while($treelet = shift @stack) { - DEBUG > 3 and print " Considering children of this $treelet->[0] node...\n"; - for($i = 2; $i < @$treelet; ++$i) { # iterate over children - next unless ref $treelet->[$i]; # text nodes are uninteresting - - DEBUG > 4 and print " Noting child $i : $treelet->[$i][0]<...>\n"; - - $is = $treelet->[$i][0] = $map->{ $was = $treelet->[$i][0] }; - if( DEBUG > 3 ) { - if(!defined $is) { - print " Code $was<> is UNKNOWN!\n"; - } elsif($is eq $was) { - DEBUG > 4 and print " Code $was<> stays the same.\n"; - } else { - print " Code $was<> maps to ", - ref($is) - ? ( "tags ", map("$_<", @$is), '...', map('>', @$is), "\n" ) - : "tag $is<...>.\n"; - } - } - - if(!defined $is) { - $self->whine($start_line, "Deleting unknown formatting code $was<>"); - $is = $treelet->[$i][0] = '1'; # But saving the children! - # I could also insert a leading "$was<" and tailing ">" as - # children of this node, but something about that seems icky. - } - if(ref $is) { - my @dynasty = @$is; - DEBUG > 4 and print " Renaming $was node to $dynasty[-1]\n"; - $treelet->[$i][0] = pop @dynasty; - my $nugget; - while(@dynasty) { - DEBUG > 4 and printf - " Grafting a new %s node between %s and %s\n", - $dynasty[-1], $treelet->[0], $treelet->[$i][0], - ; - - #$nugget = ; - splice @$treelet, $i, 1, [pop(@dynasty), {}, $treelet->[$i]]; - # relace node with a new parent - } - } elsif($is eq '0') { - splice(@$treelet, $i, 1); # just nix this node (and its descendants) - --$i; # back-update the counter - } elsif($is eq '1') { - splice(@$treelet, $i, 1 # replace this node with its children! - => splice @{ $treelet->[$i] },2 - # (not catching its first two (non-child) items) - ); - --$i; # back up for new stuff - } else { - # otherwise it's unremarkable - unshift @stack, $treelet->[$i]; # just recurse - } - } - } - - DEBUG > 2 and print "End of _remap_sequences traversal.\n\n"; - - if(@_ == 2 and @{ $_[1] } == 3 and !ref $_[1][2]) { - DEBUG and print "Noting that the treelet is now formatless.\n"; - return 0; - } - return 1; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -sub _ponder_extend { - - # "Go to an extreme, move back to a more comfortable place" - # -- /Oblique Strategies/, Brian Eno and Peter Schmidt - - my($self, $para) = @_; - my $content = join ' ', splice @$para, 2; - $content =~ s/^\s+//s; - $content =~ s/\s+$//s; - - DEBUG > 2 and print "Ogling extensor: =extend $content\n"; - - if($content =~ - m/^ - (\S+) # 1 : new item - \s+ - (\S+) # 2 : fallback(s) - (?:\s+(\S+))? # 3 : element name(s) - \s* - $ - /xs - ) { - my $new_letter = $1; - my $fallbacks_one = $2; - my $elements_one; - $elements_one = defined($3) ? $3 : $1; - - DEBUG > 2 and print "Extensor has good syntax.\n"; - - unless($new_letter =~ m/^[A-Z]$/s or $new_letter) { - DEBUG > 2 and print " $new_letter isn't a valid thing to entend.\n"; - $self->whine( - $para->[1]{'start_line'}, - "You can extend only formatting codes A-Z, not like \"$new_letter\"" - ); - return; - } - - if(grep $new_letter eq $_, @Known_formatting_codes) { - DEBUG > 2 and print " $new_letter isn't a good thing to extend, because known.\n"; - $self->whine( - $para->[1]{'start_line'}, - "You can't extend an established code like \"$new_letter\"" - ); - - #TODO: or allow if last bit is same? - - return; - } - - unless($fallbacks_one =~ m/^[A-Z](,[A-Z])*$/s # like "B", "M,I", etc. - or $fallbacks_one eq '0' or $fallbacks_one eq '1' - ) { - $self->whine( - $para->[1]{'start_line'}, - "Format for second =extend parameter must be like" - . " M or 1 or 0 or M,N or M,N,O but you have it like " - . $fallbacks_one - ); - return; - } - - unless($elements_one =~ m/^[^ ,]+(,[^ ,]+)*$/s) { # like "B", "M,I", etc. - $self->whine( - $para->[1]{'start_line'}, - "Format for third =extend parameter: like foo or bar,Baz,qu:ux but not like " - . $elements_one - ); - return; - } - - my @fallbacks = split ',', $fallbacks_one, -1; - my @elements = split ',', $elements_one, -1; - - foreach my $f (@fallbacks) { - next if exists $Known_formatting_codes{$f} or $f eq '0' or $f eq '1'; - DEBUG > 2 and print " Can't fall back on unknown code $f\n"; - $self->whine( - $para->[1]{'start_line'}, - "Can't use unknown formatting code '$f' as a fallback for '$new_letter'" - ); - return; - } - - DEBUG > 3 and printf "Extensor: Fallbacks <%s> Elements <%s>.\n", - @fallbacks, @elements; - - my $canonical_form; - foreach my $e (@elements) { - if(exists $self->{'accept_codes'}{$e}) { - DEBUG > 1 and print " Mapping '$new_letter' to known extension '$e'\n"; - $canonical_form = $e; - last; # first acceptable elementname wins! - } else { - DEBUG > 1 and print " Can't map '$new_letter' to unknown extension '$e'\n"; - } - } - - - if( defined $canonical_form ) { - # We found a good N => elementname mapping - $self->{'accept_codes'}{$new_letter} = $canonical_form; - DEBUG > 2 and print - "Extensor maps $new_letter => known element $canonical_form.\n"; - } else { - # We have to use the fallback(s), which might be '0', or '1'. - $self->{'accept_codes'}{$new_letter} - = (@fallbacks == 1) ? $fallbacks[0] : \@fallbacks; - DEBUG > 2 and print - "Extensor maps $new_letter => fallbacks @fallbacks.\n"; - } - - } else { - DEBUG > 2 and print "Extensor has bad syntax.\n"; - $self->whine( - $para->[1]{'start_line'}, - "Unknown =extend syntax: $content" - ) - } - return; -} - - -#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. - -sub _treat_Zs { # Nix Z<...>'s - my($self,@stack) = @_; - - my($i, $treelet); - my $start_line = $stack[0][1]{'start_line'}; - - # A recursive algorithm implemented iteratively! Whee! - - while($treelet = shift @stack) { - for($i = 2; $i < @$treelet; ++$i) { # iterate over children - next unless ref $treelet->[$i]; # text nodes are uninteresting - unless($treelet->[$i][0] eq 'Z') { - unshift @stack, $treelet->[$i]; # recurse - next; - } - - DEBUG > 1 and print "Nixing Z node @{$treelet->[$i]}\n"; - - # bitch UNLESS it's empty - unless( @{$treelet->[$i]} == 2 - or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '') - ) { - $self->whine( $start_line, "A non-empty Z<>" ); - } # but kill it anyway - - splice(@$treelet, $i, 1); # thereby just nix this node. - --$i; - - } - } - - return; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -# Quoting perlpodspec: - -# In parsing an L<...> code, Pod parsers must distinguish at least four -# attributes: - -############# Not used. Expressed via the element children plus -############# the value of the "content-implicit" flag. -# First: -# The link-text. If there is none, this must be undef. (E.g., in "L<Perl -# Functions|perlfunc>", the link-text is "Perl Functions". In -# "L<Time::HiRes>" and even "L<|Time::HiRes>", there is no link text. Note -# that link text may contain formatting.) -# - -############# The element children -# Second: -# The possibly inferred link-text -- i.e., if there was no real link text, -# then this is the text that we'll infer in its place. (E.g., for -# "L<Getopt::Std>", the inferred link text is "Getopt::Std".) -# - -############# The "to" attribute (which might be text, or a treelet) -# Third: -# The name or URL, or undef if none. (E.g., in "L<Perl -# Functions|perlfunc>", the name -- also sometimes called the page -- is -# "perlfunc". In "L</CAVEATS>", the name is undef.) -# - -############# The "section" attribute (which might be next, or a treelet) -# Fourth: -# The section (AKA "item" in older perlpods), or undef if none. E.g., in -# Getopt::Std/DESCRIPTION, "DESCRIPTION" is the section. (Note that this -# is not the same as a manpage section like the "5" in "man 5 crontab". -# "Section Foo" in the Pod sense means the part of the text that's -# introduced by the heading or item whose text is "Foo".) -# -# Pod parsers may also note additional attributes including: -# - -############# The "type" attribute. -# Fifth: -# A flag for whether item 3 (if present) is a URL (like -# "http://lists.perl.org" is), in which case there should be no section -# attribute; a Pod name (like "perldoc" and "Getopt::Std" are); or -# possibly a man page name (like "crontab(5)" is). -# - -############# Not implemented, I guess. -# Sixth: -# The raw original L<...> content, before text is split on "|", "/", etc, -# and before E<...> codes are expanded. - - -# For L<...> codes without a "name|" part, only E<...> and Z<> codes may -# occur -- no other formatting codes. That is, authors should not use -# "L<B<Foo::Bar>>". -# -# Note, however, that formatting codes and Z<>'s can occur in any and all -# parts of an L<...> (i.e., in name, section, text, and url). - -sub _treat_Ls { # Process our dear dear friends, the L<...> sequences - - # L<name> - # L<name/"sec"> or L<name/sec> - # L</"sec"> or L</sec> or L<"sec"> - # L<text|name> - # L<text|name/"sec"> or L<text|name/sec> - # L<text|/"sec"> or L<text|/sec> or L<text|"sec"> - # L<scheme:...> - - my($self,@stack) = @_; - - my($i, $treelet); - my $start_line = $stack[0][1]{'start_line'}; - - # A recursive algorithm implemented iteratively! Whee! - - while($treelet = shift @stack) { - for(my $i = 2; $i < @$treelet; ++$i) { - # iterate over children of current tree node - next unless ref $treelet->[$i]; # text nodes are uninteresting - unless($treelet->[$i][0] eq 'L') { - unshift @stack, $treelet->[$i]; # recurse - next; - } - - - # By here, $treelet->[$i] is definitely an L node - DEBUG > 1 and print "Ogling L node $treelet->[$i]\n"; - - # bitch if it's empty - if( @{$treelet->[$i]} == 2 - or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '') - ) { - $self->whine( $start_line, "An empty L<>" ); - $treelet->[$i] = 'L<>'; # just make it a text node - next; # and move on - } - - # Catch URLs: - # URLs can, alas, contain E<...> sequences, so we can't /assume/ - # that this is one text node. But it has to START with one text - # node... - if(! ref $treelet->[$i][2] and - $treelet->[$i][2] =~ m/^\w+:[^:\s]\S*$/s - ) { - $treelet->[$i][1]{'type'} = 'url'; - $treelet->[$i][1]{'content-implicit'} = 'yes'; - - # TODO: deal with rel: URLs here? - - if( 3 == @{ $treelet->[$i] } ) { - # But if it IS just one text node (most common case) - DEBUG > 1 and printf qq{Catching "%s as " as ho-hum L<URL> link.\n}, - $treelet->[$i][2] - ; - $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new( - $treelet->[$i][2] - ); # its own treelet - } else { - # It's a URL but complex (like "L<foo:bazE<123>bar>"). Feh. - #$treelet->[$i][1]{'to'} = [ @{$treelet->[$i]} ]; - #splice @{ $treelet->[$i][1]{'to'} }, 0,2; - #DEBUG > 1 and printf qq{Catching "%s as " as complex L<URL> link.\n}, - # join '~', @{$treelet->[$i][1]{'to' }}; - - $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new( - $treelet->[$i] # yes, clone the whole content as a treelet - ); - $treelet->[$i][1]{'to'}[0] = ''; # set the copy's tagname to nil - die "SANITY FAILURE" if $treelet->[0] eq ''; # should never happen! - DEBUG > 1 and print - qq{Catching "$treelet->[$i][1]{'to'}" as a complex L<URL> link.\n}; - } - - next; # and move on - } - - - # Catch some very simple and/or common cases - if(@{$treelet->[$i]} == 3 and ! ref $treelet->[$i][2]) { - my $it = $treelet->[$i][2]; - if($it =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s) { # man sections - # Hopefully neither too broad nor too restrictive a RE - DEBUG > 1 and print "Catching \"$it\" as manpage link.\n"; - $treelet->[$i][1]{'type'} = 'man'; - # This's the only place where man links can get made. - $treelet->[$i][1]{'content-implicit'} = 'yes'; - $treelet->[$i][1]{'to' } = - Pod::Simple::LinkSection->new( $it ); # treelet! - - next; - } - if($it =~ m/^[^\/\|,\$\%\@\ \"\<\>\:\#\&\*\{\}\[\]\(\)]+(\:\:[^\/\|,\$\%\@\ \"\<\>\:\#\&\*\{\}\[\]\(\)]+)*$/s) { - # Extremely forgiving idea of what constitutes a bare - # modulename link like L<Foo::Bar> or even L<Thing::1.0::Docs::Tralala> - DEBUG > 1 and print "Catching \"$it\" as ho-hum L<Modulename> link.\n"; - $treelet->[$i][1]{'type'} = 'pod'; - $treelet->[$i][1]{'content-implicit'} = 'yes'; - $treelet->[$i][1]{'to' } = - Pod::Simple::LinkSection->new( $it ); # treelet! - next; - } - # else fall thru... - } - - - - # ...Uhoh, here's the real L<...> parsing stuff... - # "With the ill behavior, with the ill behavior, with the ill behavior..." - - DEBUG > 1 and print "Running a real parse on this non-trivial L\n"; - - - my $link_text; # set to an arrayref if found - my $ell = $treelet->[$i]; - my @ell_content = @$ell; - splice @ell_content,0,2; # Knock off the 'L' and {} bits - - DEBUG > 3 and print " Ell content to start: ", - pretty(@ell_content), "\n"; - - - # Look for the "|" -- only in CHILDREN (not all underlings!) - # Like L<I like the strictness|strict> - DEBUG > 3 and - print " Peering at L content for a '|' ...\n"; - for(my $j = 0; $j < @ell_content; ++$j) { - next if ref $ell_content[$j]; - DEBUG > 3 and - print " Peering at L-content text bit \"$ell_content[$j]\" for a '|'.\n"; - - if($ell_content[$j] =~ m/^([^\|]*)\|(.*)$/s) { - my @link_text = ($1); # might be 0-length - $ell_content[$j] = $2; # might be 0-length - - DEBUG > 3 and - print " FOUND a '|' in it. Splitting into [$1] + [$2]\n"; - - unshift @link_text, splice @ell_content, 0, $j; - # leaving only things at J and after - @ell_content = grep ref($_)||length($_), @ell_content ; - $link_text = [grep ref($_)||length($_), @link_text ]; - DEBUG > 3 and printf - " So link text is %s\n and remaining ell content is %s\n", - pretty($link_text), pretty(@ell_content); - last; - } - } - - - # Now look for the "/" -- only in CHILDREN (not all underlings!) - # And afterward, anything left in @ell_content will be the raw name - # Like L<Foo::Bar/Object Methods> - my $section_name; # set to arrayref if found - DEBUG > 3 and print " Peering at L-content for a '/' ...\n"; - for(my $j = 0; $j < @ell_content; ++$j) { - next if ref $ell_content[$j]; - DEBUG > 3 and - print " Peering at L-content text bit \"$ell_content[$j]\" for a '/'.\n"; - - if($ell_content[$j] =~ m/^([^\/]*)\/(.*)$/s) { - my @section_name = ($2); # might be 0-length - $ell_content[$j] = $1; # might be 0-length - - DEBUG > 3 and - print " FOUND a '/' in it.", - " Splitting to page [...$1] + section [$2...]\n"; - - push @section_name, splice @ell_content, 1+$j; - # leaving only things before and including J - - @ell_content = grep ref($_)||length($_), @ell_content ; - @section_name = grep ref($_)||length($_), @section_name ; - - # Turn L<.../"foo"> into L<.../foo> - if(@section_name - and !ref($section_name[0]) and !ref($section_name[-1]) - and $section_name[ 0] =~ m/^\"/s - and $section_name[-1] =~ m/\"$/s - and !( # catch weird degenerate case of L<"> ! - @section_name == 1 and $section_name[0] eq '"' - ) - ) { - $section_name[ 0] =~ s/^\"//s; - $section_name[-1] =~ s/\"$//s; - DEBUG > 3 and - print " Quotes removed: ", pretty(@section_name), "\n"; - } else { - DEBUG > 3 and - print " No need to remove quotes in ", pretty(@section_name), "\n"; - } - - $section_name = \@section_name; - last; - } - } - - # Turn L<"Foo Bar"> into L</Foo Bar> - if(!$section_name and @ell_content - and !ref($ell_content[0]) and !ref($ell_content[-1]) - and $ell_content[ 0] =~ m/^\"/s - and $ell_content[-1] =~ m/\"$/s - and !( # catch weird degenerate case of L<"> ! - @ell_content == 1 and $ell_content[0] eq '"' - ) - ) { - $section_name = [splice @ell_content]; - $section_name->[ 0] =~ s/^\"//s; - $section_name->[-1] =~ s/\"$//s; - } - - # Turn L<Foo Bar> into L</Foo Bar>. - if(!$section_name and !$link_text and @ell_content - and grep !ref($_) && m/ /s, @ell_content - ) { - $section_name = [splice @ell_content]; - # That's support for the now-deprecated syntax. - # (Maybe generate a warning eventually?) - # Note that it deliberately won't work on L<...|Foo Bar> - } - - - # Now make up the link_text - # L<Foo> -> L<Foo|Foo> - # L</Bar> -> L<"Bar"|Bar> - # L<Foo/Bar> -> L<"Bar" in Foo/Foo> - unless($link_text) { - $ell->[1]{'content-implicit'} = 'yes'; - $link_text = []; - push @$link_text, '"', @$section_name, '"' if $section_name; - - if(@ell_content) { - $link_text->[-1] .= ' in ' if $section_name; - push @$link_text, @ell_content; - } - } - - - # And the E resolver will have to deal with all our treeletty things: - - if(@ell_content == 1 and !ref($ell_content[0]) - and $ell_content[0] =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s - ) { - $ell->[1]{'type'} = 'man'; - DEBUG > 3 and print "Considering this ($ell_content[0]) a man link.\n"; - } else { - $ell->[1]{'type'} = 'pod'; - DEBUG > 3 and print "Considering this a pod link (not man or url).\n"; - } - - if( defined $section_name ) { - $ell->[1]{'section'} = Pod::Simple::LinkSection->new( - ['', {}, @$section_name] - ); - DEBUG > 3 and print "L-section content: ", pretty($ell->[1]{'section'}), "\n"; - } - - if( @ell_content ) { - $ell->[1]{'to'} = Pod::Simple::LinkSection->new( - ['', {}, @ell_content] - ); - DEBUG > 3 and print "L-to content: ", pretty($ell->[1]{'to'}), "\n"; - } - - # And update children to be the link-text: - @$ell = (@$ell[0,1], defined($link_text) ? splice(@$link_text) : ''); - - DEBUG > 2 and print "End of L-parsing for this node $treelet->[$i]\n"; - - unshift @stack, $treelet->[$i]; # might as well recurse - } - } - - return; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -sub _treat_Es { - my($self,@stack) = @_; - - my($i, $treelet, $content, $replacer, $charnum); - my $start_line = $stack[0][1]{'start_line'}; - - # A recursive algorithm implemented iteratively! Whee! - - - # Has frightening side effects on L nodes' attributes. - - #my @ells_to_tweak; - - while($treelet = shift @stack) { - for(my $i = 2; $i < @$treelet; ++$i) { # iterate over children - next unless ref $treelet->[$i]; # text nodes are uninteresting - if($treelet->[$i][0] eq 'L') { - # SPECIAL STUFF for semi-processed L<>'s - - my $thing; - foreach my $attrname ('section', 'to') { - if(defined($thing = $treelet->[$i][1]{$attrname}) and ref $thing) { - unshift @stack, $thing; - DEBUG > 2 and print " Enqueuing ", - pretty( $treelet->[$i][1]{$attrname} ), - " as an attribute value to tweak.\n"; - } - } - - unshift @stack, $treelet->[$i]; # recurse - next; - } elsif($treelet->[$i][0] ne 'E') { - unshift @stack, $treelet->[$i]; # recurse - next; - } - - DEBUG > 1 and print "Ogling E node ", pretty($treelet->[$i]), "\n"; - - # bitch if it's empty - if( @{$treelet->[$i]} == 2 - or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '') - ) { - $self->whine( $start_line, "An empty E<>" ); - $treelet->[$i] = 'E<>'; # splice in a literal - next; - } - - # bitch if content is weird - unless(@{$treelet->[$i]} == 3 and !ref($content = $treelet->[$i][2])) { - $self->whine( $start_line, "An E<...> surrounding strange content" ); - $replacer = $treelet->[$i]; # scratch - splice(@$treelet, $i, 1, # fake out a literal - 'E<', - splice(@$replacer,2), # promote its content - '>' - ); - # Don't need to do --$i, as the 'E<' we just added isn't interesting. - next; - } - - DEBUG > 1 and print "Ogling E<$content>\n"; - - $charnum = Pod::Escapes::e2charnum($content); - DEBUG > 1 and print " Considering E<$content> with char ", - defined($charnum) ? $charnum : "undef", ".\n"; - - if(!defined( $charnum )) { - DEBUG > 1 and print "I don't know how to deal with E<$content>.\n"; - $self->whine( $start_line, "Unknown E content in E<$content>" ); - $replacer = "E<$content>"; # better than nothing - } elsif($charnum >= 255 and !UNICODE) { - $replacer = ASCII ? "\xA4" : "?"; - DEBUG > 1 and print "This Perl version can't handle ", - "E<$content> (chr $charnum), so replacing with $replacer\n"; - } else { - $replacer = Pod::Escapes::e2char($content); - DEBUG > 1 and print " Replacing E<$content> with $replacer\n"; - } - - splice(@$treelet, $i, 1, $replacer); # no need to back up $i, tho - } - } - - return; -} - - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -sub _treat_Ss { - my($self,$treelet) = @_; - - _change_S_to_nbsp($treelet,0) if $self->{'nbsp_for_S'}; - - # TODO: or a change_nbsp_to_S - # Normalizing nbsp's to S is harder: for each text node, make S content - # out of anything matching m/([^ \xA0]*(?:\xA0+[^ \xA0]*)+)/ - - - return; -} - - -sub _change_S_to_nbsp { # a recursive function - # Sanely assumes that the top node in the excursion won't be an S node. - my($treelet, $in_s) = @_; - - my $is_s = ('S' eq $treelet->[0]); - $in_s ||= $is_s; # So in_s is on either by this being an S element, - # or by an ancestor being an S element. - - for(my $i = 2; $i < @$treelet; ++$i) { - if(ref $treelet->[$i]) { - if( _change_S_to_nbsp( $treelet->[$i], $in_s ) ) { - my $to_pull_up = $treelet->[$i]; - splice @$to_pull_up,0,2; # ...leaving just its content - splice @$treelet, $i, 1, @$to_pull_up; # Pull up content - $i += @$to_pull_up - 1; # Make $i skip the pulled-up stuff - } - } else { - $treelet->[$i] =~ s/\s/\xA0/g if ASCII and $in_s; - # (If not in ASCIIland, we can't assume that \xA0 == nbsp.) - - # Note that if you apply nbsp_for_S to text, and so turn - # "foo S<bar baz> quux" into "foo bar faz quux", you - # end up with something that fails to say "and don't hyphenate - # any part of 'bar baz'". However, hyphenation is such a vexing - # problem anyway, that most Pod renderers just don't render it - # at all. But if you do want to implement hyphenation, I guess - # that you'd better have nbsp_for_S off. - } - } - - return $is_s; -} - -#----------------------------------------------------------------------------- - -sub _accessorize { # A simple-minded method-maker - no strict 'refs'; - foreach my $attrname (@_) { - next if $attrname =~ m/::/; # a hack - *{caller() . '::' . $attrname} = sub { - use strict; - $Carp::CarpLevel = 1, Carp::croak( - "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)" - ) unless (@_ == 1 or @_ == 2) and ref $_[0]; - (@_ == 1) ? $_[0]->{$attrname} - : ($_[0]->{$attrname} = $_[1]); - }; - } - # Ya know, they say accessories make the ensemble! - return; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . -#============================================================================= - -sub filter { - my($class, $source) = @_; - my $new = $class->new; - $new->output_fh(*STDOUT{IO}); - - if(ref($source || '') eq 'SCALAR') { - $new->parse_string_document( $$source ); - } elsif(ref($source)) { # it's a file handle - $new->parse_file($source); - } else { # it's a filename - $new->parse_file($source); - } - - return $new; -} - - -#----------------------------------------------------------------------------- - -sub _out { - # For use in testing: Class->_out($source) - # returns the transformation of $source - - my $class = shift(@_); - - my $mutor = shift(@_) if @_ and ref($_[0] || '') eq 'CODE'; - - DEBUG and print "\n\n", '#' x 76, - "\nAbout to parse source: {{\n$_[0]\n}}\n\n"; - - - my $parser = $class->new; - $parser->hide_line_numbers(1); - - my $out = ''; - $parser->output_string( \$out ); - DEBUG and print " _out to ", \$out, "\n"; - - $mutor->($parser) if $mutor; - - $parser->parse_string_document( $_[0] ); - # use Data::Dumper; print Dumper($parser), "\n"; - return $out; -} - - -sub _duo { - # For use in testing: Class->_duo($source1, $source2) - # returns the parse trees of $source1 and $source2. - # Good in things like: &ok( Class->duo(... , ...) ); - - my $class = shift(@_); - - Carp::croak "But $class->_duo is useful only in list context!" - unless wantarray; - - my $mutor = shift(@_) if @_ and ref($_[0] || '') eq 'CODE'; - - Carp::croak "But $class->_duo takes two parameters, not: @_" - unless @_ == 2; - - my(@out); - - while( @_ ) { - my $parser = $class->new; - - push @out, ''; - $parser->output_string( \( $out[-1] ) ); - - DEBUG and print " _duo out to ", $parser->output_string(), - " = $parser->{'output_string'}\n"; - - $parser->hide_line_numbers(1); - $mutor->($parser) if $mutor; - $parser->parse_string_document( shift( @_ ) ); - # use Data::Dumper; print Dumper($parser), "\n"; - } - - return @out; -} - - - -#----------------------------------------------------------------------------- -1; -__END__ - -TODO: -A start_formatting_code and end_formatting_code methods, which in the -base class call start_L, end_L, start_C, end_C, etc., if they are -defined. - -have the POD FORMATTING ERRORS section note the localtime, and the -version of Pod::Simple. - -option to delete all E<shy>s? -option to scream if under-0x20 literals are found in the input, or -under-E<32> E codes are found in the tree. And ditto \x7f-\x9f - -Option to turn highbit characters into their compromised form? (applies -to E parsing too) - -TODO: BOM/encoding things. - -TODO: ascii-compat things in the XML classes? - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple.pod b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple.pod deleted file mode 100644 index b0a8a6f6d08..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple.pod +++ /dev/null @@ -1,218 +0,0 @@ - -=head1 NAME - -Pod::Simple - framework for parsing Pod - -=head1 SYNOPSIS - - TODO - -=head1 DESCRIPTION - -Pod::Simple is a Perl library for parsing text in the Pod ("plain old -documentation") markup language that is typically used for writing -documentation for Perl and for Perl modules. The Pod format is explained -in the L<perlpod|perlpod> man page; the most common formatter is called -"perldoc". - -Pod formatters can use Pod::Simple to parse Pod documents into produce -renderings of them in plain ASCII, in HTML, or in any number of other -formats. Typically, such formatters will be subclasses of Pod::Simple, -and so they will inherit its methods, like C<parse_file>. - -If you're reading this document just because you have a Pod-processing -subclass that you want to use, this document (plus the documentation for -the subclass) is probably all you'll need to read. - -If you're reading this document because you want to write a formatter -subclass, continue reading this document, and then read -L<Pod::Simple::Subclassing>, and then possibly even read L<perlpodspec> -(some of which is for parser-writers, but much of which is notes to -formatter-writers). - - -=head1 MAIN METHODS - - - -=over - -=item C<< $parser = I<SomeClass>->new(); >> - -This returns a new parser object, where I<C<SomeClass>> is a subclass -of Pod::Simple. - -=item C<< $parser->output_fh( *OUT ); >> - -This sets the filehandle that C<$parser>'s output will be written to. -You can pass C<*STDOUT>, otherwise you should probably do something -like this: - - my $outfile = "output.txt"; - open TXTOUT, ">$outfile" or die "Can't write to $outfile: $!"; - $parser->output_fh(*TXTOUT); - -...before you call one of the C<< $parser->parse_I<whatever> >> methods. - -=item C<< $parser->output_string( \$somestring ); >> - -This sets the string that C<$parser>'s output will be sent to, -instead of any filehandle. - - -=item C<< $parser->parse_file( I<$some_filename> ); >> - -=item C<< $parser->parse_file( *INPUT_FH ); >> - -This reads the Pod content of the file (or filehandle) that you specify, -and processes it with that C<$parser> object, according to however -C<$parser>'s class works, and according to whatever parser options you -have set up for this C<$parser> object. - -=item C<< $parser->parse_string_document( I<$all_content> ); >> - -This works just like C<parse_file> except that it reads the Pod -content not from a file, but from a string that you have already -in memory. - -=item C<< $parser->parse_lines( I<...@lines...>, undef ); >> - -This processes the lines in C<@lines> (where each list item must be a -defined value, and must contain exactly one line of content -- so no -items like C<"foo\nbar"> are allowed). The final C<undef> is used to -indicate the end of document being parsed. - -The other C<parser_I<whatever>> methods are meant to be called only once -per C<$parser> object; but C<parse_lines> can be called as many times per -C<$parser> object as you want, as long as the last call (and only -the last call) ends with an C<undef> value. - - -=item C<< $parser->content_seen >> - -This returns true only if there has been any real content seen -for this document. - - -=item C<< I<SomeClass>->filter( I<$filename> ); >> - -=item C<< I<SomeClass>->filter( I<*INPUT_FH> ); >> - -=item C<< I<SomeClass>->filter( I<\$document_content> ); >> - -This is a shortcut method for creating a new parser object, setting the -output handle to STDOUT, and then processing the specified file (or -filehandle, or in-memory document). This is handy for one-liners like -this: - - perl -MPod::Simple::Text -e "Pod::Simple::Text->filter('thingy.pod')" - -=back - - - -=head1 SECONDARY METHODS - -Some of these methods might be of interest to general users, as -well as of interest to formatter-writers. - -Note that the general pattern here is that the accessor-methods -read the attribute's value with C<< $value = $parser->I<attribute> >> -and set the attribute's value with -C<< $parser->I<attribute>(I<newvalue>) >>. For each accessor, I typically -only mention one syntax or another, based on which I think you are actually -most likely to use. - - -=over - -=item C<< $parser->no_whining( I<SOMEVALUE> ) >> - -If you set this attribute to a true value, you will suppress the -parser's complaints about irregularities in the Pod coding. By default, -this attribute's value is false, meaning that irregularities will -be reported. - -Note that turning this attribute to true won't suppress one or two kinds -of complaints about rarely occurring unrecoverable errors. - - -=item C<< $parser->no_errata_section( I<SOMEVALUE> ) >> - -If you set this attribute to a true value, you will stop the parser from -generating a "POD ERRORS" section at the end of the document. By -default, this attribute's value is false, meaning that an errata section -will be generated, as necessary. - - -=item C<< $parser->complain_stderr( I<SOMEVALUE> ) >> - -If you set this attribute to a true value, it will send reports of -parsing errors to STDERR. By default, this attribute's value is false, -meaning that no output is sent to STDERR. - -Note that errors can be noted in an errata section, or sent to STDERR, -or both, or neither. So don't think that turning on C<complain_stderr> -will turn off C<no_errata_section> or vice versa -- these are -independent attributes. - - -=item C<< $parser->source_filename >> - -This returns the filename that this parser object was set to read from. - - -=item C<< $parser->doc_has_started >> - -This returns true if C<$parser> has read from a source, and has seen -Pod content in it. - - -=item C<< $parser->source_dead >> - -This returns true if C<$parser> has read from a source, and come to the -end of that source. - -=back - - -=head1 CAVEATS - -This is just a beta release -- there are a good number of things still -left to do. Notably, support for EBCDIC platforms is still half-done, -an untested. - - -=head1 SEE ALSO - -L<Pod::Simple::Subclassing> - -L<perlpod|perlpod> - -L<perlpodspec|perlpodspec> - -L<Pod::Escapes|Pod::Escapes> - -L<perldoc> - - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Original author: Sean M. Burke C<sburke@cpan.org> - -Maintained by: Allison Randal C<allison@perl.org> - -=cut - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/BlackBox.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/BlackBox.pm deleted file mode 100644 index 6d7fdba4fbf..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/BlackBox.pm +++ /dev/null @@ -1,1923 +0,0 @@ - -package Pod::Simple::BlackBox; -# -# "What's in the box?" "Pain." -# -########################################################################### -# -# This is where all the scary things happen: parsing lines into -# paragraphs; and then into directives, verbatims, and then also -# turning formatting sequences into treelets. -# -# Are you really sure you want to read this code? -# -#----------------------------------------------------------------------------- -# -# The basic work of this module Pod::Simple::BlackBox is doing the dirty work -# of parsing Pod into treelets (generally one per non-verbatim paragraph), and -# to call the proper callbacks on the treelets. -# -# Every node in a treelet is a ['name', {attrhash}, ...children...] - -use integer; # vroom! -use strict; -use Carp (); -BEGIN { - require Pod::Simple; - *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub parse_line { shift->parse_lines(@_) } # alias - -# - - - Turn back now! Run away! - - - - -sub parse_lines { # Usage: $parser->parse_lines(@lines) - # an undef means end-of-stream - my $self = shift; - - my $code_handler = $self->{'code_handler'}; - my $cut_handler = $self->{'cut_handler'}; - $self->{'line_count'} ||= 0; - - my $scratch; - - DEBUG > 4 and - print "# Parsing starting at line ", $self->{'line_count'}, ".\n"; - - DEBUG > 5 and - print "# About to parse lines: ", - join(' ', map defined($_) ? "[$_]" : "EOF", @_), "\n"; - - my $paras = ($self->{'paras'} ||= []); - # paragraph buffer. Because we need to defer processing of =over - # directives and verbatim paragraphs. We call _ponder_paragraph_buffer - # to process this. - - $self->{'pod_para_count'} ||= 0; - - my $line; - foreach my $source_line (@_) { - if( $self->{'source_dead'} ) { - DEBUG > 4 and print "# Source is dead.\n"; - last; - } - - unless( defined $source_line ) { - DEBUG > 4 and print "# Undef-line seen.\n"; - - push @$paras, ['~end', {'start_line' => $self->{'line_count'}}]; - push @$paras, $paras->[-1], $paras->[-1]; - # So that it definitely fills the buffer. - $self->{'source_dead'} = 1; - $self->_ponder_paragraph_buffer; - next; - } - - - if( $self->{'line_count'}++ ) { - ($line = $source_line) =~ tr/\n\r//d; - # If we don't have two vars, we'll end up with that there - # tr/// modding the (potentially read-only) original source line! - - } else { - DEBUG > 2 and print "First line: [$source_line]\n"; - - if( ($line = $source_line) =~ s/^\xEF\xBB\xBF//s ) { - DEBUG and print "UTF-8 BOM seen. Faking a '=encode utf8'.\n"; - $self->_handle_encoding_line( "=encode utf8" ); - $line =~ tr/\n\r//d; - - } elsif( $line =~ s/^\xFE\xFF//s ) { - DEBUG and print "Big-endian UTF-16 BOM seen. Aborting parsing.\n"; - $self->scream( - $self->{'line_count'}, - "UTF16-BE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet." - ); - splice @_; - push @_, undef; - next; - - # TODO: implement somehow? - - } elsif( $line =~ s/^\xFF\xFE//s ) { - DEBUG and print "Little-endian UTF-16 BOM seen. Aborting parsing.\n"; - $self->scream( - $self->{'line_count'}, - "UTF16-LE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet." - ); - splice @_; - push @_, undef; - next; - - # TODO: implement somehow? - - } else { - DEBUG > 2 and print "First line is BOM-less.\n"; - ($line = $source_line) =~ tr/\n\r//d; - } - } - - - DEBUG > 5 and print "# Parsing line: [$line]\n"; - - if(!$self->{'in_pod'}) { - if($line =~ m/^=([a-zA-Z]+)/s) { - if($1 eq 'cut') { - $self->scream( - $self->{'line_count'}, - "=cut found outside a pod block. Skipping to next block." - ); - - ## Before there were errata sections in the world, it was - ## least-pessimal to abort processing the file. But now we can - ## just barrel on thru (but still not start a pod block). - #splice @_; - #push @_, undef; - - next; - } else { - $self->{'in_pod'} = $self->{'start_of_pod_block'} - = $self->{'last_was_blank'} = 1; - # And fall thru to the pod-mode block further down - } - } else { - DEBUG > 5 and print "# It's a code-line.\n"; - $code_handler->(map $_, $line, $self->{'line_count'}, $self) - if $code_handler; - # Note: this may cause code to be processed out of order relative - # to pods, but in order relative to cuts. - - # Note also that we haven't yet applied the transcoding to $line - # by time we call $code_handler! - - if( $line =~ m/^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/ ) { - # That RE is from perlsyn, section "Plain Old Comments (Not!)", - #$fname = $2 if defined $2; - #DEBUG > 1 and defined $2 and print "# Setting fname to \"$fname\"\n"; - DEBUG > 1 and print "# Setting nextline to $1\n"; - $self->{'line_count'} = $1 - 1; - } - - next; - } - } - - # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - # Else we're in pod mode: - - # Apply any necessary transcoding: - $self->{'_transcoder'} && $self->{'_transcoder'}->($line); - - # HERE WE CATCH =encoding EARLY! - if( $line =~ m/^=encoding\s+\S+\s*$/s ) { - $line = $self->_handle_encoding_line( $line ); - } - - if($line =~ m/^=cut/s) { - # here ends the pod block, and therefore the previous pod para - DEBUG > 1 and print "Noting =cut at line ${$self}{'line_count'}\n"; - $self->{'in_pod'} = 0; - # ++$self->{'pod_para_count'}; - $self->_ponder_paragraph_buffer(); - # by now it's safe to consider the previous paragraph as done. - $cut_handler->(map $_, $line, $self->{'line_count'}, $self) - if $cut_handler; - - # TODO: add to docs: Note: this may cause cuts to be processed out - # of order relative to pods, but in order relative to code. - - } elsif($line =~ m/^\s*$/s) { # it's a blank line - if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') { - DEBUG > 1 and print "Saving blank line at line ${$self}{'line_count'}\n"; - push @{$paras->[-1]}, $line; - } # otherwise it's not interesting - - if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) { - DEBUG > 1 and print "Noting para ends with blank line at ${$self}{'line_count'}\n"; - } - - $self->{'last_was_blank'} = 1; - - } elsif($self->{'last_was_blank'}) { # A non-blank line starting a new para... - - if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(?:\s+|$)(.*)/s) { - # THIS IS THE ONE PLACE WHERE WE CONSTRUCT NEW DIRECTIVE OBJECTS - my $new = [$1, {'start_line' => $self->{'line_count'}}, $2]; - # Note that in "=head1 foo", the WS is lost. - # Example: ['=head1', {'start_line' => 123}, ' foo'] - - ++$self->{'pod_para_count'}; - - $self->_ponder_paragraph_buffer(); - # by now it's safe to consider the previous paragraph as done. - - push @$paras, $new; # the new incipient paragraph - DEBUG > 1 and print "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n"; - - } elsif($line =~ m/^\s/s) { - - if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') { - DEBUG > 1 and print "Resuming verbatim para at line ${$self}{'line_count'}\n"; - push @{$paras->[-1]}, $line; - } else { - ++$self->{'pod_para_count'}; - $self->_ponder_paragraph_buffer(); - # by now it's safe to consider the previous paragraph as done. - DEBUG > 1 and print "Starting verbatim para at line ${$self}{'line_count'}\n"; - push @$paras, ['~Verbatim', {'start_line' => $self->{'line_count'}}, $line]; - } - } else { - ++$self->{'pod_para_count'}; - $self->_ponder_paragraph_buffer(); - # by now it's safe to consider the previous paragraph as done. - push @$paras, ['~Para', {'start_line' => $self->{'line_count'}}, $line]; - DEBUG > 1 and print "Starting plain para at line ${$self}{'line_count'}\n"; - } - $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0; - - } else { - # It's a non-blank line /continuing/ the current para - if(@$paras) { - DEBUG > 2 and print "Line ${$self}{'line_count'} continues current paragraph\n"; - push @{$paras->[-1]}, $line; - } else { - # Unexpected case! - die "Continuing a paragraph but \@\$paras is empty?"; - } - $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0; - } - - } # ends the big while loop - - DEBUG > 1 and print(pretty(@$paras), "\n"); - return $self; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _handle_encoding_line { - my($self, $line) = @_; - - # The point of this routine is to set $self->{'_transcoder'} as indicated. - - return $line unless $line =~ m/^=encoding\s+(\S+)\s*$/s; - DEBUG > 1 and print "Found an encoding line \"=encoding $1\"\n"; - - my $e = $1; - my $orig = $e; - push @{ $self->{'encoding_command_reqs'} }, "=encoding $orig"; - - my $enc_error; - - # Cf. perldoc Encode and perldoc Encode::Supported - - require Pod::Simple::Transcode; - - if( $self->{'encoding'} ) { - my $norm_current = $self->{'encoding'}; - my $norm_e = $e; - foreach my $that ($norm_current, $norm_e) { - $that = lc($that); - $that =~ s/[-_]//g; - } - if($norm_current eq $norm_e) { - DEBUG > 1 and print "The '=encoding $orig' line is ", - "redundant. ($norm_current eq $norm_e). Ignoring.\n"; - $enc_error = ''; - # But that doesn't necessarily mean that the earlier one went okay - } else { - $enc_error = "Encoding is already set to " . $self->{'encoding'}; - DEBUG > 1 and print $enc_error; - } - } elsif ( - # OK, let's turn on the encoding - do { - DEBUG > 1 and print " Setting encoding to $e\n"; - $self->{'encoding'} = $e; - 1; - } - and $e eq 'HACKRAW' - ) { - DEBUG and print " Putting in HACKRAW (no-op) encoding mode.\n"; - - } elsif( Pod::Simple::Transcode::->encoding_is_available($e) ) { - - die($enc_error = "WHAT? _transcoder is already set?!") - if $self->{'_transcoder'}; # should never happen - require Pod::Simple::Transcode; - $self->{'_transcoder'} = Pod::Simple::Transcode::->make_transcoder($e); - eval { - my @x = ('', "abc", "123"); - $self->{'_transcoder'}->(@x); - }; - $@ && die( $enc_error = - "Really unexpected error setting up encoding $e: $@\nAborting" - ); - - } else { - my @supported = Pod::Simple::Transcode::->all_encodings; - - # Note unsupported, and complain - DEBUG and print " Encoding [$e] is unsupported.", - "\nSupporteds: @supported\n"; - my $suggestion = ''; - - # Look for a near match: - my $norm = lc($e); - $norm =~ tr[-_][]d; - my $n; - foreach my $enc (@supported) { - $n = lc($enc); - $n =~ tr[-_][]d; - next unless $n eq $norm; - $suggestion = " (Maybe \"$e\" should be \"$enc\"?)"; - last; - } - my $encmodver = Pod::Simple::Transcode::->encmodver; - $enc_error = join '' => - "This document probably does not appear as it should, because its ", - "\"=encoding $e\" line calls for an unsupported encoding.", - $suggestion, " [$encmodver\'s supported encodings are: @supported]" - ; - - $self->scream( $self->{'line_count'}, $enc_error ); - } - push @{ $self->{'encoding_command_statuses'} }, $enc_error; - - return '=encoding ALREADYDONE'; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _handle_encoding_second_level { - # By time this is called, the encoding (if well formed) will already - # have been acted one. - my($self, $para) = @_; - my @x = @$para; - my $content = join ' ', splice @x, 2; - $content =~ s/^\s+//s; - $content =~ s/\s+$//s; - - DEBUG > 2 and print "Ogling encoding directive: =encoding $content\n"; - - if($content eq 'ALREADYDONE') { - # It's already been handled. Check for errors. - if(! $self->{'encoding_command_statuses'} ) { - DEBUG > 2 and print " CRAZY ERROR: It wasn't really handled?!\n"; - } elsif( $self->{'encoding_command_statuses'}[-1] ) { - $self->whine( $para->[1]{'start_line'}, - sprintf "Couldn't do %s: %s", - $self->{'encoding_command_reqs' }[-1], - $self->{'encoding_command_statuses'}[-1], - ); - } else { - DEBUG > 2 and print " (Yup, it was successfully handled already.)\n"; - } - - } else { - # Otherwise it's a syntax error - $self->whine( $para->[1]{'start_line'}, - "Invalid =encoding syntax: $content" - ); - } - - return; -} - -#~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~` - -{ -my $m = -321; # magic line number - -sub _gen_errata { - my $self = $_[0]; - # Return 0 or more fake-o paragraphs explaining the accumulated - # errors on this document. - - return() unless $self->{'errata'} and keys %{$self->{'errata'}}; - - my @out; - - foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) { - push @out, - ['=item', {'start_line' => $m}, "Around line $line:"], - map( ['~Para', {'start_line' => $m, '~cooked' => 1}, - #['~Top', {'start_line' => $m}, - $_ - #] - ], - @{$self->{'errata'}{$line}} - ) - ; - } - - # TODO: report of unknown entities? unrenderable characters? - - unshift @out, - ['=head1', {'start_line' => $m, 'errata' => 1}, 'POD ERRORS'], - ['~Para', {'start_line' => $m, '~cooked' => 1, 'errata' => 1}, - "Hey! ", - ['B', {}, - 'The above document had some coding errors, which are explained below:' - ] - ], - ['=over', {'start_line' => $m, 'errata' => 1}, ''], - ; - - push @out, - ['=back', {'start_line' => $m, 'errata' => 1}, ''], - ; - - DEBUG and print "\n<<\n", pretty(\@out), "\n>>\n\n"; - - return @out; -} - -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -############################################################################## -## -## stop reading now stop reading now stop reading now stop reading now stop -## -## HERE IT BECOMES REALLY SCARY -## -## stop reading now stop reading now stop reading now stop reading now stop -## -############################################################################## - -sub _ponder_paragraph_buffer { - - # Para-token types as found in the buffer. - # ~Verbatim, ~Para, ~end, =head1..4, =for, =begin, =end, - # =over, =back, =item - # and the null =pod (to be complained about if over one line) - # - # "~data" paragraphs are something we generate at this level, depending on - # a currently open =over region - - # Events fired: Begin and end for: - # directivename (like head1 .. head4), item, extend, - # for (from =begin...=end, =for), - # over-bullet, over-number, over-text, over-block, - # item-bullet, item-number, item-text, - # Document, - # Data, Para, Verbatim - # B, C, longdirname (TODO -- wha?), etc. for all directives - # - - my $self = $_[0]; - my $paras; - return unless @{$paras = $self->{'paras'}}; - my $curr_open = ($self->{'curr_open'} ||= []); - - my $scratch; - - DEBUG > 10 and print "# Paragraph buffer: <<", pretty($paras), ">>\n"; - - # We have something in our buffer. So apparently the document has started. - unless($self->{'doc_has_started'}) { - $self->{'doc_has_started'} = 1; - - my $starting_contentless; - $starting_contentless = - ( - !@$curr_open - and @$paras and ! grep $_->[0] ne '~end', @$paras - # i.e., if the paras is all ~ends - ) - ; - DEBUG and print "# Starting ", - $starting_contentless ? 'contentless' : 'contentful', - " document\n" - ; - - $self->_handle_element_start( - ($scratch = 'Document'), - { - 'start_line' => $paras->[0][1]{'start_line'}, - $starting_contentless ? ( 'contentless' => 1 ) : (), - }, - ); - } - - my($para, $para_type); - while(@$paras) { - last if @$paras == 1 and - ( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim' - or $paras->[0][0] eq '=item' ) - ; - # Those're the three kinds of paragraphs that require lookahead. - # Actually, an "=item Foo" inside an <over type=text> region - # and any =item inside an <over type=block> region (rare) - # don't require any lookahead, but all others (bullets - # and numbers) do. - -# TODO: winge about many kinds of directives in non-resolving =for regions? -# TODO: many? like what? =head1 etc? - - $para = shift @$paras; - $para_type = $para->[0]; - - DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (", - $self->_dump_curr_open(), ")\n"; - - if($para_type eq '=for') { - next if $self->_ponder_for($para,$curr_open,$paras); - - } elsif($para_type eq '=begin') { - next if $self->_ponder_begin($para,$curr_open,$paras); - - } elsif($para_type eq '=end') { - next if $self->_ponder_end($para,$curr_open,$paras); - - } elsif($para_type eq '~end') { # The virtual end-document signal - next if $self->_ponder_doc_end($para,$curr_open,$paras); - } - - - # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - if(grep $_->[1]{'~ignore'}, @$curr_open) { - DEBUG > 1 and - print "Skipping $para_type paragraph because in ignore mode.\n"; - next; - } - #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - - if($para_type eq '=pod') { - $self->_ponder_pod($para,$curr_open,$paras); - - } elsif($para_type eq '=over') { - next if $self->_ponder_over($para,$curr_open,$paras); - - } elsif($para_type eq '=back') { - next if $self->_ponder_back($para,$curr_open,$paras); - - } else { - - # All non-magical codes!!! - - # Here we start using $para_type for our own twisted purposes, to - # mean how it should get treated, not as what the element name - # should be. - - DEBUG > 1 and print "Pondering non-magical $para_type\n"; - - my $i; - - # Enforce some =headN discipline - if($para_type =~ m/^=head\d$/s - and ! $self->{'accept_heads_anywhere'} - and @$curr_open - and $curr_open->[-1][0] eq '=over' - ) { - DEBUG > 2 and print "'=$para_type' inside an '=over'!\n"; - $self->whine( - $para->[1]{'start_line'}, - "You forgot a '=back' before '$para_type'" - ); - unshift @$paras, ['=back', {}, ''], $para; # close the =over - next; - } - - - if($para_type eq '=item') { - - my $over; - unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') { - $self->whine( - $para->[1]{'start_line'}, - "'=item' outside of any '=over'" - ); - unshift @$paras, - ['=over', {'start_line' => $para->[1]{'start_line'}}, ''], - $para - ; - next; - } - - - my $over_type = $over->[1]{'~type'}; - - if(!$over_type) { - # Shouldn't happen1 - die "Typeless over in stack, starting at line " - . $over->[1]{'start_line'}; - - } elsif($over_type eq 'block') { - unless($curr_open->[-1][1]{'~bitched_about'}) { - $curr_open->[-1][1]{'~bitched_about'} = 1; - $self->whine( - $curr_open->[-1][1]{'start_line'}, - "You can't have =items (as at line " - . $para->[1]{'start_line'} - . ") unless the first thing after the =over is an =item" - ); - } - # Just turn it into a paragraph and reconsider it - $para->[0] = '~Para'; - unshift @$paras, $para; - next; - - } elsif($over_type eq 'text') { - my $item_type = $self->_get_item_type($para); - # That kills the content of the item if it's a number or bullet. - DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; - - if($item_type eq 'text') { - # Nothing special needs doing for 'text' - } elsif($item_type eq 'number' or $item_type eq 'bullet') { - die "Unknown item type $item_type" - unless $item_type eq 'number' or $item_type eq 'bullet'; - # Undo our clobbering: - push @$para, $para->[1]{'~orig_content'}; - delete $para->[1]{'number'}; - # Only a PROPER item-number element is allowed - # to have a number attribute. - } else { - die "Unhandled item type $item_type"; # should never happen - } - - # =item-text thingies don't need any assimilation, it seems. - - } elsif($over_type eq 'number') { - my $item_type = $self->_get_item_type($para); - # That kills the content of the item if it's a number or bullet. - DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; - - my $expected_value = ++ $curr_open->[-1][1]{'~counter'}; - - if($item_type eq 'bullet') { - # Hm, it's not numeric. Correct for this. - $para->[1]{'number'} = $expected_value; - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item $expected_value'" - ); - push @$para, $para->[1]{'~orig_content'}; - # restore the bullet, blocking the assimilation of next para - - } elsif($item_type eq 'text') { - # Hm, it's not numeric. Correct for this. - $para->[1]{'number'} = $expected_value; - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item $expected_value'" - ); - # Text content will still be there and will block next ~Para - - } elsif($item_type ne 'number') { - die "Unknown item type $item_type"; # should never happen - - } elsif($expected_value == $para->[1]{'number'}) { - DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n"; - - } else { - DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'}, - " instead of the expected value of $expected_value\n"; - $self->whine( - $para->[1]{'start_line'}, - "You have '=item " . $para->[1]{'number'} . - "' instead of the expected '=item $expected_value'" - ); - $para->[1]{'number'} = $expected_value; # correcting!! - } - - if(@$para == 2) { - # For the cases where we /didn't/ push to @$para - if($paras->[0][0] eq '~Para') { - DEBUG and print "Assimilating following ~Para content into $over_type item\n"; - push @$para, splice @{shift @$paras},2; - } else { - DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; - push @$para, ''; # Just so it's not contentless - } - } - - - } elsif($over_type eq 'bullet') { - my $item_type = $self->_get_item_type($para); - # That kills the content of the item if it's a number or bullet. - DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; - - if($item_type eq 'bullet') { - # as expected! - - if( $para->[1]{'~_freaky_para_hack'} ) { - DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n"; - push @$para, delete $para->[1]{'~_freaky_para_hack'}; - } - - } elsif($item_type eq 'number') { - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item *'" - ); - push @$para, $para->[1]{'~orig_content'}; - # and block assimilation of the next paragraph - delete $para->[1]{'number'}; - # Only a PROPER item-number element is allowed - # to have a number attribute. - } elsif($item_type eq 'text') { - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item *'" - ); - # But doesn't need processing. But it'll block assimilation - # of the next para. - } else { - die "Unhandled item type $item_type"; # should never happen - } - - if(@$para == 2) { - # For the cases where we /didn't/ push to @$para - if($paras->[0][0] eq '~Para') { - DEBUG and print "Assimilating following ~Para content into $over_type item\n"; - push @$para, splice @{shift @$paras},2; - } else { - DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; - push @$para, ''; # Just so it's not contentless - } - } - - } else { - die "Unhandled =over type \"$over_type\"?"; - # Shouldn't happen! - } - - $para_type = 'Plain'; - $para->[0] .= '-' . $over_type; - # Whew. Now fall thru and process it. - - - } elsif($para_type eq '=extend') { - # Well, might as well implement it here. - $self->_ponder_extend($para); - next; # and skip - } elsif($para_type eq '=encoding') { - # Not actually acted on here, but we catch errors here. - $self->_handle_encoding_second_level($para); - - next; # and skip - } elsif($para_type eq '~Verbatim') { - $para->[0] = 'Verbatim'; - $para_type = '?Verbatim'; - } elsif($para_type eq '~Para') { - $para->[0] = 'Para'; - $para_type = '?Plain'; - } elsif($para_type eq 'Data') { - $para->[0] = 'Data'; - $para_type = '?Data'; - } elsif( $para_type =~ s/^=//s - and defined( $para_type = $self->{'accept_directives'}{$para_type} ) - ) { - DEBUG > 1 and print " Pondering known directive ${$para}[0] as $para_type\n"; - } else { - # An unknown directive! - DEBUG > 1 and printf "Unhandled directive %s (Handled: %s)\n", - $para->[0], join(' ', sort keys %{$self->{'accept_directives'}} ) - ; - $self->whine( - $para->[1]{'start_line'}, - "Unknown directive: $para->[0]" - ); - - # And maybe treat it as text instead of just letting it go? - next; - } - - if($para_type =~ s/^\?//s) { - if(! @$curr_open) { # usual case - DEBUG and print "Treating $para_type paragraph as such because stack is empty.\n"; - } else { - my @fors = grep $_->[0] eq '=for', @$curr_open; - DEBUG > 1 and print "Containing fors: ", - join(',', map $_->[1]{'target'}, @fors), "\n"; - - if(! @fors) { - DEBUG and print "Treating $para_type paragraph as such because stack has no =for's\n"; - - #} elsif(grep $_->[1]{'~resolve'}, @fors) { - #} elsif(not grep !$_->[1]{'~resolve'}, @fors) { - } elsif( $fors[-1][1]{'~resolve'} ) { - # Look to the immediately containing for - - if($para_type eq 'Data') { - DEBUG and print "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n"; - $para->[0] = 'Para'; - $para_type = 'Plain'; - } else { - DEBUG and print "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n"; - } - } else { - DEBUG and print "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n"; - $para->[0] = $para_type = 'Data'; - } - } - } - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if($para_type eq 'Plain') { - $self->_ponder_Plain($para); - } elsif($para_type eq 'Verbatim') { - $self->_ponder_Verbatim($para); - } elsif($para_type eq 'Data') { - $self->_ponder_Data($para); - } else { - die "\$para type is $para_type -- how did that happen?"; - # Shouldn't happen. - } - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - $para->[0] =~ s/^[~=]//s; - - DEBUG and print "\n", pretty($para), "\n"; - - # traverse the treelet (which might well be just one string scalar) - $self->{'content_seen'} ||= 1; - $self->_traverse_treelet_bit(@$para); - } - } - - return; -} - -########################################################################### -# The sub-ponderers... - - - -sub _ponder_for { - my ($self,$para,$curr_open,$paras) = @_; - - # Fake it out as a begin/end - my $target; - - if(grep $_->[1]{'~ignore'}, @$curr_open) { - DEBUG > 1 and print "Ignoring ignorable =for\n"; - return 1; - } - - for(my $i = 2; $i < @$para; ++$i) { - if($para->[$i] =~ s/^\s*(\S+)\s*//s) { - $target = $1; - last; - } - } - unless(defined $target) { - $self->whine( - $para->[1]{'start_line'}, - "=for without a target?" - ); - return 1; - } - DEBUG > 1 and - print "Faking out a =for $target as a =begin $target / =end $target\n"; - - $para->[0] = 'Data'; - - unshift @$paras, - ['=begin', - {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'}, - $target, - ], - $para, - ['=end', - {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'}, - $target, - ], - ; - - return 1; -} - -sub _ponder_begin { - my ($self,$para,$curr_open,$paras) = @_; - my $content = join ' ', splice @$para, 2; - $content =~ s/^\s+//s; - $content =~ s/\s+$//s; - unless(length($content)) { - $self->whine( - $para->[1]{'start_line'}, - "=begin without a target?" - ); - DEBUG and print "Ignoring targetless =begin\n"; - return 1; - } - - unless($content =~ m/^\S+$/s) { # i.e., unless it's one word - $self->whine( - $para->[1]{'start_line'}, - "'=begin' only takes one parameter, not several as in '=begin $content'" - ); - DEBUG and print "Ignoring unintelligible =begin $content\n"; - return 1; - } - - - $para->[1]{'target'} = $content; # without any ':' - - $content =~ s/^:!/!:/s; - my $neg; # whether this is a negation-match - $neg = 1 if $content =~ s/^!//s; - my $to_resolve; # whether to process formatting codes - $to_resolve = 1 if $content =~ s/^://s; - - my $dont_ignore; # whether this target matches us - - foreach my $target_name ( - split(',', $content, -1), - $neg ? () : '*' - ) { - DEBUG > 2 and - print " Considering whether =begin $content matches $target_name\n"; - next unless $self->{'accept_targets'}{$target_name}; - - DEBUG > 2 and - print " It DOES match the acceptable target $target_name!\n"; - $to_resolve = 1 - if $self->{'accept_targets'}{$target_name} eq 'force_resolve'; - $dont_ignore = 1; - $para->[1]{'target_matching'} = $target_name; - last; # stop looking at other target names - } - - if($neg) { - if( $dont_ignore ) { - $dont_ignore = ''; - delete $para->[1]{'target_matching'}; - DEBUG > 2 and print " But the leading ! means that this is a NON-match!\n"; - } else { - $dont_ignore = 1; - $para->[1]{'target_matching'} = '!'; - DEBUG > 2 and print " But the leading ! means that this IS a match!\n"; - } - } - - $para->[0] = '=for'; # Just what we happen to call these, internally - $para->[1]{'~really'} ||= '=begin'; - $para->[1]{'~ignore'} = (! $dont_ignore) || 0; - $para->[1]{'~resolve'} = $to_resolve || 0; - - DEBUG > 1 and print " Making note to ", $dont_ignore ? 'not ' : '', - "ignore contents of this region\n"; - DEBUG > 1 and $dont_ignore and print " Making note to treat contents as ", - ($to_resolve ? 'verbatim/plain' : 'data'), " paragraphs\n"; - DEBUG > 1 and print " (Stack now: ", $self->_dump_curr_open(), ")\n"; - - push @$curr_open, $para; - if(!$dont_ignore or scalar grep $_->[1]{'~ignore'}, @$curr_open) { - DEBUG > 1 and print "Ignoring ignorable =begin\n"; - } else { - $self->{'content_seen'} ||= 1; - $self->_handle_element_start((my $scratch='for'), $para->[1]); - } - - return 1; -} - -sub _ponder_end { - my ($self,$para,$curr_open,$paras) = @_; - my $content = join ' ', splice @$para, 2; - $content =~ s/^\s+//s; - $content =~ s/\s+$//s; - DEBUG and print "Ogling '=end $content' directive\n"; - - unless(length($content)) { - $self->whine( - $para->[1]{'start_line'}, - "'=end' without a target?" . ( - ( @$curr_open and $curr_open->[-1][0] eq '=for' ) - ? ( " (Should be \"=end " . $curr_open->[-1][1]{'target'} . '")' ) - : '' - ) - ); - DEBUG and print "Ignoring targetless =end\n"; - return 1; - } - - unless($content =~ m/^\S+$/) { # i.e., unless it's one word - $self->whine( - $para->[1]{'start_line'}, - "'=end $content' is invalid. (Stack: " - . $self->_dump_curr_open() . ')' - ); - DEBUG and print "Ignoring mistargetted =end $content\n"; - return 1; - } - - unless(@$curr_open and $curr_open->[-1][0] eq '=for') { - $self->whine( - $para->[1]{'start_line'}, - "=end $content without matching =begin. (Stack: " - . $self->_dump_curr_open() . ')' - ); - DEBUG and print "Ignoring mistargetted =end $content\n"; - return 1; - } - - unless($content eq $curr_open->[-1][1]{'target'}) { - $self->whine( - $para->[1]{'start_line'}, - "=end $content doesn't match =begin " - . $curr_open->[-1][1]{'target'} - . ". (Stack: " - . $self->_dump_curr_open() . ')' - ); - DEBUG and print "Ignoring mistargetted =end $content at line $para->[1]{'start_line'}\n"; - return 1; - } - - # Else it's okay to close... - if(grep $_->[1]{'~ignore'}, @$curr_open) { - DEBUG > 1 and print "Not firing any event for this =end $content because in an ignored region\n"; - # And that may be because of this to-be-closed =for region, or some - # other one, but it doesn't matter. - } else { - $curr_open->[-1][1]{'start_line'} = $para->[1]{'start_line'}; - # what's that for? - - $self->{'content_seen'} ||= 1; - $self->_handle_element_end( my $scratch = 'for' ); - } - DEBUG > 1 and print "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n"; - pop @$curr_open; - - return 1; -} - -sub _ponder_doc_end { - my ($self,$para,$curr_open,$paras) = @_; - if(@$curr_open) { # Deal with things left open - DEBUG and print "Stack is nonempty at end-document: (", - $self->_dump_curr_open(), ")\n"; - - DEBUG > 9 and print "Stack: ", pretty($curr_open), "\n"; - unshift @$paras, $self->_closers_for_all_curr_open; - # Make sure there is exactly one ~end in the parastack, at the end: - @$paras = grep $_->[0] ne '~end', @$paras; - push @$paras, $para, $para; - # We need two -- once for the next cycle where we - # generate errata, and then another to be at the end - # when that loop back around to process the errata. - return 1; - - } else { - DEBUG and print "Okay, stack is empty now.\n"; - } - - # Try generating errata section, if applicable - unless($self->{'~tried_gen_errata'}) { - $self->{'~tried_gen_errata'} = 1; - my @extras = $self->_gen_errata(); - if(@extras) { - unshift @$paras, @extras; - DEBUG and print "Generated errata... relooping...\n"; - return 1; # I.e., loop around again to process these fake-o paragraphs - } - } - - splice @$paras; # Well, that's that for this paragraph buffer. - DEBUG and print "Throwing end-document event.\n"; - - $self->_handle_element_end( my $scratch = 'Document' ); - return 1; # Hasta la byebye -} - -sub _ponder_pod { - my ($self,$para,$curr_open,$paras) = @_; - $self->whine( - $para->[1]{'start_line'}, - "=pod directives shouldn't be over one line long! Ignoring all " - . (@$para - 2) . " lines of content" - ) if @$para > 3; - # Content is always ignored. - return; -} - -sub _ponder_over { - my ($self,$para,$curr_open,$paras) = @_; - return 1 unless @$paras; - my $list_type; - - if($paras->[0][0] eq '=item') { # most common case - $list_type = $self->_get_initial_item_type($paras->[0]); - - } elsif($paras->[0][0] eq '=back') { - # Ignore empty lists. TODO: make this an option? - shift @$paras; - return 1; - - } elsif($paras->[0][0] eq '~end') { - $self->whine( - $para->[1]{'start_line'}, - "=over is the last thing in the document?!" - ); - return 1; # But feh, ignore it. - } else { - $list_type = 'block'; - } - $para->[1]{'~type'} = $list_type; - push @$curr_open, $para; - # yes, we reuse the paragraph as a stack item - - my $content = join ' ', splice @$para, 2; - my $overness; - if($content =~ m/^\s*$/s) { - $para->[1]{'indent'} = 4; - } elsif($content =~ m/^\s*((?:\d*\.)?\d+)\s*$/s) { - no integer; - $para->[1]{'indent'} = $1; - if($1 == 0) { - $self->whine( - $para->[1]{'start_line'}, - "Can't have a 0 in =over $content" - ); - $para->[1]{'indent'} = 4; - } - } else { - $self->whine( - $para->[1]{'start_line'}, - "=over should be: '=over' or '=over positive_number'" - ); - $para->[1]{'indent'} = 4; - } - DEBUG > 1 and print "=over found of type $list_type\n"; - - $self->{'content_seen'} ||= 1; - $self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]); - - return; -} - -sub _ponder_back { - my ($self,$para,$curr_open,$paras) = @_; - # TODO: fire off </item-number> or </item-bullet> or </item-text> ?? - - my $content = join ' ', splice @$para, 2; - if($content =~ m/\S/) { - $self->whine( - $para->[1]{'start_line'}, - "=back doesn't take any parameters, but you said =back $content" - ); - } - - if(@$curr_open and $curr_open->[-1][0] eq '=over') { - DEBUG > 1 and print "=back happily closes matching =over\n"; - # Expected case: we're closing the most recently opened thing - #my $over = pop @$curr_open; - $self->{'content_seen'} ||= 1; - $self->_handle_element_end( my $scratch = - 'over-' . ( (pop @$curr_open)->[1]{'~type'} ) - ); - } else { - DEBUG > 1 and print "=back found without a matching =over. Stack: (", - join(', ', map $_->[0], @$curr_open), ").\n"; - $self->whine( - $para->[1]{'start_line'}, - '=back without =over' - ); - return 1; # and ignore it - } -} - -sub _ponder_item { - my ($self,$para,$curr_open,$paras) = @_; - my $over; - unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') { - $self->whine( - $para->[1]{'start_line'}, - "'=item' outside of any '=over'" - ); - unshift @$paras, - ['=over', {'start_line' => $para->[1]{'start_line'}}, ''], - $para - ; - return 1; - } - - - my $over_type = $over->[1]{'~type'}; - - if(!$over_type) { - # Shouldn't happen1 - die "Typeless over in stack, starting at line " - . $over->[1]{'start_line'}; - - } elsif($over_type eq 'block') { - unless($curr_open->[-1][1]{'~bitched_about'}) { - $curr_open->[-1][1]{'~bitched_about'} = 1; - $self->whine( - $curr_open->[-1][1]{'start_line'}, - "You can't have =items (as at line " - . $para->[1]{'start_line'} - . ") unless the first thing after the =over is an =item" - ); - } - # Just turn it into a paragraph and reconsider it - $para->[0] = '~Para'; - unshift @$paras, $para; - return 1; - - } elsif($over_type eq 'text') { - my $item_type = $self->_get_item_type($para); - # That kills the content of the item if it's a number or bullet. - DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; - - if($item_type eq 'text') { - # Nothing special needs doing for 'text' - } elsif($item_type eq 'number' or $item_type eq 'bullet') { - die "Unknown item type $item_type" - unless $item_type eq 'number' or $item_type eq 'bullet'; - # Undo our clobbering: - push @$para, $para->[1]{'~orig_content'}; - delete $para->[1]{'number'}; - # Only a PROPER item-number element is allowed - # to have a number attribute. - } else { - die "Unhandled item type $item_type"; # should never happen - } - - # =item-text thingies don't need any assimilation, it seems. - - } elsif($over_type eq 'number') { - my $item_type = $self->_get_item_type($para); - # That kills the content of the item if it's a number or bullet. - DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; - - my $expected_value = ++ $curr_open->[-1][1]{'~counter'}; - - if($item_type eq 'bullet') { - # Hm, it's not numeric. Correct for this. - $para->[1]{'number'} = $expected_value; - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item $expected_value'" - ); - push @$para, $para->[1]{'~orig_content'}; - # restore the bullet, blocking the assimilation of next para - - } elsif($item_type eq 'text') { - # Hm, it's not numeric. Correct for this. - $para->[1]{'number'} = $expected_value; - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item $expected_value'" - ); - # Text content will still be there and will block next ~Para - - } elsif($item_type ne 'number') { - die "Unknown item type $item_type"; # should never happen - - } elsif($expected_value == $para->[1]{'number'}) { - DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n"; - - } else { - DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'}, - " instead of the expected value of $expected_value\n"; - $self->whine( - $para->[1]{'start_line'}, - "You have '=item " . $para->[1]{'number'} . - "' instead of the expected '=item $expected_value'" - ); - $para->[1]{'number'} = $expected_value; # correcting!! - } - - if(@$para == 2) { - # For the cases where we /didn't/ push to @$para - if($paras->[0][0] eq '~Para') { - DEBUG and print "Assimilating following ~Para content into $over_type item\n"; - push @$para, splice @{shift @$paras},2; - } else { - DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; - push @$para, ''; # Just so it's not contentless - } - } - - - } elsif($over_type eq 'bullet') { - my $item_type = $self->_get_item_type($para); - # That kills the content of the item if it's a number or bullet. - DEBUG and print " Item is of type ", $para->[0], " under $over_type\n"; - - if($item_type eq 'bullet') { - # as expected! - - if( $para->[1]{'~_freaky_para_hack'} ) { - DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n"; - push @$para, delete $para->[1]{'~_freaky_para_hack'}; - } - - } elsif($item_type eq 'number') { - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item *'" - ); - push @$para, $para->[1]{'~orig_content'}; - # and block assimilation of the next paragraph - delete $para->[1]{'number'}; - # Only a PROPER item-number element is allowed - # to have a number attribute. - } elsif($item_type eq 'text') { - $self->whine( - $para->[1]{'start_line'}, - "Expected '=item *'" - ); - # But doesn't need processing. But it'll block assimilation - # of the next para. - } else { - die "Unhandled item type $item_type"; # should never happen - } - - if(@$para == 2) { - # For the cases where we /didn't/ push to @$para - if($paras->[0][0] eq '~Para') { - DEBUG and print "Assimilating following ~Para content into $over_type item\n"; - push @$para, splice @{shift @$paras},2; - } else { - DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n"; - push @$para, ''; # Just so it's not contentless - } - } - - } else { - die "Unhandled =over type \"$over_type\"?"; - # Shouldn't happen! - } - $para->[0] .= '-' . $over_type; - - return; -} - -sub _ponder_Plain { - my ($self,$para) = @_; - DEBUG and print " giving plain treatment...\n"; - unless( @$para == 2 or ( @$para == 3 and $para->[2] eq '' ) - or $para->[1]{'~cooked'} - ) { - push @$para, - @{$self->_make_treelet( - join("\n", splice(@$para, 2)), - $para->[1]{'start_line'} - )}; - } - # Empty paragraphs don't need a treelet for any reason I can see. - # And precooked paragraphs already have a treelet. - return; -} - -sub _ponder_Verbatim { - my ($self,$para) = @_; - DEBUG and print " giving verbatim treatment...\n"; - - $para->[1]{'xml:space'} = 'preserve'; - for(my $i = 2; $i < @$para; $i++) { - foreach my $line ($para->[$i]) { # just for aliasing - while( $line =~ - # Sort of adapted from Text::Tabs -- yes, it's hardwired in that - # tabs are at every EIGHTH column. For portability, it has to be - # one setting everywhere, and 8th wins. - s/^([^\t]*)(\t+)/$1.(" " x ((length($2)<<3)-(length($1)&7)))/e - ) {} - - # TODO: whinge about (or otherwise treat) unindented or overlong lines - - } - } - - # Now the VerbatimFormatted hoodoo... - if( $self->{'accept_codes'} and - $self->{'accept_codes'}{'VerbatimFormatted'} - ) { - while(@$para > 3 and $para->[-1] !~ m/\S/) { pop @$para } - # Kill any number of terminal newlines - $self->_verbatim_format($para); - } elsif ($self->{'codes_in_verbatim'}) { - push @$para, - @{$self->_make_treelet( - join("\n", splice(@$para, 2)), - $para->[1]{'start_line'}, $para->[1]{'xml:space'} - )}; - $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines - } else { - push @$para, join "\n", splice(@$para, 2) if @$para > 3; - $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines - } - return; -} - -sub _ponder_Data { - my ($self,$para) = @_; - DEBUG and print " giving data treatment...\n"; - $para->[1]{'xml:space'} = 'preserve'; - push @$para, join "\n", splice(@$para, 2) if @$para > 3; - return; -} - - - - -########################################################################### - -sub _traverse_treelet_bit { # for use only by the routine above - my($self, $name) = splice @_,0,2; - - my $scratch; - $self->_handle_element_start(($scratch=$name), shift @_); - - foreach my $x (@_) { - if(ref($x)) { - &_traverse_treelet_bit($self, @$x); - } else { - $self->_handle_text($x); - } - } - - $self->_handle_element_end($scratch=$name); - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _closers_for_all_curr_open { - my $self = $_[0]; - my @closers; - foreach my $still_open (@{ $self->{'curr_open'} || return }) { - my @copy = @$still_open; - $copy[1] = {%{ $copy[1] }}; - #$copy[1]{'start_line'} = -1; - if($copy[0] eq '=for') { - $copy[0] = '=end'; - } elsif($copy[0] eq '=over') { - $copy[0] = '=back'; - } else { - die "I don't know how to auto-close an open $copy[0] region"; - } - - unless( @copy > 2 ) { - push @copy, $copy[1]{'target'}; - $copy[-1] = '' unless defined $copy[-1]; - # since =over's don't have targets - } - - DEBUG and print "Queuing up fake-o event: ", pretty(\@copy), "\n"; - unshift @closers, \@copy; - } - return @closers; -} - -#-------------------------------------------------------------------------- - -sub _verbatim_format { - my($it, $p) = @_; - - my $formatting; - - for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines - DEBUG and print "_verbatim_format appends a newline to $i: $p->[$i]\n"; - $p->[$i] .= "\n"; - # Unlike with simple Verbatim blocks, we don't end up just doing - # a join("\n", ...) on the contents, so we have to append a - # newline to ever line, and then nix the last one later. - } - - if( DEBUG > 4 ) { - print "<<\n"; - for(my $i = $#$p; $i >= 2; $i--) { # work backwards over the lines - print "_verbatim_format $i: $p->[$i]"; - } - print ">>\n"; - } - - for(my $i = $#$p; $i > 2; $i--) { - # work backwards over the lines, except the first (#2) - - #next unless $p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s - # and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s; - # look at a formatty line preceding a nonformatty one - DEBUG > 5 and print "Scrutinizing line $i: $$p[$i]\n"; - if($p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s) { - DEBUG > 5 and print " It's a formatty line. ", - "Peeking at previous line ", $i-1, ": $$p[$i-1]: \n"; - - if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) { - DEBUG > 5 and print " Previous line is formatty! Skipping this one.\n"; - next; - } else { - DEBUG > 5 and print " Previous line is non-formatty! Yay!\n"; - } - } else { - DEBUG > 5 and print " It's not a formatty line. Ignoring\n"; - next; - } - - # A formatty line has to have #: in the first two columns, and uses - # "^" to mean bold, "/" to mean underline, and "%" to mean bold italic. - # Example: - # What do you want? i like pie. [or whatever] - # #:^^^^^^^^^^^^^^^^^ ///////////// - - - DEBUG > 4 and print "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n"; - - $formatting = ' ' . $1; - $formatting =~ s/\s+$//s; # nix trailing whitespace - unless(length $formatting and $p->[$i-1] =~ m/\S/) { # no-op - splice @$p,$i,1; # remove this line - $i--; # don't consider next line - next; - } - - if( length($formatting) >= length($p->[$i-1]) ) { - $formatting = substr($formatting, 0, length($p->[$i-1]) - 1) . ' '; - } else { - $formatting .= ' ' x (length($p->[$i-1]) - length($formatting)); - } - # Make $formatting and the previous line be exactly the same length, - # with $formatting having a " " as the last character. - - DEBUG > 4 and print "Formatting <$formatting> on <", $p->[$i-1], ">\n"; - - - my @new_line; - while( $formatting =~ m{\G(( +)|(\^+)|(\/+)|(\%+))}g ) { - #print "Format matches $1\n"; - - if($2) { - #print "SKIPPING <$2>\n"; - push @new_line, - substr($p->[$i-1], pos($formatting)-length($1), length($1)); - } else { - #print "SNARING $+\n"; - push @new_line, [ - ( - $3 ? 'VerbatimB' : - $4 ? 'VerbatimI' : - $5 ? 'VerbatimBI' : die("Should never get called") - ), {}, - substr($p->[$i-1], pos($formatting)-length($1), length($1)) - ]; - #print "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n"; - } - } - my @nixed = - splice @$p, $i-1, 2, @new_line; # replace myself and the next line - DEBUG > 10 and print "Nixed count: ", scalar(@nixed), "\n"; - - DEBUG > 6 and print "New version of the above line is these tokens (", - scalar(@new_line), "):", - map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n"; - $i--; # So the next line we scrutinize is the line before the one - # that we just went and formatted - } - - $p->[0] = 'VerbatimFormatted'; - - # Collapse adjacent text nodes, just for kicks. - for( my $i = 2; $i > $#$p; $i++ ) { # work forwards over the tokens except for the last - if( !ref($p->[$i]) and !ref($p->[$i + 1]) ) { - DEBUG > 5 and print "_verbatim_format merges {$p->[$i]} and {$p->[$i+1]}\n"; - $p->[$i] .= splice @$p, $i+1, 1; # merge - --$i; # and back up - } - } - - # Now look for the last text token, and remove the terminal newline - for( my $i = $#$p; $i >= 2; $i-- ) { - # work backwards over the tokens, even the first - if( !ref($p->[$i]) ) { - if($p->[$i] =~ s/\n$//s) { - DEBUG > 5 and print "_verbatim_format killed the terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]}\n"; - } else { - DEBUG > 5 and print - "No terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]} !?\n"; - } - last; # we only want the next one - } - } - - return; -} - - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - - -sub _treelet_from_formatting_codes { - # Given a paragraph, returns a treelet. Full of scary tokenizing code. - # Like [ '~Top', {'start_line' => $start_line}, - # "I like ", - # [ 'B', {}, "pie" ], - # "!" - # ] - - my($self, $para, $start_line, $preserve_space) = @_; - - my $treelet = ['~Top', {'start_line' => $start_line},]; - - unless ($preserve_space || $self->{'preserve_whitespace'}) { - $para =~ s/\. /\.\xA0 /g if $self->{'fullstop_space_harden'}; - - $para =~ s/\s+/ /g; # collapse and trim all whitespace first. - $para =~ s/ $//; - $para =~ s/^ //; - } - - # Only apparent problem the above code is that N<< >> turns into - # N<< >>. But then, word wrapping does that too! So don't do that! - - my @stack; - my @lineage = ($treelet); - - DEBUG > 4 and print "Paragraph:\n$para\n\n"; - - # Here begins our frightening tokenizer RE. The following regex matches - # text in four main parts: - # - # * Start-codes. The first alternative matches C< or C<<, the latter - # followed by some whitespace. $1 will hold the entire start code - # (including any space following a multiple-angle-bracket delimiter), - # and $2 will hold only the additional brackets past the first in a - # multiple-bracket delimiter. length($2) + 1 will be the number of - # closing brackets we have to find. - # - # * Closing brackets. Match some amount of whitespace followed by - # multiple close brackets. The logic to see if this closes anything - # is down below. Note that in order to parse C<< >> correctly, we - # have to use look-behind (?<=\s\s), since the match of the starting - # code will have consumed the whitespace. - # - # * A single closing bracket, to close a simple code like C<>. - # - # * Something that isn't a start or end code. We have to be careful - # about accepting whitespace, since perlpodspec says that any whitespace - # before a multiple-bracket closing delimiter should be ignored. - # - while($para =~ - m/\G - (?: - # Match starting codes, including the whitespace following a - # multiple-delimiter start code. $1 gets the whole start code and - # $2 gets all but one of the <s in the multiple-bracket case. - ([A-Z]<(?:(<+)\s+)?) - | - # Match multiple-bracket end codes. $3 gets the whitespace that - # should be discarded before an end bracket but kept in other cases - # and $4 gets the end brackets themselves. - (\s+|(?<=\s\s))(>{2,}) - | - (\s?>) # $5: simple end-codes - | - ( # $6: stuff containing no start-codes or end-codes - (?: - [^A-Z\s>] - | - (?: - [A-Z](?!<) - ) - | - (?: - \s(?!\s*>) - ) - )+ - ) - ) - /xgo - ) { - DEBUG > 4 and print "\nParagraphic tokenstack = (@stack)\n"; - if(defined $1) { - if(defined $2) { - DEBUG > 3 and print "Found complex start-text code \"$1\"\n"; - push @stack, length($2) + 1; - # length of the necessary complex end-code string - } else { - DEBUG > 3 and print "Found simple start-text code \"$1\"\n"; - push @stack, 0; # signal that we're looking for simple - } - push @lineage, [ substr($1,0,1), {}, ]; # new node object - push @{ $lineage[-2] }, $lineage[-1]; - - } elsif(defined $4) { - DEBUG > 3 and print "Found apparent complex end-text code \"$3$4\"\n"; - # This is where it gets messy... - if(! @stack) { - # We saw " >>>>" but needed nothing. This is ALL just stuff then. - DEBUG > 4 and print " But it's really just stuff.\n"; - push @{ $lineage[-1] }, $3, $4; - next; - } elsif(!$stack[-1]) { - # We saw " >>>>" but needed only ">". Back pos up. - DEBUG > 4 and print " And that's more than we needed to close simple.\n"; - push @{ $lineage[-1] }, $3; # That was a for-real space, too. - pos($para) = pos($para) - length($4) + 1; - } elsif($stack[-1] == length($4)) { - # We found " >>>>", and it was exactly what we needed. Commonest case. - DEBUG > 4 and print " And that's exactly what we needed to close complex.\n"; - } elsif($stack[-1] < length($4)) { - # We saw " >>>>" but needed only " >>". Back pos up. - DEBUG > 4 and print " And that's more than we needed to close complex.\n"; - pos($para) = pos($para) - length($4) + $stack[-1]; - } else { - # We saw " >>>>" but needed " >>>>>>". So this is all just stuff! - DEBUG > 4 and print " But it's really just stuff, because we needed more.\n"; - push @{ $lineage[-1] }, $3, $4; - next; - } - #print "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n"; - - push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] }; - # Keep the element from being childless - - pop @stack; - pop @lineage; - - } elsif(defined $5) { - DEBUG > 3 and print "Found apparent simple end-text code \"$4\"\n"; - - if(@stack and ! $stack[-1]) { - # We're indeed expecting a simple end-code - DEBUG > 4 and print " It's indeed an end-code.\n"; - - if(length($5) == 2) { # There was a space there: " >" - push @{ $lineage[-1] }, ' '; - } elsif( 2 == @{ $lineage[-1] } ) { # Closing a childless element - push @{ $lineage[-1] }, ''; # keep it from being really childless - } - - pop @stack; - pop @lineage; - } else { - DEBUG > 4 and print " It's just stuff.\n"; - push @{ $lineage[-1] }, $5; - } - - } elsif(defined $6) { - DEBUG > 3 and print "Found stuff \"$6\"\n"; - push @{ $lineage[-1] }, $6; - - } else { - # should never ever ever ever happen - DEBUG and print "AYYAYAAAAA at line ", __LINE__, "\n"; - die "SPORK 512512!"; - } - } - - if(@stack) { # Uhoh, some sequences weren't closed. - my $x= "..."; - while(@stack) { - push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] }; - # Hmmmmm! - - my $code = (pop @lineage)->[0]; - my $ender_length = pop @stack; - if($ender_length) { - --$ender_length; - $x = $code . ("<" x $ender_length) . " $x " . (">" x $ender_length); - } else { - $x = $code . "<$x>"; - } - } - DEBUG > 1 and print "Unterminated $x sequence\n"; - $self->whine($start_line, - "Unterminated $x sequence", - ); - } - - return $treelet; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub text_content_of_treelet { # method: $parser->text_content_of_treelet($lol) - return stringify_lol($_[1]); -} - -sub stringify_lol { # function: stringify_lol($lol) - my $string_form = ''; - _stringify_lol( $_[0] => \$string_form ); - return $string_form; -} - -sub _stringify_lol { # the real recursor - my($lol, $to) = @_; - use UNIVERSAL (); - for(my $i = 2; $i < @$lol; ++$i) { - if( ref($lol->[$i] || '') and UNIVERSAL::isa($lol->[$i], 'ARRAY') ) { - _stringify_lol( $lol->[$i], $to); # recurse! - } else { - $$to .= $lol->[$i]; - } - } - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _dump_curr_open { # return a string representation of the stack - my $curr_open = $_[0]{'curr_open'}; - - return '[empty]' unless @$curr_open; - return join '; ', - map {; - ($_->[0] eq '=for') - ? ( ($_->[1]{'~really'} || '=over') - . ' ' . $_->[1]{'target'}) - : $_->[0] - } - @$curr_open - ; -} - -########################################################################### -my %pretty_form = ( - "\a" => '\a', # ding! - "\b" => '\b', # BS - "\e" => '\e', # ESC - "\f" => '\f', # FF - "\t" => '\t', # tab - "\cm" => '\cm', - "\cj" => '\cj', - "\n" => '\n', # probably overrides one of either \cm or \cj - '"' => '\"', - '\\' => '\\\\', - '$' => '\\$', - '@' => '\\@', - '%' => '\\%', - '#' => '\\#', -); - -sub pretty { # adopted from Class::Classless - # Not the most brilliant routine, but passable. - # Don't give it a cyclic data structure! - my @stuff = @_; # copy - my $x; - my $out = - # join ",\n" . - join ", ", - map {; - if(!defined($_)) { - "undef"; - } elsif(ref($_) eq 'ARRAY' or ref($_) eq 'Pod::Simple::LinkSection') { - $x = "[ " . pretty(@$_) . " ]" ; - $x; - } elsif(ref($_) eq 'SCALAR') { - $x = "\\" . pretty($$_) ; - $x; - } elsif(ref($_) eq 'HASH') { - my $hr = $_; - $x = "{" . join(", ", - map(pretty($_) . '=>' . pretty($hr->{$_}), - sort keys %$hr ) ) . "}" ; - $x; - } elsif(!length($_)) { q{''} # empty string - } elsif( - $_ eq '0' # very common case - or( - m/^-?(?:[123456789]\d*|0)(?:\.\d+)?$/s - and $_ ne '-0' # the strange case that that RE lets thru - ) - ) { $_; - } else { - if( chr(65) eq 'A' ) { - s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> - #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg; - <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg; - } else { - # We're in some crazy non-ASCII world! - s<([^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])> - #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg; - <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg; - } - qq{"$_"}; - } - } @stuff; - # $out =~ s/\n */ /g if length($out) < 75; - return $out; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -# A rather unsubtle method of blowing away all the state information -# from a parser object so it can be reused. Provided as a utility for -# backward compatibilty in Pod::Man, etc. but not recommended for -# general use. - -sub reinit { - my $self = shift; - foreach (qw(source_dead source_filename doc_has_started -start_of_pod_block content_seen last_was_blank paras curr_open -line_count pod_para_count in_pod ~tried_gen_errata errata errors_seen -Title)) { - - delete $self->{$_}; - } -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -1; - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Checker.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Checker.pm deleted file mode 100644 index 0d01f50ec2f..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Checker.pm +++ /dev/null @@ -1,171 +0,0 @@ - -# A quite dimwitted pod2plaintext that need only know how to format whatever -# text comes out of Pod::BlackBox's _gen_errata - -require 5; -package Pod::Simple::Checker; -use strict; -use Carp (); -use Pod::Simple::Methody (); -use Pod::Simple (); -use vars qw( @ISA $VERSION ); -$VERSION = '2.02'; -@ISA = ('Pod::Simple::Methody'); -BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) - ? \&Pod::Simple::DEBUG - : sub() {0} - } - -use Text::Wrap 98.112902 (); # was 2001.0131, but I don't think we need that -$Text::Wrap::wrap = 'overflow'; -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub any_errata_seen { # read-only accessor - return $_[1]->{'Errata_seen'}; -} - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - $new->{'output_fh'} ||= *STDOUT{IO}; - $new->nix_X_codes(1); - $new->nbsp_for_S(1); - $new->{'Thispara'} = ''; - $new->{'Indent'} = 0; - $new->{'Indentstring'} = ' '; - $new->{'Errata_seen'} = 0; - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub handle_text { $_[0]{'Errata_seen'} and $_[0]{'Thispara'} .= $_[1] } - -sub start_Para { $_[0]{'Thispara'} = '' } - -sub start_head1 { - if($_[0]{'Errata_seen'}) { - $_[0]{'Thispara'} = ''; - } else { - if($_[1]{'errata'}) { # start of errata! - $_[0]{'Errata_seen'} = 1; - $_[0]{'Thispara'} = $_[0]{'source_filename'} ? - "$_[0]{'source_filename'} -- " : '' - } - } -} -sub start_head2 { $_[0]{'Thispara'} = '' } -sub start_head3 { $_[0]{'Thispara'} = '' } -sub start_head4 { $_[0]{'Thispara'} = '' } - -sub start_Verbatim { $_[0]{'Thispara'} = '' } -sub start_item_bullet { $_[0]{'Thispara'} = '* ' } -sub start_item_number { $_[0]{'Thispara'} = "$_[1]{'number'}. " } -sub start_item_text { $_[0]{'Thispara'} = '' } - -sub start_over_bullet { ++$_[0]{'Indent'} } -sub start_over_number { ++$_[0]{'Indent'} } -sub start_over_text { ++$_[0]{'Indent'} } -sub start_over_block { ++$_[0]{'Indent'} } - -sub end_over_bullet { --$_[0]{'Indent'} } -sub end_over_number { --$_[0]{'Indent'} } -sub end_over_text { --$_[0]{'Indent'} } -sub end_over_block { --$_[0]{'Indent'} } - - -# . . . . . Now the actual formatters: - -sub end_head1 { $_[0]->emit_par(-4) } -sub end_head2 { $_[0]->emit_par(-3) } -sub end_head3 { $_[0]->emit_par(-2) } -sub end_head4 { $_[0]->emit_par(-1) } -sub end_Para { $_[0]->emit_par( 0) } -sub end_item_bullet { $_[0]->emit_par( 0) } -sub end_item_number { $_[0]->emit_par( 0) } -sub end_item_text { $_[0]->emit_par(-2) } - -sub emit_par { - return unless $_[0]{'Errata_seen'}; - my($self, $tweak_indent) = splice(@_,0,2); - my $indent = ' ' x ( 2 * $self->{'Indent'} + ($tweak_indent||0) ); - # Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0 - - $self->{'Thispara'} =~ tr{\xAD}{}d if Pod::Simple::ASCII; - my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n"); - $out =~ tr{\xA0}{ } if Pod::Simple::ASCII; - print {$self->{'output_fh'}} $out, - #"\n" - ; - $self->{'Thispara'} = ''; - - return; -} - -# . . . . . . . . . . And then off by its lonesome: - -sub end_Verbatim { - return unless $_[0]{'Errata_seen'}; - my $self = shift; - if(Pod::Simple::ASCII) { - $self->{'Thispara'} =~ tr{\xA0}{ }; - $self->{'Thispara'} =~ tr{\xAD}{}d; - } - - my $i = ' ' x ( 2 * $self->{'Indent'} + 4); - - $self->{'Thispara'} =~ s/^/$i/mg; - - print { $self->{'output_fh'} } '', - $self->{'Thispara'}, - "\n\n" - ; - $self->{'Thispara'} = ''; - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -1; - -__END__ - -=head1 NAME - -Pod::Simple::Checker -- check the Pod syntax of a document - -=head1 SYNOPSIS - - perl -MPod::Simple::Checker -e \ - "exit Pod::Simple::Checker->filter(shift)->any_errata_seen" \ - thingy.pod - -=head1 DESCRIPTION - -This class is for checking the syntactic validity of Pod. -It works by basically acting like a simple-minded version of -L<Pod::Simple::Text> that formats only the "Pod Errors" section -(if Pod::Simple even generates one for the given document). - -This is a subclass of L<Pod::Simple> and inherits all its methods. - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Checker> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Debug.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Debug.pm deleted file mode 100644 index b00e58daba8..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Debug.pm +++ /dev/null @@ -1,151 +0,0 @@ - -require 5; -package Pod::Simple::Debug; -use strict; - -sub import { - my($value,$variable); - - if(@_ == 2) { - $value = $_[1]; - } elsif(@_ == 3) { - ($variable, $value) = @_[1,2]; - - ($variable, $value) = ($value, $variable) - if defined $value and ref($value) eq 'SCALAR' - and not(defined $variable and ref($variable) eq 'SCALAR') - ; # tolerate getting it backwards - - unless( defined $variable and ref($variable) eq 'SCALAR') { - require Carp; - Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor" - . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting"); - } - } else { - require Carp; - Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor" - . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting"); - } - - if( defined &Pod::Simple::DEBUG ) { - require Carp; - Carp::croak("It's too late to call Pod::Simple::Debug -- " - . "Pod::Simple has already loaded\nAborting"); - } - - $value = 0 unless defined $value; - - unless($value =~ m/^-?\d+$/) { - require Carp; - Carp::croak( "$value isn't a numeric value." - . "\nUsage:\n use Pod::Simple::Debug (NUMVAL)\nor" - . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting"); - } - - if( defined $variable ) { - # make a not-really-constant - *Pod::Simple::DEBUG = sub () { $$variable } ; - $$variable = $value; - print "# Starting Pod::Simple::DEBUG = non-constant $variable with val $value\n"; - } else { - *Pod::Simple::DEBUG = eval " sub () { $value } "; - print "# Starting Pod::Simple::DEBUG = $value\n"; - } - - require Pod::Simple; - return; -} - -1; - - -__END__ - -=head1 NAME - -Pod::Simple::Debug -- put Pod::Simple into trace/debug mode - -=head1 SYNOPSIS - - use Pod::Simple::Debug (5); # or some integer - -Or: - - my $debuglevel; - use Pod::Simple::Debug (\$debuglevel, 0); - ...some stuff that uses Pod::Simple to do stuff, but which - you don't want debug output from... - - $debug_level = 4; - ...some stuff that uses Pod::Simple to do stuff, but which - you DO want debug output from... - - $debug_level = 0; - -=head1 DESCRIPTION - -This is an internal module for controlling the debug level (a.k.a. trace -level) of Pod::Simple. This is of interest only to Pod::Simple -developers. - - -=head1 CAVEATS - -Note that you should load this module I<before> loading Pod::Simple (or -any Pod::Simple-based class). If you try loading Pod::Simple::Debug -after &Pod::Simple::DEBUG is already defined, Pod::Simple::Debug will -throw a fatal error to the effect that -"it's s too late to call Pod::Simple::Debug". - -Note that the C<use Pod::Simple::Debug (\$x, I<somenum>)> mode will make -Pod::Simple (et al) run rather slower, since &Pod::Simple::DEBUG won't -be a constant sub anymore, and so Pod::Simple (et al) won't compile with -constant-folding. - - -=head1 GUTS - -Doing this: - - use Pod::Simple::Debug (5); # or some integer - -is basically equivalent to: - - BEGIN { sub Pod::Simple::DEBUG () {5} } # or some integer - use Pod::Simple (); - -And this: - - use Pod::Simple::Debug (\$debug_level,0); # or some integer - -is basically equivalent to this: - - my $debug_level; - BEGIN { $debug_level = 0 } - BEGIN { sub Pod::Simple::DEBUG () { $debug_level } - use Pod::Simple (); - -=head1 SEE ALSO - -L<Pod::Simple> - -The article "Constants in Perl", in I<The Perl Journal> issue -21. See L<http://www.sysadminmag.com/tpj/issues/vol5_5/> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/DumpAsText.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/DumpAsText.pm deleted file mode 100644 index e678e42fa18..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/DumpAsText.pm +++ /dev/null @@ -1,130 +0,0 @@ - -require 5; -package Pod::Simple::DumpAsText; -$VERSION = '2.02'; -use Pod::Simple (); -BEGIN {@ISA = ('Pod::Simple')} - -use strict; - -use Carp (); - -BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - $new->{'output_fh'} ||= *STDOUT{IO}; - $new->accept_codes('VerbatimFormatted'); - return $new; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _handle_element_start { - # ($self, $element_name, $attr_hash_r) - my $fh = $_[0]{'output_fh'}; - my($key, $value); - DEBUG and print "++ $_[1]\n"; - - print $fh ' ' x ($_[0]{'indent'} || 0), "++", $_[1], "\n"; - $_[0]{'indent'}++; - while(($key,$value) = each %{$_[2]}) { - unless($key =~ m/^~/s) { - next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; - _perly_escape($key); - _perly_escape($value); - printf $fh qq{%s \\ "%s" => "%s"\n}, - ' ' x ($_[0]{'indent'} || 0), $key, $value; - } - } - return; -} - -sub _handle_text { - DEBUG and print "== \"$_[1]\"\n"; - - if(length $_[1]) { - my $indent = ' ' x $_[0]{'indent'}; - my $text = $_[1]; - _perly_escape($text); - $text =~ # A not-totally-brilliant wrapping algorithm: - s/( - [^\n]{55} # Snare some characters from a line - [^\n\ ]{0,50} # and finish any current word - ) - \x20{1,10}(?!\n) # capture some spaces not at line-end - /$1"\n$indent . "/gx # => line-break here - ; - - print {$_[0]{'output_fh'}} $indent, '* "', $text, "\"\n"; - } - return; -} - -sub _handle_element_end { - DEBUG and print "-- $_[1]\n"; - print {$_[0]{'output_fh'}} - ' ' x --$_[0]{'indent'}, "--", $_[1], "\n"; - return; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -sub _perly_escape { - foreach my $x (@_) { - $x =~ s/([^\x00-\xFF])/sprintf'\x{%X}',ord($1)/eg; - # Escape things very cautiously: - $x =~ s/([^-\n\t \&\<\>\'!\#\%\(\)\*\+,\.\/\:\;=\?\~\[\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf'\x%02X',ord($1)/eg; - } - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -1; - - -__END__ - -=head1 NAME - -Pod::Simple::DumpAsText -- dump Pod-parsing events as text - -=head1 SYNOPSIS - - perl -MPod::Simple::DumpAsText -e \ - "exit Pod::Simple::DumpAsText->filter(shift)->any_errata_seen" \ - thingy.pod - -=head1 DESCRIPTION - -This class is for dumping, as text, the events gotten from parsing a Pod -document. This class is of interest to people writing Pod formatters -based on Pod::Simple. It is useful for seeing exactly what events you -get out of some Pod that you feed in. - -This is a subclass of L<Pod::Simple> and inherits all its methods. - -=head1 SEE ALSO - -L<Pod::Simple::DumpAsXML> - -L<Pod::Simple> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/DumpAsXML.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/DumpAsXML.pm deleted file mode 100644 index fe0c1662e5d..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/DumpAsXML.pm +++ /dev/null @@ -1,146 +0,0 @@ - -require 5; -package Pod::Simple::DumpAsXML; -$VERSION = '2.02'; -use Pod::Simple (); -BEGIN {@ISA = ('Pod::Simple')} - -use strict; - -use Carp (); - -BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - $new->{'output_fh'} ||= *STDOUT{IO}; - $new->accept_codes('VerbatimFormatted'); - return $new; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _handle_element_start { - # ($self, $element_name, $attr_hash_r) - my $fh = $_[0]{'output_fh'}; - my($key, $value); - DEBUG and print "++ $_[1]\n"; - - print $fh ' ' x ($_[0]{'indent'} || 0), "<", $_[1]; - - foreach my $key (sort keys %{$_[2]}) { - unless($key =~ m/^~/s) { - next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; - _xml_escape($value = $_[2]{$key}); - print $fh ' ', $key, '="', $value, '"'; - } - } - - - print $fh ">\n"; - $_[0]{'indent'}++; - return; -} - -sub _handle_text { - DEBUG and print "== \"$_[1]\"\n"; - if(length $_[1]) { - my $indent = ' ' x $_[0]{'indent'}; - my $text = $_[1]; - _xml_escape($text); - $text =~ # A not-totally-brilliant wrapping algorithm: - s/( - [^\n]{55} # Snare some characters from a line - [^\n\ ]{0,50} # and finish any current word - ) - \x20{1,10}(?!\n) # capture some spaces not at line-end - /$1\n$indent/gx # => line-break here - ; - - print {$_[0]{'output_fh'}} $indent, $text, "\n"; - } - return; -} - -sub _handle_element_end { - DEBUG and print "-- $_[1]\n"; - print {$_[0]{'output_fh'}} - ' ' x --$_[0]{'indent'}, "</", $_[1], ">\n"; - return; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -sub _xml_escape { - foreach my $x (@_) { - # Escape things very cautiously: - $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg; - # Yes, stipulate the list without a range, so that this can work right on - # all charsets that this module happens to run under. - # Altho, hmm, what about that ord? Presumably that won't work right - # under non-ASCII charsets. Something should be done about that. - } - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -1; - -__END__ - -=head1 NAME - -Pod::Simple::DumpAsXML -- turn Pod into XML - -=head1 SYNOPSIS - - perl -MPod::Simple::DumpAsXML -e \ - "exit Pod::Simple::DumpAsXML->filter(shift)->any_errata_seen" \ - thingy.pod - -=head1 DESCRIPTION - -Pod::Simple::DumpAsXML is a subclass of L<Pod::Simple> that parses Pod -and turns it into indented and wrapped XML. This class is of -interest to people writing Pod formatters based on Pod::Simple. - -Pod::Simple::DumpAsXML inherits methods from -L<Pod::Simple>. - - -=head1 SEE ALSO - -L<Pod::Simple::XMLOutStream> is rather like this class. -Pod::Simple::XMLOutStream's output is space-padded in a way -that's better for sending to an XML processor (that is, it has -no ignoreable whitespace). But -Pod::Simple::DumpAsXML's output is much more human-readable, being -(more-or-less) one token per line, with line-wrapping. - -L<Pod::Simple::DumpAsText> is rather like this class, -except that it doesn't dump with XML syntax. Try them and see -which one you like best! - -L<Pod::Simple>, L<Pod::Simple::DumpAsXML> - -The older libraries L<Pod::PXML>, L<Pod::XML>, L<Pod::SAX> - - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTML.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTML.pm deleted file mode 100644 index c0a505d533e..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTML.pm +++ /dev/null @@ -1,889 +0,0 @@ - -require 5; -package Pod::Simple::HTML; -use strict; -use Pod::Simple::PullParser (); -use vars qw( - @ISA %Tagmap $Computerese $LamePad $Linearization_Limit $VERSION - $Perldoc_URL_Prefix $Perldoc_URL_Postfix - $Title_Prefix $Title_Postfix $HTML_EXTENSION %ToIndex - $Doctype_decl $Content_decl -); -@ISA = ('Pod::Simple::PullParser'); -$VERSION = '3.03'; - -use UNIVERSAL (); -BEGIN { - if(defined &DEBUG) { } # no-op - elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } - else { *DEBUG = sub () {0}; } -} - -$Doctype_decl ||= ''; # No. Just No. Don't even ask me for it. - # qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" - # "http://www.w3.org/TR/html4/loose.dtd">\n}; - -$Content_decl ||= - q{<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" >}; - -$HTML_EXTENSION = '.html' unless defined $HTML_EXTENSION; -$Computerese = "" unless defined $Computerese; -$LamePad = '' unless defined $LamePad; - -$Linearization_Limit = 120 unless defined $Linearization_Limit; - # headings/items longer than that won't get an <a name="..."> -$Perldoc_URL_Prefix = 'http://search.cpan.org/perldoc?' - unless defined $Perldoc_URL_Prefix; -$Perldoc_URL_Postfix = '' - unless defined $Perldoc_URL_Postfix; - -$Title_Prefix = '' unless defined $Title_Prefix; -$Title_Postfix = '' unless defined $Title_Postfix; -%ToIndex = map {; $_ => 1 } qw(head1 head2 head3 head4 ); # item-text - # 'item-text' stuff in the index doesn't quite work, and may - # not be a good idea anyhow. - - -__PACKAGE__->_accessorize( - 'perldoc_url_prefix', - # In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what - # to put before the "Foo%3a%3aBar". - # (for singleton mode only?) - 'perldoc_url_postfix', - # what to put after "Foo%3a%3aBar" in the URL. Normally "". - - 'batch_mode', # whether we're in batch mode - 'batch_mode_current_level', - # When in batch mode, how deep the current module is: 1 for "LWP", - # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc - - 'title_prefix', 'title_postfix', - # What to put before and after the title in the head. - # Should already be &-escaped - - 'html_header_before_title', - 'html_header_after_title', - 'html_footer', - - 'index', # whether to add an index at the top of each page - # (actually it's a table-of-contents, but we'll call it an index, - # out of apparently longstanding habit) - - 'html_css', # URL of CSS file to point to - 'html_javascript', # URL of CSS file to point to - - 'force_title', # should already be &-escaped - 'default_title', # should already be &-escaped -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -my @_to_accept; - -%Tagmap = ( - 'Verbatim' => "\n<pre$Computerese>", - '/Verbatim' => "</pre>\n", - 'VerbatimFormatted' => "\n<pre$Computerese>", - '/VerbatimFormatted' => "</pre>\n", - 'VerbatimB' => "<b>", - '/VerbatimB' => "</b>", - 'VerbatimI' => "<i>", - '/VerbatimI' => "</i>", - 'VerbatimBI' => "<b><i>", - '/VerbatimBI' => "</i></b>", - - - 'Data' => "\n", - '/Data' => "\n", - - 'head1' => "\n<h1>", # And also stick in an <a name="..."> - 'head2' => "\n<h2>", # '' - 'head3' => "\n<h3>", # '' - 'head4' => "\n<h4>", # '' - '/head1' => "</a></h1>\n", - '/head2' => "</a></h2>\n", - '/head3' => "</a></h3>\n", - '/head4' => "</a></h4>\n", - - 'X' => "<!--\n\tINDEX: ", - '/X' => "\n-->", - - changes(qw( - Para=p - B=b I=i - over-bullet=ul - over-number=ol - over-text=dl - over-block=blockquote - item-bullet=li - item-number=li - item-text=dt - )), - changes2( - map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ } - qw[ - sample=samp - definition=dfn - kbd=keyboard - variable=var - citation=cite - abbreviation=abbr - acronym=acronym - subscript=sub - superscript=sup - big=big - small=small - underline=u - strikethrough=s - ] # no point in providing a way to get <q>...</q>, I think - ), - - '/item-bullet' => "</li>$LamePad\n", - '/item-number' => "</li>$LamePad\n", - '/item-text' => "</a></dt>$LamePad\n", - 'item-body' => "\n<dd>", - '/item-body' => "</dd>\n", - - - 'B' => "<b>", '/B' => "</b>", - 'I' => "<i>", '/I' => "</i>", - 'F' => "<em$Computerese>", '/F' => "</em>", - 'C' => "<code$Computerese>", '/C' => "</code>", - 'L' => "<a href='YOU_SHOULD_NEVER_SEE_THIS'>", # ideally never used! - '/L' => "</a>", -); - -sub changes { - return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s - ? ( $1, => "\n<$2>", "/$1", => "</$2>\n" ) : die "Funky $_" - } @_; -} -sub changes2 { - return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s - ? ( $1, => "<$2>", "/$1", => "</$2>" ) : die "Funky $_" - } @_; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -sub go { exit Pod::Simple::HTML->parse_from_file(@ARGV) } - # Just so we can run from the command line. No options. - # For that, use perldoc! -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub new { - my $new = shift->SUPER::new(@_); - #$new->nix_X_codes(1); - $new->nbsp_for_S(1); - $new->accept_targets( 'html', 'HTML' ); - $new->accept_codes('VerbatimFormatted'); - $new->accept_codes(@_to_accept); - DEBUG > 2 and print "To accept: ", join(' ',@_to_accept), "\n"; - - $new->perldoc_url_prefix( $Perldoc_URL_Prefix ); - $new->perldoc_url_postfix( $Perldoc_URL_Postfix ); - $new->title_prefix( $Title_Prefix ); - $new->title_postfix( $Title_Postfix ); - - $new->html_header_before_title( - qq[$Doctype_decl<html><head><title>] - ); - $new->html_header_after_title( join "\n" => - "</title>", - $Content_decl, - "</head>\n<body class='pod'>", - $new->version_tag_comment, - "<!-- start doc -->\n", - ); - $new->html_footer( qq[\n<!-- end doc -->\n\n</body></html>\n] ); - - $new->{'Tagmap'} = {%Tagmap}; - return $new; -} - -sub batch_mode_page_object_init { - my($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_; - DEBUG and print "Initting $self\n for $module\n", - " in $infile\n out $outfile\n depth $depth\n"; - $self->batch_mode(1); - $self->batch_mode_current_level($depth); - return $self; -} - -sub run { - my $self = $_[0]; - return $self->do_middle if $self->bare_output; - return - $self->do_beginning && $self->do_middle && $self->do_end; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub do_beginning { - my $self = $_[0]; - - my $title; - - if(defined $self->force_title) { - $title = $self->force_title; - DEBUG and print "Forcing title to be $title\n"; - } else { - # Actually try looking for the title in the document: - $title = $self->get_short_title(); - unless($self->content_seen) { - DEBUG and print "No content seen in search for title.\n"; - return; - } - $self->{'Title'} = $title; - - if(defined $title and $title =~ m/\S/) { - $title = $self->title_prefix . esc($title) . $self->title_postfix; - } else { - $title = $self->default_title; - $title = '' unless defined $title; - DEBUG and print "Title defaults to $title\n"; - } - } - - - my $after = $self->html_header_after_title || ''; - if($self->html_css) { - my $link = - $self->html_css =~ m/</ - ? $self->html_css # It's a big blob of markup, let's drop it in - : sprintf( # It's just a URL, so let's wrap it up - qq[<link rel="stylesheet" type="text/css" title="pod_stylesheet" href="%s">\n], - $self->html_css, - ); - $after =~ s{(</head>)}{$link\n$1}i; # otherwise nevermind - } - $self->_add_top_anchor(\$after); - - if($self->html_javascript) { - my $link = - $self->html_javascript =~ m/</ - ? $self->html_javascript # It's a big blob of markup, let's drop it in - : sprintf( # It's just a URL, so let's wrap it up - qq[<script type="text/javascript" src="%s"></script>\n], - $self->html_javascript, - ); - $after =~ s{(</head>)}{$link\n$1}i; # otherwise nevermind - } - - print {$self->{'output_fh'}} - $self->html_header_before_title || '', - $title, # already escaped - $after, - ; - - DEBUG and print "Returning from do_beginning...\n"; - return 1; -} - -sub _add_top_anchor { - my($self, $text_r) = @_; - unless($$text_r and $$text_r =~ m/name=['"]___top['"]/) { # a hack - $$text_r .= "<a name='___top' class='dummyTopAnchor' ></a>\n"; - } - return; -} - -sub version_tag_comment { - my $self = shift; - return sprintf - "<!--\n generated by %s v%s,\n using %s v%s,\n under Perl v%s at %s GMT.\n\n %s\n\n-->\n", - esc( - ref($self), $self->VERSION(), $ISA[0], $ISA[0]->VERSION(), - $], scalar(gmtime), - ), $self->_modnote(), - ; -} - -sub _modnote { - my $class = ref($_[0]) || $_[0]; - return join "\n " => grep m/\S/, split "\n", - -qq{ -If you want to change this HTML document, you probably shouldn't do that -by changing it directly. Instead, see about changing the calling options -to $class, and/or subclassing $class, -then reconverting this document from the Pod source. -When in doubt, email the author of $class for advice. -See 'perldoc $class' for more info. -}; - -} - -sub do_end { - my $self = $_[0]; - print {$self->{'output_fh'}} $self->html_footer || ''; - return 1; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# Normally this would just be a call to _do_middle_main_loop -- but we -# have to do some elaborate things to emit all the content and then -# summarize it and output it /before/ the content that it's a summary of. - -sub do_middle { - my $self = $_[0]; - return $self->_do_middle_main_loop unless $self->index; - - if( $self->output_string ) { - # An efficiency hack - my $out = $self->output_string; #it's a reference to it - my $sneakytag = "\f\f\e\e\b\bIndex Here\e\e\b\b\f\f\n"; - $$out .= $sneakytag; - $self->_do_middle_main_loop; - $sneakytag = quotemeta($sneakytag); - my $index = $self->index_as_html(); - if( $$out =~ s/$sneakytag/$index/s ) { - # Expected case - DEBUG and print "Inserted ", length($index), " bytes of index HTML into $out.\n"; - } else { - DEBUG and print "Odd, couldn't find where to insert the index in the output!\n"; - # I don't think this should ever happen. - } - return 1; - } - - unless( $self->output_fh ) { - require Carp; - Carp::confess("Parser object \$p doesn't seem to have any output object! I don't know how to deal with that."); - } - - # If we get here, we're outputting to a FH. So we need to do some magic. - # Namely, divert all content to a string, which we output after the index. - my $fh = $self->output_fh; - my $content = ''; - { - # Our horrible bait and switch: - $self->output_string( \$content ); - $self->_do_middle_main_loop; - $self->abandon_output_string(); - $self->output_fh($fh); - } - print $fh $self->index_as_html(); - print $fh $content; - - return 1; -} - -########################################################################### - -sub index_as_html { - my $self = $_[0]; - # This is meant to be called AFTER the input document has been parsed! - - my $points = $self->{'PSHTML_index_points'} || []; - - @$points > 1 or return qq[<div class='indexgroupEmpty'></div>\n]; - # There's no point in having a 0-item or 1-item index, I dare say. - - my(@out) = qq{\n<div class='indexgroup'>}; - my $level = 0; - - my( $target_level, $previous_tagname, $tagname, $text, $anchorname, $indent); - foreach my $p (@$points, ['head0', '(end)']) { - ($tagname, $text) = @$p; - $anchorname = $self->section_escape($text); - if( $tagname =~ m{^head(\d+)$} ) { - $target_level = 0 + $1; - } else { # must be some kinda list item - if($previous_tagname =~ m{^head\d+$} ) { - $target_level = $level + 1; - } else { - $target_level = $level; # no change needed - } - } - - # Get to target_level by opening or closing ULs - while($level > $target_level) - { --$level; push @out, (" " x $level) . "</ul>"; } - while($level < $target_level) - { ++$level; push @out, (" " x ($level-1)) - . "<ul class='indexList indexList$level'>"; } - - $previous_tagname = $tagname; - next unless $level; - - $indent = ' ' x $level; - push @out, sprintf - "%s<li class='indexItem indexItem%s'><a href='#%s'>%s</a>", - $indent, $level, $anchorname, esc($text) - ; - } - push @out, "</div>\n"; - return join "\n", @out; -} - -########################################################################### - -sub _do_middle_main_loop { - my $self = $_[0]; - my $fh = $self->{'output_fh'}; - my $tagmap = $self->{'Tagmap'}; - - my($token, $type, $tagname, $linkto, $linktype); - my @stack; - my $dont_wrap = 0; - - while($token = $self->get_token) { - - # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if( ($type = $token->type) eq 'start' ) { - if(($tagname = $token->tagname) eq 'L') { - $linktype = $token->attr('type') || 'insane'; - - $linkto = $self->do_link($token); - - if(defined $linkto and length $linkto) { - esc($linkto); - # (Yes, SGML-escaping applies on top of %-escaping! - # But it's rarely noticeable in practice.) - print $fh qq{<a href="$linkto" class="podlink$linktype"\n>}; - } else { - print $fh "<a>"; # Yes, an 'a' element with no attributes! - } - - } elsif ($tagname eq 'item-text' or $tagname =~ m/^head\d$/s) { - print $fh $tagmap->{$tagname} || next; - - my @to_unget; - while(1) { - push @to_unget, $self->get_token; - last if $to_unget[-1]->is_end - and $to_unget[-1]->tagname eq $tagname; - - # TODO: support for X<...>'s found in here? (maybe hack into linearize_tokens) - } - - my $name = $self->linearize_tokens(@to_unget); - - print $fh "<a "; - print $fh "class='u' href='#___top' title='click to go to top of document'\n" - if $tagname =~ m/^head\d$/s; - - if(defined $name) { - my $esc = esc( $self->section_name_tidy( $name ) ); - print $fh qq[name="$esc"]; - DEBUG and print "Linearized ", scalar(@to_unget), - " tokens as \"$name\".\n"; - push @{ $self->{'PSHTML_index_points'} }, [$tagname, $name] - if $ToIndex{ $tagname }; - # Obviously, this discards all formatting codes (saving - # just their content), but ahwell. - - } else { # ludicrously long, so nevermind - DEBUG and print "Linearized ", scalar(@to_unget), - " tokens, but it was too long, so nevermind.\n"; - } - print $fh "\n>"; - $self->unget_token(@to_unget); - - } elsif ($tagname eq 'Data') { - my $next = $self->get_token; - next unless defined $next; - unless( $next->type eq 'text' ) { - $self->unget_token($next); - next; - } - DEBUG and print " raw text ", $next->text, "\n"; - printf $fh "\n" . $next->text . "\n"; - next; - - } else { - if( $tagname =~ m/^over-/s ) { - push @stack, ''; - } elsif( $tagname =~ m/^item-/s and @stack and $stack[-1] ) { - print $fh $stack[-1]; - $stack[-1] = ''; - } - print $fh $tagmap->{$tagname} || next; - ++$dont_wrap if $tagname eq 'Verbatim' or $tagname eq "VerbatimFormatted" - or $tagname eq 'X'; - } - - # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } elsif( $type eq 'end' ) { - if( ($tagname = $token->tagname) =~ m/^over-/s ) { - if( my $end = pop @stack ) { - print $fh $end; - } - } elsif( $tagname =~ m/^item-/s and @stack) { - $stack[-1] = $tagmap->{"/$tagname"}; - if( $tagname eq 'item-text' and defined(my $next = $self->get_token) ) { - $self->unget_token($next); - if( $next->type eq 'start' and $next->tagname !~ m/^item-/s ) { - print $fh $tagmap->{"/item-text"},$tagmap->{"item-body"}; - $stack[-1] = $tagmap->{"/item-body"}; - } - } - next; - } - print $fh $tagmap->{"/$tagname"} || next; - --$dont_wrap if $tagname eq 'Verbatim' or $tagname eq 'X'; - - # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } elsif( $type eq 'text' ) { - esc($type = $token->text); # reuse $type, why not - $type =~ s/([\?\!\"\'\.\,]) /$1\n/g unless $dont_wrap; - print $fh $type; - } - - } - return 1; -} - -########################################################################### -# - -sub do_link { - my($self, $token) = @_; - my $type = $token->attr('type'); - if(!defined $type) { - $self->whine("Typeless L!?", $token->attr('start_line')); - } elsif( $type eq 'pod') { return $self->do_pod_link($token); - } elsif( $type eq 'url') { return $self->do_url_link($token); - } elsif( $type eq 'man') { return $self->do_man_link($token); - } else { - $self->whine("L of unknown type $type!?", $token->attr('start_line')); - } - return 'FNORG'; # should never get called -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub do_url_link { return $_[1]->attr('to') } - -sub do_man_link { return undef } - # But subclasses are welcome to override this if they have man - # pages somewhere URL-accessible. - - -sub do_pod_link { - # And now things get really messy... - my($self, $link) = @_; - my $to = $link->attr('to'); - my $section = $link->attr('section'); - return undef unless( # should never happen - (defined $to and length $to) or - (defined $section and length $section) - ); - - $section = $self->section_escape($section) - if defined $section and length($section .= ''); # (stringify) - - DEBUG and printf "Resolving \"%s\" \"%s\"...\n", - $to || "(nil)", $section || "(nil)"; - - { - # An early hack: - my $complete_url = $self->resolve_pod_link_by_table($to, $section); - if( $complete_url ) { - DEBUG > 1 and print "resolve_pod_link_by_table(T,S) gives ", - $complete_url, "\n (Returning that.)\n"; - return $complete_url; - } else { - DEBUG > 4 and print " resolve_pod_link_by_table(T,S)", - " didn't return anything interesting.\n"; - } - } - - if(defined $to and length $to) { - # Give this routine first hack again - my $there = $self->resolve_pod_link_by_table($to); - if(defined $there and length $there) { - DEBUG > 1 - and print "resolve_pod_link_by_table(T) gives $there\n"; - } else { - $there = - $self->resolve_pod_page_link($to, $section); - # (I pass it the section value, but I don't see a - # particular reason it'd use it.) - DEBUG > 1 and print "resolve_pod_page_link gives ", $to || "(nil)", "\n"; - unless( defined $there and length $there ) { - DEBUG and print "Can't resolve $to\n"; - return undef; - } - # resolve_pod_page_link returning undef is how it - # can signal that it gives up on making a link - } - $to = $there; - } - - #DEBUG and print "So far [", $to||'nil', "] [", $section||'nil', "]\n"; - - my $out = (defined $to and length $to) ? $to : ''; - $out .= "#" . $section if defined $section and length $section; - - unless(length $out) { # sanity check - DEBUG and printf "Oddly, couldn't resolve \"%s\" \"%s\"...\n", - $to || "(nil)", $section || "(nil)"; - return undef; - } - - DEBUG and print "Resolved to $out\n"; - return $out; -} - - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -sub section_escape { - my($self, $section) = @_; - return $self->section_url_escape( - $self->section_name_tidy($section) - ); -} - -sub section_name_tidy { - my($self, $section) = @_; - $section =~ tr/ /_/; - $section =~ tr/\x00-\x1F\x80-\x9F//d if 'A' eq chr(65); # drop crazy characters - $section = $self->unicode_escape_url($section); - $section = '_' unless length $section; - return $section; -} - -sub section_url_escape { shift->general_url_escape(@_) } -sub pagepath_url_escape { shift->general_url_escape(@_) } - -sub general_url_escape { - my($self, $string) = @_; - - $string =~ s/([^\x00-\xFF])/join '', map sprintf('%%%02X',$_), unpack 'C*', $1/eg; - # express Unicode things as urlencode(utf(orig)). - - # A pretty conservative escaping, behoovey even for query components - # of a URL (see RFC 2396) - - $string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg; - # Yes, stipulate the list without a range, so that this can work right on - # all charsets that this module happens to run under. - # Altho, hmm, what about that ord? Presumably that won't work right - # under non-ASCII charsets. Something should be done - # about that, I guess? - - return $string; -} - -#-------------------------------------------------------------------------- -# -# Oh look, a yawning portal to Hell! Let's play touch football right by it! -# - -sub resolve_pod_page_link { - # resolve_pod_page_link must return a properly escaped URL - my $self = shift; - return $self->batch_mode() - ? $self->resolve_pod_page_link_batch_mode(@_) - : $self->resolve_pod_page_link_singleton_mode(@_) - ; -} - -sub resolve_pod_page_link_singleton_mode { - my($self, $it) = @_; - return undef unless defined $it and length $it; - my $url = $self->pagepath_url_escape($it); - - $url =~ s{::$}{}s; # probably never comes up anyway - $url =~ s{::}{/}g unless $self->perldoc_url_prefix =~ m/\?/s; # sane DWIM? - - return undef unless length $url; - return $self->perldoc_url_prefix . $url . $self->perldoc_url_postfix; -} - -sub resolve_pod_page_link_batch_mode { - my($self, $to) = @_; - DEBUG > 1 and print " During batch mode, resolving $to ...\n"; - my @path = grep length($_), split m/::/s, $to, -1; - unless( @path ) { # sanity - DEBUG and print "Very odd! Splitting $to gives (nil)!\n"; - return undef; - } - $self->batch_mode_rectify_path(\@path); - my $out = join('/', map $self->pagepath_url_escape($_), @path) - . $HTML_EXTENSION; - DEBUG > 1 and print " => $out\n"; - return $out; -} - -sub batch_mode_rectify_path { - my($self, $pathbits) = @_; - my $level = $self->batch_mode_current_level; - $level--; # how many levels up to go to get to the root - if($level < 1) { - unshift @$pathbits, '.'; # just to be pretty - } else { - unshift @$pathbits, ('..') x $level; - } - return; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub resolve_pod_link_by_table { - # A crazy hack to allow specifying custom L<foo> => URL mappings - - return unless $_[0]->{'podhtml_LOT'}; # An optimizy shortcut - - my($self, $to, $section) = @_; - - # TODO: add a method that actually populates podhtml_LOT from a file? - - if(defined $section) { - $to = '' unless defined $to and length $to; - return $self->{'podhtml_LOT'}{"$to#$section"}; # quite possibly undef! - } else { - return $self->{'podhtml_LOT'}{$to}; # quite possibly undef! - } - return; -} - -########################################################################### - -sub linearize_tokens { # self, tokens - my $self = shift; - my $out = ''; - - my $t; - while($t = shift @_) { - if(!ref $t or !UNIVERSAL::can($t, 'is_text')) { - $out .= $t; # a string, or some insane thing - } elsif($t->is_text) { - $out .= $t->text; - } elsif($t->is_start and $t->tag eq 'X') { - # Ignore until the end of this X<...> sequence: - my $x_open = 1; - while($x_open) { - next if( ($t = shift @_)->is_text ); - if( $t->is_start and $t->tag eq 'X') { ++$x_open } - elsif($t->is_end and $t->tag eq 'X') { --$x_open } - } - } - } - return undef if length $out > $Linearization_Limit; - return $out; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub unicode_escape_url { - my($self, $string) = @_; - $string =~ s/([^\x00-\xFF])/'('.ord($1).')'/eg; - # Turn char 1234 into "(1234)" - return $string; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -sub esc { # a function. - if(defined wantarray) { - if(wantarray) { - @_ = splice @_; # break aliasing - } else { - my $x = shift; - $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg; - return $x; - } - } - foreach my $x (@_) { - # Escape things very cautiously: - $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg - if defined $x; - # Leave out "- so that "--" won't make it thru in X-generated comments - # with text in them. - - # Yes, stipulate the list without a range, so that this can work right on - # all charsets that this module happens to run under. - # Altho, hmm, what about that ord? Presumably that won't work right - # under non-ASCII charsets. Something should be done about that. - } - return @_; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -1; -__END__ - -=head1 NAME - -Pod::Simple::HTML - convert Pod to HTML - -=head1 SYNOPSIS - - perl -MPod::Simple::HTML -e Pod::Simple::HTML::go thingy.pod - - -=head1 DESCRIPTION - -This class is for making an HTML rendering of a Pod document. - -This is a subclass of L<Pod::Simple::PullParser> and inherits all its -methods (and options). - -Note that if you want to do a batch conversion of a lot of Pod -documents to HTML, you should see the module L<Pod::Simple::HTMLBatch>. - - - -=head1 CALLING FROM THE COMMAND LINE - -TODO - - perl -MPod::Simple::HTML -e Pod::Simple::HTML::go Thing.pod Thing.html - - - -=head1 CALLING FROM PERL - -TODO make a new object, set any options, and use parse_from_file - - -=head1 METHODS - -TODO -all (most?) accessorized methods - - -=head1 SUBCLASSING - -TODO - - can just set any of: html_css html_javascript title_prefix - 'html_header_before_title', - 'html_header_after_title', - 'html_footer', - -maybe override do_pod_link - -maybe override do_beginning do_end - - - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::HTMLBatch> - - -TODO: a corpus of sample Pod input and HTML output? Or common -idioms? - - - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002-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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTMLBatch.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTMLBatch.pm deleted file mode 100644 index bce0a44b454..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTMLBatch.pm +++ /dev/null @@ -1,1342 +0,0 @@ - -require 5; -package Pod::Simple::HTMLBatch; -use strict; -use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION - $CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA -); -$VERSION = '3.02'; -@ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML! - -# TODO: nocontents stylesheets. Strike some of the color variations? - -use Pod::Simple::HTML (); -BEGIN {*esc = \&Pod::Simple::HTML::esc } -use File::Spec (); -use UNIVERSAL (); - # "Isn't the Universe an amazing place? I wouldn't live anywhere else!" - -use Pod::Simple::Search; -$SEARCH_CLASS ||= 'Pod::Simple::Search'; - -BEGIN { - if(defined &DEBUG) { } # no-op - elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } - else { *DEBUG = sub () {0}; } -} - -$SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i; -# flag to occasionally sleep for $SLEEPY - 1 seconds. - -$HTML_RENDER_CLASS ||= "Pod::Simple::HTML"; - -# -# Methods beginning with "_" are particularly internal and possibly ugly. -# - -Pod::Simple::_accessorize( __PACKAGE__, - 'verbose', # how verbose to be during batch conversion - 'html_render_class', # what class to use to render - 'contents_file', # If set, should be the name of a file (in current directory) - # to write the list of all modules to - 'index', # will set $htmlpage->index(...) to this (true or false) - 'progress', # progress object - 'contents_page_start', 'contents_page_end', - - 'css_flurry', '_css_wad', 'javascript_flurry', '_javascript_wad', - 'no_contents_links', # set to true to suppress automatic adding of << links. - '_contents', -); - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# Just so we can run from the command line more easily -sub go { - @ARGV == 2 or die sprintf( - "Usage: perl -M%s -e %s:go indirs outdir\n (or use \"\@INC\" for indirs)\n", - __PACKAGE__, __PACKAGE__, - ); - - if(defined($ARGV[1]) and length($ARGV[1])) { - my $d = $ARGV[1]; - -e $d or die "I see no output directory named \"$d\"\nAborting"; - -d $d or die "But \"$d\" isn't a directory!\nAborting"; - -w $d or die "Directory \"$d\" isn't writeable!\nAborting"; - } - - __PACKAGE__->batch_convert(@ARGV); -} -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub new { - my $new = bless {}, ref($_[0]) || $_[0]; - $new->html_render_class($HTML_RENDER_CLASS); - $new->verbose(1 + DEBUG); - $new->_contents([]); - - $new->index(1); - - $new-> _css_wad([]); $new->css_flurry(1); - $new->_javascript_wad([]); $new->javascript_flurry(1); - - $new->contents_file( - 'index' . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION) - ); - - $new->contents_page_start( join "\n", grep $_, - $Pod::Simple::HTML::Doctype_decl, - "<html><head>", - "<title>Perl Documentation</title>", - $Pod::Simple::HTML::Content_decl, - "</head>", - "\n<body class='contentspage'>\n<h1>Perl Documentation</h1>\n" - ); # override if you need a different title - - - $new->contents_page_end( sprintf( - "\n\n<p class='contentsfooty'>Generated by %s v%s under Perl v%s\n<br >At %s GMT, which is %s local time.</p>\n\n</body></html>\n", - esc( - ref($new), - eval {$new->VERSION} || $VERSION, - $], scalar(gmtime), scalar(localtime), - ))); - - return $new; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub muse { - my $self = shift; - if($self->verbose) { - print 'T+', int(time() - $self->{'_batch_start_time'}), "s: ", @_, "\n"; - } - return 1; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub batch_convert { - my($self, $dirs, $outdir) = @_; - $self ||= __PACKAGE__; # tolerate being called as an optionless function - $self = $self->new unless ref $self; # tolerate being used as a class method - - if(!defined($dirs) or $dirs eq '' or $dirs eq '@INC' ) { - $dirs = ''; - } elsif(ref $dirs) { - # OK, it's an explicit set of dirs to scan, specified as an arrayref. - } else { - # OK, it's an explicit set of dirs to scan, specified as a - # string like "/thing:/also:/whatever/perl" (":"-delim, as usual) - # or, under MSWin, like "c:/thing;d:/also;c:/whatever/perl" (";"-delim!) - require Config; - my $ps = quotemeta( $Config::Config{'path_sep'} || ":" ); - $dirs = [ grep length($_), split qr/$ps/, $dirs ]; - } - - $outdir = $self->filespecsys->curdir - unless defined $outdir and length $outdir; - - $self->_batch_convert_main($dirs, $outdir); -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _batch_convert_main { - my($self, $dirs, $outdir) = @_; - # $dirs is either false, or an arrayref. - # $outdir is a pathspec. - - $self->{'_batch_start_time'} ||= time(); - - $self->muse( "= ", scalar(localtime) ); - $self->muse( "Starting batch conversion to \"$outdir\"" ); - - my $progress = $self->progress; - if(!$progress and $self->verbose > 0 and $self->verbose() <= 5) { - require Pod::Simple::Progress; - $progress = Pod::Simple::Progress->new( - ($self->verbose < 2) ? () # Default omission-delay - : ($self->verbose == 2) ? 1 # Reduce the omission-delay - : 0 # Eliminate the omission-delay - ); - $self->progress($progress); - } - - if($dirs) { - $self->muse(scalar(@$dirs), " dirs to scan: @$dirs"); - } else { - $self->muse("Scanning \@INC. This could take a minute or two."); - } - my $mod2path = $self->find_all_pods($dirs ? $dirs : ()); - $self->muse("Done scanning."); - - my $total = keys %$mod2path; - unless($total) { - $self->muse("No pod found. Aborting batch conversion.\n"); - return $self; - } - - $progress and $progress->goal($total); - $self->muse("Now converting pod files to HTML.", - ($total > 25) ? " This will take a while more." : () - ); - - $self->_spray_css( $outdir ); - $self->_spray_javascript( $outdir ); - - $self->_do_all_batch_conversions($mod2path, $outdir); - - $progress and $progress->done(sprintf ( - "Done converting %d files.", $self->{"__batch_conv_page_count"} - )); - return $self->_batch_convert_finish($outdir); - return $self; -} - - -sub _do_all_batch_conversions { - my($self, $mod2path, $outdir) = @_; - $self->{"__batch_conv_page_count"} = 0; - - foreach my $module (sort {lc($a) cmp lc($b)} keys %$mod2path) { - $self->_do_one_batch_conversion($module, $mod2path, $outdir); - sleep($SLEEPY - 1) if $SLEEPY; - } - - return; -} - -sub _batch_convert_finish { - my($self, $outdir) = @_; - $self->write_contents_file($outdir); - $self->muse("Done with batch conversion. $$self{'__batch_conv_page_count'} files done."); - $self->muse( "= ", scalar(localtime) ); - $self->progress and $self->progress->done("All done!"); - return; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _do_one_batch_conversion { - my($self, $module, $mod2path, $outdir, $outfile) = @_; - - my $retval; - my $total = scalar keys %$mod2path; - my $infile = $mod2path->{$module}; - my @namelets = grep m/\S/, split "::", $module; - # this can stick around in the contents LoL - my $depth = scalar @namelets; - die "Contentless thingie?! $module $infile" unless @namelets; #sanity - - $outfile ||= do { - my @n = @namelets; - $n[-1] .= $HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION; - $self->filespecsys->catfile( $outdir, @n ); - }; - - my $progress = $self->progress; - - my $page = $self->html_render_class->new; - if(DEBUG > 5) { - $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: ", - ref($page), " render ($depth) $module => $outfile"); - } elsif(DEBUG > 2) { - $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: $module => $outfile") - } - - # Give each class a chance to init the converter: - - $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth) - if $page->can('batch_mode_page_object_init'); - $self->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth) - if $self->can('batch_mode_page_object_init'); - - # Now get busy... - $self->makepath($outdir => \@namelets); - - $progress and $progress->reach($self->{"__batch_conv_page_count"}, "Rendering $module"); - - if( $retval = $page->parse_from_file($infile, $outfile) ) { - ++ $self->{"__batch_conv_page_count"} ; - $self->note_for_contents_file( \@namelets, $infile, $outfile ); - } else { - $self->muse("Odd, parse_from_file(\"$infile\", \"$outfile\") returned false."); - } - - $page->batch_mode_page_object_kill($self, $module, $infile, $outfile, $depth) - if $page->can('batch_mode_page_object_kill'); - # The following isn't a typo. Note that it switches $self and $page. - $self->batch_mode_page_object_kill($page, $module, $infile, $outfile, $depth) - if $self->can('batch_mode_page_object_kill'); - - DEBUG > 4 and printf "%s %sb < $infile %s %sb\n", - $outfile, -s $outfile, $infile, -s $infile - ; - - undef($page); - return $retval; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub filespecsys { $_[0]{'_filespecsys'} || 'File::Spec' } - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub note_for_contents_file { - my($self, $namelets, $infile, $outfile) = @_; - - # I think the infile and outfile parts are never used. -- SMB - # But it's handy to have them around for debugging. - - if( $self->contents_file ) { - my $c = $self->_contents(); - push @$c, - [ join("::", @$namelets), $infile, $outfile, $namelets ] - # 0 1 2 3 - ; - DEBUG > 3 and print "Noting @$c[-1]\n"; - } - return; -} - -#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- - -sub write_contents_file { - my($self, $outdir) = @_; - my $outfile = $self->_contents_filespec($outdir) || return; - - $self->muse("Preparing list of modules for ToC"); - - my($toplevel, # maps toplevelbit => [all submodules] - $toplevel_form_freq, # ends up being 'foo' => 'Foo' - ) = $self->_prep_contents_breakdown; - - my $Contents = eval { $self->_wopen($outfile) }; - if( $Contents ) { - $self->muse( "Writing contents file $outfile" ); - } else { - warn "Couldn't write-open contents file $outfile: $!\nAbort writing to $outfile at all"; - return; - } - - $self->_write_contents_start( $Contents, $outfile, ); - $self->_write_contents_middle( $Contents, $outfile, $toplevel, $toplevel_form_freq ); - $self->_write_contents_end( $Contents, $outfile, ); - return $outfile; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _write_contents_start { - my($self, $Contents, $outfile) = @_; - my $starter = $self->contents_page_start || ''; - - { - my $css_wad = $self->_css_wad_to_markup(1); - if( $css_wad ) { - $starter =~ s{(</head>)}{\n$css_wad\n$1}i; # otherwise nevermind - } - - my $javascript_wad = $self->_javascript_wad_to_markup(1); - if( $javascript_wad ) { - $starter =~ s{(</head>)}{\n$javascript_wad\n$1}i; # otherwise nevermind - } - } - - unless(print $Contents $starter, "<dl class='superindex'>\n" ) { - warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all"; - close($Contents); - return 0; - } - return 1; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _write_contents_middle { - my($self, $Contents, $outfile, $toplevel2submodules, $toplevel_form_freq) = @_; - - foreach my $t (sort keys %$toplevel2submodules) { - my @downlines = sort {$a->[-1] cmp $b->[-1]} - @{ $toplevel2submodules->{$t} }; - - printf $Contents qq[<dt><a name="%s">%s</a></dt>\n<dd>\n], - esc( $t, $toplevel_form_freq->{$t} ) - ; - - my($path, $name); - foreach my $e (@downlines) { - $name = $e->[0]; - $path = join( "/", '.', esc( @{$e->[3]} ) ) - . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION); - print $Contents qq{ <a href="$path">}, esc($name), "</a> \n"; - } - print $Contents "</dd>\n\n"; - } - return 1; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _write_contents_end { - my($self, $Contents, $outfile) = @_; - unless( - print $Contents "</dl>\n", - $self->contents_page_end || '', - ) { - warn "Couldn't write to $outfile: $!"; - } - close($Contents) or warn "Couldn't close $outfile: $!"; - return 1; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _prep_contents_breakdown { - my($self) = @_; - my $contents = $self->_contents; - my %toplevel; # maps lctoplevelbit => [all submodules] - my %toplevel_form_freq; # ends up being 'foo' => 'Foo' - # (mapping anycase forms to most freq form) - - foreach my $entry (@$contents) { - my $toplevel = - $entry->[0] =~ m/^perl\w*$/ ? 'perl_core_docs' - # group all the perlwhatever docs together - : $entry->[3][0] # normal case - ; - ++$toplevel_form_freq{ lc $toplevel }{ $toplevel }; - push @{ $toplevel{ lc $toplevel } }, $entry; - push @$entry, lc($entry->[0]); # add a sort-order key to the end - } - - foreach my $toplevel (sort keys %toplevel) { - my $fgroup = $toplevel_form_freq{$toplevel}; - $toplevel_form_freq{$toplevel} = - ( - sort { $fgroup->{$b} <=> $fgroup->{$a} or $a cmp $b } - keys %$fgroup - # This hash is extremely unlikely to have more than 4 members, so this - # sort isn't so very wasteful - )[0]; - } - - return(\%toplevel, \%toplevel_form_freq) if wantarray; - return \%toplevel; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _contents_filespec { - my($self, $outdir) = @_; - my $outfile = $self->contents_file; - return unless $outfile; - return $self->filespecsys->catfile( $outdir, $outfile ); -} - -#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- - -sub makepath { - my($self, $outdir, $namelets) = @_; - return unless @$namelets > 1; - for my $i (0 .. ($#$namelets - 1)) { - my $dir = $self->filespecsys->catdir( $outdir, @$namelets[0 .. $i] ); - if(-e $dir) { - die "$dir exists but not as a directory!?" unless -d $dir; - next; - } - DEBUG > 3 and print " Making $dir\n"; - mkdir $dir, 0777 - or die "Can't mkdir $dir: $!\nAborting" - ; - } - return; -} - -#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- - -sub batch_mode_page_object_init { - my $self = shift; - my($page, $module, $infile, $outfile, $depth) = @_; - - # TODO: any further options to percolate onto this new object here? - - $page->default_title($module); - $page->index( $self->index ); - - $page->html_css( $self-> _css_wad_to_markup($depth) ); - $page->html_javascript( $self->_javascript_wad_to_markup($depth) ); - - $self->add_header_backlink($page, $module, $infile, $outfile, $depth); - $self->add_footer_backlink($page, $module, $infile, $outfile, $depth); - - - return $self; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub add_header_backlink { - my $self = shift; - return if $self->no_contents_links; - my($page, $module, $infile, $outfile, $depth) = @_; - $page->html_header_after_title( join '', - $page->html_header_after_title || '', - - qq[<p class="backlinktop"><b><a name="___top" href="], - $self->url_up_to_contents($depth), - qq[" accesskey="1" title="All Documents"><<</a></b></p>\n], - ) - if $self->contents_file - ; - return; -} - -sub add_footer_backlink { - my $self = shift; - return if $self->no_contents_links; - my($page, $module, $infile, $outfile, $depth) = @_; - $page->html_footer( join '', - qq[<p class="backlinkbottom"><b><a name="___bottom" href="], - $self->url_up_to_contents($depth), - qq[" title="All Documents"><<</a></b></p>\n], - - $page->html_footer || '', - ) - if $self->contents_file - ; - return; -} - -sub url_up_to_contents { - my($self, $depth) = @_; - --$depth; - return join '/', ('..') x $depth, esc($self->contents_file); -} - -#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- - -sub find_all_pods { - my($self, $dirs) = @_; - # You can override find_all_pods in a subclass if you want to - # do extra filtering or whatnot. But for the moment, we just - # pass to modnames2paths: - return $self->modnames2paths($dirs); -} - -#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- - -sub modnames2paths { # return a hashref mapping modulenames => paths - my($self, $dirs) = @_; - - my $m2p; - { - my $search = $SEARCH_CLASS->new; - DEBUG and print "Searching via $search\n"; - $search->verbose(1) if DEBUG > 10; - $search->progress( $self->progress->copy->goal(0) ) if $self->progress; - $search->shadows(0); # don't bother noting shadowed files - $search->inc( $dirs ? 0 : 1 ); - $search->survey( $dirs ? @$dirs : () ); - $m2p = $search->name2path; - die "What, no name2path?!" unless $m2p; - } - - $self->muse("That's odd... no modules found!") unless keys %$m2p; - if( DEBUG > 4 ) { - print "Modules found (name => path):\n"; - foreach my $m (sort {lc($a) cmp lc($b)} keys %$m2p) { - print " $m $$m2p{$m}\n"; - } - print "(total ", scalar(keys %$m2p), ")\n\n"; - } elsif( DEBUG ) { - print "Found ", scalar(keys %$m2p), " modules.\n"; - } - $self->muse( "Found ", scalar(keys %$m2p), " modules." ); - - # return the Foo::Bar => /whatever/Foo/Bar.pod|pm hashref - return $m2p; -} - -#=========================================================================== - -sub _wopen { - # this is abstracted out so that the daemon class can override it - my($self, $outpath) = @_; - require Symbol; - my $out_fh = Symbol::gensym(); - DEBUG > 5 and print "Write-opening to $outpath\n"; - return $out_fh if open($out_fh, "> $outpath"); - require Carp; - Carp::croak("Can't write-open $outpath: $!"); -} - -#========================================================================== - -sub add_css { - my($self, $url, $is_default, $name, $content_type, $media, $_code) = @_; - return unless $url; - unless($name) { - # cook up a reasonable name based on the URL - $name = $url; - if( $name !~ m/\?/ and $name =~ m{([^/]+)$}s ) { - $name = $1; - $name =~ s/\.css//i; - } - } - $media ||= 'all'; - $content_type ||= 'text/css'; - - my $bunch = [$url, $name, $content_type, $media, $_code]; - if($is_default) { unshift @{ $self->_css_wad }, $bunch } - else { push @{ $self->_css_wad }, $bunch } - return; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _spray_css { - my($self, $outdir) = @_; - - return unless $self->css_flurry(); - $self->_gen_css_wad(); - - my $lol = $self->_css_wad; - foreach my $chunk (@$lol) { - my $url = $chunk->[0]; - my $outfile; - if( ref($chunk->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.css$)} ) { - $outfile = $self->filespecsys->catfile( $outdir, $1 ); - DEBUG > 5 and print "Noting $$chunk[0] as a file I'll create.\n"; - } else { - DEBUG > 5 and print "OK, noting $$chunk[0] as an external CSS.\n"; - # Requires no further attention. - next; - } - - #$self->muse( "Writing autogenerated CSS file $outfile" ); - my $Cssout = $self->_wopen($outfile); - print $Cssout ${$chunk->[-1]} - or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all"; - close($Cssout); - DEBUG > 5 and print "Wrote $outfile\n"; - } - - return; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _css_wad_to_markup { - my($self, $depth) = @_; - - my @css = @{ $self->_css_wad || return '' }; - return '' unless @css; - - my $rel = 'stylesheet'; - my $out = ''; - - --$depth; - my $uplink = $depth ? ('../' x $depth) : ''; - - foreach my $chunk (@css) { - next unless $chunk and @$chunk; - - my( $url1, $url2, $title, $type, $media) = ( - $self->_maybe_uplink( $chunk->[0], $uplink ), - esc(grep !ref($_), @$chunk) - ); - - $out .= qq{<link rel="$rel" title="$title" type="$type" href="$url1$url2" media="$media" >\n}; - - $rel = 'alternate stylesheet'; # alternates = all non-first iterations - } - return $out; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _maybe_uplink { - # if the given URL looks relative, return the given uplink string -- - # otherwise return emptystring - my($self, $url, $uplink) = @_; - ($url =~ m{^\./} or $url !~ m{[/\:]} ) - ? $uplink - : '' - # qualify it, if/as needed -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _gen_css_wad { - my $self = $_[0]; - my $css_template = $self->_css_template; - foreach my $variation ( - - # Commented out for sake of concision: - # - # 011n=black_with_red_on_white - # 001n=black_with_yellow_on_white - # 101n=black_with_green_on_white - # 110=white_with_yellow_on_black - # 010=white_with_green_on_black - # 011=white_with_blue_on_black - # 100=white_with_red_on_black - - qw[ - 110n=black_with_blue_on_white - 010n=black_with_magenta_on_white - 100n=black_with_cyan_on_white - - 101=white_with_purple_on_black - 001=white_with_navy_blue_on_black - - 010a=grey_with_green_on_black - 010b=white_with_green_on_grey - 101an=black_with_green_on_grey - 101bn=grey_with_green_on_white - ]) { - - my $outname = $variation; - my($flipmode, @swap) = ( ($4 || ''), $1,$2,$3) - if $outname =~ s/^([012])([012])([[012])([a-z]*)=?//s; - @swap = () if '010' eq join '', @swap; # 010 is a swop-no-op! - - my $this_css = - "/* This file is autogenerated. Do not edit. $variation */\n\n" - . $css_template; - - # Only look at three-digitty colors, for now at least. - if( $flipmode =~ m/n/ ) { - $this_css =~ s/(#[0-9a-fA-F]{3})\b/_color_negate($1)/eg; - $this_css =~ s/\bthin\b/medium/g; - } - $this_css =~ s<#([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])\b> - < join '', '#', ($1,$2,$3)[@swap] >eg if @swap; - - if( $flipmode =~ m/a/) - { $this_css =~ s/#fff\b/#999/gi } # black -> dark grey - elsif($flipmode =~ m/b/) - { $this_css =~ s/#000\b/#666/gi } # white -> light grey - - my $name = $outname; - $name =~ tr/-_/ /; - $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css); - } - - # Now a few indexless variations: - foreach my $variation (qw[ - black_with_blue_on_white white_with_purple_on_black - white_with_green_on_grey grey_with_green_on_white - ]) { - my $outname = "indexless_$variation"; - my $this_css = join "\n", - "/* This file is autogenerated. Do not edit. $outname */\n", - "\@import url(\"./_$variation.css\");", - ".indexgroup { display: none; }", - "\n", - ; - my $name = $outname; - $name =~ tr/-_/ /; - $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css); - } - - return; -} - -sub _color_negate { - my $x = lc $_[0]; - $x =~ tr[0123456789abcdef] - [fedcba9876543210]; - return $x; -} - -#=========================================================================== - -sub add_javascript { - my($self, $url, $content_type, $_code) = @_; - return unless $url; - push @{ $self->_javascript_wad }, [ - $url, $content_type || 'text/javascript', $_code - ]; - return; -} - -sub _spray_javascript { - my($self, $outdir) = @_; - return unless $self->javascript_flurry(); - $self->_gen_javascript_wad(); - - my $lol = $self->_javascript_wad; - foreach my $script (@$lol) { - my $url = $script->[0]; - my $outfile; - - if( ref($script->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.js$)} ) { - $outfile = $self->filespecsys->catfile( $outdir, $1 ); - DEBUG > 5 and print "Noting $$script[0] as a file I'll create.\n"; - } else { - DEBUG > 5 and print "OK, noting $$script[0] as an external JavaScript.\n"; - next; - } - - #$self->muse( "Writing JavaScript file $outfile" ); - my $Jsout = $self->_wopen($outfile); - - print $Jsout ${$script->[-1]} - or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all"; - close($Jsout); - DEBUG > 5 and print "Wrote $outfile\n"; - } - - return; -} - -sub _gen_javascript_wad { - my $self = $_[0]; - my $js_code = $self->_javascript || return; - $self->add_javascript( "_podly.js", 0, \$js_code); - return; -} - -sub _javascript_wad_to_markup { - my($self, $depth) = @_; - - my @scripts = @{ $self->_javascript_wad || return '' }; - return '' unless @scripts; - - my $out = ''; - - --$depth; - my $uplink = $depth ? ('../' x $depth) : ''; - - foreach my $s (@scripts) { - next unless $s and @$s; - - my( $url1, $url2, $type, $media) = ( - $self->_maybe_uplink( $s->[0], $uplink ), - esc(grep !ref($_), @$s) - ); - - $out .= qq{<script type="$type" src="$url1$url2"></script>\n}; - } - return $out; -} - -#=========================================================================== - -sub _css_template { return $CSS } -sub _javascript { return $JAVASCRIPT } - -$CSS = <<'EOCSS'; -/* For accessibility reasons, never specify text sizes in px/pt/pc/in/cm/mm */ - -@media all { .hide { display: none; } } - -@media print { - .noprint, div.indexgroup, .backlinktop, .backlinkbottom { display: none } - - * { - border-color: black !important; - color: black !important; - background-color: transparent !important; - background-image: none !important; - } - - dl.superindex > dd { - word-spacing: .6em; - } -} - -@media aural, braille, embossed { - div.indexgroup { display: none; } /* Too noisy, don't you think? */ - dl.superindex > dt:before { content: "Group "; } - dl.superindex > dt:after { content: " contains:"; } - .backlinktop a:before { content: "Back to contents"; } - .backlinkbottom a:before { content: "Back to contents"; } -} - -@media aural { - dl.superindex > dt { pause-before: 600ms; } -} - -@media screen, tty, tv, projection { - .noscreen { display: none; } - - a:link { color: #7070ff; text-decoration: underline; } - a:visited { color: #e030ff; text-decoration: underline; } - a:active { color: #800000; text-decoration: underline; } - body.contentspage a { text-decoration: none; } - a.u { color: #fff !important; text-decoration: none; } - - body.pod { - margin: 0 5px; - color: #fff; - background-color: #000; - } - - body.pod h1, body.pod h2, body.pod h3, body.pod h4 { - font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif; - font-weight: normal; - margin-top: 1.2em; - margin-bottom: .1em; - border-top: thin solid transparent; - /* margin-left: -5px; border-left: 2px #7070ff solid; padding-left: 3px; */ - } - - body.pod h1 { border-top-color: #0a0; } - body.pod h2 { border-top-color: #080; } - body.pod h3 { border-top-color: #040; } - body.pod h4 { border-top-color: #010; } - - p.backlinktop + h1 { border-top: none; margin-top: 0em; } - p.backlinktop + h2 { border-top: none; margin-top: 0em; } - p.backlinktop + h3 { border-top: none; margin-top: 0em; } - p.backlinktop + h4 { border-top: none; margin-top: 0em; } - - body.pod dt { - font-size: 105%; /* just a wee bit more than normal */ - } - - .indexgroup { font-size: 80%; } - - .backlinktop, .backlinkbottom { - margin-left: -5px; - margin-right: -5px; - background-color: #040; - border-top: thin solid #050; - border-bottom: thin solid #050; - } - - .backlinktop a, .backlinkbottom a { - text-decoration: none; - color: #080; - background-color: #000; - border: thin solid #0d0; - } - .backlinkbottom { margin-bottom: 0; padding-bottom: 0; } - .backlinktop { margin-top: 0; padding-top: 0; } - - body.contentspage { - color: #fff; - background-color: #000; - } - - body.contentspage h1 { - color: #0d0; - margin-left: 1em; - margin-right: 1em; - text-indent: -.9em; - font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif; - font-weight: normal; - border-top: thin solid #fff; - border-bottom: thin solid #fff; - text-align: center; - } - - dl.superindex > dt { - font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif; - font-weight: normal; - font-size: 90%; - margin-top: .45em; - /* margin-bottom: -.15em; */ - } - dl.superindex > dd { - word-spacing: .6em; /* most important rule here! */ - } - dl.superindex > a:link { - text-decoration: none; - color: #fff; - } - - .contentsfooty { - border-top: thin solid #999; - font-size: 90%; - } - -} - -/* The End */ - -EOCSS - -#========================================================================== - -$JAVASCRIPT = <<'EOJAVASCRIPT'; - -// From http://www.alistapart.com/articles/alternate/ - -function setActiveStyleSheet(title) { - var i, a, main; - for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) { - if(a.getAttribute("rel").indexOf("style") != -1 && a.getAttribute("title")) { - a.disabled = true; - if(a.getAttribute("title") == title) a.disabled = false; - } - } -} - -function getActiveStyleSheet() { - var i, a; - for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) { - if( a.getAttribute("rel").indexOf("style") != -1 - && a.getAttribute("title") - && !a.disabled - ) return a.getAttribute("title"); - } - return null; -} - -function getPreferredStyleSheet() { - var i, a; - for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) { - if( a.getAttribute("rel").indexOf("style") != -1 - && a.getAttribute("rel").indexOf("alt") == -1 - && a.getAttribute("title") - ) return a.getAttribute("title"); - } - return null; -} - -function createCookie(name,value,days) { - if (days) { - var date = new Date(); - date.setTime(date.getTime()+(days*24*60*60*1000)); - var expires = "; expires="+date.toGMTString(); - } - else expires = ""; - document.cookie = name+"="+value+expires+"; path=/"; -} - -function readCookie(name) { - var nameEQ = name + "="; - var ca = document.cookie.split(';'); - for(var i=0 ; i < ca.length ; i++) { - var c = ca[i]; - while (c.charAt(0)==' ') c = c.substring(1,c.length); - if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length); - } - return null; -} - -window.onload = function(e) { - var cookie = readCookie("style"); - var title = cookie ? cookie : getPreferredStyleSheet(); - setActiveStyleSheet(title); -} - -window.onunload = function(e) { - var title = getActiveStyleSheet(); - createCookie("style", title, 365); -} - -var cookie = readCookie("style"); -var title = cookie ? cookie : getPreferredStyleSheet(); -setActiveStyleSheet(title); - -// The End - -EOJAVASCRIPT - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1; -__END__ - - -=head1 NAME - -Pod::Simple::HTMLBatch - convert several Pod files to several HTML files - -=head1 SYNOPSIS - - perl -MPod::Simple::HTMLBatch -e 'Pod::Simple::HTMLBatch::go' in out - - -=head1 DESCRIPTION - -This module is used for running batch-conversions of a lot of HTML -documents - -This class is NOT a subclass of Pod::Simple::HTML -(nor of bad old Pod::Html) -- although it uses -Pod::Simple::HTML for doing the conversion of each document. - -The normal use of this class is like so: - - use Pod::Simple::HTMLBatch; - my $batchconv = Pod::Simple::HTMLBatch->new; - $batchconv->some_option( some_value ); - $batchconv->some_other_option( some_other_value ); - $batchconv->batch_convert( \@search_dirs, $output_dir ); - -=head2 FROM THE COMMAND LINE - -Note that this class also provides -(but does not export) the function Pod::Simple::HTMLBatch::go. -This is basically just a shortcut for C<< -Pod::Simple::HTMLBatch->batch_convert(@ARGV) >>. -It's meant to be handy for calling from the command line. - -However, the shortcut requires that you specify exactly two command-line -arguments, C<indirs> and C<outdir>. - -Example: - - % mkdir out_html - % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go @INC out_html - (to convert the pod from Perl's @INC - files under the directory ../htmlversion) - -(Note that the command line there contains a literal atsign-I-N-C. This -is handled as a special case by batch_convert, in order to save you having -to enter the odd-looking "" as the first command-line parameter when you -mean "just use whatever's in @INC".) - -Example: - - % mkdir ../seekrut - % chmod og-rx ../seekrut - % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go . ../htmlversion - (to convert the pod under the current dir into HTML - files under the directory ../htmlversion) - -Example: - - % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go happydocs . - (to convert all pod from happydocs into the current directory) - - - -=head1 MAIN METHODS - -=over - -=item $batchconv = Pod::Simple::HTMLBatch->new; - -This TODO - - -=item $batchconv->batch_convert( I<indirs>, I<outdir> ); - -this TODO - -=item $batchconv->batch_convert( undef , ...); - -=item $batchconv->batch_convert( q{@INC}, ...); - -These two values for I<indirs> specify that the normal Perl @INC - -=item $batchconv->batch_convert( \@dirs , ...); - -This specifies that the input directories are the items in -the arrayref C<\@dirs>. - -=item $batchconv->batch_convert( "somedir" , ...); - -This specifies that the director "somedir" is the input. -(This can be an absolute or relative path, it doesn't matter.) - -A common value you might want would be just "." for the current -directory: - - $batchconv->batch_convert( "." , ...); - - -=item $batchconv->batch_convert( 'somedir:someother:also' , ...); - -This specifies that you want the dirs "somedir", "somother", and "also" -scanned, just as if you'd passed the arrayref -C<[qw( somedir someother also)]>. Note that a ":"-separator is normal -under Unix, but Under MSWin, you'll need C<'somedir;someother;also'> -instead, since the pathsep on MSWin is ";" instead of ":". (And -I<that> is because ":" often comes up in paths, like -C<"c:/perl/lib">.) - -(Exactly what separator character should be used, is gotten from -C<$Config::Config{'path_sep'}>, via the L<Config> module.) - -=item $batchconv->batch_convert( ... , undef ); - -This specifies that you want the HTML output to go into the current -directory. - -(Note that a missing or undefined value means a different thing in -the first slot than in the second. That's so that C<batch_convert()> -with no arguments (or undef arguments) means "go from @INC, into -the current directory.) - -=item $batchconv->batch_convert( ... , 'somedir' ); - -This specifies that you want the HTML output to go into the -directory 'somedir'. -(This can be an absolute or relative path, it doesn't matter.) - -=back - - -Note that you can also call C<batch_convert> as a class method, -like so: - - Pod::Simple::HTMLBatch->batch_convert( ... ); - -That is just short for this: - - Pod::Simple::HTMLBatch-> new-> batch_convert(...); - -That is, it runs a conversion with default options, for -whatever inputdirs and output dir you specify. - - -=head2 ACCESSOR METHODS - -The following are all accessor methods -- that is, they don't do anything -on their own, but just alter the contents of the conversion object, -which comprises the options for this particular batch conversion. - -We show the "put" form of the accessors below (i.e., the syntax you use -for setting the accessor to a specific value). But you can also -call each method with no parameters to get its current value. For -example, C<< $self->contents_file() >> returns the current value of -the contents_file attribute. - -=over - - -=item $batchconv->verbose( I<nonnegative_integer> ); - -This controls how verbose to be during batch conversion, as far as -notes to STDOUT (or whatever is C<select>'d) about how the conversion -is going. If 0, no progress information is printed. -If 1 (the default value), some progress information is printed. -Higher values print more information. - - -=item $batchconv->index( I<true-or-false> ); - -This controls whether or not each HTML page is liable to have a little -table of contents at the top (which we call an "index" for historical -reasons). This is true by default. - - -=item $batchconv->contents_file( I<filename> ); - -If set, should be the name of a file (in the output directory) -to write the HTML index to. The default value is "index.html". -If you set this to a false value, no contents file will be written. - -=item $batchconv->contents_page_start( I<HTML_string> ); - -This specifies what string should be put at the beginning of -the contents page. -The default is a string more or less like this: - - <html> - <head><title>Perl Documentation</title></head> - <body class='contentspage'> - <h1>Perl Documentation</h1> - -=item $batchconv->contents_page_end( I<HTML_string> ); - -This specifies what string should be put at the end of the contents page. -The default is a string more or less like this: - - <p class='contentsfooty'>Generated by - Pod::Simple::HTMLBatch v3.01 under Perl v5.008 - <br >At Fri May 14 22:26:42 2004 GMT, - which is Fri May 14 14:26:42 2004 local time.</p> - - - -=item $batchconv->add_css( $url ); - -TODO - -=item $batchconv->add_javascript( $url ); - -TODO - -=item $batchconv->css_flurry( I<true-or-false> ); - -If true (the default value), we autogenerate some CSS files in the -output directory, and set our HTML files to use those. -TODO: continue - -=item $batchconv->javascript_flurry( I<true-or-false> ); - -If true (the default value), we autogenerate a JavaScript in the -output directory, and set our HTML files to use it. Currently, -the JavaScript is used only to get the browser to remember what -stylesheet it prefers. -TODO: continue - -=item $batchconv->no_contents_links( I<true-or-false> ); - -TODO - -=item $batchconv->html_render_class( I<classname> ); - -This sets what class is used for rendering the files. -The default is "Pod::Simple::Search". If you set it to something else, -it should probably be a subclass of Pod::Simple::Search, and you should -C<require> or C<use> that class so that's it's loaded before -Pod::Simple::HTMLBatch tries loading it. - -=back - - - - -=head1 NOTES ON CUSTOMIZATION - -TODO - - call add_css($someurl) to add stylesheet as alternate - call add_css($someurl,1) to add as primary stylesheet - - call add_javascript - - subclass Pod::Simple::HTML and set $batchconv->html_render_class to - that classname - and maybe override - $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth) - or maybe override - $batchconv->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth) - - - -=head1 ASK ME! - -If you want to do some kind of big pod-to-HTML version with some -particular kind of option that you don't see how to achieve using this -module, email me (C<sburke@cpan.org>) and I'll probably have a good idea -how to do it. For reasons of concision and energetic laziness, some -methods and options in this module (and the dozen modules it depends on) -are undocumented; but one of those undocumented bits might be just what -you're looking for. - - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::HTMLBatch>, L<perlpod>, L<perlpodspec> - - - - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTMLLegacy.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTMLLegacy.pm deleted file mode 100644 index f78de90144f..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/HTMLLegacy.pm +++ /dev/null @@ -1,104 +0,0 @@ - -require 5; -package Pod::Simple::HTMLLegacy; -use strict; - -use vars qw($VERSION); -use Getopt::Long; - -$VERSION = "5.01"; - -#-------------------------------------------------------------------------- -# -# This class is meant to thinly emulate bad old Pod::Html -# -# TODO: some basic docs - -sub pod2html { - my @args = (@_); - - my( $verbose, $infile, $outfile, $title ); - my $index = 1; - - { - my($help); - - my($netscape); # dummy - local @ARGV = @args; - GetOptions( - "help" => \$help, - "verbose!" => \$verbose, - "infile=s" => \$infile, - "outfile=s" => \$outfile, - "title=s" => \$title, - "index!" => \$index, - - "netscape!" => \$netscape, - ) or return bad_opts(@args); - bad_opts(@args) if @ARGV; # it should be all switches! - return help_message() if $help; - } - - for($infile, $outfile) { $_ = undef unless defined and length } - - if($verbose) { - warn sprintf "%s version %s\n", __PACKAGE__, $VERSION; - warn "OK, processed args [@args] ...\n"; - warn sprintf - " Verbose: %s\n Index: %s\n Infile: %s\n Outfile: %s\n Title: %s\n", - map defined($_) ? $_ : "(nil)", - $verbose, $index, $infile, $outfile, $title, - ; - *Pod::Simple::HTML::DEBUG = sub(){1}; - } - require Pod::Simple::HTML; - Pod::Simple::HTML->VERSION(3); - - die "No such input file as $infile\n" - if defined $infile and ! -e $infile; - - - my $pod = Pod::Simple::HTML->new; - $pod->force_title($title) if defined $title; - $pod->index($index); - return $pod->parse_from_file($infile, $outfile); -} - -#-------------------------------------------------------------------------- - -sub bad_opts { die _help_message(); } -sub help_message { print STDOUT _help_message() } - -#-------------------------------------------------------------------------- - -sub _help_message { - - join '', - -"[", __PACKAGE__, " version ", $VERSION, qq~] -Usage: pod2html --help --infile=<name> --outfile=<name> - --verbose --index --noindex - -Options: - --help - prints this message. - --[no]index - generate an index at the top of the resulting html - (default behavior). - --infile - filename for the pod to convert (input taken from stdin - by default). - --outfile - filename for the resulting html file (output sent to - stdout by default). - --title - title that will appear in resulting html file. - --[no]verbose - self-explanatory (off by default). - -Note that pod2html is DEPRECATED, and this version implements only - some of the options known to older versions. -For more information, see 'perldoc pod2html'. -~; - -} - -1; -__END__ - -OVER the underpass! UNDER the overpass! Around the FUTURE and BEYOND REPAIR!! - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/LinkSection.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/LinkSection.pm deleted file mode 100644 index 14c3ba85d27..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/LinkSection.pm +++ /dev/null @@ -1,145 +0,0 @@ - -require 5; -package Pod::Simple::LinkSection; - # Based somewhat dimly on Array::Autojoin - -use strict; -use Pod::Simple::BlackBox; - -use overload( # So it'll stringify nice - '""' => \&Pod::Simple::BlackBox::stringify_lol, - 'bool' => \&Pod::Simple::BlackBox::stringify_lol, - # '.=' => \&tack_on, # grudgingly support - - 'fallback' => 1, # turn on cleverness -); - -sub tack_on { - $_[0] = ['', {}, "$_[0]" ]; - return $_[0][2] .= $_[1]; -} - -sub as_string { - goto &Pod::Simple::BlackBox::stringify_lol; -} -sub stringify { - goto &Pod::Simple::BlackBox::stringify_lol; -} - -sub new { - my $class = shift; - $class = ref($class) || $class; - my $new; - if(@_ == 1) { - if (!ref($_[0] || '')) { # most common case: one bare string - return bless ['', {}, $_[0] ], $class; - } elsif( ref($_[0] || '') eq 'ARRAY') { - $new = [ @{ $_[0] } ]; - } else { - Carp::croak( "$class new() doesn't know to clone $new" ); - } - } else { # misc stuff - $new = [ '', {}, @_ ]; - } - - # By now it's a treelet: [ 'foo', {}, ... ] - foreach my $x (@$new) { - if(ref($x || '') eq 'ARRAY') { - $x = $class->new($x); # recurse - } elsif(ref($x || '') eq 'HASH') { - $x = { %$x }; - } - # otherwise leave it. - } - - return bless $new, $class; -} - -# Not much in this class is likely to be link-section specific -- -# but it just so happens that link-sections are about the only treelets -# that are exposed to the user. - -1; - -__END__ - -# TODO: let it be an option whether a given subclass even wants little treelets? - - -__END__ - -=head1 NAME - -Pod::Simple::LinkSection -- represent "section" attributes of L codes - -=head1 SYNOPSIS - - # a long story - -=head1 DESCRIPTION - -This class is not of interest to general users. - -Pod::Simple uses this class for representing the value of the -"section" attribute of "L" start-element events. Most applications -can just use the normal stringification of objects of this class; -they stringify to just the text content of the section, -such as "foo" for -C<< LZ<><Stuff/foo> >>, and "bar" for -C<< LZ<><Stuff/bIZ<><ar>> >>. - -However, anyone particularly interested in getting the full value of -the treelet, can just traverse the content of the treeleet -@$treelet_object. To wit: - - - % perl -MData::Dumper -e - "use base qw(Pod::Simple::Methody); - sub start_L { print Dumper($_[1]{'section'} ) } - __PACKAGE__->new->parse_string_document('=head1 L<Foo/bI<ar>baz>>') - " -Output: - $VAR1 = bless( [ - '', - {}, - 'b', - bless( [ - 'I', - {}, - 'ar' - ], 'Pod::Simple::LinkSection' ), - 'baz' - ], 'Pod::Simple::LinkSection' ); - -But stringify it and you get just the text content: - - % perl -MData::Dumper -e - "use base qw(Pod::Simple::Methody); - sub start_L { print Dumper( '' . $_[1]{'section'} ) } - __PACKAGE__->new->parse_string_document('=head1 L<Foo/bI<ar>baz>>') - " -Output: - $VAR1 = 'barbaz'; - - -=head1 SEE ALSO - -L<Pod::Simple> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Methody.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Methody.pm deleted file mode 100644 index 2ad607e61b4..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Methody.pm +++ /dev/null @@ -1,127 +0,0 @@ - -require 5; -package Pod::Simple::Methody; -use strict; -use Pod::Simple (); -use vars qw(@ISA $VERSION); -$VERSION = '2.02'; -@ISA = ('Pod::Simple'); - -# Yes, we could use named variables, but I want this to be impose -# as little an additional performance hit as possible. - -sub _handle_element_start { - $_[1] =~ tr/-:./__/; - ( $_[0]->can( 'start_' . $_[1] ) - || return - )->( - $_[0], $_[2] - ); -} - -sub _handle_text { - ( $_[0]->can( 'handle_text' ) - || return - )->( - @_ - ); -} - -sub _handle_element_end { - $_[1] =~ tr/-:./__/; - ( $_[0]->can( 'end_' . $_[1] ) - || return - )->( - $_[0] - ); -} - -1; - - -__END__ - -=head1 NAME - -Pod::Simple::Methody -- turn Pod::Simple events into method calls - -=head1 SYNOPSIS - - require 5; - use strict; - package SomePodFormatter; - use base qw(Pod::Simple::Methody); - - sub handle_text { - my($self, $text) = @_; - ... - } - - sub start_head1 { - my($self, $attrs) = @_; - ... - } - sub end_head1 { - my($self) = @_; - ... - } - -...and start_/end_ methods for whatever other events you want to catch. - -=head1 DESCRIPTION - -This class is of -interest to people writing Pod formatters based on Pod::Simple. - -This class (which is very small -- read the source) overrides -Pod::Simple's _handle_element_start, _handle_text, and -_handle_element_end methods so that parser events are turned into method -calls. (Otherwise, this is a subclass of L<Pod::Simple> and inherits all -its methods.) - -You can use this class as the base class for a Pod formatter/processor. - -=head1 METHOD CALLING - -When Pod::Simple sees a "=head1 Hi there", for example, it basically does -this: - - $parser->_handle_element_start( "head1", \%attributes ); - $parser->_handle_text( "Hi there" ); - $parser->_handle_element_end( "head1" ); - -But if you subclass Pod::Simple::Methody, it will instead do this -when it sees a "=head1 Hi there": - - $parser->start_head1( \%attributes ) if $parser->can('start_head1'); - $parser->handle_text( "Hi there" ) if $parser->can('handle_text'); - $parser->end_head1() if $parser->can('end_head1'); - -If Pod::Simple sends an event where the element name has a dash, -period, or colon, the corresponding method name will have a underscore -in its place. For example, "foo.bar:baz" becomes start_foo_bar_baz -and end_foo_bar_baz. - -See the source for Pod::Simple::Text for an example of using this class. - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::Subclassing> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Progress.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Progress.pm deleted file mode 100644 index bc42a952dc3..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Progress.pm +++ /dev/null @@ -1,93 +0,0 @@ - -require 5; -package Pod::Simple::Progress; -$VERSION = "1.01"; -use strict; - -# Objects of this class are used for noting progress of an -# operation every so often. Messages delivered more often than that -# are suppressed. -# -# There's actually nothing in here that's specific to Pod processing; -# but it's ad-hoc enough that I'm not willing to give it a name that -# implies that it's generally useful, like "IO::Progress" or something. -# -# -- sburke -# -#-------------------------------------------------------------------------- - -sub new { - my($class,$delay) = @_; - my $self = bless {'quiet_until' => 1}, ref($class) || $class; - $self->to(*STDOUT{IO}); - $self->delay(defined($delay) ? $delay : 5); - return $self; -} - -sub copy { - my $orig = shift; - bless {%$orig, 'quiet_until' => 1}, ref($orig); -} -#-------------------------------------------------------------------------- - -sub reach { - my($self, $point, $note) = @_; - if( (my $now = time) >= $self->{'quiet_until'}) { - my $goal; - my $to = $self->{'to'}; - print $to join('', - ($self->{'quiet_until'} == 1) ? () : '... ', - (defined $point) ? ( - '#', - ($goal = $self->{'goal'}) ? ( - ' ' x (length($goal) - length($point)), - $point, '/', $goal, - ) : $point, - $note ? ': ' : (), - ) : (), - $note || '', - "\n" - ); - $self->{'quiet_until'} = $now + $self->{'delay'}; - } - return $self; -} - -#-------------------------------------------------------------------------- - -sub done { - my($self, $note) = @_; - $self->{'quiet_until'} = 1; - return $self->reach( undef, $note ); -} - -#-------------------------------------------------------------------------- -# Simple accessors: - -sub delay { - return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] } -sub goal { - return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] } -sub to { - return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] } - -#-------------------------------------------------------------------------- - -unless(caller) { # Simple self-test: - my $p = __PACKAGE__->new->goal(5); - $p->reach(1, "Primus!"); - sleep 1; - $p->reach(2, "Secundus!"); - sleep 3; - $p->reach(3, "Tertius!"); - sleep 5; - $p->reach(4); - $p->reach(5, "Quintus!"); - sleep 1; - $p->done("All done"); -} - -#-------------------------------------------------------------------------- -1; -__END__ - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParser.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParser.pm deleted file mode 100644 index 15d973134cf..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParser.pm +++ /dev/null @@ -1,795 +0,0 @@ - -require 5; -package Pod::Simple::PullParser; -$VERSION = '2.02'; -use Pod::Simple (); -BEGIN {@ISA = ('Pod::Simple')} - -use strict; -use Carp (); - -use Pod::Simple::PullParserStartToken; -use Pod::Simple::PullParserEndToken; -use Pod::Simple::PullParserTextToken; - -BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } - -__PACKAGE__->_accessorize( - 'source_fh', # the filehandle we're reading from - 'source_scalar_ref', # the scalarref we're reading from - 'source_arrayref', # the arrayref we're reading from -); - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# -# And here is how we implement a pull-parser on top of a push-parser... - -sub filter { - my($self, $source) = @_; - $self = $self->new unless ref $self; - - $source = *STDIN{IO} unless defined $source; - $self->set_source($source); - $self->output_fh(*STDOUT{IO}); - - $self->run; # define run() in a subclass if you want to use filter()! - return $self; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub parse_string_document { - my $this = shift; - $this->set_source(\ $_[0]); - $this->run; -} - -sub parse_file { - my($this, $filename) = @_; - $this->set_source($filename); - $this->run; -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# In case anyone tries to use them: - -sub run { - use Carp (); - if( __PACKAGE__ eq ref($_[0]) || $_[0]) { # I'm not being subclassed! - Carp::croak "You can call run() only on subclasses of " - . __PACKAGE__; - } else { - Carp::croak join '', - "You can't call run() because ", - ref($_[0]) || $_[0], " didn't define a run() method"; - } -} - -sub parse_lines { - use Carp (); - Carp::croak "Use set_source with ", __PACKAGE__, - " and subclasses, not parse_lines"; -} - -sub parse_line { - use Carp (); - Carp::croak "Use set_source with ", __PACKAGE__, - " and subclasses, not parse_line"; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub new { - my $class = shift; - my $self = $class->SUPER::new(@_); - die "Couldn't construct for $class" unless $self; - - $self->{'token_buffer'} ||= []; - $self->{'start_token_class'} ||= 'Pod::Simple::PullParserStartToken'; - $self->{'text_token_class'} ||= 'Pod::Simple::PullParserTextToken'; - $self->{'end_token_class'} ||= 'Pod::Simple::PullParserEndToken'; - - DEBUG > 1 and print "New pullparser object: $self\n"; - - return $self; -} - -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -sub get_token { - my $self = shift; - DEBUG > 1 and print "\nget_token starting up on $self.\n"; - DEBUG > 2 and print " Items in token-buffer (", - scalar( @{ $self->{'token_buffer'} } ) , - ") :\n", map( - " " . $_->dump . "\n", @{ $self->{'token_buffer'} } - ), - @{ $self->{'token_buffer'} } ? '' : ' (no tokens)', - "\n" - ; - - until( @{ $self->{'token_buffer'} } ) { - DEBUG > 3 and print "I need to get something into my empty token buffer...\n"; - if($self->{'source_dead'}) { - DEBUG and print "$self 's source is dead.\n"; - push @{ $self->{'token_buffer'} }, undef; - } elsif(exists $self->{'source_fh'}) { - my @lines; - my $fh = $self->{'source_fh'} - || Carp::croak('You have to call set_source before you can call get_token'); - - DEBUG and print "$self 's source is filehandle $fh.\n"; - # Read those many lines at a time - for(my $i = Pod::Simple::MANY_LINES; $i--;) { - DEBUG > 3 and print " Fetching a line from source filehandle $fh...\n"; - local $/ = $Pod::Simple::NL; - push @lines, scalar(<$fh>); # readline - DEBUG > 3 and print " Line is: ", - defined($lines[-1]) ? $lines[-1] : "<undef>\n"; - unless( defined $lines[-1] ) { - DEBUG and print "That's it for that source fh! Killing.\n"; - delete $self->{'source_fh'}; # so it can be GC'd - last; - } - # but pass thru the undef, which will set source_dead to true - - # TODO: look to see if $lines[-1] is =encoding, and if so, - # do horribly magic things - - } - - if(DEBUG > 8) { - print "* I've gotten ", scalar(@lines), " lines:\n"; - foreach my $l (@lines) { - if(defined $l) { - print " line {$l}\n"; - } else { - print " line undef\n"; - } - } - print "* end of ", scalar(@lines), " lines\n"; - } - - $self->SUPER::parse_lines(@lines); - - } elsif(exists $self->{'source_arrayref'}) { - DEBUG and print "$self 's source is arrayref $self->{'source_arrayref'}, with ", - scalar(@{$self->{'source_arrayref'}}), " items left in it.\n"; - - DEBUG > 3 and print " Fetching ", Pod::Simple::MANY_LINES, " lines.\n"; - $self->SUPER::parse_lines( - splice @{ $self->{'source_arrayref'} }, - 0, - Pod::Simple::MANY_LINES - ); - unless( @{ $self->{'source_arrayref'} } ) { - DEBUG and print "That's it for that source arrayref! Killing.\n"; - $self->SUPER::parse_lines(undef); - delete $self->{'source_arrayref'}; # so it can be GC'd - } - # to make sure that an undef is always sent to signal end-of-stream - - } elsif(exists $self->{'source_scalar_ref'}) { - - DEBUG and print "$self 's source is scalarref $self->{'source_scalar_ref'}, with ", - length(${ $self->{'source_scalar_ref'} }) - - (pos(${ $self->{'source_scalar_ref'} }) || 0), - " characters left to parse.\n"; - - DEBUG > 3 and print " Fetching a line from source-string...\n"; - if( ${ $self->{'source_scalar_ref'} } =~ - m/([^\n\r]*)((?:\r?\n)?)/g - ) { - #print(">> $1\n"), - $self->SUPER::parse_lines($1) - if length($1) or length($2) - or pos( ${ $self->{'source_scalar_ref'} }) - != length( ${ $self->{'source_scalar_ref'} }); - # I.e., unless it's a zero-length "empty line" at the very - # end of "foo\nbar\n" (i.e., between the \n and the EOS). - } else { # that's the end. Byebye - $self->SUPER::parse_lines(undef); - delete $self->{'source_scalar_ref'}; - DEBUG and print "That's it for that source scalarref! Killing.\n"; - } - - - } else { - die "What source??"; - } - } - DEBUG and print "get_token about to return ", - Pod::Simple::pretty( @{$self->{'token_buffer'}} - ? $self->{'token_buffer'}[-1] : undef - ), "\n"; - return shift @{$self->{'token_buffer'}}; # that's an undef if empty -} - -use UNIVERSAL (); -sub unget_token { - my $self = shift; - DEBUG and print "Ungetting ", scalar(@_), " tokens: ", - @_ ? "@_\n" : "().\n"; - foreach my $t (@_) { - Carp::croak "Can't unget that, because it's not a token -- it's undef!" - unless defined $t; - Carp::croak "Can't unget $t, because it's not a token -- it's a string!" - unless ref $t; - Carp::croak "Can't unget $t, because it's not a token object!" - unless UNIVERSAL::can($t, 'type'); - } - - unshift @{$self->{'token_buffer'}}, @_; - DEBUG > 1 and print "Token buffer now has ", - scalar(@{$self->{'token_buffer'}}), " items in it.\n"; - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -# $self->{'source_filename'} = $source; - -sub set_source { - my $self = shift @_; - return $self->{'source_fh'} unless @_; - my $handle; - if(!defined $_[0]) { - Carp::croak("Can't use empty-string as a source for set_source"); - } elsif(ref(\( $_[0] )) eq 'GLOB') { - $self->{'source_filename'} = '' . ($handle = $_[0]); - DEBUG and print "$self 's source is glob $_[0]\n"; - # and fall thru - } elsif(ref( $_[0] ) eq 'SCALAR') { - $self->{'source_scalar_ref'} = $_[0]; - DEBUG and print "$self 's source is scalar ref $_[0]\n"; - return; - } elsif(ref( $_[0] ) eq 'ARRAY') { - $self->{'source_arrayref'} = $_[0]; - DEBUG and print "$self 's source is array ref $_[0]\n"; - return; - } elsif(ref $_[0]) { - $self->{'source_filename'} = '' . ($handle = $_[0]); - DEBUG and print "$self 's source is fh-obj $_[0]\n"; - } elsif(!length $_[0]) { - Carp::croak("Can't use empty-string as a source for set_source"); - } else { # It's a filename! - DEBUG and print "$self 's source is filename $_[0]\n"; - { - local *PODSOURCE; - open(PODSOURCE, "<$_[0]") || Carp::croak "Can't open $_[0]: $!"; - $handle = *PODSOURCE{IO}; - } - $self->{'source_filename'} = $_[0]; - DEBUG and print " Its name is $_[0].\n"; - - # TODO: file-discipline things here! - } - - $self->{'source_fh'} = $handle; - DEBUG and print " Its handle is $handle\n"; - return 1; -} - -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -sub get_title_short { shift->get_short_title(@_) } # alias - -sub get_short_title { - my $title = shift->get_title(@_); - $title = $1 if $title =~ m/^(\S{1,60})\s+--?\s+./s; - # turn "Foo::Bar -- bars for your foo" into "Foo::Bar" - return $title; -} - -sub get_title { shift->_get_titled_section( - 'NAME', max_token => 50, desperate => 1, @_) -} -sub get_version { shift->_get_titled_section( - 'VERSION', - max_token => 400, - accept_verbatim => 1, - max_content_length => 3_000, - @_, - ); -} -sub get_description { shift->_get_titled_section( - 'DESCRIPTION', - max_token => 400, - max_content_length => 3_000, - @_, -) } - -sub get_authors { shift->get_author(@_) } # a harmless alias - -sub get_author { - my $this = shift; - # Max_token is so high because these are - # typically at the end of the document: - $this->_get_titled_section('AUTHOR' , max_token => 10_000, @_) || - $this->_get_titled_section('AUTHORS', max_token => 10_000, @_); -} - -#-------------------------------------------------------------------------- - -sub _get_titled_section { - # Based on a get_title originally contributed by Graham Barr - my($self, $titlename, %options) = (@_); - - my $max_token = delete $options{'max_token'}; - my $desperate_for_title = delete $options{'desperate'}; - my $accept_verbatim = delete $options{'accept_verbatim'}; - my $max_content_length = delete $options{'max_content_length'}; - $max_content_length = 120 unless defined $max_content_length; - - Carp::croak( "Unknown " . ((1 == keys %options) ? "option: " : "options: ") - . join " ", map "[$_]", sort keys %options - ) - if keys %options; - - my %content_containers; - $content_containers{'Para'} = 1; - if($accept_verbatim) { - $content_containers{'Verbatim'} = 1; - $content_containers{'VerbatimFormatted'} = 1; - } - - my $token_count = 0; - my $title; - my @to_unget; - my $state = 0; - my $depth = 0; - - Carp::croak "What kind of titlename is \"$titlename\"?!" unless - defined $titlename and $titlename =~ m/^[A-Z ]{1,60}$/s; #sanity - my $titlename_re = quotemeta($titlename); - - my $head1_text_content; - my $para_text_content; - - while( - ++$token_count <= ($max_token || 1_000_000) - and defined(my $token = $self->get_token) - ) { - push @to_unget, $token; - - if ($state == 0) { # seeking =head1 - if( $token->is_start and $token->tagname eq 'head1' ) { - DEBUG and print " Found head1. Seeking content...\n"; - ++$state; - $head1_text_content = ''; - } - } - - elsif($state == 1) { # accumulating text until end of head1 - if( $token->is_text ) { - DEBUG and print " Adding \"", $token->text, "\" to head1-content.\n"; - $head1_text_content .= $token->text; - } elsif( $token->is_end and $token->tagname eq 'head1' ) { - DEBUG and print " Found end of head1. Considering content...\n"; - if($head1_text_content eq $titlename - or $head1_text_content =~ m/\($titlename_re\)/s - # We accept "=head1 Nomen Modularis (NAME)" for sake of i18n - ) { - DEBUG and print " Yup, it was $titlename. Seeking next para-content...\n"; - ++$state; - } elsif( - $desperate_for_title - # if we're so desperate we'll take the first - # =head1's content as a title - and $head1_text_content =~ m/\S/ - and $head1_text_content !~ m/^[ A-Z]+$/s - and $head1_text_content !~ - m/\((?: - NAME | TITLE | VERSION | AUTHORS? | DESCRIPTION | SYNOPSIS - | COPYRIGHT | LICENSE | NOTES? | FUNCTIONS? | METHODS? - | CAVEATS? | BUGS? | SEE\ ALSO | SWITCHES | ENVIRONMENT - )\)/sx - # avoid accepting things like =head1 Thingy Thongy (DESCRIPTION) - and ($max_content_length - ? (length($head1_text_content) <= $max_content_length) # sanity - : 1) - ) { - DEBUG and print " It looks titular: \"$head1_text_content\".\n", - "\n Using that.\n"; - $title = $head1_text_content; - last; - } else { - --$state; - DEBUG and print " Didn't look titular ($head1_text_content).\n", - "\n Dropping back to seeking-head1-content mode...\n"; - } - } - } - - elsif($state == 2) { - # seeking start of para (which must immediately follow) - if($token->is_start and $content_containers{ $token->tagname }) { - DEBUG and print " Found start of Para. Accumulating content...\n"; - $para_text_content = ''; - ++$state; - } else { - DEBUG and print - " Didn't see an immediately subsequent start-Para. Reseeking H1\n"; - $state = 0; - } - } - - elsif($state == 3) { - # accumulating text until end of Para - if( $token->is_text ) { - DEBUG and print " Adding \"", $token->text, "\" to para-content.\n"; - $para_text_content .= $token->text; - # and keep looking - - } elsif( $token->is_end and $content_containers{ $token->tagname } ) { - DEBUG and print " Found end of Para. Considering content: ", - $para_text_content, "\n"; - - if( $para_text_content =~ m/\S/ - and ($max_content_length - ? (length($para_text_content) <= $max_content_length) - : 1) - ) { - # Some minimal sanity constraints, I think. - DEBUG and print " It looks contentworthy, I guess. Using it.\n"; - $title = $para_text_content; - last; - } else { - DEBUG and print " Doesn't look at all contentworthy!\n Giving up.\n"; - undef $title; - last; - } - } - } - - else { - die "IMPOSSIBLE STATE $state!\n"; # should never happen - } - - } - - # Put it all back! - $self->unget_token(@to_unget); - - if(DEBUG) { - if(defined $title) { print " Returing title <$title>\n" } - else { print "Returning title <>\n" } - } - - return '' unless defined $title; - $title =~ s/^\s+//; - return $title; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# -# Methods that actually do work at parse-time: - -sub _handle_element_start { - my $self = shift; # leaving ($element_name, $attr_hash_r) - DEBUG > 2 and print "++ $_[0] (", map("<$_> ", %{$_[1]}), ")\n"; - - push @{ $self->{'token_buffer'} }, - $self->{'start_token_class'}->new(@_); - return; -} - -sub _handle_text { - my $self = shift; # leaving ($text) - DEBUG > 2 and print "== $_[0]\n"; - push @{ $self->{'token_buffer'} }, - $self->{'text_token_class'}->new(@_); - return; -} - -sub _handle_element_end { - my $self = shift; # leaving ($element_name); - DEBUG > 2 and print "-- $_[0]\n"; - push @{ $self->{'token_buffer'} }, - $self->{'end_token_class'}->new(@_); - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -1; - - -__END__ - -=head1 NAME - -Pod::Simple::PullParser -- a pull-parser interface to parsing Pod - -=head1 SYNOPSIS - - my $parser = SomePodProcessor->new; - $parser->set_source( "whatever.pod" ); - $parser->run; - -Or: - - my $parser = SomePodProcessor->new; - $parser->set_source( $some_filehandle_object ); - $parser->run; - -Or: - - my $parser = SomePodProcessor->new; - $parser->set_source( \$document_source ); - $parser->run; - -Or: - - my $parser = SomePodProcessor->new; - $parser->set_source( \@document_lines ); - $parser->run; - -And elsewhere: - - require 5; - package SomePodProcessor; - use strict; - use base qw(Pod::Simple::PullParser); - - sub run { - my $self = shift; - Token: - while(my $token = $self->get_token) { - ...process each token... - } - } - -=head1 DESCRIPTION - -This class is for using Pod::Simple to build a Pod processor -- but -one that uses an interface based on a stream of token objects, -instead of based on events. - -This is a subclass of L<Pod::Simple> and inherits all its methods. - -A subclass of Pod::Simple::PullParser should define a C<run> method -that calls C<< $token = $parser->get_token >> to pull tokens. - -See the source for Pod::Simple::RTF for an example of a formatter -that uses Pod::Simple::PullParser. - -=head1 METHODS - -=over - -=item my $token = $parser->get_token - -This returns the next token object (which will be of a subclass of -L<Pod::Simple::PullParserToken>), or undef if the parser-stream has hit -the end of the document. - -=item $parser->unget_token( $token ) - -=item $parser->unget_token( $token1, $token2, ... ) - -This restores the token object(s) to the front of the parser stream. - -=back - -The source has to be set before you can parse anything. The lowest-level -way is to call C<set_source>: - -=over - -=item $parser->set_source( $filename ) - -=item $parser->set_source( $filehandle_object ) - -=item $parser->set_source( \$document_source ) - -=item $parser->set_source( \@document_lines ) - -=back - -Or you can call these methods, which Pod::Simple::PullParser has defined -to work just like Pod::Simple's same-named methods: - -=over - -=item $parser->parse_file(...) - -=item $parser->parse_string_document(...) - -=item $parser->filter(...) - -=item $parser->parse_from_file(...) - -=back - -For those to work, the Pod-processing subclass of -Pod::Simple::PullParser has to have defined a $parser->run method -- -so it is advised that all Pod::Simple::PullParser subclasses do so. -See the Synopsis above, or the source for Pod::Simple::RTF. - -Authors of formatter subclasses might find these methods useful to -call on a parser object that you haven't started pulling tokens -from yet: - -=over - -=item my $title_string = $parser->get_title - -This tries to get the title string out of $parser, by getting some tokens, -and scanning them for the title, and then ungetting them so that you can -process the token-stream from the beginning. - -For example, suppose you have a document that starts out: - - =head1 NAME - - Hoo::Boy::Wowza -- Stuff B<wow> yeah! - -$parser->get_title on that document will return "Hoo::Boy::Wowza -- -Stuff wow yeah!". - -In cases where get_title can't find the title, it will return empty-string -(""). - -=item my $title_string = $parser->get_short_title - -This is just like get_title, except that it returns just the modulename, if -the title seems to be of the form "SomeModuleName -- description". - -For example, suppose you have a document that starts out: - - =head1 NAME - - Hoo::Boy::Wowza -- Stuff B<wow> yeah! - -then $parser->get_short_title on that document will return -"Hoo::Boy::Wowza". - -But if the document starts out: - - =head1 NAME - - Hooboy, stuff B<wow> yeah! - -then $parser->get_short_title on that document will return "Hooboy, -stuff wow yeah!". - -If the title can't be found, then get_short_title returns empty-string -(""). - -=item $author_name = $parser->get_author - -This works like get_title except that it returns the contents of the -"=head1 AUTHOR\n\nParagraph...\n" section, assuming that that section -isn't terribly long. - -(This method tolerates "AUTHORS" instead of "AUTHOR" too.) - -=item $description_name = $parser->get_description - -This works like get_title except that it returns the contents of the -"=head1 PARAGRAPH\n\nParagraph...\n" section, assuming that that section -isn't terribly long. - -=item $version_block = $parser->get_version - -This works like get_title except that it returns the contents of -the "=head1 VERSION\n\n[BIG BLOCK]\n" block. Note that this does NOT -return the module's C<$VERSION>!! - - -=back - -=head1 NOTE - -You don't actually I<have> to define a C<run> method. If you're -writing a Pod-formatter class, you should define a C<run> just so -that users can call C<parse_file> etc, but you don't I<have> to. - -And if you're not writing a formatter class, but are instead just -writing a program that does something simple with a Pod::PullParser -object (and not an object of a subclass), then there's no reason to -bother subclassing to add a C<run> method. - -=head1 SEE ALSO - -L<Pod::Simple> - -L<Pod::Simple::PullParserToken> -- and its subclasses -L<Pod::Simple::PullParserStartToken>, -L<Pod::Simple::PullParserTextToken>, and -L<Pod::Simple::PullParserEndToken>. - -L<HTML::TokeParser>, which inspired this. - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - - - -JUNK: - -sub _old_get_title { # some witchery in here - my $self = $_[0]; - my $title; - my @to_unget; - - while(1) { - push @to_unget, $self->get_token; - unless(defined $to_unget[-1]) { # whoops, short doc! - pop @to_unget; - last; - } - - DEBUG and print "-Got token ", $to_unget[-1]->dump, "\n"; - - (DEBUG and print "Too much in the buffer.\n"), - last if @to_unget > 25; # sanity - - my $pattern = ''; - if( #$to_unget[-1]->type eq 'end' - #and $to_unget[-1]->tagname eq 'Para' - #and - ($pattern = join('', - map {; - ($_->type eq 'start') ? ("<" . $_->tagname .">") - : ($_->type eq 'end' ) ? ("</". $_->tagname .">") - : ($_->type eq 'text' ) ? ($_->text =~ m<^([A-Z]+)$>s ? $1 : 'X') - : "BLORP" - } @to_unget - )) =~ m{<head1>NAME</head1><Para>(X|</?[BCIFLS]>)+</Para>$}s - ) { - # Whee, it fits the pattern - DEBUG and print "Seems to match =head1 NAME pattern.\n"; - $title = ''; - foreach my $t (reverse @to_unget) { - last if $t->type eq 'start' and $t->tagname eq 'Para'; - $title = $t->text . $title if $t->type eq 'text'; - } - undef $title if $title =~ m<^\s*$>; # make sure it's contentful! - last; - - } elsif ($pattern =~ m{<head(\d)>(.+)</head\d>$} - and !( $1 eq '1' and $2 eq 'NAME' ) - ) { - # Well, it fits a fallback pattern - DEBUG and print "Seems to match NAMEless pattern.\n"; - $title = ''; - foreach my $t (reverse @to_unget) { - last if $t->type eq 'start' and $t->tagname =~ m/^head\d$/s; - $title = $t->text . $title if $t->type eq 'text'; - } - undef $title if $title =~ m<^\s*$>; # make sure it's contentful! - last; - - } else { - DEBUG and $pattern and print "Leading pattern: $pattern\n"; - } - } - - # Put it all back: - $self->unget_token(@to_unget); - - if(DEBUG) { - if(defined $title) { print " Returing title <$title>\n" } - else { print "Returning title <>\n" } - } - - return '' unless defined $title; - return $title; -} - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserEndToken.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserEndToken.pm deleted file mode 100644 index 7b219f8660d..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserEndToken.pm +++ /dev/null @@ -1,93 +0,0 @@ - -require 5; -package Pod::Simple::PullParserEndToken; -use Pod::Simple::PullParserToken (); -@ISA = ('Pod::Simple::PullParserToken'); -use strict; - -sub new { # Class->new(tagname); - my $class = shift; - return bless ['end', @_], ref($class) || $class; -} - -# Purely accessors: - -sub tagname { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] } -sub tag { shift->tagname(@_) } - -# shortcut: -sub is_tagname { $_[0][1] eq $_[1] } -sub is_tag { shift->is_tagname(@_) } - -1; - - -__END__ - -=head1 NAME - -Pod::Simple::PullParserEndToken -- end-tokens from Pod::Simple::PullParser - -=head1 SYNOPSIS - -(See L<Pod::Simple::PullParser>) - -=head1 DESCRIPTION - -When you do $parser->get_token on a L<Pod::Simple::PullParser>, you might -get an object of this class. - -This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods, -and adds these methods: - -=over - -=item $token->tagname - -This returns the tagname for this end-token object. -For example, parsing a "=head1 ..." line will give you -a start-token with the tagname of "head1", token(s) for its -content, and then an end-token with the tagname of "head1". - -=item $token->tagname(I<somestring>) - -This changes the tagname for this end-token object. -You probably won't need to do this. - -=item $token->tag(...) - -A shortcut for $token->tagname(...) - -=item $token->is_tag(I<somestring>) or $token->is_tagname(I<somestring>) - -These are shortcuts for C<< $token->tag() eq I<somestring> >> - -=back - -You're unlikely to ever need to construct an object of this class for -yourself, but if you want to, call -C<< -Pod::Simple::PullParserEndToken->new( I<tagname> ) ->> - -=head1 SEE ALSO - -L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserStartToken.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserStartToken.pm deleted file mode 100644 index 9ead50d96ef..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserStartToken.pm +++ /dev/null @@ -1,130 +0,0 @@ - -require 5; -package Pod::Simple::PullParserStartToken; -use Pod::Simple::PullParserToken (); -@ISA = ('Pod::Simple::PullParserToken'); -use strict; - -sub new { # Class->new(tagname, optional_attrhash); - my $class = shift; - return bless ['start', @_], ref($class) || $class; -} - -# Purely accessors: - -sub tagname { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] } -sub tag { shift->tagname(@_) } - -sub is_tagname { $_[0][1] eq $_[1] } -sub is_tag { shift->is_tagname(@_) } - - -sub attr_hash { $_[0][2] ||= {} } - -sub attr { - if(@_ == 2) { # Reading: $token->attr('attrname') - ${$_[0][2] || return undef}{ $_[1] }; - } elsif(@_ > 2) { # Writing: $token->attr('attrname', 'newval') - ${$_[0][2] ||= {}}{ $_[1] } = $_[2]; - } else { - require Carp; - Carp::croak( - 'usage: $object->attr("val") or $object->attr("key", "newval")'); - return undef; - } -} - -1; - - -__END__ - -=head1 NAME - -Pod::Simple::PullParserStartToken -- start-tokens from Pod::Simple::PullParser - -=head1 SYNOPSIS - -(See L<Pod::Simple::PullParser>) - -=head1 DESCRIPTION - -When you do $parser->get_token on a L<Pod::Simple::PullParser> object, you might -get an object of this class. - -This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods, -and adds these methods: - -=over - -=item $token->tagname - -This returns the tagname for this start-token object. -For example, parsing a "=head1 ..." line will give you -a start-token with the tagname of "head1", token(s) for its -content, and then an end-token with the tagname of "head1". - -=item $token->tagname(I<somestring>) - -This changes the tagname for this start-token object. -You probably won't need -to do this. - -=item $token->tag(...) - -A shortcut for $token->tagname(...) - -=item $token->is_tag(I<somestring>) or $token->is_tagname(I<somestring>) - -These are shortcuts for C<< $token->tag() eq I<somestring> >> - -=item $token->attr(I<attrname>) - -This returns the value of the I<attrname> attribute for this start-token -object, or undef. - -For example, parsing a LZ<><Foo/"Bar"> link will produce a start-token -with a "to" attribute with the value "Foo", a "type" attribute with the -value "pod", and a "section" attribute with the value "Bar". - -=item $token->attr(I<attrname>, I<newvalue>) - -This sets the I<attrname> attribute for this start-token object to -I<newvalue>. You probably won't need to do this. - -=item $token->attr_hash - -This returns the hashref that is the attribute set for this start-token. -This is useful if (for example) you want to ask what all the attributes -are -- you can just do C<< keys %{$token->attr_hash} >> - -=back - - -You're unlikely to ever need to construct an object of this class for -yourself, but if you want to, call -C<< -Pod::Simple::PullParserStartToken->new( I<tagname>, I<attrhash> ) ->> - -=head1 SEE ALSO - -L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserTextToken.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserTextToken.pm deleted file mode 100644 index 2d1a1d7dc45..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserTextToken.pm +++ /dev/null @@ -1,101 +0,0 @@ - -require 5; -package Pod::Simple::PullParserTextToken; -use Pod::Simple::PullParserToken (); -@ISA = ('Pod::Simple::PullParserToken'); -use strict; - -sub new { # Class->new(text); - my $class = shift; - return bless ['text', @_], ref($class) || $class; -} - -# Purely accessors: - -sub text { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] } - -sub text_r { \ $_[0][1] } - -1; - -__END__ - -=head1 NAME - -Pod::Simple::PullParserTextToken -- text-tokens from Pod::Simple::PullParser - -=head1 SYNOPSIS - -(See L<Pod::Simple::PullParser>) - -=head1 DESCRIPTION - -When you do $parser->get_token on a L<Pod::Simple::PullParser>, you might -get an object of this class. - -This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods, -and adds these methods: - -=over - -=item $token->text - -This returns the text that this token holds. For example, parsing -CZ<><foo> will return a C start-token, a text-token, and a C end-token. And -if you want to get the "foo" out of the text-token, call C<< $token->text >> - -=item $token->text(I<somestring>) - -This changes the string that this token holds. You probably won't need -to do this. - -=item $token->text_r() - -This returns a scalar reference to the string that this token holds. -This can be useful if you don't want to memory-copy the potentially -large text value (well, as large as a paragraph or a verbatim block) -as calling $token->text would do. - -Or, if you want to alter the value, you can even do things like this: - - for ( ${ $token->text_r } ) { # Aliases it with $_ !! - - s/ The / the /g; # just for example - - if( 'A' eq chr(65) ) { # (if in an ASCII world) - tr/\xA0/ /; - tr/\xAD//d; - } - - ...or however you want to alter the value... - } - -=back - -You're unlikely to ever need to construct an object of this class for -yourself, but if you want to, call -C<< -Pod::Simple::PullParserTextToken->new( I<text> ) ->> - -=head1 SEE ALSO - -L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserToken.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserToken.pm deleted file mode 100644 index 9ec3659f4ed..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/PullParserToken.pm +++ /dev/null @@ -1,138 +0,0 @@ - -require 5; -package Pod::Simple::PullParserToken; - # Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token -@ISA = (); -$VERSION = '2.02'; -use strict; - -sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway - my $class = shift; - return bless [@_], ref($class) || $class; -} - -sub type { $_[0][0] } # Can't change the type of an object -sub dump { Pod::Simple::pretty( [ @{ $_[0] } ] ) } - -sub is_start { $_[0][0] eq 'start' } -sub is_end { $_[0][0] eq 'end' } -sub is_text { $_[0][0] eq 'text' } - -1; -__END__ - -sub dump { '[' . _esc( @{ $_[0] } ) . ']' } - -# JUNK: - -sub _esc { - return '' unless @_; - my @out; - foreach my $in (@_) { - push @out, '"' . $in . '"'; - $out[-1] =~ s/([^- \:\:\.\,\'\>\<\"\/\=\?\+\|\[\]\{\}\_a-zA-Z0-9_\`\~\!\#\%\^\&\*\(\)])/ - sprintf( (ord($1) < 256) ? "\\x%02X" : "\\x{%X}", ord($1)) - /eg; - } - return join ', ', @out; -} - - -__END__ - -=head1 NAME - -Pod::Simple::PullParserToken -- tokens from Pod::Simple::PullParser - -=head1 SYNOPSIS - -Given a $parser that's an object of class Pod::Simple::PullParser -(or a subclass)... - - while(my $token = $parser->get_token) { - $DEBUG and print "Token: ", $token->dump, "\n"; - if($token->is_start) { - ...access $token->tagname, $token->attr, etc... - - } elsif($token->is_text) { - ...access $token->text, $token->text_r, etc... - - } elsif($token->is_end) { - ...access $token->tagname... - - } - } - -(Also see L<Pod::Simple::PullParser>) - -=head1 DESCRIPTION - -When you do $parser->get_token on a L<Pod::Simple::PullParser>, you should -get an object of a subclass of Pod::Simple::PullParserToken. - -Subclasses will add methods, and will also inherit these methods: - -=over - -=item $token->type - -This returns the type of the token. This will be either the string -"start", the string "text", or the string "end". - -Once you know what the type of an object is, you then know what -subclass it belongs to, and therefore what methods it supports. - -Yes, you could probably do the same thing with code like -$token->isa('Pod::Simple::PullParserEndToken'), but that's not so -pretty as using just $token->type, or even the following shortcuts: - -=item $token->is_start - -This is a shortcut for C<< $token->type() eq "start" >> - -=item $token->is_text - -This is a shortcut for C<< $token->type() eq "text" >> - -=item $token->is_end - -This is a shortcut for C<< $token->type() eq "end" >> - -=item $token->dump - -This returns a handy stringified value of this object. This -is useful for debugging, as in: - - while(my $token = $parser->get_token) { - $DEBUG and print "Token: ", $token->dump, "\n"; - ... - } - -=back - -=head1 SEE ALSO - -My subclasses: -L<Pod::Simple::PullParserStartToken>, -L<Pod::Simple::PullParserTextToken>, and -L<Pod::Simple::PullParserEndToken>. - -L<Pod::Simple::PullParser> and L<Pod::Simple> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/RTF.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/RTF.pm deleted file mode 100644 index de2a7b32d64..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/RTF.pm +++ /dev/null @@ -1,674 +0,0 @@ - -require 5; -package Pod::Simple::RTF; - -#sub DEBUG () {4}; -#sub Pod::Simple::DEBUG () {4}; -#sub Pod::Simple::PullParser::DEBUG () {4}; - -use strict; -use vars qw($VERSION @ISA %Escape $WRAP %Tagmap); -$VERSION = '2.02'; -use Pod::Simple::PullParser (); -BEGIN {@ISA = ('Pod::Simple::PullParser')} - -use Carp (); -BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } - -$WRAP = 1 unless defined $WRAP; - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub _openclose { - return map {; - m/^([-A-Za-z]+)=(\w[^\=]*)$/s or die "what's <$_>?"; - ( $1, "{\\$2\n", "/$1", "}" ); - } @_; -} - -my @_to_accept; - -%Tagmap = ( - # 'foo=bar' means ('foo' => '{\bar'."\n", '/foo' => '}') - _openclose( - 'B=cs18\b', - 'I=cs16\i', - 'C=cs19\f1\lang1024\noproof', - 'F=cs17\i\lang1024\noproof', - - 'VerbatimI=cs26\i', - 'VerbatimB=cs27\b', - 'VerbatimBI=cs28\b\i', - - map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ } - qw[ - underline=ul smallcaps=scaps shadow=shad - superscript=super subscript=sub strikethrough=strike - outline=outl emboss=embo engrave=impr - dotted-underline=uld dash-underline=uldash - dot-dash-underline=uldashd dot-dot-dash-underline=uldashdd - double-underline=uldb thick-underline=ulth - word-underline=ulw wave-underline=ulwave - ] - # But no double-strikethrough, because MSWord can't agree with the - # RTF spec on whether it's supposed to be \strikedl or \striked1 (!!!) - ), - - # Bit of a hack here: - 'L=pod' => '{\cs22\i'."\n", - 'L=url' => '{\cs23\i'."\n", - 'L=man' => '{\cs24\i'."\n", - '/L' => '}', - - 'Data' => "\n", - '/Data' => "\n", - - 'Verbatim' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n", - '/Verbatim' => "\n\\par}\n", - 'VerbatimFormatted' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n", - '/VerbatimFormatted' => "\n\\par}\n", - 'Para' => "\n{\\pard\\li#rtfindent#\\sa180\n", - '/Para' => "\n\\par}\n", - 'head1' => "\n{\\pard\\li#rtfindent#\\s31\\keepn\\sb90\\sa180\\f2\\fs#head1_halfpoint_size#\\ul{\n", - '/head1' => "\n}\\par}\n", - 'head2' => "\n{\\pard\\li#rtfindent#\\s32\\keepn\\sb90\\sa180\\f2\\fs#head2_halfpoint_size#\\ul{\n", - '/head2' => "\n}\\par}\n", - 'head3' => "\n{\\pard\\li#rtfindent#\\s33\\keepn\\sb90\\sa180\\f2\\fs#head3_halfpoint_size#\\ul{\n", - '/head3' => "\n}\\par}\n", - 'head4' => "\n{\\pard\\li#rtfindent#\\s34\\keepn\\sb90\\sa180\\f2\\fs#head4_halfpoint_size#\\ul{\n", - '/head4' => "\n}\\par}\n", - # wordpad borks on \tc\tcl1, or I'd put that in =head1 and =head2 - - 'item-bullet' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n", - '/item-bullet' => "\n\\par}\n", - 'item-number' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n", - '/item-number' => "\n\\par}\n", - 'item-text' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n", - '/item-text' => "\n\\par}\n", - - # we don't need any styles for over-* and /over-* -); - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -sub new { - my $new = shift->SUPER::new(@_); - $new->nix_X_codes(1); - $new->nbsp_for_S(1); - $new->accept_targets( 'rtf', 'RTF' ); - - $new->{'Tagmap'} = {%Tagmap}; - - $new->accept_codes(@_to_accept); - $new->accept_codes('VerbatimFormatted'); - DEBUG > 2 and print "To accept: ", join(' ',@_to_accept), "\n"; - $new->doc_lang( - ( $ENV{'RTFDEFLANG'} || '') =~ m/^(\d{1,10})$/s ? $1 - : ($ENV{'RTFDEFLANG'} || '') =~ m/^0?x([a-fA-F0-9]{1,10})$/s ? hex($1) - # yes, tolerate hex! - : ($ENV{'RTFDEFLANG'} || '') =~ m/^([a-fA-F0-9]{4})$/s ? hex($1) - # yes, tolerate even more hex! - : '1033' - ); - - $new->head1_halfpoint_size(32); - $new->head2_halfpoint_size(28); - $new->head3_halfpoint_size(25); - $new->head4_halfpoint_size(22); - $new->codeblock_halfpoint_size(18); - $new->header_halfpoint_size(17); - $new->normal_halfpoint_size(25); - - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -__PACKAGE__->_accessorize( - 'doc_lang', - 'head1_halfpoint_size', - 'head2_halfpoint_size', - 'head3_halfpoint_size', - 'head4_halfpoint_size', - 'codeblock_halfpoint_size', - 'header_halfpoint_size', - 'normal_halfpoint_size', - 'no_proofing_exemptions', -); - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -sub run { - my $self = $_[0]; - return $self->do_middle if $self->bare_output; - return - $self->do_beginning && $self->do_middle && $self->do_end; -} - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub do_middle { # the main work - my $self = $_[0]; - my $fh = $self->{'output_fh'}; - - my($token, $type, $tagname, $scratch); - my @stack; - my @indent_stack; - $self->{'rtfindent'} = 0 unless defined $self->{'rtfindent'}; - - while($token = $self->get_token) { - - if( ($type = $token->type) eq 'text' ) { - if( $self->{'rtfverbatim'} ) { - DEBUG > 1 and print " $type " , $token->text, " in verbatim!\n"; - rtf_esc_codely($scratch = $token->text); - print $fh $scratch; - next; - } - - DEBUG > 1 and print " $type " , $token->text, "\n"; - - $scratch = $token->text; - $scratch =~ tr/\t\cb\cc/ /d; - - $self->{'no_proofing_exemptions'} or $scratch =~ - s/(?: - ^ - | - (?<=[\cm\cj\t "\[\<\(]) - ) # start on whitespace, sequence-start, or quote - ( # something looking like a Perl token: - (?: - [\$\@\:\<\*\\_]\S+ # either starting with a sigil, etc. - ) - | - # or starting alpha, but containing anything strange: - (?: - [a-zA-Z'\x80-\xFF]+[\$\@\:_<>\(\\\*]\S+ - ) - ) - /\cb$1\cc/xsg - ; - - rtf_esc($scratch); - $scratch =~ - s/( - [^\cm\cj\n]{65} # Snare 65 characters from a line - [^\cm\cj\n\x20]{0,50} # and finish any current word - ) - (\x20{1,10})(?![\cm\cj\n]) # capture some spaces not at line-end - /$1$2\n/gx # and put a NL before those spaces - if $WRAP; - # This may wrap at well past the 65th column, but not past the 120th. - - print $fh $scratch; - - } elsif( $type eq 'start' ) { - DEBUG > 1 and print " +$type ",$token->tagname, - " (", map("<$_> ", %{$token->attr_hash}), ")\n"; - - if( ($tagname = $token->tagname) eq 'Verbatim' - or $tagname eq 'VerbatimFormatted' - ) { - ++$self->{'rtfverbatim'}; - my $next = $self->get_token; - next unless defined $next; - my $line_count = 1; - if($next->type eq 'text') { - my $t = $next->text_r; - while( $$t =~ m/$/mg ) { - last if ++$line_count > 15; # no point in counting further - } - DEBUG > 3 and print " verbatim line count: $line_count\n"; - } - $self->unget_token($next); - $self->{'rtfkeep'} = ($line_count > 15) ? '' : '\keepn' ; - - } elsif( $tagname =~ m/^item-/s ) { - my @to_unget; - my $text_count_here = 0; - $self->{'rtfitemkeepn'} = ''; - # Some heuristics to stop item-*'s functioning as subheadings - # from getting split from the things they're subheadings for. - # - # It's not terribly pretty, but it really does make things pretty. - # - while(1) { - push @to_unget, $self->get_token; - pop(@to_unget), last unless defined $to_unget[-1]; - # Erroneously used to be "unshift" instead of pop! Adds instead - # of removes, and operates on the beginning instead of the end! - - if($to_unget[-1]->type eq 'text') { - if( ($text_count_here += length ${$to_unget[-1]->text_r}) > 150 ){ - DEBUG > 1 and print " item-* is too long to be keepn'd.\n"; - last; - } - } elsif (@to_unget > 1 and - $to_unget[-2]->type eq 'end' and - $to_unget[-2]->tagname =~ m/^item-/s - ) { - # Bail out here, after setting rtfitemkeepn yea or nay. - $self->{'rtfitemkeepn'} = '\keepn' if - $to_unget[-1]->type eq 'start' and - $to_unget[-1]->tagname eq 'Para'; - - DEBUG > 1 and printf " item-* before %s(%s) %s keepn'd.\n", - $to_unget[-1]->type, - $to_unget[-1]->can('tagname') ? $to_unget[-1]->tagname : '', - $self->{'rtfitemkeepn'} ? "gets" : "doesn't get"; - last; - } elsif (@to_unget > 40) { - DEBUG > 1 and print " item-* now has too many tokens (", - scalar(@to_unget), - (DEBUG > 4) ? (q<: >, map($_->dump, @to_unget)) : (), - ") to be keepn'd.\n"; - last; # give up - } - # else keep while'ing along - } - # Now put it aaaaall back... - $self->unget_token(@to_unget); - - } elsif( $tagname =~ m/^over-/s ) { - push @stack, $1; - push @indent_stack, - int($token->attr('indent') * 4 * $self->normal_halfpoint_size); - DEBUG and print "Indenting over $indent_stack[-1] twips.\n"; - $self->{'rtfindent'} += $indent_stack[-1]; - - } elsif ($tagname eq 'L') { - $tagname .= '=' . ($token->attr('type') || 'pod'); - - } elsif ($tagname eq 'Data') { - my $next = $self->get_token; - next unless defined $next; - unless( $next->type eq 'text' ) { - $self->unget_token($next); - next; - } - DEBUG and print " raw text ", $next->text, "\n"; - printf $fh "\n" . $next->text . "\n"; - next; - } - - defined($scratch = $self->{'Tagmap'}{$tagname}) or next; - $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate - print $fh $scratch; - - if ($tagname eq 'item-number') { - print $fh $token->attr('number'), ". \n"; - } elsif ($tagname eq 'item-bullet') { - print $fh "\\'95 \n"; - #for funky testing: print $fh '', rtf_esc("\x{4E4B}\x{9053}"); - } - - } elsif( $type eq 'end' ) { - DEBUG > 1 and print " -$type ",$token->tagname,"\n"; - if( ($tagname = $token->tagname) =~ m/^over-/s ) { - DEBUG and print "Indenting back $indent_stack[-1] twips.\n"; - $self->{'rtfindent'} -= pop @indent_stack; - pop @stack; - } elsif( $tagname eq 'Verbatim' or $tagname eq 'VerbatimFormatted') { - --$self->{'rtfverbatim'}; - } - defined($scratch = $self->{'Tagmap'}{"/$tagname"}) or next; - $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate - print $fh $scratch; - } - } - return 1; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -sub do_beginning { - my $self = $_[0]; - my $fh = $self->{'output_fh'}; - return print $fh join '', - $self->doc_init, - $self->font_table, - $self->stylesheet, - $self->color_table, - $self->doc_info, - $self->doc_start, - "\n" - ; -} - -sub do_end { - my $self = $_[0]; - my $fh = $self->{'output_fh'}; - return print $fh '}'; # that should do it -} - -########################################################################### - -sub stylesheet { - return sprintf <<'END', -{\stylesheet -{\snext0 Normal;} -{\*\cs10 \additive Default Paragraph Font;} -{\*\cs16 \additive \i \sbasedon10 pod-I;} -{\*\cs17 \additive \i\lang1024\noproof \sbasedon10 pod-F;} -{\*\cs18 \additive \b \sbasedon10 pod-B;} -{\*\cs19 \additive \f1\lang1024\noproof\sbasedon10 pod-C;} -{\s20\ql \li0\ri0\sa180\widctlpar\f1\fs%s\lang1024\noproof\sbasedon0 \snext0 pod-codeblock;} -{\*\cs21 \additive \lang1024\noproof \sbasedon10 pod-computerese;} -{\*\cs22 \additive \i\lang1024\noproof\sbasedon10 pod-L-pod;} -{\*\cs23 \additive \i\lang1024\noproof\sbasedon10 pod-L-url;} -{\*\cs24 \additive \i\lang1024\noproof\sbasedon10 pod-L-man;} - -{\*\cs25 \additive \f1\lang1024\noproof\sbasedon0 pod-codelbock-plain;} -{\*\cs26 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-ital;} -{\*\cs27 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold;} -{\*\cs28 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold-ital;} - -{\s31\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head1;} -{\s32\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head2;} -{\s33\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head3;} -{\s34\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head4;} -} - -END - - $_[0]->codeblock_halfpoint_size(), - $_[0]->head1_halfpoint_size(), - $_[0]->head2_halfpoint_size(), - $_[0]->head3_halfpoint_size(), - $_[0]->head4_halfpoint_size(), - ; -} - -########################################################################### -# Override these as necessary for further customization - -sub font_table { - return <<'END'; # text font, code font, heading font -{\fonttbl -{\f0\froman Times New Roman;} -{\f1\fmodern Courier New;} -{\f2\fswiss Arial;} -} - -END -} - -sub doc_init { - return <<'END'; -{\rtf1\ansi\deff0 - -END -} - -sub color_table { - return <<'END'; -{\colortbl;\red255\green0\blue0;\red0\green0\blue255;} -END -} - - -sub doc_info { - my $self = $_[0]; - - my $class = ref($self) || $self; - - my $tag = __PACKAGE__ . ' ' . $VERSION; - - unless($class eq __PACKAGE__) { - $tag = " ($tag)"; - $tag = " v" . $self->VERSION . $tag if defined $self->VERSION; - $tag = $class . $tag; - } - - return sprintf <<'END', -{\info{\doccomm -%s - using %s v%s - under Perl v%s at %s GMT} -{\author [see doc]}{\company [see doc]}{\operator [see doc]} -} - -END - - # None of the following things should need escaping, I dare say! - $tag, - $ISA[0], $ISA[0]->VERSION(), - $], scalar(gmtime), - ; -} - -sub doc_start { - my $self = $_[0]; - my $title = $self->get_short_title(); - DEBUG and print "Short Title: <$title>\n"; - $title .= ' ' if length $title; - - $title =~ s/ *$/ /s; - $title =~ s/^ //s; - $title =~ s/ $/, /s; - # make sure it ends in a comma and a space, unless it's 0-length - - my $is_obviously_module_name; - $is_obviously_module_name = 1 - if $title =~ m/^\S+$/s and $title =~ m/::/s; - # catches the most common case, at least - - DEBUG and print "Title0: <$title>\n"; - $title = rtf_esc($title); - DEBUG and print "Title1: <$title>\n"; - $title = '\lang1024\noproof ' . $title - if $is_obviously_module_name; - - return sprintf <<'END', -\deflang%s\plain\lang%s\widowctrl -{\header\pard\qr\plain\f2\fs%s -%s -p.\chpgn\par} -\fs%s - -END - ($self->doc_lang) x 2, - $self->header_halfpoint_size, - $title, - $self->normal_halfpoint_size, - ; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -#------------------------------------------------------------------------- - -use integer; -sub rtf_esc { - my $x; # scratch - if(!defined wantarray) { # void context: alter in-place! - for(@_) { - s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER - s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; - } - return; - } elsif(wantarray) { # return an array - return map {; ($x = $_) =~ - s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER - $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; - $x; - } @_; - } else { # return a single scalar - ($x = ((@_ == 1) ? $_[0] : join '', @_) - ) =~ s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER - # Escape \, {, }, -, control chars, and 7f-ff. - $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; - return $x; - } -} - -sub rtf_esc_codely { - # Doesn't change "-" to hard-hyphen, nor apply computerese style-smarts. - # We don't want to change the "-" to hard-hyphen, because we want to - # be able to paste this into a file and run it without there being - # dire screaming about the mysterious hard-hyphen character (which - # looks just like a normal dash character). - - my $x; # scratch - if(!defined wantarray) { # void context: alter in-place! - for(@_) { - s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER - s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; - } - return; - } elsif(wantarray) { # return an array - return map {; ($x = $_) =~ - s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER - $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; - $x; - } @_; - } else { # return a single scalar - ($x = ((@_ == 1) ? $_[0] : join '', @_) - ) =~ s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER - # Escape \, {, }, -, control chars, and 7f-ff. - $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; - return $x; - } -} - -%Escape = ( - map( (chr($_),chr($_)), # things not apparently needing escaping - 0x20 .. 0x7E ), - map( (chr($_),sprintf("\\'%02x", $_)), # apparently escapeworthy things - 0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46), - - # We get to escape out 'F' so that we can send RTF files thru the mail - # without the slightest worry that paragraphs beginning with "From" - # will get munged. - - # And some refinements: - "\cm" => "\n", - "\cj" => "\n", - "\n" => "\n\\line ", - - "\t" => "\\tab ", # Tabs (altho theoretically raw \t's are okay) - "\f" => "\n\\page\n", # Formfeed - "-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen - "\xA0" => "\\~", # Latin-1 non-breaking space - "\xAD" => "\\-", # Latin-1 soft (optional) hyphen - - # CRAZY HACKS: - "\n" => "\\line\n", - "\r" => "\n", - "\cb" => "{\n\\cs21\\lang1024\\noproof ", # \\cf1 - "\cc" => "}", -); -1; - -__END__ - -=head1 NAME - -Pod::Simple::RTF -- format Pod as RTF - -=head1 SYNOPSIS - - perl -MPod::Simple::RTF -e \ - "exit Pod::Simple::RTF->filter(shift)->any_errata_seen" \ - thingy.pod > thingy.rtf - -=head1 DESCRIPTION - -This class is a formatter that takes Pod and renders it as RTF, good for -viewing/printing in MSWord, WordPad/write.exe, TextEdit, etc. - -This is a subclass of L<Pod::Simple> and inherits all its methods. - -=head1 FORMAT CONTROL ATTRIBUTES - -You can set these attributes on the parser object before you -call C<parse_file> (or a similar method) on it: - -=over - -=item $parser->head1_halfpoint_size( I<halfpoint_integer> ); - -=item $parser->head2_halfpoint_size( I<halfpoint_integer> ); - -=item $parser->head3_halfpoint_size( I<halfpoint_integer> ); - -=item $parser->head4_halfpoint_size( I<halfpoint_integer> ); - -These methods set the size (in half-points, like 52 for 26-point) -that these heading levels will appear as. - -=item $parser->codeblock_halfpoint_size( I<halfpoint_integer> ); - -This method sets the size (in half-points, like 21 for 10.5-point) -that codeblocks ("verbatim sections") will appear as. - -=item $parser->header_halfpoint_size( I<halfpoint_integer> ); - -This method sets the size (in half-points, like 15 for 7.5-point) -that the header on each page will appear in. The header -is usually just "I<modulename> p. I<pagenumber>". - -=item $parser->normal_halfpoint_size( I<halfpoint_integer> ); - -This method sets the size (in half-points, like 26 for 13-point) -that normal paragraphic text will appear in. - -=item $parser->no_proofing_exemptions( I<true_or_false> ); - -Set this value to true if you don't want the formatter to try -putting a hidden code on all Perl symbols (as best as it can -notice them) that labels them as being not in English, and -so not worth spellchecking. - -=item $parser->doc_lang( I<microsoft_decimal_language_code> ) - -This sets the language code to tag this document as being in. By -default, it is currently the value of the environment variable -C<RTFDEFLANG>, or if that's not set, then the value -1033 (for US English). - -Setting this appropriately is useful if you want to use the RTF -to spellcheck, and/or if you want it to hyphenate right. - -Here are some notable values: - - 1033 US English - 2057 UK English - 3081 Australia English - 4105 Canada English - 1034 Spain Spanish - 2058 Mexico Spanish - 1031 Germany German - 1036 France French - 3084 Canada French - 1035 Finnish - 1044 Norwegian (Bokmal) - 2068 Norwegian (Nynorsk) - -=back - -If you are particularly interested in customizing this module's output -even more, see the source and/or write to me. - -=head1 SEE ALSO - -L<Pod::Simple>, L<RTF::Writer>, L<RTF::Cookbook>, L<RTF::Document>, -L<RTF::Generator> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Search.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Search.pm deleted file mode 100644 index 980b3b7739c..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Search.pm +++ /dev/null @@ -1,1016 +0,0 @@ - -require 5.005; -package Pod::Simple::Search; -use strict; - -use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY); -$VERSION = 3.04; ## Current version of this package - -BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level -use Carp (); - -$SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i; - # flag to occasionally sleep for $SLEEPY - 1 seconds. - -$MAX_VERSION_WITHIN ||= 60; - -############################################################################# - -#use diagnostics; -use File::Spec (); -use File::Basename qw( basename ); -use Config (); -use Cwd qw( cwd ); - -#========================================================================== -__PACKAGE__->_accessorize( # Make my dumb accessor methods - 'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob', - 'limit_re', 'shadows', 'verbose', 'name2path', 'path2name', -); -#========================================================================== - -sub new { - my $class = shift; - my $self = bless {}, ref($class) || $class; - $self->init; - return $self; -} - -sub init { - my $self = shift; - $self->inc(1); - $self->verbose(DEBUG); - return $self; -} - -#-------------------------------------------------------------------------- - -sub survey { - my($self, @search_dirs) = @_; - $self = $self->new unless ref $self; # tolerate being a class method - - $self->_expand_inc( \@search_dirs ); - - - $self->{'_scan_count'} = 0; - $self->{'_dirs_visited'} = {}; - $self->path2name( {} ); - $self->name2path( {} ); - $self->limit_re( $self->_limit_glob_to_limit_re ) if $self->{'limit_glob'}; - my $cwd = cwd(); - my $verbose = $self->verbose; - local $_; # don't clobber the caller's $_ ! - - foreach my $try (@search_dirs) { - unless( File::Spec->file_name_is_absolute($try) ) { - # make path absolute - $try = File::Spec->catfile( $cwd ,$try); - } - # simplify path - $try = File::Spec->canonpath($try); - - my $start_in; - my $modname_prefix; - if($self->{'dir_prefix'}) { - $start_in = File::Spec->catdir( - $try, - grep length($_), split '[\\/:]+', $self->{'dir_prefix'} - ); - $modname_prefix = [grep length($_), split m{[:/\\]}, $self->{'dir_prefix'}]; - $verbose and print "Appending \"$self->{'dir_prefix'}\" to $try, ", - "giving $start_in (= @$modname_prefix)\n"; - } else { - $start_in = $try; - } - - if( $self->{'_dirs_visited'}{$start_in} ) { - $verbose and print "Directory '$start_in' already seen, skipping.\n"; - next; - } else { - $self->{'_dirs_visited'}{$start_in} = 1; - } - - unless(-e $start_in) { - $verbose and print "Skipping non-existent $start_in\n"; - next; - } - - my $closure = $self->_make_search_callback; - - if(-d $start_in) { - # Normal case: - $verbose and print "Beginning excursion under $start_in\n"; - $self->_recurse_dir( $start_in, $closure, $modname_prefix ); - $verbose and print "Back from excursion under $start_in\n\n"; - - } elsif(-f _) { - # A excursion consisting of just one file! - $_ = basename($start_in); - $verbose and print "Pondering $start_in ($_)\n"; - $closure->($start_in, $_, 0, []); - - } else { - $verbose and print "Skipping mysterious $start_in\n"; - } - } - $self->progress and $self->progress->done( - "Noted $$self{'_scan_count'} Pod files total"); - - return unless defined wantarray; # void - return $self->name2path unless wantarray; # scalar - return $self->name2path, $self->path2name; # list -} - - -#========================================================================== -sub _make_search_callback { - my $self = $_[0]; - - # Put the options in variables, for easy access - my( $laborious, $verbose, $shadows, $limit_re, $callback, $progress,$path2name,$name2path) = - map scalar($self->$_()), - qw(laborious verbose shadows limit_re callback progress path2name name2path); - - my($file, $shortname, $isdir, $modname_bits); - return sub { - ($file, $shortname, $isdir, $modname_bits) = @_; - - if($isdir) { # this never gets called on the startdir itself, just subdirs - - if( $self->{'_dirs_visited'}{$file} ) { - $verbose and print "Directory '$file' already seen, skipping.\n"; - return 'PRUNE'; - } - - print "Looking in dir $file\n" if $verbose; - - unless ($laborious) { # $laborious overrides pruning - if( m/^(\d+\.[\d_]{3,})\z/s - and do { my $x = $1; $x =~ tr/_//d; $x != $] } - ) { - $verbose and print "Perl $] version mismatch on $_, skipping.\n"; - return 'PRUNE'; - } - - if( m/^([A-Za-z][a-zA-Z0-9_]*)\z/s ) { - $verbose and print "$_ is a well-named module subdir. Looking....\n"; - } else { - $verbose and print "$_ is a fishy directory name. Skipping.\n"; - return 'PRUNE'; - } - } # end unless $laborious - - $self->{'_dirs_visited'}{$file} = 1; - return; # (not pruning); - } - - - # Make sure it's a file even worth even considering - if($laborious) { - unless( - m/\.(pod|pm|plx?)\z/i || -x _ and -T _ - # Note that the cheapest operation (the RE) is run first. - ) { - $verbose > 1 and print " Brushing off uninteresting $file\n"; - return; - } - } else { - unless( m/^[-_a-zA-Z0-9]+\.(?:pod|pm|plx?)\z/is ) { - $verbose > 1 and print " Brushing off oddly-named $file\n"; - return; - } - } - - $verbose and print "Considering item $file\n"; - my $name = $self->_path2modname( $file, $shortname, $modname_bits ); - $verbose > 0.01 and print " Nominating $file as $name\n"; - - if($limit_re and $name !~ m/$limit_re/i) { - $verbose and print "Shunning $name as not matching $limit_re\n"; - return; - } - - if( !$shadows and $name2path->{$name} ) { - $verbose and print "Not worth considering $file ", - "-- already saw $name as ", - join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n"; - return; - } - - # Put off until as late as possible the expense of - # actually reading the file: - if( m/\.pod\z/is ) { - # just assume it has pod, okay? - } else { - $progress and $progress->reach($self->{'_scan_count'}, "Scanning $file"); - return unless $self->contains_pod( $file ); - } - ++ $self->{'_scan_count'}; - - # Or finally take note of it: - if( $name2path->{$name} ) { - $verbose and print - "Duplicate POD found (shadowing?): $name ($file)\n", - " Already seen in ", - join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n"; - } else { - $name2path->{$name} = $file; # Noting just the first occurrence - } - $verbose and print " Noting $name = $file\n"; - if( $callback ) { - local $_ = $_; # insulate from changes, just in case - $callback->($file, $name); - } - $path2name->{$file} = $name; - return; - } -} - -#========================================================================== - -sub _path2modname { - my($self, $file, $shortname, $modname_bits) = @_; - - # 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 perl*.pod (e.g. in pod/perlfunc.pod) - # * dig into the file for case-preserved name if not already mixed case - - my @m = @$modname_bits; - my $x; - my $verbose = $self->verbose; - - # Shaving off leading naughty-bits - while(@m - and defined($x = lc( $m[0] )) - and( $x eq 'site_perl' - or($x eq 'pod' and @m == 1 and $shortname =~ m{^perl.*\.pod$}s ) - or $x =~ m{\\d+\\.z\\d+([_.]?\\d+)?} # if looks like a vernum - or $x eq lc( $Config::Config{'archname'} ) - )) { shift @m } - - my $name = join '::', @m, $shortname; - $self->_simplify_base($name); - - # On VMS, case-preserved document names can't be constructed from - # filenames, so try to extract them from the "=head1 NAME" tag in the - # file instead. - if ($^O eq 'VMS' && ($name eq lc($name) || $name eq uc($name))) { - open PODFILE, "<$file" or die "_path2modname: Can't open $file: $!"; - my $in_pod = 0; - my $in_name = 0; - my $line; - while ($line = <PODFILE>) { - chomp $line; - $in_pod = 1 if ($line =~ m/^=\w/); - $in_pod = 0 if ($line =~ m/^=cut/); - next unless $in_pod; # skip non-pod text - next if ($line =~ m/^\s*\z/); # and blank lines - next if ($in_pod && ($line =~ m/^X</)); # and commands - if ($in_name) { - if ($line =~ m/(\w+::)?(\w+)/) { - # substitute case-preserved version of name - my $podname = $2; - my $prefix = $1 || ''; - $verbose and print "Attempting case restore of '$name' from '$prefix$podname'\n"; - unless ($name =~ s/$prefix$podname/$prefix$podname/i) { - $verbose and print "Attempting case restore of '$name' from '$podname'\n"; - $name =~ s/$podname/$podname/i; - } - last; - } - } - $in_name = 1 if ($line =~ m/^=head1 NAME/); - } - close PODFILE; - } - - return $name; -} - -#========================================================================== - -sub _recurse_dir { - my($self, $startdir, $callback, $modname_bits) = @_; - - my $maxdepth = $self->{'fs_recursion_maxdepth'} || 10; - my $verbose = $self->verbose; - - my $here_string = File::Spec->curdir; - my $up_string = File::Spec->updir; - $modname_bits ||= []; - - my $recursor; - $recursor = sub { - my($dir_long, $dir_bare) = @_; - if( @$modname_bits >= 10 ) { - $verbose and print "Too deep! [@$modname_bits]\n"; - return; - } - - unless(-d $dir_long) { - $verbose > 2 and print "But it's not a dir! $dir_long\n"; - return; - } - unless( opendir(INDIR, $dir_long) ) { - $verbose > 2 and print "Can't opendir $dir_long : $!\n"; - closedir(INDIR); - return - } - my @items = sort readdir(INDIR); - closedir(INDIR); - - push @$modname_bits, $dir_bare unless $dir_bare eq ''; - - my $i_full; - foreach my $i (@items) { - next if $i eq $here_string or $i eq $up_string or $i eq ''; - $i_full = File::Spec->catfile( $dir_long, $i ); - - if(!-r $i_full) { - $verbose and print "Skipping unreadable $i_full\n"; - - } elsif(-f $i_full) { - $_ = $i; - $callback->( $i_full, $i, 0, $modname_bits ); - - } elsif(-d _) { - $i =~ s/\.DIR\z//i if $^O eq 'VMS'; - $_ = $i; - my $rv = $callback->( $i_full, $i, 1, $modname_bits ) || ''; - - if($rv eq 'PRUNE') { - $verbose > 1 and print "OK, pruning"; - } else { - # Otherwise, recurse into it - $recursor->( File::Spec->catdir($dir_long, $i) , $i); - } - } else { - $verbose > 1 and print "Skipping oddity $i_full\n"; - } - } - pop @$modname_bits; - return; - };; - - local $_; - $recursor->($startdir, ''); - - undef $recursor; # allow it to be GC'd - - return; -} - - -#========================================================================== - -sub run { - # A function, useful in one-liners - - my $self = __PACKAGE__->new; - $self->limit_glob($ARGV[0]) if @ARGV; - $self->callback( sub { - my($file, $name) = @_; - my $version = ''; - - # Yes, I know we won't catch the version in like a File/Thing.pm - # if we see File/Thing.pod first. That's just the way the - # cookie crumbles. -- SMB - - if($file =~ m/\.pod$/i) { - # Don't bother looking for $VERSION in .pod files - DEBUG and print "Not looking for \$VERSION in .pod $file\n"; - } elsif( !open(INPOD, $file) ) { - DEBUG and print "Couldn't open $file: $!\n"; - close(INPOD); - } else { - # Sane case: file is readable - my $lines = 0; - while(<INPOD>) { - last if $lines++ > $MAX_VERSION_WITHIN; # some degree of sanity - if( s/^\s*\$VERSION\s*=\s*//s and m/\d/ ) { - DEBUG and print "Found version line (#$lines): $_"; - s/\s*\#.*//s; - s/\;\s*$//s; - s/\s+$//s; - s/\t+/ /s; # nix tabs - # Optimize the most common cases: - $_ = "v$1" - if m{^v?["']?([0-9_]+(\.[0-9_]+)*)["']?$}s - # like in $VERSION = "3.14159"; - or m{\$Revision:\s*([0-9_]+(?:\.[0-9_]+)*)\s*\$}s - # like in sprintf("%d.%02d", q$Revision: 4.13 $ =~ /(\d+)\.(\d+)/); - ; - - # Like in sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/) - $_ = sprintf("v%d.%s", - map {s/_//g; $_} - $1 =~ m/-(\d+)_([\d_]+)/) # snare just the numeric part - if m{\$Name:\s*([^\$]+)\$}s - ; - $version = $_; - DEBUG and print "Noting $version as version\n"; - last; - } - } - close(INPOD); - } - print "$name\t$version\t$file\n"; - return; - # End of callback! - }); - - $self->survey; -} - -#========================================================================== - -sub simplify_name { - my($self, $str) = @_; - - # Remove all path components - # XXX Why not just use basename()? -- SMB - - if ($^O eq 'MacOS') { $str =~ s{^.*:+}{}s } - else { $str =~ s{^.*/+}{}s } - - $self->_simplify_base($str); - return $str; -} - -#========================================================================== - -sub _simplify_base { # Internal method only - - # strip Perl's own extensions - $_[1] =~ s/\.(pod|pm|plx?)\z//i; - - # strip meaningless extensions on Win32 and OS/2 - $_[1] =~ s/\.(bat|exe|cmd)\z//i if $^O =~ /mswin|os2/i; - - # strip meaningless extensions on VMS - $_[1] =~ s/\.(com)\z//i if $^O eq 'VMS'; - - return; -} - -#========================================================================== - -sub _expand_inc { - my($self, $search_dirs) = @_; - - return unless $self->{'inc'}; - - if ($^O eq 'MacOS') { - push @$search_dirs, - grep $_ ne File::Spec->curdir, $self->_mac_whammy(@INC); - # Any other OSs need custom handling here? - } else { - push @$search_dirs, grep $_ ne File::Spec->curdir, @INC; - } - - $self->{'laborious'} = 0; # Since inc said to use INC - return; -} - -#========================================================================== - -sub _mac_whammy { # Tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS - my @them; - (undef,@them) = @_; - for $_ (@them) { - if ( $_ eq '.' ) { - $_ = ':'; - } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) { - $_ = ':'. $_; - } else { - $_ =~ s|^\./|:|; - } - } - return @them; -} - -#========================================================================== - -sub _limit_glob_to_limit_re { - my $self = $_[0]; - my $limit_glob = $self->{'limit_glob'} || return; - - my $limit_re = '^' . quotemeta($limit_glob) . '$'; - $limit_re =~ s/\\\?/./g; # glob "?" => "." - $limit_re =~ s/\\\*/.*?/g; # glob "*" => ".*?" - $limit_re =~ s/\.\*\?\$$//s; # final glob "*" => ".*?$" => "" - - $self->{'verbose'} and print "Turning limit_glob $limit_glob into re $limit_re\n"; - - # A common optimization: - if(!exists($self->{'dir_prefix'}) - and $limit_glob =~ m/^(?:\w+\:\:)+/s # like "File::*" or "File::Thing*" - # Optimize for sane and common cases (but not things like "*::File") - ) { - $self->{'dir_prefix'} = join "::", $limit_glob =~ m/^(?:\w+::)+/sg; - $self->{'verbose'} and print " and setting dir_prefix to $self->{'dir_prefix'}\n"; - } - - return $limit_re; -} - -#========================================================================== - -# contribution mostly from Tim Jenness <t.jenness@jach.hawaii.edu> - -sub find { - my($self, $pod, @search_dirs) = @_; - $self = $self->new unless ref $self; # tolerate being a class method - - # Check usage - Carp::carp 'Usage: \$self->find($podname, ...)' - unless defined $pod and length $pod; - - my $verbose = $self->verbose; - - # Split on :: and then join the name together using File::Spec - my @parts = split /::/, $pod; - $verbose and print "Chomping {$pod} => {@parts}\n"; - - #@search_dirs = File::Spec->curdir unless @search_dirs; - - if( $self->inc ) { - if( $^O eq 'MacOS' ) { - push @search_dirs, $self->_mac_whammy(@INC); - } else { - 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'}; - # and if that's undef or q{} or nonexistent, we just ignore it later - } - - my %seen_dir; - Dir: - foreach my $dir ( @search_dirs ) { - next unless defined $dir and length $dir; - next if $seen_dir{$dir}; - $seen_dir{$dir} = 1; - unless(-d $dir) { - print "Directory $dir does not exist\n" if $verbose; - next Dir; - } - - print "Looking in directory $dir\n" if $verbose; - my $fullname = File::Spec->catfile( $dir, @parts ); - print "Filename is now $fullname\n" if $verbose; - - foreach my $ext ('', '.pod', '.pm', '.pl') { # possible extensions - my $fullext = $fullname . $ext; - if( -f $fullext and $self->contains_pod( $fullext ) ){ - print "FOUND: $fullext\n" if $verbose; - return $fullext; - } - } - my $subdir = File::Spec->catdir($dir,'pod'); - if(-d $subdir) { # slip in the ./pod dir too - $verbose and print "Noticing $subdir and stopping there...\n"; - $dir = $subdir; - redo Dir; - } - } - - return undef; -} - -#========================================================================== - -sub contains_pod { - my($self, $file) = @_; - my $verbose = $self->{'verbose'}; - - # check for one line of POD - $verbose > 1 and print " Scanning $file for pod...\n"; - unless( open(MAYBEPOD,"<$file") ) { - print "Error: $file is unreadable: $!\n"; - return undef; - } - - sleep($SLEEPY - 1) if $SLEEPY; - # avoid totally hogging the processor on OSs with poor process control - - local $_; - while( <MAYBEPOD> ) { - if(m/^=(head\d|pod|over|item)\b/s) { - close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; - chomp; - $verbose > 1 and print " Found some pod ($_) in $file\n"; - return 1; - } - } - close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; - $verbose > 1 and print " No POD in $file, skipping.\n"; - return 0; -} - -#========================================================================== - -sub _accessorize { # A simple-minded method-maker - shift; - no strict 'refs'; - foreach my $attrname (@_) { - *{caller() . '::' . $attrname} = sub { - use strict; - $Carp::CarpLevel = 1, Carp::croak( - "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)" - ) unless (@_ == 1 or @_ == 2) and ref $_[0]; - - # Read access: - return $_[0]->{$attrname} if @_ == 1; - - # Write access: - $_[0]->{$attrname} = $_[1]; - return $_[0]; # RETURNS MYSELF! - }; - } - # Ya know, they say accessories make the ensemble! - return; -} - -#========================================================================== -sub _state_as_string { - my $self = $_[0]; - return '' unless ref $self; - my @out = "{\n # State of $self ...\n"; - foreach my $k (sort keys %$self) { - push @out, " ", _esc($k), " => ", _esc($self->{$k}), ",\n"; - } - push @out, "}\n"; - my $x = join '', @out; - $x =~ s/^/#/mg; - return $x; -} - -sub _esc { - my $in = $_[0]; - return 'undef' unless defined $in; - $in =~ - s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> - <'\\x'.(unpack("H2",$1))>eg; - return qq{"$in"}; -} - -#========================================================================== - -run() unless caller; # run if "perl whatever/Search.pm" - -1; - -#========================================================================== - -__END__ - - -=head1 NAME - -Pod::Simple::Search - find POD documents in directory trees - -=head1 SYNOPSIS - - use Pod::Simple::Search; - my $name2path = Pod::Simple::Search->new->limit_glob('LWP::*')->survey; - print "Looky see what I found: ", - join(' ', sort keys %$name2path), "\n"; - - print "LWPUA docs = ", - Pod::Simple::Search->new->find('LWP::UserAgent') || "?", - "\n"; - -=head1 DESCRIPTION - -B<Pod::Simple::Search> is a class that you use for running searches -for Pod files. An object of this class has several attributes -(mostly options for controlling search options), and some methods -for searching based on those attributes. - -The way to use this class is to make a new object of this class, -set any options, and then call one of the search options -(probably C<survey> or C<find>). The sections below discuss the -syntaxes for doing all that. - - -=head1 CONSTRUCTOR - -This class provides the one constructor, called C<new>. -It takes no parameters: - - use Pod::Simple::Search; - my $search = Pod::Simple::Search->new; - -=head1 ACCESSORS - -This class defines several methods for setting (and, occasionally, -reading) the contents of an object. With two exceptions (discussed at -the end of this section), these attributes are just for controlling the -way searches are carried out. - -Note that each of these return C<$self> when you call them as -C<< $self->I<whatever(value)> >>. That's so that you can chain -together set-attribute calls like this: - - my $name2path = - Pod::Simple::Search->new - -> inc(0) -> verbose(1) -> callback(\&blab) - ->survey(@there); - -...which works exactly as if you'd done this: - - my $search = Pod::Simple::Search->new; - $search->inc(0); - $search->verbose(1); - $search->callback(\&blab); - my $name2path = $search->survey(@there); - -=over - -=item $search->inc( I<true-or-false> ); - -This attribute, if set to a true value, means that searches should -implicitly add perl's I<@INC> paths. This -automatically considers paths specified in the C<PERL5LIB> environment -as this is prepended to I<@INC> by the Perl interpreter itself. -This attribute's default value is B<TRUE>. If you want to search -only specific directories, set $self->inc(0) before calling -$inc->survey or $inc->find. - - -=item $search->verbose( I<nonnegative-number> ); - -This attribute, if set to a nonzero positive value, will make searches output -(via C<warn>) notes about what they're doing as they do it. -This option may be useful for debugging a pod-related module. -This attribute's default value is zero, meaning that no C<warn> messages -are produced. (Setting verbose to 1 turns on some messages, and setting -it to 2 turns on even more messages, i.e., makes the following search(es) -even more verbose than 1 would make them.) - - -=item $search->limit_glob( I<some-glob-string> ); - -This option means that you want to limit the results just to items whose -podnames match the given glob/wildcard expression. For example, you -might limit your search to just "LWP::*", to search only for modules -starting with "LWP::*" (but not including the module "LWP" itself); or -you might limit your search to "LW*" to see only modules whose (full) -names begin with "LW"; or you might search for "*Find*" to search for -all modules with "Find" somewhere in their full name. (You can also use -"?" in a glob expression; so "DB?" will match "DBI" and "DBD".) - - -=item $search->callback( I<\&some_routine> ); - -This attribute means that every time this search sees a matching -Pod file, it should call this callback routine. The routine is called -with two parameters: the current file's filespec, and its pod name. -(For example: C<("/etc/perljunk/File/Crunk.pm", "File::Crunk")> would -be in C<@_>.) - -The callback routine's return value is not used for anything. - -This attribute's default value is false, meaning that no callback -is called. - -=item $search->laborious( I<true-or-false> ); - -Unless you set this attribute to a true value, Pod::Search will -apply Perl-specific heuristics to find the correct module PODs quickly. -This attribute's default value is false. You won't normally need -to set this to true. - -Specifically: Turning on this option will disable the heuristics for -seeing only files with Perl-like extensions, omitting subdirectories -that are numeric but do I<not> match the current Perl interpreter's -version ID, suppressing F<site_perl> as a module hierarchy name, etc. - - -=item $search->shadows( I<true-or-false> ); - -Unless you set this attribute to a true value, Pod::Simple::Search will -consider only the first file of a given modulename as it looks thru the -specified directories; that is, with this option off, if -Pod::Simple::Search has seen a C<somepathdir/Foo/Bar.pm> already in this -search, then it won't bother looking at a C<somelaterpathdir/Foo/Bar.pm> -later on in that search, because that file is merely a "shadow". But if -you turn on C<< $self->shadows(1) >>, then these "shadow" files are -inspected too, and are noted in the pathname2podname return hash. - -This attribute's default value is false; and normally you won't -need to turn it on. - - -=item $search->limit_re( I<some-regxp> ); - -Setting this attribute (to a value that's a regexp) means that you want -to limit the results just to items whose podnames match the given -regexp. Normally this option is not needed, and the more efficient -C<limit_glob> attribute is used instead. - - -=item $search->dir_prefix( I<some-string-value> ); - -Setting this attribute to a string value means that the searches should -begin in the specified subdirectory name (like "Pod" or "File::Find", -also expressable as "File/Find"). For example, the search option -C<< $search->limit_glob("File::Find::R*") >> -is the same as the combination of the search options -C<< $search->limit_re("^File::Find::R") -> dir_prefix("File::Find") >>. - -Normally you don't need to know about the C<dir_prefix> option, but I -include it in case it might prove useful for someone somewhere. - -(Implementationally, searching with limit_glob ends up setting limit_re -and usually dir_prefix.) - - -=item $search->progress( I<some-progress-object> ); - -If you set a value for this attribute, the value is expected -to be an object (probably of a class that you define) that has a -C<reach> method and a C<done> method. This is meant for reporting -progress during the search, if you don't want to use a simple -callback. - -Normally you don't need to know about the C<progress> option, but I -include it in case it might prove useful for someone somewhere. - -While a search is in progress, the progress object's C<reach> and -C<done> methods are called like this: - - # Every time a file is being scanned for pod: - $progress->reach($count, "Scanning $file"); ++$count; - - # And then at the end of the search: - $progress->done("Noted $count Pod files total"); - -Internally, we often set this to an object of class -Pod::Simple::Progress. That class is probably undocumented, -but you may wish to look at its source. - - -=item $name2path = $self->name2path; - -This attribute is not a search parameter, but is used to report the -result of C<survey> method, as discussed in the next section. - -=item $path2name = $self->path2name; - -This attribute is not a search parameter, but is used to report the -result of C<survey> method, as discussed in the next section. - -=back - -=head1 MAIN SEARCH METHODS - -Once you've actually set any options you want (if any), you can go -ahead and use the following methods to search for Pod files -in particular ways. - - -=head2 C<< $search->survey( @directories ) >> - -The method C<survey> searches for POD documents in a given set of -files and/or directories. This runs the search according to the various -options set by the accessors above. (For example, if the C<inc> attribute -is on, as it is by default, then the perl @INC directories are implicitly -added to the list of directories (if any) that you specify.) - -The return value of C<survey> is two hashes: - -=over - -=item C<name2path> - -A hash that maps from each pod-name to the filespec (like -"Stuff::Thing" => "/whatever/plib/Stuff/Thing.pm") - -=item C<path2name> - -A hash that maps from each Pod filespec to its pod-name (like -"/whatever/plib/Stuff/Thing.pm" => "Stuff::Thing") - -=back - -Besides saving these hashes as the hashref attributes -C<name2path> and C<path2name>, calling this function also returns -these hashrefs. In list context, the return value of -C<< $search->survey >> is the list C<(\%name2path, \%path2name)>. -In scalar context, the return value is C<\%name2path>. -Or you can just call this in void context. - -Regardless of calling context, calling C<survey> saves -its results in its C<name2path> and C<path2name> attributes. - -E.g., when searching in F<$HOME/perl5lib>, the file -F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>, -whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be -I<Myclass::Subclass>. The name information can be used for POD -translators. - -Only text files containing at least one valid POD command are found. - -In verbose mode, a warning is printed if shadows are found (i.e., more -than one POD file with the same POD name is found, e.g. F<CPAN.pm> in -different directories). This usually indicates duplicate occurrences of -modules in the I<@INC> search path, which is occasionally inadvertent -(but is often simply a case of a user's path dir having a more recent -version than the system's general path dirs in general.) - -The options to this argument is a list of either directories that are -searched recursively, or files. (Usually you wouldn't specify files, -but just dirs.) Or you can just specify an empty-list, as in -$name2path; with the -C<inc> option on, as it is by default, teh - -The POD names of files are the plain basenames with any Perl-like -extension (.pm, .pl, .pod) stripped, and path separators replaced by -C<::>'s. - -Calling Pod::Simple::Search->search(...) is short for -Pod::Simple::Search->new->search(...). That is, a throwaway object -with default attribute values is used. - - -=head2 C<< $search->simplify_name( $str ) >> - -The method B<simplify_name> is equivalent to B<basename>, 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. - - -=head2 C<< $search->find( $pod ) >> - -=head2 C<< $search->find( $pod, @search_dirs ) >> - -Returns the location of a Pod file, given a Pod/module/script name -(like "Foo::Bar" or "perlvar" or "perldoc"), and an idea of -what files/directories to look in. -It searches according to the various options set by the accessors above. -(For example, if the C<inc> attribute is on, as it is by default, then -the perl @INC directories are implicitly added to the list of -directories (if any) that you specify.) - -This 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. Additionally, '.pm', '.pl' and '.pod' -are automatically appended to the search as required. -(So, for example, under Unix, "A::B" is converted to "somedir/A/B.pm", -"somedir/A/B.pod", or "somedir/A/B.pl", as appropriate.) - -If no such Pod file is found, this method returns undef. - -If any of the given search directories contains a F<pod/> subdirectory, -then it is searched. (That's how we manage to find F<perlfunc>, -for example, which is usually in F<pod/perlfunc> in most Perl dists.) - -The C<verbose> and C<inc> attributes influence the behavior of this -search; notably, C<inc>, if true, adds @INC I<and also -$Config::Config{'scriptdir'}> to the list of directories to search. - -It is common to simply say C<< $filename = Pod::Simple::Search-> new -->find("perlvar") >> so that just the @INC (well, and scriptdir) -directories are searched. (This happens because the C<inc> -attribute is true by default.) - -Calling Pod::Simple::Search->find(...) is short for -Pod::Simple::Search->new->find(...). That is, a throwaway object -with default attribute values is used. - - -=head2 C<< $self->contains_pod( $file ) >> - -Returns true if the supplied filename (not POD module) contains some Pod -documentation. - - -=head1 AUTHOR - -Sean M. Burke E<lt>sburke@cpan.orgE<gt> -borrowed code from -Marek Rouchal's Pod::Find, which in turn -heavily borrowed code from Nick Ing-Simmons' PodToHtml. - -Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided -C<find> and C<contains_pod> to Pod::Find. - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Perldoc> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/SimpleTree.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/SimpleTree.pm deleted file mode 100644 index 64dd155104a..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/SimpleTree.pm +++ /dev/null @@ -1,155 +0,0 @@ - - -require 5; -package Pod::Simple::SimpleTree; -use strict; -use Carp (); -use Pod::Simple (); -use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS); -$VERSION = '2.02'; -BEGIN { - @ISA = ('Pod::Simple'); - *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; -} - -__PACKAGE__->_accessorize( - 'root', # root of the tree -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub _handle_element_start { # self, tagname, attrhash - DEBUG > 2 and print "Handling $_[1] start-event\n"; - my $x = [$_[1], $_[2]]; - if($_[0]{'_currpos'}) { - push @{ $_[0]{'_currpos'}[0] }, $x; # insert in parent's child-list - unshift @{ $_[0]{'_currpos'} }, $x; # prefix to stack - } else { - DEBUG and print " And oo, it gets to be root!\n"; - $_[0]{'_currpos'} = [ $_[0]{'root'} = $x ]; - # first event! set to stack, and set as root. - } - DEBUG > 3 and print "Stack is now: ", - join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n"; - return; -} - -sub _handle_element_end { # self, tagname - DEBUG > 2 and print "Handling $_[1] end-event\n"; - shift @{$_[0]{'_currpos'}}; - DEBUG > 3 and print "Stack is now: ", - join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n"; - return; -} - -sub _handle_text { # self, text - DEBUG > 2 and print "Handling $_[1] text-event\n"; - push @{ $_[0]{'_currpos'}[0] }, $_[1]; - return; -} - - -# A bit of evil from the black box... please avert your eyes, kind souls. -sub _traverse_treelet_bit { - DEBUG > 2 and print "Handling $_[1] paragraph event\n"; - my $self = shift; - push @{ $self->{'_currpos'}[0] }, [@_]; - return; -} -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1; -__END__ - -=head1 NAME - -Pod::Simple::SimpleTree -- parse Pod into a simple parse tree - -=head1 SYNOPSIS - - % cat ptest.pod - - =head1 PIE - - I like B<pie>! - - % perl -MPod::Simple::SimpleTree -MData::Dumper -e \ - "print Dumper(Pod::Simple::SimpleTree->new->parse_file(shift)->root)" \ - ptest.pod - - $VAR1 = [ - 'Document', - { 'start_line' => 1 }, - [ - 'head1', - { 'start_line' => 1 }, - 'PIE' - ], - [ - 'Para', - { 'start_line' => 3 }, - 'I like ', - [ - 'B', - {}, - 'pie' - ], - '!' - ] - ]; - -=head1 DESCRIPTION - -This class is of interest to people writing a Pod processor/formatter. - -This class takes Pod and parses it, returning a parse tree made just -of arrayrefs, and hashrefs, and strings. - -This is a subclass of L<Pod::Simple> and inherits all its methods. - -This class is inspired by XML::Parser's "Tree" parsing-style, although -it doesn't use exactly the same LoL format. - -=head1 METHODS - -At the end of the parse, call C<< $parser->root >> to get the -tree's top node. - -=head1 Tree Contents - -Every element node in the parse tree is represented by an arrayref of -the form: C<[ I<elementname>, \%attributes, I<...subnodes...> ]>. -See the example tree dump in the Synopsis, above. - -Every text node in the tree is represented by a simple (non-ref) -string scalar. So you can test C<ref($node)> to see whather you have -an element node or just a text node. - -The top node in the tree is C<[ 'Document', \%attributes, -I<...subnodes...> ]> - - -=head1 SEE ALSO - -L<Pod::Simple> - -L<perllol> - -L<The "Tree" subsubsection in XML::Parser|XML::Parser/"Tree"> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Subclassing.pod b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Subclassing.pod deleted file mode 100644 index d4ee6943444..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Subclassing.pod +++ /dev/null @@ -1,922 +0,0 @@ - -=head1 NAME - -Pod::Simple::Subclassing -- write a formatter as a Pod::Simple subclass - -=head1 SYNOPSIS - - package Pod::SomeFormatter; - use Pod::Simple; - @ISA = qw(Pod::Simple); - $VERSION = '1.01'; - use strict; - - sub _handle_element_start { - my($parser, $element_name, $attr_hash_r) = @_; - ... - } - - sub _handle_element_end { - my($parser, $element_name) = @_; - ... - } - - sub _handle_text { - my($parser, $text) = @_; - ... - } - 1; - -=head1 DESCRIPTION - -This document is about using Pod::Simple to write a Pod processor, -generally a Pod formatter. If you just want to know about using an -existing Pod formatter, instead see its documentation and see also the -docs in L<Pod::Simple>. - -The zeroeth step in writing a Pod formatter is to make sure that there -isn't already a decent one in CPAN. See L<http://search.cpan.org/>, and -run a search on the name of the format you want to render to. Also -consider joining the Pod People list -L<http://lists.perl.org/showlist.cgi?name=pod-people> and asking whether -anyone has a formatter for that format -- maybe someone cobbled one -together but just hasn't released it. - -The first step in writing a Pod processor is to read L<perlpodspec>, -which contains notes information on writing a Pod parser (which has been -largely taken care of by Pod::Simple), but also a lot of requirements -and recommendations for writing a formatter. - -The second step is to actually learn the format you're planning to -format to -- or at least as much as you need to know to represent Pod, -which probably isn't much. - -The third step is to pick which of Pod::Simple's interfaces you want to -use -- the basic interface via Pod::Simple or L<Pod::Simple::Methody> is -event-based, sort of like L<HTML::Parser>'s interface, or sort of like -L<XML::Parser>'s "Handlers" interface), but L<Pod::Simple::PullParser> -provides a token-stream interface, sort of like L<HTML::TokeParser>'s -interface; L<Pod::Simple::SimpleTree> provides a simple tree interface, -rather like XML::Parser's "Tree" interface. Users familiar with -XML-handling will find one of these styles relatively familiar; but if -you would be even more at home with XML, there are classes that produce -an XML representation of the Pod stream, notably -L<Pod::Simple::XMLOutStream>; you can feed the output of such a class to -whatever XML parsing system you are most at home with. - -The last step is to write your code based on how the events (or tokens, -or tree-nodes, or the XML, or however you're parsing) will map to -constructs in the output format. Also sure to consider how to escape -text nodes containing arbitrary text, and also what to do with text -nodes that represent preformatted text (from verbatim sections). - - - -=head1 Events - -TODO intro... mention that events are supplied for implicits, like for -missing >'s - - -In the following section, we use XML to represent the event structure -associated with a particular construct. That is, TODO - -=over - -=item C<< $parser->_handle_element_start( I<element_name>, I<attr_hashref> ) >> - -=item C<< $parser->_handle_element_end( I<element_name> ) >> - -=item C<< $parser->_handle_text( I<text_string> ) >> - -=back - -TODO describe - - -=over - -=item events with an element_name of Document - -Parsing a document produces this event structure: - - <Document start_line="543"> - ...all events... - </Document> - -The value of the I<start_line> attribute will be the line number of the first -Pod directive in the document. - -If there is no Pod in the given document, then the -event structure will be this: - - <Document contentless="1" start_line="543"> - </Document> - -In that case, the value of the I<start_line> attribute will not be meaningful; -under current implementations, it will probably be the line number of the -last line in the file. - -=item events with an element_name of Para - -Parsing a plain (non-verbatim, non-directive, non-data) paragraph in -a Pod document produces this event structure: - - <Para start_line="543"> - ...all events in this paragraph... - </Para> - -The value of the I<start_line> attribute will be the line number of the start -of the paragraph. - -For example, parsing this paragraph of Pod: - - The value of the I<start_line> attribute will be the - line number of the start of the paragraph. - -produces this event structure: - - <Para start_line="129"> - The value of the - <I> - start_line - </I> - attribute will be the line number of the first Pod directive - in the document. - </Para> - -=item events with an element_name of B, C, F, or I. - -Parsing a BE<lt>...E<gt> formatting code (or of course any of its -semantically identical syntactic variants -S<BE<lt>E<lt> ... E<gt>E<gt>>, -or S<BE<lt>E<lt>E<lt>E<lt> ... E<gt>E<gt>E<gt>E<gt>>, etc.) -produces this event structure: - - <B> - ...stuff... - </B> - -Currently, there are no attributes conveyed. - -Parsing C, F, or I codes produce the same structure, with only a -different element name. - -If your parser object has been set to accept other formatting codes, -then they will be presented like these B/C/F/I codes -- i.e., without -any attributes. - -=item events with an element_name of S - -Normally, parsing an SE<lt>...E<gt> sequence produces this event -structure, just as if it were a B/C/F/I code: - - <S> - ...stuff... - </S> - -However, Pod::Simple (and presumably all derived parsers) offers the -C<nbsp_for_S> option which, if enabled, will suppress all S events, and -instead change all spaces in the content to non-breaking spaces. This is -intended for formatters that output to a format that has no code that -means the same as SE<lt>...E<gt>, but which has a code/character that -means non-breaking space. - -=item events with an element_name of X - -Normally, parsing an XE<lt>...E<gt> sequence produces this event -structure, just as if it were a B/C/F/I code: - - <X> - ...stuff... - </X> - -However, Pod::Simple (and presumably all derived parsers) offers the -C<nix_X_codes> option which, if enabled, will suppress all X events -and ignore their content. For formatters/processors that don't use -X events, this is presumably quite useful. - - -=item events with an element_name of L - -Because the LE<lt>...E<gt> is the most complex construct in the -language, it should not surprise you that the events it generates are -the most complex in the language. Most of complexity is hidden away in -the attribute values, so for those of you writing a Pod formatter that -produces a non-hypertextual format, you can just ignore the attributes -and treat an L event structure like a formatting element that -(presumably) doesn't actually produce a change in formatting. That is, -the content of the L event structure (as opposed to its -attributes) is always what text should be displayed. - -There are, at first glance, three kinds of L links: URL, man, and pod. - -When a LE<lt>I<some_url>E<gt> code is parsed, it produces this event -structure: - - <L content-implicit="yes" to="that_url" type="url"> - that_url - </L> - -The C<type="url"> attribute is always specified for this type of -L code. - -For example, this Pod source: - - L<http://www.perl.com/CPAN/authors/> - -produces this event structure: - - <L content-implicit="yes" to="http://www.perl.com/CPAN/authors/" type="url"> - http://www.perl.com/CPAN/authors/ - </L> - -When a LE<lt>I<manpage(section)>E<gt> code is parsed (and these are -fairly rare and not terribly useful), it produces this event structure: - - <L content-implicit="yes" to="manpage(section)" type="man"> - manpage(section) - </L> - -The C<type="man"> attribute is always specified for this type of -L code. - -For example, this Pod source: - - L<crontab(5)> - -produces this event structure: - - <L content-implicit="yes" to="crontab(5)" type="man"> - crontab(5) - </L> - -In the rare cases where a man page link has a specified, that text appears -in a I<section> attribute. For example, this Pod source: - - L<crontab(5)/"ENVIRONMENT"> - -will produce this event structure: - - <L content-implicit="yes" section="ENVIRONMENT" to="crontab(5)" type="man"> - "ENVIRONMENT" in crontab(5) - </L> - -In the rare case where the Pod document has code like -LE<lt>I<sometext>|I<manpage(section)>E<gt>, then the I<sometext> will appear -as the content of the element, the I<manpage(section)> text will appear -only as the value of the I<to> attribute, and there will be no -C<content-implicit="yes"> attribute (whose presence means that the Pod parser -had to infer what text should appear as the link text -- as opposed to -cases where that attribute is absent, which means that the Pod parser did -I<not> have to infer the link text, because that L code explicitly specified -some link text.) - -For example, this Pod source: - - L<hell itself!|crontab(5)> - -will produce this event structure: - - <L to="crontab(5)" type="man"> - hell itself! - </L> - -The last type of L structure is for links to/within Pod documents. It is -the most complex because it can have a I<to> attribute, I<or> a -I<section> attribute, or both. The C<type="pod"> attribute is always -specified for this type of L code. - -In the most common case, the simple case of a LE<lt>podpageE<gt> code -produces this event structure: - - <L content-implicit="yes" to="Net::Ping" type="pod"> - podpage - </L> - -For example, this Pod source: - - L<Net::Ping> - -produces this event structure: - - <L content-implicit="yes" to="Net::Ping" type="pod"> - Net::Ping - </L> - -In cases where there is link-text explicitly specified, it -is to be found in the content of the element (and not the -attributes), just as with the LE<lt>I<sometext>|I<manpage(section)>E<gt> -case discussed above. For example, this Pod source: - - L<Perl Error Messages|perldiag> - -produces this event structure: - - <L to="perldiag" type="pod"> - Perl Error Messages - </L> - -In cases of links to a section in the current Pod document, -there is a I<section> attribute instead of a I<to> attribute. -For example, this Pod source: - - L</"Member Data"> - -produces this event structure: - - <L content-implicit="yes" section="Member Data" type="pod"> - "Member Data" - </L> - -As another example, this Pod source: - - L<the various attributes|/"Member Data"> - -produces this event structure: - - <L section="Member Data" type="pod"> - the various attributes - </L> - -In cases of links to a section in a different Pod document, -there are both a I<section> attribute and a L<to> attribute. -For example, this Pod source: - - L<perlsyn/"Basic BLOCKs and Switch Statements"> - -produces this event structure: - - <L content-implicit="yes" section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod"> - "Basic BLOCKs and Switch Statements" in perlsyn - </L> - -As another example, this Pod source: - - L<SWITCH statements|perlsyn/"Basic BLOCKs and Switch Statements"> - -produces this event structure: - - <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod"> - SWITCH statements - </L> - -Incidentally, note that we do not distinguish between these syntaxes: - - L</"Member Data"> - L<"Member Data"> - L</Member Data> - L<Member Data> [deprecated syntax] - -That is, they all produce the same event structure, namely: - - <L content-implicit="yes" section="Member Data" type="pod"> - "Member Data" - </L> - -=item events with an element_name of E or Z - -While there are Pod codes EE<lt>...E<gt> and ZE<lt>E<gt>, these -I<do not> produce any E or Z events -- that is, there are no such -events as E or Z. - -=item events with an element_name of Verbatim - -When a Pod verbatim paragraph (AKA "codeblock") is parsed, it -produces this event structure: - - <Verbatim start_line="543" xml:space="preserve"> - ...text... - </Verbatim> - -The value of the I<start_line> attribute will be the line number of the -first line of this verbatim block. The I<xml:space> attribute is always -present, and always has the value "preserve". - -The text content will have tabs already expanded. - - -=item events with an element_name of head1 .. head4 - -When a "=head1 ..." directive is parsed, it produces this event -structure: - - <head1> - ...stuff... - </head1> - -For example, a directive consisting of this: - - =head1 Options to C<new> et al. - -will produce this event structure: - - <head1 start_line="543"> - Options to - <C> - new - </C> - et al. - </head1> - -"=head2" thru "=head4" directives are the same, except for the element -names in the event structure. - -=item events with an element_name of over-bullet - -When an "=over ... Z<>=back" block is parsed where the items are -a bulletted list, it will produce this event structure: - - <over-bullet indent="4" start_line="543"> - <item-bullet start_line="545"> - ...Stuff... - </item-bullet> - ...more item-bullets... - </over-bullet> - -The value of the I<indent> attribute is whatever value is after the -"=over" directive, as in "=over 8". If no such value is specified -in the directive, then the I<indent> attribute has the value "4". - -For example, this Pod source: - - =over - - =item * - - Stuff - - =item * - - Bar I<baz>! - - =back - -produces this event structure: - - <over-bullet indent="4" start_line="10"> - <item-bullet start_line="12"> - Stuff - </item-bullet> - <item-bullet start_line="14"> - Bar <I>baz</I>! - </item-bullet> - </over-bullet> - -=item events with an element_name of over-number - -When an "=over ... Z<>=back" block is parsed where the items are -a numbered list, it will produce this event structure: - - <over-number indent="4" start_line="543"> - <item-number number="1" start_line="545"> - ...Stuff... - </item-number> - ...more item-number... - </over-bullet> - -This is like the "over-bullet" event structure; but note that the contents -are "item-number" instead of "item-bullet", and note that they will have -a "number" attribute, which some formatters/processors may ignore -(since, for example, there's no need for it in HTML when producing -an "<UL><LI>...</LI>...</UL>" structure), but which any processor may use. - -Note that the values for the I<number> attributes of "item-number" -elements in a given "over-number" area I<will> start at 1 and go up by -one each time. If the Pod source doesn't follow that order (even though -it really should should!), whatever numbers it has will be ignored (with -the correct values being put in the I<number> attributes), and an error -message might be issued to the user. - -=item events with an element_name of over-text - -These events are are somewhat unlike the other over-* -structures, as far as what their contents are. When -an "=over ... Z<>=back" block is parsed where the items are -a list of text "subheadings", it will produce this event structure: - - <over-text indent="4" start_line="543"> - <item-text> - ...stuff... - </item-text> - ...stuff (generally Para or Verbatim elements)... - <item-text> - ...more item-text and/or stuff... - </over-text> - -The I<indent> attribute is as with the other over-* events. - -For example, this Pod source: - - =over - - =item Foo - - Stuff - - =item Bar I<baz>! - - Quux - - =back - -produces this event structure: - - <over-text indent="4" start_line="20"> - <item-text start_line="22"> - Foo - </item-text> - <Para start_line="24"> - Stuff - </Para> - <item-text start_line="26"> - Bar - <I> - baz - </I> - ! - </item-text> - <Para start_line="28"> - Quux - </Para> - </over-text> - - - -=item events with an element_name of over-block - -These events are are somewhat unlike the other over-* -structures, as far as what their contents are. When -an "=over ... Z<>=back" block is parsed where there are no items, -it will produce this event structure: - - <over-block indent="4" start_line="543"> - ...stuff (generally Para or Verbatim elements)... - </over-block> - -The I<indent> attribute is as with the other over-* events. - -For example, this Pod source: - - =over - - For cutting off our trade with all parts of the world - - For transporting us beyond seas to be tried for pretended offenses - - He is at this time transporting large armies of foreign mercenaries to - complete the works of death, desolation and tyranny, already begun with - circumstances of cruelty and perfidy scarcely paralleled in the most - barbarous ages, and totally unworthy the head of a civilized nation. - - =cut - -will produce this event structure: - - <over-block indent="4" start_line="2"> - <Para start_line="4"> - For cutting off our trade with all parts of the world - </Para> - <Para start_line="6"> - For transporting us beyond seas to be tried for pretended offenses - </Para> - <Para start_line="8"> - He is at this time transporting large armies of [...more text...] - </Para> - </over-block> - -=item events with an element_name of item-bullet - -See L</"events with an element_name of over-bullet">, above. - -=item events with an element_name of item-number - -See L</"events with an element_name of over-number">, above. - -=item events with an element_name of item-text - -See L</"events with an element_name of over-text">, above. - -=item events with an element_name of for - -TODO... - -=item events with an element_name of Data - -TODO... - -=back - - - -=head1 More Pod::Simple Methods - -Pod::Simple provides a lot of methods that aren't generally interesting -to the end user of an existing Pod formatter, but some of which you -might find useful in writing a Pod formatter. They are listed below. The -first several methods (the accept_* methods) are for declaring the -capabilites of your parser, notably what C<=for I<targetname>> sections -it's interested in, what extra NE<lt>...E<gt> codes it accepts beyond -the ones described in the I<perlpod>. - -=over - -=item C<< $parser->accept_targets( I<SOMEVALUE> ) >> - -As the parser sees sections like: - - =for html <img src="fig1.jpg"> - -or - - =begin html - - <img src="fig1.jpg"> - - =end html - -...the parser will ignore these sections unless your subclass has -specified that it wants to see sections targetted to "html" (or whatever -the formatter name is). - -If you want to process all sections, even if they're not targetted for you, -call this before you start parsing: - - $parser->accept_targets('*'); - -=item C<< $parser->accept_targets_as_text( I<SOMEVALUE> ) >> - -This is like accept_targets, except that it specifies also that the -content of sections for this target should be treated as Pod text even -if the target name in "=for I<targetname>" doesn't start with a ":". - -At time of writing, I don't think you'll need to use this. - - -=item C<< $parser->accept_codes( I<Codename>, I<Codename>... ) >> - -This tells the parser that you accept additional formatting codes, -beyond just the standard ones (I B C L F S X, plus the two weird ones -you don't actually see in the parse tree, Z and E). For example, to also -accept codes "N", "R", and "W": - - $parser->accept_codes( qw( N R W ) ); - -B<TODO: document how this interacts with =extend, and long element names> - - -=item C<< $parser->accept_directive_as_data( I<directive_name> ) >> - -=item C<< $parser->accept_directive_as_verbatim( I<directive_name> ) >> - -=item C<< $parser->accept_directive_as_processed( I<directive_name> ) >> - -In the unlikely situation that you need to tell the parser that you will -accept additional directives ("=foo" things), you need to first set the -parset to treat its content as data (i.e., not really processed at -all), or as verbatim (mostly just expanding tabs), or as processed text -(parsing formatting codes like BE<lt>...E<gt>). - -For example, to accept a new directive "=method", you'd presumably -use: - - $parser->accept_directive_as_processed("method"); - -so that you could have Pod lines like: - - =method I<$whatever> thing B<um> - -Making up your own directives breaks compatibility with other Pod -formatters, in a way that using "=for I<target> ..." lines doesn't; -however, you may find this useful if you're making a Pod superset -format where you don't need to worry about compatibility. - - -=item C<< $parser->nbsp_for_S( I<BOOLEAN> ); >> - -Setting this attribute to a true value (and by default it is false) will -turn "SE<lt>...E<gt>" sequences into sequences of words separated by -C<\xA0> (non-breaking space) characters. For example, it will take this: - - I like S<Dutch apple pie>, don't you? - -and treat it as if it were: - - I like DutchE<nbsp>appleE<nbsp>pie, don't you? - -This is handy for output formats that don't have anything quite like an -"SE<lt>...E<gt>" code, but which do have a code for non-breaking space. - -There is currently no method for going the other way; but I can -probably provide one upon request. - - -=item C<< $parser->version_report() >> - -This returns a string reporting the $VERSION value from your module (and -its classname) as well as the $VERSION value of Pod::Simple. Note that -L<perlpodspec> requires output formats (wherever possible) to note -this detail in a comment in the output format. For example, for -some kind of SGML output format: - - print OUT "<!-- \n", $parser->version_report, "\n -->"; - - -=item C<< $parser->pod_para_count() >> - -This returns the count of Pod paragraphs seen so far. - - -=item C<< $parser->line_count() >> - -This is the current line number being parsed. But you might find the -"line_number" event attribute more accurate, when it is present. - - -=item C<< $parser->nix_X_codes( I<SOMEVALUE> ) >> - -This attribute, when set to a true value (and it is false by default) -ignores any "XE<lt>...E<gt>" sequences in the document being parsed. -Many formats don't actually use the content of these codes, so have -no reason to process them. - - -=item C<< $parser->merge_text( I<SOMEVALUE> ) >> - -This attribute, when set to a true value (and it is false by default) -makes sure that only one event (or token, or node) will be created -for any single contiguous sequence of text. For example, consider -this somewhat contrived example: - - I just LOVE Z<>hotE<32>apple pie! - -When that is parsed and events are about to be called on it, it may -actually seem to be four different text events, one right after another: -one event for "I just LOVE ", one for "hot", one for " ", and one for -"apple pie!". But if you have merge_text on, then you're guaranteed -that it will be fired as one text event: "I just LOVE hot apple pie!". - - -=item C<< $parser->code_handler( I<CODE_REF> ) >> - -This specifies code that should be called when a code line is seen -(i.e., a line outside of the Pod). Normally this is undef, meaning -that no code should be called. If you provide a routine, it should -start out like this: - - sub get_code_line { # or whatever you'll call it - my($line, $line_number, $parser) = @_; - ... - } - -Note, however, that sometimes the Pod events aren't processed in exactly -the same order as the code lines are -- i.e., if you have a file with -Pod, then code, then more Pod, sometimes the code will be processed (via -whatever you have code_handler call) before the all of the preceding Pod -has been processed. - - -=item C<< $parser->cut_handler( I<CODE_REF> ) >> - -This is just like the code_handler attribute, except that it's for -"=cut" lines, not code lines. The same caveats apply. "=cut" lines are -unlikely to be interesting, but this is included for completeness. - - -=item C<< $parser->whine( I<linenumber>, I<complaint string> ) >> - -This notes a problem in the Pod, which will be reported to in the "Pod -Errors" section of the document and/or send to STDERR, depending on the -values of the attributes C<no_whining>, C<no_errata_section>, and -C<complain_stderr>. - -=item C<< $parser->scream( I<linenumber>, I<complaint string> ) >> - -This notes an error like C<whine> does, except that it is not -suppressable with C<no_whining>. This should be used only for very -serious errors. - - -=item C<< $parser->source_dead(1) >> - -This aborts parsing of the current document, by switching on the flag -that indicates that EOF has been seen. In particularly drastic cases, -you might want to do this. It's rather nicer than just calling -C<die>! - -=item C<< $parser->hide_line_numbers( I<SOMEVALUE> ) >> - -Some subclasses that indescriminately dump event attributes (well, -except for ones beginning with "~") can use this object attribute for -refraining to dump the "start_line" attribute. - -=item C<< $parser->no_whining( I<SOMEVALUE> ) >> - -This attribute, if set to true, will suppress reports of non-fatal -error messages. The default value is false, meaning that complaints -I<are> reported. How they get reported depends on the values of -the attributes C<no_errata_section> and C<complain_stderr>. - -=item C<< $parser->no_errata_section( I<SOMEVALUE> ) >> - -This attribute, if set to true, will suppress generation of an errata -section. The default value is false -- i.e., an errata section will be -generated. - -=item C<< $parser->complain_stderr( I<SOMEVALUE> ) >> - -This attribute, if set to true will send complaints to STDERR. The -default value is false -- i.e., complaints do not go to STDERR. - -=item C<< $parser->bare_output( I<SOMEVALUE> ) >> - -Some formatter subclasses use this as a flag for whether output should -have prologue and epilogue code omitted. For example, setting this to -true for an HTML formatter class should omit the -"<html><head><title>...</title><body>..." prologue and the -"</body></html>" epilogue. - -If you want to set this to true, you should probably also set -C<no_whining> or at least C<no_errata_section> to true. - -=item C<< $parser->preserve_whitespace( I<SOMEVALUE> ) >> - -If you set this attribute to a true value, the parser will try to -preserve whitespace in the output. This means that such formatting -conventions as two spaces after periods will be preserved by the parser. -This is primarily useful for output formats that treat whitespace as -significant (such as text or *roff, but not HTML). - -=back - - -=head1 SEE ALSO - -L<Pod::Simple> -- event-based Pod-parsing framework - -L<Pod::Simple::Methody> -- like Pod::Simple, but each sort of event -calls its own method (like C<start_head3>) - -L<Pod::Simple::PullParser> -- a Pod-parsing framework like Pod::Simple, -but with a token-stream interface - -L<Pod::Simple::SimpleTree> -- a Pod-parsing framework like Pod::Simple, -but with a tree interface - -L<Pod::Simple::Checker> -- a simple Pod::Simple subclass that reads -documents, and then makes a plaintext report of any errors found in the -document - -L<Pod::Simple::DumpAsXML> -- for dumping Pod documents as tidily -indented XML, showing each event on its own line - -L<Pod::Simple::XMLOutStream> -- dumps a Pod document as XML (without -introducing extra whitespace as Pod::Simple::DumpAsXML does). - -L<Pod::Simple::DumpAsText> -- for dumping Pod documents as tidily -indented text, showing each event on its own line - -L<Pod::Simple::LinkSection> -- class for objects representing the values -of the TODO and TODO attributes of LE<lt>...E<gt> elements - -L<Pod::Escapes> -- the module the Pod::Simple uses for evaluating -EE<lt>...E<gt> content - -L<Pod::Simple::Text> -- a simple plaintext formatter for Pod - -L<Pod::Simple::TextContent> -- like Pod::Simple::Text, but -makes no effort for indent or wrap the text being formatted - -L<perlpod|perlpod> - -L<perlpodspec|perlpodspec> - -L<perldoc> - - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - - -=for notes -Hm, my old podchecker version (1.2) says: - *** WARNING: node 'http://search.cpan.org/' contains non-escaped | or / at line 38 in file Subclassing.pod - *** WARNING: node 'http://lists.perl.org/showlist.cgi?name=pod-people' contains non-escaped | or / at line 41 in file Subclassing.pod -Yes, L<...> is hard. - - -=cut - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Text.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Text.pm deleted file mode 100644 index df82c0784c8..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Text.pm +++ /dev/null @@ -1,152 +0,0 @@ - -require 5; -package Pod::Simple::Text; -use strict; -use Carp (); -use Pod::Simple::Methody (); -use Pod::Simple (); -use vars qw( @ISA $VERSION $FREAKYMODE); -$VERSION = '2.02'; -@ISA = ('Pod::Simple::Methody'); -BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) - ? \&Pod::Simple::DEBUG - : sub() {0} - } - -use Text::Wrap 98.112902 (); -$Text::Wrap::wrap = 'overflow'; -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - $new->{'output_fh'} ||= *STDOUT{IO}; - $new->accept_target_as_text(qw( text plaintext plain )); - $new->nix_X_codes(1); - $new->nbsp_for_S(1); - $new->{'Thispara'} = ''; - $new->{'Indent'} = 0; - $new->{'Indentstring'} = ' '; - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub handle_text { $_[0]{'Thispara'} .= $_[1] } - -sub start_Para { $_[0]{'Thispara'} = '' } -sub start_head1 { $_[0]{'Thispara'} = '' } -sub start_head2 { $_[0]{'Thispara'} = '' } -sub start_head3 { $_[0]{'Thispara'} = '' } -sub start_head4 { $_[0]{'Thispara'} = '' } - -sub start_Verbatim { $_[0]{'Thispara'} = '' } -sub start_item_bullet { $_[0]{'Thispara'} = $FREAKYMODE ? '' : '* ' } -sub start_item_number { $_[0]{'Thispara'} = $FREAKYMODE ? '' : "$_[1]{'number'}. " } -sub start_item_text { $_[0]{'Thispara'} = '' } - -sub start_over_bullet { ++$_[0]{'Indent'} } -sub start_over_number { ++$_[0]{'Indent'} } -sub start_over_text { ++$_[0]{'Indent'} } -sub start_over_block { ++$_[0]{'Indent'} } - -sub end_over_bullet { --$_[0]{'Indent'} } -sub end_over_number { --$_[0]{'Indent'} } -sub end_over_text { --$_[0]{'Indent'} } -sub end_over_block { --$_[0]{'Indent'} } - - -# . . . . . Now the actual formatters: - -sub end_head1 { $_[0]->emit_par(-4) } -sub end_head2 { $_[0]->emit_par(-3) } -sub end_head3 { $_[0]->emit_par(-2) } -sub end_head4 { $_[0]->emit_par(-1) } -sub end_Para { $_[0]->emit_par( 0) } -sub end_item_bullet { $_[0]->emit_par( 0) } -sub end_item_number { $_[0]->emit_par( 0) } -sub end_item_text { $_[0]->emit_par(-2) } - -sub emit_par { - my($self, $tweak_indent) = splice(@_,0,2); - my $indent = ' ' x ( 2 * $self->{'Indent'} + 4 + ($tweak_indent||0) ); - # Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0 - - $self->{'Thispara'} =~ tr{\xAD}{}d if Pod::Simple::ASCII; - my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n"); - $out =~ tr{\xA0}{ } if Pod::Simple::ASCII; - print {$self->{'output_fh'}} $out, "\n"; - $self->{'Thispara'} = ''; - - return; -} - -# . . . . . . . . . . And then off by its lonesome: - -sub end_Verbatim { - my $self = shift; - if(Pod::Simple::ASCII) { - $self->{'Thispara'} =~ tr{\xA0}{ }; - $self->{'Thispara'} =~ tr{\xAD}{}d; - } - - my $i = ' ' x ( 2 * $self->{'Indent'} + 4); - #my $i = ' ' x (4 + $self->{'Indent'}); - - $self->{'Thispara'} =~ s/^/$i/mg; - - print { $self->{'output_fh'} } '', - $self->{'Thispara'}, - "\n\n" - ; - $self->{'Thispara'} = ''; - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -1; - - -__END__ - -=head1 NAME - -Pod::Simple::Text -- format Pod as plaintext - -=head1 SYNOPSIS - - perl -MPod::Simple::Text -e \ - "exit Pod::Simple::Text->filter(shift)->any_errata_seen" \ - thingy.pod - -=head1 DESCRIPTION - -This class is a formatter that takes Pod and renders it as -wrapped plaintext. - -Its wrapping is done by L<Text::Wrap>, so you can change -C<$Text::Wrap::columns> as you like. - -This is a subclass of L<Pod::Simple> and inherits all its methods. - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::TextContent>, L<Pod::Text> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TextContent.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TextContent.pm deleted file mode 100644 index 3675b005ef1..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TextContent.pm +++ /dev/null @@ -1,87 +0,0 @@ - - -require 5; -package Pod::Simple::TextContent; -use strict; -use Carp (); -use Pod::Simple (); -use vars qw( @ISA $VERSION ); -$VERSION = '2.02'; -@ISA = ('Pod::Simple'); - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - $new->{'output_fh'} ||= *STDOUT{IO}; - $new->nix_X_codes(1); - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub _handle_element_start { - print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s; - return; -} - -sub _handle_text { - if( chr(65) eq 'A' ) { # in ASCIIworld - $_[1] =~ tr/\xAD//d; - $_[1] =~ tr/\xA0/ /; - } - print {$_[0]{'output_fh'}} $_[1]; - return; -} - -sub _handle_element_end { - print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s; - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -1; - - -__END__ - -=head1 NAME - -Pod::Simple::TextContent -- get the text content of Pod - -=head1 SYNOPSIS - - TODO - - perl -MPod::Simple::TextContent -e \ - "exit Pod::Simple::TextContent->filter(shift)->any_errata_seen" \ - thingy.pod - -=head1 DESCRIPTION - -This class is that parses Pod and dumps just the text content. It is -mainly meant for use by the Pod::Simple test suite, but you may find -some other use for it. - -This is a subclass of L<Pod::Simple> and inherits all its methods. - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell> - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TiedOutFH.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TiedOutFH.pm deleted file mode 100644 index b031fe5869b..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TiedOutFH.pm +++ /dev/null @@ -1,103 +0,0 @@ - -use strict; -package Pod::Simple::TiedOutFH; -use Symbol ('gensym'); -use Carp (); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub handle_on { # some horrible frightening things are encapsulated in here - my $class = shift; - $class = ref($class) || $class; - - Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_; - - my $x = (defined($_[0]) and ref($_[0])) - ? $_[0] - : ( \( $_[0] ) )[0] - ; - $$x = '' unless defined $$x; - - #Pod::Simple::DEBUG and print "New $class handle on $x = \"$$x\"\n"; - - my $new = gensym(); - tie *$new, $class, $x; - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub TIEHANDLE { # Ties to just a scalar ref - my($class, $scalar_ref) = @_; - $$scalar_ref = '' unless defined $$scalar_ref; - return bless \$scalar_ref, ref($class) || $class; -} - -sub PRINT { - my $it = shift; - foreach my $x (@_) { $$$it .= $x } - - #Pod::Simple::DEBUG > 10 and print " appended to $$it = \"$$$it\"\n"; - - return 1; -} - -sub FETCH { - return ${$_[0]}; -} - -sub PRINTF { - my $it = shift; - my $format = shift; - $$$it .= sprintf $format, @_; - return 1; -} - -sub FILENO { ${ $_[0] } + 100 } # just to produce SOME number - -sub CLOSE { 1 } - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1; -__END__ - -Chole - - * 1 large red onion - * 2 tomatillos - * 4 or 5 roma tomatoes (optionally with the pulp discarded) - * 1 tablespoons chopped ginger root (or more, to taste) - * 2 tablespoons canola oil (or vegetable oil) - - * 1 tablespoon garam masala - * 1/2 teaspoon red chili powder, or to taste - * Salt, to taste (probably quite a bit) - * 2 (15-ounce) cans chick peas or garbanzo beans, drained and rinsed - * juice of one smallish lime - * a dash of balsamic vinegar (to taste) - * cooked rice, preferably long-grain white rice (whether plain, - basmati rice, jasmine rice, or even a mild pilaf) - -In a blender or food processor, puree the onions, tomatoes, tomatillos, -and ginger root. You can even do it with a Braun hand "mixer", if you -chop things finer to start with, and work at it. - -In a saucepan set over moderate heat, warm the oil until hot. - -Add the puree and the balsamic vinegar, and cook, stirring occasionally, -for 20 to 40 minutes. (Cooking it longer will make it sweeter.) - -Add the Garam Masala, chili powder, and cook, stirring occasionally, for -5 minutes. - -Add the salt and chick peas and cook, stirring, until heated through. - -Stir in the lime juice, and optionally one or two teaspoons of tahini. -You can let it simmer longer, depending on how much softer you want the -garbanzos to get. - -Serve over rice, like a curry. - -Yields 5 to 7 servings. - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Transcode.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Transcode.pm deleted file mode 100644 index 434f963388b..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/Transcode.pm +++ /dev/null @@ -1,33 +0,0 @@ - -require 5; -package Pod::Simple::Transcode; - -BEGIN { - if(defined &DEBUG) {;} # Okay - elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG; } - else { *DEBUG = sub () {0}; } -} - -foreach my $class ( - 'Pod::Simple::TranscodeSmart', - 'Pod::Simple::TranscodeDumb', - '', -) { - $class or die "Couldn't load any encoding classes"; - DEBUG and print "About to try loading $class...\n"; - eval "require $class;"; - if($@) { - DEBUG and print "Couldn't load $class: $@\n"; - } else { - DEBUG and print "OK, loaded $class.\n"; - @ISA = ($class); - last; - } -} - -sub _blorp { return; } # just to avoid any "empty class" warning - -1; -__END__ - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TranscodeDumb.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TranscodeDumb.pm deleted file mode 100644 index d5eb7e5fb8c..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TranscodeDumb.pm +++ /dev/null @@ -1,63 +0,0 @@ - -require 5; -## This module is to be use()'d only by Pod::Simple::Transcode - -package Pod::Simple::TranscodeDumb; -use strict; -use vars qw($VERSION %Supported); -$VERSION = '2.02'; -# This module basically pretends it knows how to transcode, except -# only for null-transcodings! We use this when Encode isn't -# available. - -%Supported = ( - 'ascii' => 1, - 'ascii-ctrl' => 1, - 'iso-8859-1' => 1, - 'null' => 1, - 'latin1' => 1, - 'latin-1' => 1, - %Supported, -); - -sub is_dumb {1} -sub is_smart {0} - -sub all_encodings { - return sort keys %Supported; -} - -sub encoding_is_available { - return exists $Supported{lc $_[1]}; -} - -sub encmodver { - return __PACKAGE__ . " v" .($VERSION || '?'); -} - -sub make_transcoder { - my($e) = $_[1]; - die "WHAT ENCODING!?!?" unless $e; - my $x; - return sub {; - #foreach $x (@_) { - # if(Pod::Simple::ASCII and !Pod::Simple::UNICODE and $] > 5.005) { - # # We're in horrible gimp territory, so we need to knock out - # # all the highbit things - # $x = - # pack 'C*', - # map {; ($_ < 128) ? $_ : 0x7e } - # unpack "C*", - # $x - # ; - # } - #} - # - #return; - }; -} - - -1; - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TranscodeSmart.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TranscodeSmart.pm deleted file mode 100644 index 3fc26a4a260..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/TranscodeSmart.pm +++ /dev/null @@ -1,42 +0,0 @@ - -require 5; -use 5.008; -## Anything before 5.8.0 is GIMPY! -## This module is to be use()'d only by Pod::Simple::Transcode - -package Pod::Simple::TranscodeSmart; -use strict; -use Pod::Simple; -require Encode; - -sub is_dumb {0} -sub is_smart {1} - -sub all_encodings { - return Encode::->encodings(':all'); -} - -sub encoding_is_available { - return Encode::resolve_alias($_[1]); -} - -sub encmodver { - return "Encode.pm v" .($Encode::VERSION || '?'); -} - -sub make_transcoder { - my($e) = $_[1]; - die "WHAT ENCODING!?!?" unless $e; - my $x; - return sub { - foreach $x (@_) { - $x = Encode::decode($e, $x); - } - return; - }; -} - - -1; - - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/XMLOutStream.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/XMLOutStream.pm deleted file mode 100644 index 1e7ec15d9a7..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Simple/XMLOutStream.pm +++ /dev/null @@ -1,157 +0,0 @@ - -require 5; -package Pod::Simple::XMLOutStream; -use strict; -use Carp (); -use Pod::Simple (); -use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS); -$VERSION = '2.02'; -BEGIN { - @ISA = ('Pod::Simple'); - *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; -} - -$ATTR_PAD = "\n" unless defined $ATTR_PAD; - # Don't mess with this unless you know what you're doing. - -$SORT_ATTRS = 0 unless defined $SORT_ATTRS; - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - $new->{'output_fh'} ||= *STDOUT{IO}; - #$new->accept_codes('VerbatimFormatted'); - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub _handle_element_start { - # ($self, $element_name, $attr_hash_r) - my $fh = $_[0]{'output_fh'}; - my($key, $value); - DEBUG and print "++ $_[1]\n"; - print $fh "<", $_[1]; - if($SORT_ATTRS) { - foreach my $key (sort keys %{$_[2]}) { - unless($key =~ m/^~/s) { - next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; - _xml_escape($value = $_[2]{$key}); - print $fh $ATTR_PAD, $key, '="', $value, '"'; - } - } - } else { # faster - while(($key,$value) = each %{$_[2]}) { - unless($key =~ m/^~/s) { - next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; - _xml_escape($value); - print $fh $ATTR_PAD, $key, '="', $value, '"'; - } - } - } - print $fh ">"; - return; -} - -sub _handle_text { - DEBUG and print "== \"$_[1]\"\n"; - if(length $_[1]) { - my $text = $_[1]; - _xml_escape($text); - print {$_[0]{'output_fh'}} $text; - } - return; -} - -sub _handle_element_end { - DEBUG and print "-- $_[1]\n"; - print {$_[0]{'output_fh'}} "</", $_[1], ">"; - return; -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -sub _xml_escape { - foreach my $x (@_) { - # Escape things very cautiously: - $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg; - # Yes, stipulate the list without a range, so that this can work right on - # all charsets that this module happens to run under. - # Altho, hmm, what about that ord? Presumably that won't work right - # under non-ASCII charsets. Something should be done about that. - } - return; -} - -#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -1; - -__END__ - -=head1 NAME - -Pod::Simple::XMLOutStream -- turn Pod into XML - -=head1 SYNOPSIS - - perl -MPod::Simple::XMLOutStream -e \ - "exit Pod::Simple::XMLOutStream->filter(shift)->any_errata_seen" \ - thingy.pod - -=head1 DESCRIPTION - -Pod::Simple::XMLOutStream is a subclass of L<Pod::Simple> that parses -Pod and turns it into XML. - -Pod::Simple::XMLOutStream inherits methods from -L<Pod::Simple>. - - -=head1 SEE ALSO - -L<Pod::Simple::DumpAsXML> is rather like this class; see its -documentation for a discussion of the differences. - -L<Pod::Simple>, L<Pod::Simple::DumpAsXML>, L<Pod::SAX> - -L<Pod::Simple::Subclassing> - -The older (and possibly obsolete) libraries L<Pod::PXML>, L<Pod::XML> - - -=head1 ABOUT EXTENDING POD - -TODO: An example or two of =extend, then point to Pod::Simple::Subclassing - - -=head1 ASK ME! - -If you actually want to use Pod as a format that you want to render to -XML (particularly if to an XML instance with more elements than normal -Pod has), please email me (C<sburke@cpan.org>) and I'll probably have -some recommendations. - -For reasons of concision and energetic laziness, some methods and -options in this module (and the dozen modules it depends on) are -undocumented; but one of those undocumented bits might be just what -you're looking for. - - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002-4 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. - -=head1 AUTHOR - -Sean M. Burke C<sburke@cpan.org> - -=cut - diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text.pm deleted file mode 100644 index 03a62bff56d..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text.pm +++ /dev/null @@ -1,786 +0,0 @@ -# Pod::Text -- Convert POD data to formatted ASCII text. -# $Id: Text.pm,v 3.8 2006-09-16 20:55:41 eagle Exp $ -# -# Copyright 1999, 2000, 2001, 2002, 2004, 2006 -# by Russ Allbery <rra@stanford.edu> -# -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This module converts POD to formatted text. It replaces the old Pod::Text -# module that came with versions of Perl prior to 5.6.0 and attempts to match -# its output except for some specific circumstances where other decisions -# seemed to produce better output. It uses Pod::Parser and is designed to be -# very easy to subclass. -# -# Perl core hackers, please note that this module is also separately -# maintained outside of the Perl core as part of the podlators. Please send -# me any patches at the address above in addition to sending them to the -# standard Perl mailing lists. - -############################################################################## -# Modules and declarations -############################################################################## - -package Pod::Text; - -require 5.004; - -use strict; -use vars qw(@ISA @EXPORT %ESCAPES $VERSION); - -use Carp qw(carp croak); -use Exporter (); -use Pod::Simple (); - -@ISA = qw(Pod::Simple Exporter); - -# We have to export pod2text for backward compatibility. -@EXPORT = qw(pod2text); - -# Don't use the CVS revision as the version, since this module is also in Perl -# core and too many things could munge CVS magic revision strings. This -# number should ideally be the same as the CVS revision in podlators, however. -$VERSION = 3.08; - -############################################################################## -# Initialization -############################################################################## - -# This function handles code blocks. It's registered as a callback to -# Pod::Simple and therefore doesn't work as a regular method call, but all it -# does is call output_code with the line. -sub handle_code { - my ($line, $number, $parser) = @_; - $parser->output_code ($line . "\n"); -} - -# Initialize the object and set various Pod::Simple options that we need. -# Here, we also process any additional options passed to the constructor or -# set up defaults if none were given. Note that all internal object keys are -# in all-caps, reserving all lower-case object keys for Pod::Simple and user -# arguments. -sub new { - my $class = shift; - my $self = $class->SUPER::new; - - # Tell Pod::Simple to handle S<> by automatically inserting . - $self->nbsp_for_S (1); - - # Tell Pod::Simple to keep whitespace whenever possible. - if ($self->can ('preserve_whitespace')) { - $self->preserve_whitespace (1); - } else { - $self->fullstop_space_harden (1); - } - - # The =for and =begin targets that we accept. - $self->accept_targets (qw/text TEXT/); - - # Ensure that contiguous blocks of code are merged together. Otherwise, - # some of the guesswork heuristics don't work right. - $self->merge_text (1); - - # Pod::Simple doesn't do anything useful with our arguments, but we want - # to put them in our object as hash keys and values. This could cause - # problems if we ever clash with Pod::Simple's own internal class - # variables. - my %opts = @_; - my @opts = map { ("opt_$_", $opts{$_}) } keys %opts; - %$self = (%$self, @opts); - - # Initialize various things from our parameters. - $$self{opt_alt} = 0 unless defined $$self{opt_alt}; - $$self{opt_indent} = 4 unless defined $$self{opt_indent}; - $$self{opt_margin} = 0 unless defined $$self{opt_margin}; - $$self{opt_loose} = 0 unless defined $$self{opt_loose}; - $$self{opt_sentence} = 0 unless defined $$self{opt_sentence}; - $$self{opt_width} = 76 unless defined $$self{opt_width}; - - # Figure out what quotes we'll be using for C<> text. - $$self{opt_quotes} ||= '"'; - if ($$self{opt_quotes} eq 'none') { - $$self{LQUOTE} = $$self{RQUOTE} = ''; - } elsif (length ($$self{opt_quotes}) == 1) { - $$self{LQUOTE} = $$self{RQUOTE} = $$self{opt_quotes}; - } elsif ($$self{opt_quotes} =~ /^(.)(.)$/ - || $$self{opt_quotes} =~ /^(..)(..)$/) { - $$self{LQUOTE} = $1; - $$self{RQUOTE} = $2; - } else { - croak qq(Invalid quote specification "$$self{opt_quotes}"); - } - - # If requested, do something with the non-POD text. - $self->code_handler (\&handle_code) if $$self{opt_code}; - - # Return the created object. - return $self; -} - -############################################################################## -# Core parsing -############################################################################## - -# This is the glue that connects the code below with Pod::Simple itself. The -# goal is to convert the event stream coming from the POD parser into method -# calls to handlers once the complete content of a tag has been seen. Each -# paragraph or POD command will have textual content associated with it, and -# as soon as all of a paragraph or POD command has been seen, that content -# will be passed in to the corresponding method for handling that type of -# object. The exceptions are handlers for lists, which have opening tag -# handlers and closing tag handlers that will be called right away. -# -# The internal hash key PENDING is used to store the contents of a tag until -# all of it has been seen. It holds a stack of open tags, each one -# represented by a tuple of the attributes hash for the tag and the contents -# of the tag. - -# Add a block of text to the contents of the current node, formatting it -# according to the current formatting instructions as we do. -sub _handle_text { - my ($self, $text) = @_; - my $tag = $$self{PENDING}[-1]; - $$tag[1] .= $text; -} - -# Given an element name, get the corresponding method name. -sub method_for_element { - my ($self, $element) = @_; - $element =~ tr/-/_/; - $element =~ tr/A-Z/a-z/; - $element =~ tr/_a-z0-9//cd; - return $element; -} - -# Handle the start of a new element. If cmd_element is defined, assume that -# we need to collect the entire tree for this element before passing it to the -# element method, and create a new tree into which we'll collect blocks of -# text and nested elements. Otherwise, if start_element is defined, call it. -sub _handle_element_start { - my ($self, $element, $attrs) = @_; - my $method = $self->method_for_element ($element); - - # If we have a command handler, we need to accumulate the contents of the - # tag before calling it. - if ($self->can ("cmd_$method")) { - push (@{ $$self{PENDING} }, [ $attrs, '' ]); - } elsif ($self->can ("start_$method")) { - my $method = 'start_' . $method; - $self->$method ($attrs, ''); - } -} - -# Handle the end of an element. If we had a cmd_ method for this element, -# this is where we pass along the text that we've accumulated. Otherwise, if -# we have an end_ method for the element, call that. -sub _handle_element_end { - my ($self, $element) = @_; - my $method = $self->method_for_element ($element); - - # If we have a command handler, pull off the pending text and pass it to - # the handler along with the saved attribute hash. - if ($self->can ("cmd_$method")) { - my $tag = pop @{ $$self{PENDING} }; - my $method = 'cmd_' . $method; - my $text = $self->$method (@$tag); - if (defined $text) { - if (@{ $$self{PENDING} } > 1) { - $$self{PENDING}[-1][1] .= $text; - } else { - $self->output ($text); - } - } - } elsif ($self->can ("end_$method")) { - my $method = 'end_' . $method; - $self->$method (); - } -} - -############################################################################## -# Output formatting -############################################################################## - -# Wrap a line, indenting by the current left margin. We can't use Text::Wrap -# because it plays games with tabs. We can't use formline, even though we'd -# really like to, because it screws up non-printing characters. So we have to -# do the wrapping ourselves. -sub wrap { - my $self = shift; - local $_ = shift; - my $output = ''; - my $spaces = ' ' x $$self{MARGIN}; - my $width = $$self{opt_width} - $$self{MARGIN}; - while (length > $width) { - if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) { - $output .= $spaces . $1 . "\n"; - } else { - last; - } - } - $output .= $spaces . $_; - $output =~ s/\s+$/\n\n/; - return $output; -} - -# Reformat a paragraph of text for the current margin. Takes the text to -# reformat and returns the formatted text. -sub reformat { - my $self = shift; - local $_ = shift; - - # If we're trying to preserve two spaces after sentences, do some munging - # to support that. Otherwise, smash all repeated whitespace. - if ($$self{opt_sentence}) { - s/ +$//mg; - s/\.\n/. \n/g; - s/\n/ /g; - s/ +/ /g; - } else { - s/\s+/ /g; - } - return $self->wrap ($_); -} - -# Output text to the output device. -sub output { - my ($self, $text) = @_; - $text =~ tr/\240\255/ /d; - print { $$self{output_fh} } $text; -} - -# Output a block of code (something that isn't part of the POD text). Called -# by preprocess_paragraph only if we were given the code option. Exists here -# only so that it can be overridden by subclasses. -sub output_code { $_[0]->output ($_[1]) } - -############################################################################## -# Document initialization -############################################################################## - -# Set up various things that have to be initialized on a per-document basis. -sub start_document { - my $self = shift; - my $margin = $$self{opt_indent} + $$self{opt_margin}; - - # Initialize a few per-document variables. - $$self{INDENTS} = []; # Stack of indentations. - $$self{MARGIN} = $margin; # Default left margin. - $$self{PENDING} = [[]]; # Pending output. - - return ''; -} - -############################################################################## -# Text blocks -############################################################################## - -# This method is called whenever an =item command is complete (in other words, -# we've seen its associated paragraph or know for certain that it doesn't have -# one). It gets the paragraph associated with the item as an argument. If -# that argument is empty, just output the item tag; if it contains a newline, -# output the item tag followed by the newline. Otherwise, see if there's -# enough room for us to output the item tag in the margin of the text or if we -# have to put it on a separate line. -sub item { - my ($self, $text) = @_; - my $tag = $$self{ITEM}; - unless (defined $tag) { - carp "Item called without tag"; - return; - } - undef $$self{ITEM}; - - # Calculate the indentation and margin. $fits is set to true if the tag - # will fit into the margin of the paragraph given our indentation level. - my $indent = $$self{INDENTS}[-1]; - $indent = $$self{opt_indent} unless defined $indent; - my $margin = ' ' x $$self{opt_margin}; - my $fits = ($$self{MARGIN} - $indent >= length ($tag) + 1); - - # If the tag doesn't fit, or if we have no associated text, print out the - # tag separately. Otherwise, put the tag in the margin of the paragraph. - if (!$text || $text =~ /^\s+$/ || !$fits) { - my $realindent = $$self{MARGIN}; - $$self{MARGIN} = $indent; - my $output = $self->reformat ($tag); - $output =~ s/^$margin /$margin:/ if ($$self{opt_alt} && $indent > 0); - $output =~ s/\n*$/\n/; - - # If the text is just whitespace, we have an empty item paragraph; - # this can result from =over/=item/=back without any intermixed - # paragraphs. Insert some whitespace to keep the =item from merging - # into the next paragraph. - $output .= "\n" if $text && $text =~ /^\s*$/; - - $self->output ($output); - $$self{MARGIN} = $realindent; - $self->output ($self->reformat ($text)) if ($text && $text =~ /\S/); - } else { - my $space = ' ' x $indent; - $space =~ s/^$margin /$margin:/ if $$self{opt_alt}; - $text = $self->reformat ($text); - $text =~ s/^$margin /$margin:/ if ($$self{opt_alt} && $indent > 0); - my $tagspace = ' ' x length $tag; - $text =~ s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item"; - $self->output ($text); - } -} - -# Handle a basic block of text. The only tricky thing here is that if there -# is a pending item tag, we need to format this as an item paragraph. -sub cmd_para { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$/\n/; - if (defined $$self{ITEM}) { - $self->item ($text . "\n"); - } else { - $self->output ($self->reformat ($text . "\n")); - } - return ''; -} - -# Handle a verbatim paragraph. Just print it out, but indent it according to -# our margin. -sub cmd_verbatim { - my ($self, $attrs, $text) = @_; - $self->item if defined $$self{ITEM}; - return if $text =~ /^\s*$/; - $text =~ s/^(\n*)(\s*\S+)/$1 . (' ' x $$self{MARGIN}) . $2/gme; - $text =~ s/\s*$/\n\n/; - $self->output ($text); - return ''; -} - -# Handle literal text (produced by =for and similar constructs). Just output -# it with the minimum of changes. -sub cmd_data { - my ($self, $attrs, $text) = @_; - $text =~ s/^\n+//; - $text =~ s/\n{0,2}$/\n/; - $self->output ($text); - return ''; -} - -############################################################################## -# Headings -############################################################################## - -# The common code for handling all headers. Takes the header text, the -# indentation, and the surrounding marker for the alt formatting method. -sub heading { - my ($self, $text, $indent, $marker) = @_; - $self->item ("\n\n") if defined $$self{ITEM}; - $text =~ s/\s+$//; - if ($$self{opt_alt}) { - my $closemark = reverse (split (//, $marker)); - my $margin = ' ' x $$self{opt_margin}; - $self->output ("\n" . "$margin$marker $text $closemark" . "\n\n"); - } else { - $text .= "\n" if $$self{opt_loose}; - my $margin = ' ' x ($$self{opt_margin} + $indent); - $self->output ($margin . $text . "\n"); - } - return ''; -} - -# First level heading. -sub cmd_head1 { - my ($self, $attrs, $text) = @_; - $self->heading ($text, 0, '===='); -} - -# Second level heading. -sub cmd_head2 { - my ($self, $attrs, $text) = @_; - $self->heading ($text, $$self{opt_indent} / 2, '== '); -} - -# Third level heading. -sub cmd_head3 { - my ($self, $attrs, $text) = @_; - $self->heading ($text, $$self{opt_indent} * 2 / 3 + 0.5, '= '); -} - -# Fourth level heading. -sub cmd_head4 { - my ($self, $attrs, $text) = @_; - $self->heading ($text, $$self{opt_indent} * 3 / 4 + 0.5, '- '); -} - -############################################################################## -# List handling -############################################################################## - -# Handle the beginning of an =over block. Takes the type of the block as the -# first argument, and then the attr hash. This is called by the handlers for -# the four different types of lists (bullet, number, text, and block). -sub over_common_start { - my ($self, $attrs) = @_; - $self->item ("\n\n") if defined $$self{ITEM}; - - # Find the indentation level. - my $indent = $$attrs{indent}; - unless (defined ($indent) && $indent =~ /^\s*[-+]?\d{1,4}\s*$/) { - $indent = $$self{opt_indent}; - } - - # Add this to our stack of indents and increase our current margin. - push (@{ $$self{INDENTS} }, $$self{MARGIN}); - $$self{MARGIN} += ($indent + 0); - return ''; -} - -# End an =over block. Takes no options other than the class pointer. Output -# any pending items and then pop one level of indentation. -sub over_common_end { - my ($self) = @_; - $self->item ("\n\n") if defined $$self{ITEM}; - $$self{MARGIN} = pop @{ $$self{INDENTS} }; - return ''; -} - -# Dispatch the start and end calls as appropriate. -sub start_over_bullet { $_[0]->over_common_start ($_[1]) } -sub start_over_number { $_[0]->over_common_start ($_[1]) } -sub start_over_text { $_[0]->over_common_start ($_[1]) } -sub start_over_block { $_[0]->over_common_start ($_[1]) } -sub end_over_bullet { $_[0]->over_common_end } -sub end_over_number { $_[0]->over_common_end } -sub end_over_text { $_[0]->over_common_end } -sub end_over_block { $_[0]->over_common_end } - -# The common handler for all item commands. Takes the type of the item, the -# attributes, and then the text of the item. -sub item_common { - my ($self, $type, $attrs, $text) = @_; - $self->item if defined $$self{ITEM}; - - # Clean up the text. We want to end up with two variables, one ($text) - # which contains any body text after taking out the item portion, and - # another ($item) which contains the actual item text. Note the use of - # the internal Pod::Simple attribute here; that's a potential land mine. - $text =~ s/\s+$//; - my ($item, $index); - if ($type eq 'bullet') { - $item = '*'; - } elsif ($type eq 'number') { - $item = $$attrs{'~orig_content'}; - } else { - $item = $text; - $item =~ s/\s*\n\s*/ /g; - $text = ''; - } - $$self{ITEM} = $item; - - # If body text for this item was included, go ahead and output that now. - if ($text) { - $text =~ s/\s*$/\n/; - $self->item ($text); - } - return ''; -} - -# Dispatch the item commands to the appropriate place. -sub cmd_item_bullet { my $self = shift; $self->item_common ('bullet', @_) } -sub cmd_item_number { my $self = shift; $self->item_common ('number', @_) } -sub cmd_item_text { my $self = shift; $self->item_common ('text', @_) } -sub cmd_item_block { my $self = shift; $self->item_common ('block', @_) } - -############################################################################## -# Formatting codes -############################################################################## - -# The simple ones. -sub cmd_b { return $_[0]{alt} ? "``$_[2]''" : $_[2] } -sub cmd_f { return $_[0]{alt} ? "\"$_[2]\"" : $_[2] } -sub cmd_i { return '*' . $_[2] . '*' } -sub cmd_x { return '' } - -# Apply a whole bunch of messy heuristics to not quote things that don't -# benefit from being quoted. These originally come from Barrie Slaymaker and -# largely duplicate code in Pod::Man. -sub cmd_c { - my ($self, $attrs, $text) = @_; - - # A regex that matches the portion of a variable reference that's the - # array or hash index, separated out just because we want to use it in - # several places in the following regex. - my $index = '(?: \[.*\] | \{.*\} )?'; - - # Check for things that we don't want to quote, and if we find any of - # them, return the string with just a font change and no quoting. - $text =~ m{ - ^\s* - (?: - ( [\'\`\"] ) .* \1 # already quoted - | \` .* \' # `quoted' - | \$+ [\#^]? \S $index # special ($^Foo, $") - | [\$\@%&*]+ \#? [:\'\w]+ $index # plain var or func - | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call - | [+-]? ( \d[\d.]* | \.\d+ ) (?: [eE][+-]?\d+ )? # a number - | 0x [a-fA-F\d]+ # a hex constant - ) - \s*\z - }xo && return $text; - - # If we didn't return, go ahead and quote the text. - return $$self{opt_alt} - ? "``$text''" - : "$$self{LQUOTE}$text$$self{RQUOTE}"; -} - -# Links reduce to the text that we're given, wrapped in angle brackets if it's -# a URL. -sub cmd_l { - my ($self, $attrs, $text) = @_; - return $$attrs{type} eq 'url' ? "<$text>" : $text; -} - -############################################################################## -# Backwards compatibility -############################################################################## - -# The old Pod::Text module did everything in a pod2text() function. This -# tries to provide the same interface for legacy applications. -sub pod2text { - my @args; - - # This is really ugly; I hate doing option parsing in the middle of a - # module. But the old Pod::Text module supported passing flags to its - # entry function, so handle -a and -<number>. - while ($_[0] =~ /^-/) { - my $flag = shift; - if ($flag eq '-a') { push (@args, alt => 1) } - elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) } - else { - unshift (@_, $flag); - last; - } - } - - # Now that we know what arguments we're using, create the parser. - my $parser = Pod::Text->new (@args); - - # If two arguments were given, the second argument is going to be a file - # handle. That means we want to call parse_from_filehandle(), which means - # we need to turn the first argument into a file handle. Magic open will - # handle the <&STDIN case automagically. - if (defined $_[1]) { - my @fhs = @_; - local *IN; - unless (open (IN, $fhs[0])) { - croak ("Can't open $fhs[0] for reading: $!\n"); - return; - } - $fhs[0] = \*IN; - $parser->output_fh ($fhs[1]); - my $retval = $parser->parse_file ($fhs[0]); - my $fh = $parser->output_fh (); - close $fh; - return $retval; - } else { - return $parser->parse_file (@_); - } -} - -# Reset the underlying Pod::Simple object between calls to parse_from_file so -# that the same object can be reused to convert multiple pages. -sub parse_from_file { - my $self = shift; - $self->reinit; - - # Fake the old cutting option to Pod::Parser. This fiddings with internal - # Pod::Simple state and is quite ugly; we need a better approach. - if (ref ($_[0]) eq 'HASH') { - my $opts = shift @_; - if (defined ($$opts{-cutting}) && !$$opts{-cutting}) { - $$self{in_pod} = 1; - $$self{last_was_blank} = 1; - } - } - - # Do the work. - my $retval = $self->Pod::Simple::parse_from_file (@_); - - # Flush output, since Pod::Simple doesn't do this. Ideally we should also - # close the file descriptor if we had to open one, but we can't easily - # figure this out. - my $fh = $self->output_fh (); - my $oldfh = select $fh; - my $oldflush = $|; - $| = 1; - print $fh ''; - $| = $oldflush; - select $oldfh; - return $retval; -} - -# Pod::Simple failed to provide this backward compatibility function, so -# implement it ourselves. File handles are one of the inputs that -# parse_from_file supports. -sub parse_from_filehandle { - my $self = shift; - $self->parse_from_file (@_); -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Text - Convert POD data to formatted ASCII text - -=head1 SYNOPSIS - - use Pod::Text; - my $parser = Pod::Text->new (sentence => 0, width => 78); - - # Read POD from STDIN and write to STDOUT. - $parser->parse_from_filehandle; - - # Read POD from file.pod and write to file.txt. - $parser->parse_from_file ('file.pod', 'file.txt'); - -=head1 DESCRIPTION - -Pod::Text is a module that can convert documentation in the POD format (the -preferred language for documenting Perl) into formatted ASCII. It uses no -special formatting controls or codes whatsoever, and its output is therefore -suitable for nearly any device. - -As a derived class from Pod::Simple, Pod::Text supports the same methods and -interfaces. See L<Pod::Simple> for all the details; briefly, one creates a -new parser with C<< Pod::Text->new() >> and then normally calls parse_file(). - -new() can take options, in the form of key/value pairs, that control the -behavior of the parser. The currently recognized options are: - -=over 4 - -=item alt - -If set to a true value, selects an alternate output format that, among other -things, uses a different heading style and marks C<=item> entries with a -colon in the left margin. Defaults to false. - -=item code - -If set to a true value, the non-POD parts of the input file will be included -in the output. Useful for viewing code documented with POD blocks with the -POD rendered and the code left intact. - -=item indent - -The number of spaces to indent regular text, and the default indentation for -C<=over> blocks. Defaults to 4. - -=item loose - -If set to a true value, a blank line is printed after a C<=head1> heading. -If set to false (the default), no blank line is printed after C<=head1>, -although one is still printed after C<=head2>. This is the default because -it's the expected formatting for manual pages; if you're formatting -arbitrary text documents, setting this to true may result in more pleasing -output. - -=item margin - -The width of the left margin in spaces. Defaults to 0. This is the margin -for all text, including headings, not the amount by which regular text is -indented; for the latter, see the I<indent> option. To set the right -margin, see the I<width> option. - -=item quotes - -Sets the quote marks used to surround CE<lt>> text. If the value is a -single character, it is used as both the left and right quote; if it is two -characters, the first character is used as the left quote and the second as -the right quoted; and if it is four characters, the first two are used as -the left quote and the second two as the right quote. - -This may also be set to the special value C<none>, in which case no quote -marks are added around CE<lt>> text. - -=item sentence - -If set to a true value, Pod::Text will assume that each sentence ends in two -spaces, and will try to preserve that spacing. If set to false, all -consecutive whitespace in non-verbatim paragraphs is compressed into a -single space. Defaults to true. - -=item width - -The column at which to wrap text on the right-hand side. Defaults to 76. - -=back - -The standard Pod::Simple method parse_file() takes one argument, the file or -file handle to read from, and writes output to standard output unless that -has been changed with the output_fh() method. See L<Pod::Simple> for the -specific details and for other alternative interfaces. - -=head1 DIAGNOSTICS - -=over 4 - -=item Bizarre space in item - -=item Item called without tag - -(W) Something has gone wrong in internal C<=item> processing. These -messages indicate a bug in Pod::Text; you should never see them. - -=item Can't open %s for reading: %s - -(F) Pod::Text was invoked via the compatibility mode pod2text() interface -and the input file it was given could not be opened. - -=item Invalid quote specification "%s" - -(F) The quote specification given (the quotes option to the constructor) was -invalid. A quote specification must be one, two, or four characters long. - -=back - -=head1 NOTES - -This is a replacement for an earlier Pod::Text module written by Tom -Christiansen. It has a revamped interface, since it now uses Pod::Simple, -but an interface roughly compatible with the old Pod::Text::pod2text() -function is still available. Please change to the new calling convention, -though. - -The original Pod::Text contained code to do formatting via termcap -sequences, although it wasn't turned on by default and it was problematic to -get it to work at all. This rewrite doesn't even try to do that, but a -subclass of it does. Look for L<Pod::Text::Termcap>. - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Text::Termcap>, L<pod2text(1)> - -The current version of this module is always available from its web site at -L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the -Perl core distribution as of 5.6.0. - -=head1 AUTHOR - -Russ Allbery <rra@stanford.edu>, based I<very> heavily on the original -Pod::Text by Tom Christiansen <tchrist@mox.perl.com> and its conversion to -Pod::Parser by Brad Appleton <bradapp@enteract.com>. Sean Burke's initial -conversion of Pod::Man to use Pod::Simple provided much-needed guidance on -how to use Pod::Simple. - -=head1 COPYRIGHT AND LICENSE - -Copyright 1999, 2000, 2001, 2002, 2004, 2006 Russ Allbery <rra@stanford.edu>. - -This program is free software; you may redistribute it and/or modify it -under the same terms as Perl itself. - -=cut diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Color.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Color.pm deleted file mode 100644 index ce95dbe56f0..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Color.pm +++ /dev/null @@ -1,147 +0,0 @@ -# Pod::Text::Color -- Convert POD data to formatted color ASCII text -# $Id: Color.pm,v 2.3 2006-01-25 23:56:54 eagle Exp $ -# -# Copyright 1999, 2001, 2004, 2006 by Russ Allbery <rra@stanford.edu> -# -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This is just a basic proof of concept. It should later be modified to make -# better use of color, take options changing what colors are used for what -# text, and the like. - -############################################################################## -# Modules and declarations -############################################################################## - -package Pod::Text::Color; - -require 5.004; - -use Pod::Text (); -use Term::ANSIColor qw(colored); - -use strict; -use vars qw(@ISA $VERSION); - -@ISA = qw(Pod::Text); - -# Don't use the CVS revision as the version, since this module is also in Perl -# core and too many things could munge CVS magic revision strings. This -# number should ideally be the same as the CVS revision in podlators, however. -$VERSION = 2.03; - -############################################################################## -# Overrides -############################################################################## - -# Make level one headings bold. -sub cmd_head1 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $self->SUPER::cmd_head1 ($attrs, colored ($text, 'bold')); -} - -# Make level two headings bold. -sub cmd_head2 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $self->SUPER::cmd_head2 ($attrs, colored ($text, 'bold')); -} - -# Fix the various formatting codes. -sub cmd_b { return colored ($_[2], 'bold') } -sub cmd_f { return colored ($_[2], 'cyan') } -sub cmd_i { return colored ($_[2], 'yellow') } - -# Output any included code in green. -sub output_code { - my ($self, $code) = @_; - $code = colored ($code, 'green'); - $self->output ($code); -} - -# We unfortunately have to override the wrapping code here, since the normal -# wrapping code gets really confused by all the escape sequences. -sub wrap { - my $self = shift; - local $_ = shift; - my $output = ''; - my $spaces = ' ' x $$self{MARGIN}; - my $width = $$self{opt_width} - $$self{MARGIN}; - - # We have to do $shortchar and $longchar in variables because the - # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x. - my $char = '(?:(?:\e\[[\d;]+m)*[^\n])'; - my $shortchar = $char . "{0,$width}"; - my $longchar = $char . "{$width}"; - while (length > $width) { - if (s/^($shortchar)\s+// || s/^($longchar)//) { - $output .= $spaces . $1 . "\n"; - } else { - last; - } - } - $output .= $spaces . $_; - $output =~ s/\s+$/\n\n/; - $output; -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Text::Color - Convert POD data to formatted color ASCII text - -=head1 SYNOPSIS - - use Pod::Text::Color; - my $parser = Pod::Text::Color->new (sentence => 0, width => 78); - - # Read POD from STDIN and write to STDOUT. - $parser->parse_from_filehandle; - - # Read POD from file.pod and write to file.txt. - $parser->parse_from_file ('file.pod', 'file.txt'); - -=head1 DESCRIPTION - -Pod::Text::Color is a simple subclass of Pod::Text that highlights output -text using ANSI color escape sequences. Apart from the color, it in all -ways functions like Pod::Text. See L<Pod::Text> for details and available -options. - -Term::ANSIColor is used to get colors and therefore must be installed to use -this module. - -=head1 BUGS - -This is just a basic proof of concept. It should be seriously expanded to -support configurable coloration via options passed to the constructor, and -B<pod2text> should be taught about those. - -=head1 SEE ALSO - -L<Pod::Text>, L<Pod::Simple> - -The current version of this module is always available from its web site at -L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the -Perl core distribution as of 5.6.0. - -=head1 AUTHOR - -Russ Allbery <rra@stanford.edu>. - -=head1 COPYRIGHT AND LICENSE - -Copyright 1999, 2001, 2004, 2006 by Russ Allbery <rra@stanford.edu>. - -This program is free software; you may redistribute it and/or modify it -under the same terms as Perl itself. - -=cut diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Overstrike.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Overstrike.pm deleted file mode 100644 index 4ec2fc046a2..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Overstrike.pm +++ /dev/null @@ -1,208 +0,0 @@ -# Pod::Text::Overstrike -- Convert POD data to formatted overstrike text -# $Id: Overstrike.pm,v 2.0 2004/06/09 04:51:20 eagle Exp $ -# -# Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000 -# (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>) -# -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This was written because the output from: -# -# pod2text Text.pm > plain.txt; less plain.txt -# -# is not as rich as the output from -# -# pod2man Text.pm | nroff -man > fancy.txt; less fancy.txt -# -# and because both Pod::Text::Color and Pod::Text::Termcap are not device -# independent. - -############################################################################## -# Modules and declarations -############################################################################## - -package Pod::Text::Overstrike; - -require 5.004; - -use Pod::Text (); - -use strict; -use vars qw(@ISA $VERSION); - -@ISA = qw(Pod::Text); - -# Don't use the CVS revision as the version, since this module is also in Perl -# core and too many things could munge CVS magic revision strings. This -# number should ideally be the same as the CVS revision in podlators, however. -$VERSION = 2.00; - -############################################################################## -# Overrides -############################################################################## - -# Make level one headings bold, overridding any existing formatting. -sub cmd_head1 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $text = $self->strip_format ($text); - $text =~ s/(.)/$1\b$1/g; - return $self->SUPER::cmd_head1 ($attrs, $text); -} - -# Make level two headings bold, overriding any existing formatting. -sub cmd_head2 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $text = $self->strip_format ($text); - $text =~ s/(.)/$1\b$1/g; - return $self->SUPER::cmd_head2 ($attrs, $text); -} - -# Make level three headings underscored, overriding any existing formatting. -sub cmd_head3 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $text = $self->strip_format ($text); - $text =~ s/(.)/_\b$1/g; - return $self->SUPER::cmd_head3 ($attrs, $text); -} - -# Level four headings look like level three headings. -sub cmd_head4 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $text = $self->strip_format ($text); - $text =~ s/(.)/_\b$1/g; - return $self->SUPER::cmd_head4 ($attrs, $text); -} - -# The common code for handling all headers. We have to override to avoid -# interpolating twice and because we don't want to honor alt. -sub heading { - my ($self, $text, $indent, $marker) = @_; - $self->item ("\n\n") if defined $$self{ITEM}; - $text .= "\n" if $$self{opt_loose}; - my $margin = ' ' x ($$self{opt_margin} + $indent); - $self->output ($margin . $text . "\n"); - return ''; -} - -# Fix the various formatting codes. -sub cmd_b { local $_ = $_[0]->strip_format ($_[2]); s/(.)/$1\b$1/g; $_ } -sub cmd_f { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ } -sub cmd_i { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ } - -# Output any included code in bold. -sub output_code { - my ($self, $code) = @_; - $code =~ s/(.)/$1\b$1/g; - $self->output ($code); -} - -# We unfortunately have to override the wrapping code here, since the normal -# wrapping code gets really confused by all the backspaces. -sub wrap { - my $self = shift; - local $_ = shift; - my $output = ''; - my $spaces = ' ' x $$self{MARGIN}; - my $width = $$self{opt_width} - $$self{MARGIN}; - while (length > $width) { - # This regex represents a single character, that's possibly underlined - # or in bold (in which case, it's three characters; the character, a - # backspace, and a character). Use [^\n] rather than . to protect - # against odd settings of $*. - my $char = '(?:[^\n][\b])?[^\n]'; - if (s/^((?>$char){0,$width})(?:\Z|\s+)//) { - $output .= $spaces . $1 . "\n"; - } else { - last; - } - } - $output .= $spaces . $_; - $output =~ s/\s+$/\n\n/; - return $output; -} - -############################################################################## -# Utility functions -############################################################################## - -# Strip all of the formatting from a provided string, returning the stripped -# version. -sub strip_format { - my ($self, $text) = @_; - $text =~ s/(.)[\b]\1/$1/g; - $text =~ s/_[\b]//g; - return $text; -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Text::Overstrike - Convert POD data to formatted overstrike text - -=head1 SYNOPSIS - - use Pod::Text::Overstrike; - my $parser = Pod::Text::Overstrike->new (sentence => 0, width => 78); - - # Read POD from STDIN and write to STDOUT. - $parser->parse_from_filehandle; - - # Read POD from file.pod and write to file.txt. - $parser->parse_from_file ('file.pod', 'file.txt'); - -=head1 DESCRIPTION - -Pod::Text::Overstrike is a simple subclass of Pod::Text that highlights -output text using overstrike sequences, in a manner similar to nroff. -Characters in bold text are overstruck (character, backspace, character) and -characters in underlined text are converted to overstruck underscores -(underscore, backspace, character). This format was originally designed for -hardcopy terminals and/or lineprinters, yet is readable on softcopy (CRT) -terminals. - -Overstruck text is best viewed by page-at-a-time programs that take -advantage of the terminal's B<stand-out> and I<underline> capabilities, such -as the less program on Unix. - -Apart from the overstrike, it in all ways functions like Pod::Text. See -L<Pod::Text> for details and available options. - -=head1 BUGS - -Currently, the outermost formatting instruction wins, so for example -underlined text inside a region of bold text is displayed as simply bold. -There may be some better approach possible. - -=head1 SEE ALSO - -L<Pod::Text>, L<Pod::Simple> - -The current version of this module is always available from its web site at -L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the -Perl core distribution as of 5.6.0. - -=head1 AUTHOR - -Joe Smith <Joe.Smith@inwap.com>, using the framework created by Russ Allbery -<rra@stanford.edu>. - -=head1 COPYRIGHT AND LICENSE - -Copyright 2000 by Joe Smith <Joe.Smith@inwap.com>. -Copyright 2001, 2004 by Russ Allbery <rra@stanford.edu>. - -This program is free software; you may redistribute it and/or modify it -under the same terms as Perl itself. - -=cut diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Termcap.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Termcap.pm deleted file mode 100644 index 0b3caf34369..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Text/Termcap.pm +++ /dev/null @@ -1,184 +0,0 @@ -# Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes. -# $Id: Termcap.pm,v 2.3 2006-01-25 23:56:54 eagle Exp $ -# -# Copyright 1999, 2001, 2002, 2004, 2006 by Russ Allbery <rra@stanford.edu> -# -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This is a simple subclass of Pod::Text that overrides a few key methods to -# output the right termcap escape sequences for formatted text on the current -# terminal type. - -############################################################################## -# Modules and declarations -############################################################################## - -package Pod::Text::Termcap; - -require 5.004; - -use Pod::Text (); -use POSIX (); -use Term::Cap; - -use strict; -use vars qw(@ISA $VERSION); - -@ISA = qw(Pod::Text); - -# Don't use the CVS revision as the version, since this module is also in Perl -# core and too many things could munge CVS magic revision strings. This -# number should ideally be the same as the CVS revision in podlators, however. -$VERSION = 2.03; - -############################################################################## -# Overrides -############################################################################## - -# In the initialization method, grab our terminal characteristics as well as -# do all the stuff we normally do. -sub new { - my ($self, @args) = @_; - my ($ospeed, $term, $termios); - $self = $self->SUPER::new (@args); - - # $ENV{HOME} is usually not set on Windows. The default Term::Cap path - # may not work on Solaris. - my $home = exists $ENV{HOME} ? "$ENV{HOME}/.termcap:" : ''; - $ENV{TERMPATH} = $home . '/etc/termcap:/usr/share/misc/termcap' - . ':/usr/share/lib/termcap'; - - # Fall back on a hard-coded terminal speed if POSIX::Termios isn't - # available (such as on VMS). - eval { $termios = POSIX::Termios->new }; - if ($@) { - $ospeed = 9600; - } else { - $termios->getattr; - $ospeed = $termios->getospeed || 9600; - } - - # Fall back on the ANSI escape sequences if Term::Cap doesn't work. - eval { $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed } }; - $$self{BOLD} = $$term{_md} || "\e[1m"; - $$self{UNDL} = $$term{_us} || "\e[4m"; - $$self{NORM} = $$term{_me} || "\e[m"; - - unless (defined $$self{width}) { - $$self{opt_width} = $ENV{COLUMNS} || $$term{_co} || 80; - $$self{opt_width} -= 2; - } - - return $self; -} - -# Make level one headings bold. -sub cmd_head1 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $self->SUPER::cmd_head1 ($attrs, "$$self{BOLD}$text$$self{NORM}"); -} - -# Make level two headings bold. -sub cmd_head2 { - my ($self, $attrs, $text) = @_; - $text =~ s/\s+$//; - $self->SUPER::cmd_head2 ($attrs, "$$self{BOLD}$text$$self{NORM}"); -} - -# Fix up B<> and I<>. Note that we intentionally don't do F<>. -sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" } -sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" } - -# Output any included code in bold. -sub output_code { - my ($self, $code) = @_; - $self->output ($$self{BOLD} . $code . $$self{NORM}); -} - -# Override the wrapping code to igore the special sequences. -sub wrap { - my $self = shift; - local $_ = shift; - my $output = ''; - my $spaces = ' ' x $$self{MARGIN}; - my $width = $$self{opt_width} - $$self{MARGIN}; - - # $codes matches a single special sequence. $char matches any number of - # special sequences preceeding a single character other than a newline. - # We have to do $shortchar and $longchar in variables because the - # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x. - my $codes = "(?:\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)"; - my $char = "(?:$codes*[^\\n])"; - my $shortchar = $char . "{0,$width}"; - my $longchar = $char . "{$width}"; - while (length > $width) { - if (s/^($shortchar)\s+// || s/^($longchar)//) { - $output .= $spaces . $1 . "\n"; - } else { - last; - } - } - $output .= $spaces . $_; - $output =~ s/\s+$/\n\n/; - return $output; -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Text::Termcap - Convert POD data to ASCII text with format escapes - -=head1 SYNOPSIS - - use Pod::Text::Termcap; - my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78); - - # Read POD from STDIN and write to STDOUT. - $parser->parse_from_filehandle; - - # Read POD from file.pod and write to file.txt. - $parser->parse_from_file ('file.pod', 'file.txt'); - -=head1 DESCRIPTION - -Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output -text using the correct termcap escape sequences for the current terminal. -Apart from the format codes, it in all ways functions like Pod::Text. See -L<Pod::Text> for details and available options. - -=head1 NOTES - -This module uses Term::Cap to retrieve the formatting escape sequences for -the current terminal, and falls back on the ECMA-48 (the same in this -regard as ANSI X3.64 and ISO 6429, the escape codes also used by DEC VT100 -terminals) if the bold, underline, and reset codes aren't set in the -termcap information. - -=head1 SEE ALSO - -L<Pod::Text>, L<Pod::Simple>, L<Term::Cap> - -The current version of this module is always available from its web site at -L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the -Perl core distribution as of 5.6.0. - -=head1 AUTHOR - -Russ Allbery <rra@stanford.edu>. - -=head1 COPYRIGHT AND LICENSE - -Copyright 1999, 2001, 2002, 2004, 2006 by Russ Allbery <rra@stanford.edu>. - -This program is free software; you may redistribute it and/or modify it -under the same terms as Perl itself. - -=cut diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Usage.pm b/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Usage.pm deleted file mode 100644 index cbb55c5fe26..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/5.10/Pod/Usage.pm +++ /dev/null @@ -1,674 +0,0 @@ -############################################################################# -# Pod/Usage.pm -- print usage messages for the running script. -# -# Copyright (C) 1996-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::Usage; - -use vars qw($VERSION); -$VERSION = "1.35"; ## Current version of this package -require 5.005; ## requires this Perl version or later - -=head1 NAME - -Pod::Usage, pod2usage() - print a usage message from embedded pod documentation - -=head1 SYNOPSIS - - use Pod::Usage - - my $message_text = "This text precedes the usage message."; - my $exit_status = 2; ## The exit status to use - my $verbose_level = 0; ## The verbose level to use - my $filehandle = \*STDERR; ## The filehandle to write to - - pod2usage($message_text); - - pod2usage($exit_status); - - pod2usage( { -message => $message_text , - -exitval => $exit_status , - -verbose => $verbose_level, - -output => $filehandle } ); - - pod2usage( -msg => $message_text , - -exitval => $exit_status , - -verbose => $verbose_level, - -output => $filehandle ); - - pod2usage( -verbose => 2, - -noperldoc => 1 ) - -=head1 ARGUMENTS - -B<pod2usage> should be given either a single argument, or a list of -arguments corresponding to an associative array (a "hash"). When a single -argument is given, it should correspond to exactly one of the following: - -=over 4 - -=item * - -A string containing the text of a message to print I<before> printing -the usage message - -=item * - -A numeric value corresponding to the desired exit status - -=item * - -A reference to a hash - -=back - -If more than one argument is given then the entire argument list is -assumed to be a hash. If a hash is supplied (either as a reference or -as a list) it should contain one or more elements with the following -keys: - -=over 4 - -=item C<-message> - -=item C<-msg> - -The text of a message to print immediately prior to printing the -program's usage message. - -=item C<-exitval> - -The desired exit status to pass to the B<exit()> function. -This should be an integer, or else the string "NOEXIT" to -indicate that control should simply be returned without -terminating the invoking process. - -=item C<-verbose> - -The desired level of "verboseness" to use when printing the usage -message. If the corresponding value is 0, then only the "SYNOPSIS" -section of the pod documentation is printed. If the corresponding value -is 1, then the "SYNOPSIS" section, along with any section entitled -"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the -corresponding value is 2 or more then the entire manpage is printed. - -The special verbosity level 99 requires to also specify the -sections -parameter; then these sections are extracted (see L<Pod::Select>) -and printed. - -=item C<-sections> - -A string representing a selection list for sections to be printed -when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">. - -=item C<-output> - -A reference to a filehandle, or the pathname of a file to which the -usage message should be written. The default is C<\*STDERR> unless the -exit value is less than 2 (in which case the default is C<\*STDOUT>). - -=item C<-input> - -A reference to a filehandle, or the pathname of a file from which the -invoking script's pod documentation should be read. It defaults to the -file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>). - -=item C<-pathlist> - -A list of directory paths. If the input file does not exist, then it -will be searched for in the given directory list (in the order the -directories appear in the list). It defaults to the list of directories -implied by C<$ENV{PATH}>. The list may be specified either by a reference -to an array, or by a string of directory paths which use the same path -separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for -MSWin32 and DOS). - -=item C<-noperldoc> - -By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is -specified. This does not work well e.g. if the script was packed -with L<PAR>. The -noperldoc option suppresses the external call to -L<perldoc> and uses the simple text formatter (L<Pod::Text>) to -output the POD. - -=back - -=head1 DESCRIPTION - -B<pod2usage> will print a usage message for the invoking script (using -its embedded pod documentation) and then exit the script with the -desired exit status. The usage message printed may have any one of three -levels of "verboseness": If the verbose level is 0, then only a synopsis -is printed. If the verbose level is 1, then the synopsis is printed -along with a description (if present) of the command line options and -arguments. If the verbose level is 2, then the entire manual page is -printed. - -Unless they are explicitly specified, the default values for the exit -status, verbose level, and output stream to use are determined as -follows: - -=over 4 - -=item * - -If neither the exit status nor the verbose level is specified, then the -default is to use an exit status of 2 with a verbose level of 0. - -=item * - -If an exit status I<is> specified but the verbose level is I<not>, then the -verbose level will default to 1 if the exit status is less than 2 and -will default to 0 otherwise. - -=item * - -If an exit status is I<not> specified but verbose level I<is> given, then -the exit status will default to 2 if the verbose level is 0 and will -default to 1 otherwise. - -=item * - -If the exit status used is less than 2, then output is printed on -C<STDOUT>. Otherwise output is printed on C<STDERR>. - -=back - -Although the above may seem a bit confusing at first, it generally does -"the right thing" in most situations. This determination of the default -values to use is based upon the following typical Unix conventions: - -=over 4 - -=item * - -An exit status of 0 implies "success". For example, B<diff(1)> exits -with a status of 0 if the two files have the same contents. - -=item * - -An exit status of 1 implies possibly abnormal, but non-defective, program -termination. For example, B<grep(1)> exits with a status of 1 if -it did I<not> find a matching line for the given regular expression. - -=item * - -An exit status of 2 or more implies a fatal error. For example, B<ls(1)> -exits with a status of 2 if you specify an illegal (unknown) option on -the command line. - -=item * - -Usage messages issued as a result of bad command-line syntax should go -to C<STDERR>. However, usage messages issued due to an explicit request -to print usage (like specifying B<-help> on the command line) should go -to C<STDOUT>, just in case the user wants to pipe the output to a pager -(such as B<more(1)>). - -=item * - -If program usage has been explicitly requested by the user, it is often -desirable to exit with a status of 1 (as opposed to 0) after issuing -the user-requested usage message. It is also desirable to give a -more verbose description of program usage in this case. - -=back - -B<pod2usage> doesn't force the above conventions upon you, but it will -use them by default if you don't expressly tell it to do otherwise. The -ability of B<pod2usage()> to accept a single number or a string makes it -convenient to use as an innocent looking error message handling function: - - use Pod::Usage; - use Getopt::Long; - - ## Parse options - GetOptions("help", "man", "flag1") || pod2usage(2); - pod2usage(1) if ($opt_help); - pod2usage(-verbose => 2) if ($opt_man); - - ## Check for too many filenames - pod2usage("$0: Too many files given.\n") if (@ARGV > 1); - -Some user's however may feel that the above "economy of expression" is -not particularly readable nor consistent and may instead choose to do -something more like the following: - - use Pod::Usage; - use Getopt::Long; - - ## Parse options - GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0); - pod2usage(-verbose => 1) if ($opt_help); - pod2usage(-verbose => 2) if ($opt_man); - - ## Check for too many filenames - pod2usage(-verbose => 2, -message => "$0: Too many files given.\n") - if (@ARGV > 1); - -As with all things in Perl, I<there's more than one way to do it>, and -B<pod2usage()> adheres to this philosophy. If you are interested in -seeing a number of different ways to invoke B<pod2usage> (although by no -means exhaustive), please refer to L<"EXAMPLES">. - -=head1 EXAMPLES - -Each of the following invocations of C<pod2usage()> will print just the -"SYNOPSIS" section to C<STDERR> and will exit with a status of 2: - - pod2usage(); - - pod2usage(2); - - pod2usage(-verbose => 0); - - pod2usage(-exitval => 2); - - pod2usage({-exitval => 2, -output => \*STDERR}); - - pod2usage({-verbose => 0, -output => \*STDERR}); - - pod2usage(-exitval => 2, -verbose => 0); - - pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR); - -Each of the following invocations of C<pod2usage()> will print a message -of "Syntax error." (followed by a newline) to C<STDERR>, immediately -followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and -will exit with a status of 2: - - pod2usage("Syntax error."); - - pod2usage(-message => "Syntax error.", -verbose => 0); - - pod2usage(-msg => "Syntax error.", -exitval => 2); - - pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR}); - - pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR}); - - pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0); - - pod2usage(-message => "Syntax error.", - -exitval => 2, - -verbose => 0, - -output => \*STDERR); - -Each of the following invocations of C<pod2usage()> will print the -"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to -C<STDOUT> and will exit with a status of 1: - - pod2usage(1); - - pod2usage(-verbose => 1); - - pod2usage(-exitval => 1); - - pod2usage({-exitval => 1, -output => \*STDOUT}); - - pod2usage({-verbose => 1, -output => \*STDOUT}); - - pod2usage(-exitval => 1, -verbose => 1); - - pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT}); - -Each of the following invocations of C<pod2usage()> will print the -entire manual page to C<STDOUT> and will exit with a status of 1: - - pod2usage(-verbose => 2); - - pod2usage({-verbose => 2, -output => \*STDOUT}); - - pod2usage(-exitval => 1, -verbose => 2); - - pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT}); - -=head2 Recommended Use - -Most scripts should print some type of usage message to C<STDERR> when a -command line syntax error is detected. They should also provide an -option (usually C<-H> or C<-help>) to print a (possibly more verbose) -usage message to C<STDOUT>. Some scripts may even wish to go so far as to -provide a means of printing their complete documentation to C<STDOUT> -(perhaps by allowing a C<-man> option). The following complete example -uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these -things: - - use Getopt::Long; - use Pod::Usage; - - my $man = 0; - my $help = 0; - ## Parse options and print usage if there is a syntax error, - ## or if usage was explicitly requested. - GetOptions('help|?' => \$help, man => \$man) or pod2usage(2); - pod2usage(1) if $help; - pod2usage(-verbose => 2) if $man; - - ## If no arguments were given, then allow STDIN to be used only - ## if it's not connected to a terminal (otherwise print usage) - pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN)); - __END__ - - =head1 NAME - - sample - Using GetOpt::Long and Pod::Usage - - =head1 SYNOPSIS - - sample [options] [file ...] - - Options: - -help brief help message - -man full documentation - - =head1 OPTIONS - - =over 8 - - =item B<-help> - - Print a brief help message and exits. - - =item B<-man> - - Prints the manual page and exits. - - =back - - =head1 DESCRIPTION - - B<This program> will read the given input file(s) and do something - useful with the contents thereof. - - =cut - -=head1 CAVEATS - -By default, B<pod2usage()> will use C<$0> as the path to the pod input -file. Unfortunately, not all systems on which Perl runs will set C<$0> -properly (although if C<$0> isn't found, B<pod2usage()> will search -C<$ENV{PATH}> or else the list specified by the C<-pathlist> option). -If this is the case for your system, you may need to explicitly specify -the path to the pod docs for the invoking script using something -similar to the following: - - pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs"); - -In the pathological case that a script is called via a relative path -I<and> the script itself changes the current working directory -(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will -fail even on robust platforms. Don't do that. - -=head1 AUTHOR - -Please report bugs using L<http://rt.cpan.org>. - -Brad Appleton E<lt>bradapp@enteract.comE<gt> - -Based on code for B<Pod::Text::pod2text()> written by -Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> - -=head1 ACKNOWLEDGMENTS - -Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience -with re-writing this manpage. - -=cut - -############################################################################# - -use strict; -#use diagnostics; -use Carp; -use Config; -use Exporter; -use File::Spec; - -use vars qw(@ISA @EXPORT); -@EXPORT = qw(&pod2usage); -BEGIN { - if ( $] >= 5.005_58 ) { - require Pod::Text; - @ISA = qw( Pod::Text ); - } - else { - require Pod::PlainText; - @ISA = qw( Pod::PlainText ); - } -} - - -##--------------------------------------------------------------------------- - -##--------------------------------- -## Function definitions begin here -##--------------------------------- - -sub pod2usage { - local($_) = shift; - my %opts; - ## Collect arguments - if (@_ > 0) { - ## Too many arguments - assume that this is a hash and - ## the user forgot to pass a reference to it. - %opts = ($_, @_); - } - elsif (!defined $_) { - $_ = ""; - } - elsif (ref $_) { - ## User passed a ref to a hash - %opts = %{$_} if (ref($_) eq 'HASH'); - } - elsif (/^[-+]?\d+$/) { - ## User passed in the exit value to use - $opts{"-exitval"} = $_; - } - else { - ## User passed in a message to print before issuing usage. - $_ and $opts{"-message"} = $_; - } - - ## Need this for backward compatibility since we formerly used - ## options that were all uppercase words rather than ones that - ## looked like Unix command-line options. - ## to be uppercase keywords) - %opts = map { - my $val = $opts{$_}; - s/^(?=\w)/-/; - /^-msg/i and $_ = '-message'; - /^-exit/i and $_ = '-exitval'; - lc($_) => $val; - } (keys %opts); - - ## Now determine default -exitval and -verbose values to use - if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) { - $opts{"-exitval"} = 2; - $opts{"-verbose"} = 0; - } - elsif (! defined $opts{"-exitval"}) { - $opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2; - } - elsif (! defined $opts{"-verbose"}) { - $opts{"-verbose"} = (lc($opts{"-exitval"}) eq "noexit" || - $opts{"-exitval"} < 2); - } - - ## Default the output file - $opts{"-output"} = (lc($opts{"-exitval"}) eq "noexit" || - $opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR - unless (defined $opts{"-output"}); - ## Default the input file - $opts{"-input"} = $0 unless (defined $opts{"-input"}); - - ## Look up input file in path if it doesnt exist. - unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) { - my ($dirname, $basename) = ('', $opts{"-input"}); - my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";" - : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ":"); - my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB}; - - my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec); - for $dirname (@paths) { - $_ = File::Spec->catfile($dirname, $basename) if length; - last if (-e $_) && ($opts{"-input"} = $_); - } - } - - ## Now create a pod reader and constrain it to the desired sections. - my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts); - if ($opts{"-verbose"} == 0) { - $parser->select('SYNOPSIS\s*'); - } - elsif ($opts{"-verbose"} == 1) { - my $opt_re = '(?i)' . - '(?:OPTIONS|ARGUMENTS)' . - '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?'; - $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" ); - } - elsif ($opts{"-verbose"} >= 2 && $opts{"-verbose"} != 99) { - $parser->select('.*'); - } - elsif ($opts{"-verbose"} == 99) { - $parser->select( $opts{"-sections"} ); - $opts{"-verbose"} = 1; - } - - ## Now translate the pod document and then exit with the desired status - if ( !$opts{"-noperldoc"} - and $opts{"-verbose"} >= 2 - and !ref($opts{"-input"}) - and $opts{"-output"} == \*STDOUT ) - { - ## spit out the entire PODs. Might as well invoke perldoc - my $progpath = File::Spec->catfile($Config{scriptdir}, "perldoc"); - system($progpath, $opts{"-input"}); - if($?) { - # RT16091: fall back to more if perldoc failed - system($ENV{PAGER} || 'more', $opts{"-input"}); - } - } - else { - $parser->parse_from_file($opts{"-input"}, $opts{"-output"}); - } - - exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit'); -} - -##--------------------------------------------------------------------------- - -##------------------------------- -## Method definitions begin here -##------------------------------- - -sub new { - my $this = shift; - my $class = ref($this) || $this; - my %params = @_; - my $self = {%params}; - bless $self, $class; - if ($self->can('initialize')) { - $self->initialize(); - } else { - $self = $self->SUPER::new(); - %$self = (%$self, %params); - } - return $self; -} - -sub select { - my ($self, @res) = @_; - if ($ISA[0]->can('select')) { - $self->SUPER::select(@_); - } else { - $self->{USAGE_SELECT} = \@res; - } -} - -# Override Pod::Text->seq_i to return just "arg", not "*arg*". -sub seq_i { return $_[1] } - -# This overrides the Pod::Text method to do something very akin to what -# Pod::Select did as well as the work done below by preprocess_paragraph. -# Note that the below is very, very specific to Pod::Text. -sub _handle_element_end { - my ($self, $element) = @_; - if ($element eq 'head1') { - $$self{USAGE_HEAD1} = $$self{PENDING}[-1][1]; - if ($self->{USAGE_OPTIONS}->{-verbose} < 2) { - $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/; - } - } elsif ($element eq 'head2') { - $$self{USAGE_HEAD2} = $$self{PENDING}[-1][1]; - } - if ($element eq 'head1' || $element eq 'head2') { - $$self{USAGE_SKIPPING} = 1; - my $heading = $$self{USAGE_HEAD1}; - $heading .= '/' . $$self{USAGE_HEAD2} if defined $$self{USAGE_HEAD2}; - if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) { - $$self{USAGE_SKIPPING} = 0; - } else { - for (@{ $$self{USAGE_SELECT} }) { - if ($heading =~ /^$_\s*$/) { - $$self{USAGE_SKIPPING} = 0; - last; - } - } - } - - # Try to do some lowercasing instead of all-caps in headings, and use - # a colon to end all headings. - if($self->{USAGE_OPTIONS}->{-verbose} < 2) { - local $_ = $$self{PENDING}[-1][1]; - s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge; - s/\s*$/:/ unless (/:\s*$/); - $_ .= "\n"; - $$self{PENDING}[-1][1] = $_; - } - } - if ($$self{USAGE_SKIPPING}) { - pop @{ $$self{PENDING} }; - } else { - $self->SUPER::_handle_element_end($element); - } -} - -sub start_document { - my $self = shift; - $self->SUPER::start_document(); - my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1; - my $out_fh = $self->output_fh(); - print $out_fh "$msg\n"; -} - -sub begin_pod { - my $self = shift; - $self->SUPER::begin_pod(); ## Have to call superclass - my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1; - my $out_fh = $self->output_handle(); - print $out_fh "$msg\n"; -} - -sub preprocess_paragraph { - my $self = shift; - local $_ = shift; - my $line = shift; - ## See if this is a heading and we arent printing the entire manpage. - if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) { - ## Change the title of the SYNOPSIS section to USAGE - s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/; - ## Try to do some lowercasing instead of all-caps in headings - s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge; - ## Use a colon to end all headings - s/\s*$/:/ unless (/:\s*$/); - $_ .= "\n"; - } - return $self->SUPER::preprocess_paragraph($_); -} - -1; # keep require happy |