diff options
| author |   millert <millert@openbsd.org> | 2010-09-24 14:59:12 +0000 |
|---|---|---|
| committer | millert <millert@openbsd.org> | 2010-09-24 14:59:12 +0000 |
| commit | 41d3e4696cd3daae0ce9e1dce10beb6336934dd1 (patch) | |
| tree | dbc77d51b3c598c8bf289a326809b6fbddd7c78a /gnu/usr.bin/perl/lib/Pod | |
| parent | Add support pipex for L2TP call and L2TP on IPv6. (diff) | |
| download | wireguard-openbsd-41d3e4696cd3daae0ce9e1dce10beb6336934dd1.tar.xz wireguard-openbsd-41d3e4696cd3daae0ce9e1dce10beb6336934dd1.zip | |
remove files no longer in perl 5.12.2 (or that have moved)
Diffstat (limited to 'gnu/usr.bin/perl/lib/Pod')
235 files changed, 0 insertions, 48276 deletions
diff --git a/gnu/usr.bin/perl/lib/Pod/Checker.pm b/gnu/usr.bin/perl/lib/Pod/Checker.pm deleted file mode 100644 index 2e00d0d0963..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Checker.pm +++ /dev/null @@ -1,1268 +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 strict; - -use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES); -$VERSION = '1.45'; ## Current version of this package -require 5.005; ## requires this Perl version or later - -use Pod::ParseUtils; ## for hyperlinks and lists - -=head1 NAME - -Pod::Checker, podchecker - check pod documents for syntax errors - -=head1 SYNOPSIS - - use Pod::Checker; - - $syntax_okay = podchecker($filepath, $outputpath, %options); - - my $checker = new Pod::Checker %options; - $checker->parse_from_file($filepath, \*STDERR); - -=head1 OPTIONS/ARGUMENTS - -C<$filepath> is the input POD to read and C<$outputpath> is -where to write POD syntax error messages. Either argument may be a scalar -indicating a file-path, or else a reference to an open filehandle. -If unspecified, the input-file it defaults to C<\*STDIN>, and -the output-file defaults to C<\*STDERR>. - -=head2 podchecker() - -This function can take a hash of options: - -=over 4 - -=item B<-warnings> =E<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 diagnostics; -use Carp qw(croak); -use Exporter; -use Pod::Parser; - -@ISA = qw(Pod::Parser); -@EXPORT = qw(&podchecker); - -my %VALID_COMMANDS = ( - 'pod' => 1, - 'cut' => 1, - 'head1' => 1, - 'head2' => 1, - 'head3' => 1, - 'head4' => 1, - 'over' => 1, - 'back' => 1, - 'item' => 1, - 'for' => 1, - 'begin' => 1, - 'end' => 1, - 'encoding' => 1, -); - -my %VALID_SEQUENCES = ( - 'I' => 1, - 'B' => 1, - 'S' => 1, - 'C' => 1, - 'L' => 1, - 'F' => 1, - 'X' => 1, - 'Z' => 1, - 'E' => 1, -); - -# stolen from HTML::Entities -my %ENTITIES = ( - # Some normal chars that have special meaning in SGML context - amp => '&', # ampersand -'gt' => '>', # greater than -'lt' => '<', # less than - quot => '"', # double quote - - # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML - AElig => '', # capital AE diphthong (ligature) - Aacute => '', # capital A, acute accent - Acirc => '', # capital A, circumflex accent - Agrave => '', # capital A, grave accent - Aring => '', # capital A, ring - Atilde => '', # capital A, tilde - Auml => '', # capital A, dieresis or umlaut mark - Ccedil => '', # capital C, cedilla - ETH => '', # capital Eth, Icelandic - Eacute => '', # capital E, acute accent - Ecirc => '', # capital E, circumflex accent - Egrave => '', # capital E, grave accent - Euml => '', # capital E, dieresis or umlaut mark - Iacute => '', # capital I, acute accent - Icirc => '', # capital I, circumflex accent - Igrave => '', # capital I, grave accent - Iuml => '', # capital I, dieresis or umlaut mark - Ntilde => '', # capital N, tilde - Oacute => '', # capital O, acute accent - Ocirc => '', # capital O, circumflex accent - Ograve => '', # capital O, grave accent - Oslash => '', # capital O, slash - Otilde => '', # capital O, tilde - Ouml => '', # capital O, dieresis or umlaut mark - THORN => '', # capital THORN, Icelandic - Uacute => '', # capital U, acute accent - Ucirc => '', # capital U, circumflex accent - Ugrave => '', # capital U, grave accent - Uuml => '', # capital U, dieresis or umlaut mark - Yacute => '', # capital Y, acute accent - aacute => '', # small a, acute accent - acirc => '', # small a, circumflex accent - aelig => '', # small ae diphthong (ligature) - agrave => '', # small a, grave accent - aring => '', # small a, ring - atilde => '', # small a, tilde - auml => '', # small a, dieresis or umlaut mark - ccedil => '', # small c, cedilla - eacute => '', # small e, acute accent - ecirc => '', # small e, circumflex accent - egrave => '', # small e, grave accent - eth => '', # small eth, Icelandic - euml => '', # small e, dieresis or umlaut mark - iacute => '', # small i, acute accent - icirc => '', # small i, circumflex accent - igrave => '', # small i, grave accent - iuml => '', # small i, dieresis or umlaut mark - ntilde => '', # small n, tilde - oacute => '', # small o, acute accent - ocirc => '', # small o, circumflex accent - ograve => '', # small o, grave accent - oslash => '', # small o, slash - otilde => '', # small o, tilde - ouml => '', # small o, dieresis or umlaut mark - szlig => '', # small sharp s, German (sz ligature) - thorn => '', # small thorn, Icelandic - uacute => '', # small u, acute accent - ucirc => '', # small u, circumflex accent - ugrave => '', # small u, grave accent - uuml => '', # small u, dieresis or umlaut mark - yacute => '', # small y, acute accent - yuml => '', # small y, dieresis or umlaut mark - - # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) - copy => '', # copyright sign - reg => '', # registered sign - nbsp => "\240", # non breaking space - - # Additional ISO-8859/1 entities listed in rfc1866 (section 14) - iexcl => '', - cent => '', - pound => '', - curren => '', - yen => '', - brvbar => '', - sect => '', - uml => '', - ordf => '', - laquo => '', -'not' => '', # not is a keyword in perl - shy => '', - macr => '', - deg => '', - plusmn => '', - sup1 => '', - sup2 => '', - sup3 => '', - acute => '', - micro => '', - para => '', - middot => '', - cedil => '', - ordm => '', - raquo => '', - frac14 => '', - frac12 => '', - frac34 => '', - iquest => '', -'times' => '', # times is a keyword in perl - divide => '', - -# some POD special entities - verbar => '|', - sol => '/' -); - -##--------------------------------------------------------------------------- - -##--------------------------------- -## Function definitions begin here -##--------------------------------- - -sub podchecker { - my ($infile, $outfile, %options) = @_; - local $_; - - ## Set defaults - $infile ||= \*STDIN; - $outfile ||= \*STDERR; - - ## Now create a pod checker - my $checker = new Pod::Checker(%options); - - ## Now check the pod document for errors - $checker->parse_from_file($infile, $outfile); - - ## Return the number of errors found - return $checker->num_errors(); -} - -##--------------------------------------------------------------------------- - -##------------------------------- -## Method definitions begin here -##------------------------------- - -################################## - -=over 4 - -=item 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 => q{Nested =begin's (first at line } . - $self->{_have_begin} . ')'}); - } - else { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - unless($arg && $arg =~ /(\S+)/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'No argument for =begin'}); - } - # remember the =begin - $self->{_have_begin} = "$line:$1"; - } - } - elsif($cmd eq 'end') { - if($self->{_have_begin}) { - # close the existing =begin - $self->{_have_begin} = ''; - # check for spurious characters - $arg = $self->interpolate_and_check($paragraph, $line,$file); - # the closing argument is optional - #if($arg && $arg =~ /\S/) { - # $self->poderror({ -line => $line, -file => $file, - # -severity => 'WARNING', - # -msg => "Spurious character(s) after =end" }); - #} - } - else { - # don't have a matching =begin - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=end without =begin' }); - } - } - elsif($cmd eq 'for') { - unless($paragraph =~ /\s*(\S+)\s*/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=for without formatter specification' }); - } - $arg = ''; # do not expand paragraph below - } - elsif($cmd =~ /^(pod|cut)$/) { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - if($arg && $arg =~ /(\S+)/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Spurious text after =$cmd"}); - } - } - $self->{_commands_in_head}++; - ## Check the interior sequences in the command-text - $self->interpolate_and_check($paragraph, $line,$file) - unless(defined $arg); - } -} - -sub _open_list -{ - my ($self,$indent,$line,$file) = @_; - my $list = Pod::List->new( - -indent => $indent, - -start => $line, - -file => $file); - unshift(@{$self->{_list_stack}}, $list); - undef $self->{_list_item_contents}; - $list; -} - -sub _close_list -{ - my ($self,$line,$file) = @_; - my $list = shift(@{$self->{_list_stack}}); - if(defined $self->{_list_item_contents} && - $self->{_list_item_contents} == 0) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'previous =item has no contents' }); - } - undef $self->{_list_item_contents}; - $list; -} - -# process a block of some text -sub interpolate_and_check { - my ($self, $paragraph, $line, $file) = @_; - ## Check the interior sequences in the command-text - # and return the text - $self->_check_ptree( - $self->parse_text($paragraph,$line), $line, $file, ''); -} - -sub _check_ptree { - my ($self,$ptree,$line,$file,$nestlist) = @_; - local($_); - my $text = ''; - # process each node in the parse tree - foreach(@$ptree) { - # regular text chunk - unless(ref) { - # count the unescaped angle brackets - # complain only when warning level is greater than 1 - if($self->{-warnings} && $self->{-warnings}>1) { - my $count; - if($count = tr/<>/<>/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "$count unescaped <> in paragraph" }); - } - } - $text .= $_; - next; - } - # have an interior sequence - my $cmd = $_->cmd_name(); - my $contents = $_->parse_tree(); - ($file,$line) = $_->file_line(); - # check for valid tag - if (! $VALID_SEQUENCES{$cmd}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => qq(Unknown interior-sequence '$cmd')}); - # expand it anyway - $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - next; - } - if($nestlist =~ /$cmd/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "nested commands $cmd<...$cmd<...>...>"}); - # _TODO_ should we add the contents anyway? - # expand it anyway, see below - } - if($cmd eq 'E') { - # preserve entities - if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'garbled entity ' . $_->raw_text()}); - next; - } - my $ent = $$contents[0]; - my $val; - if($ent =~ /^0x[0-9a-f]+$/i) { - # hexadec entity - $val = hex($ent); - } - elsif($ent =~ /^0\d+$/) { - # octal - $val = oct($ent); - } - elsif($ent =~ /^\d+$/) { - # numeric entity - $val = $ent; - } - if(defined $val) { - if($val>0 && $val<256) { - $text .= chr($val); - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Entity number out of range ' . $_->raw_text()}); - } - } - elsif($ENTITIES{$ent}) { - # known ISO entity - $text .= $ENTITIES{$ent}; - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'Unknown entity ' . $_->raw_text()}); - $text .= "E<$ent>"; - } - } - elsif($cmd eq 'L') { - # try to parse the hyperlink - my $link = Pod::Hyperlink->new($contents->raw_text()); - unless(defined $link) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'malformed link ' . $_->raw_text() ." : $@"}); - next; - } - $link->line($line); # remember line - if($self->{-warnings}) { - foreach my $w ($link->warning()) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => $w }); - } - } - # check the link text - $text .= $self->_check_ptree($self->parse_text($link->text(), - $line), $line, $file, "$nestlist$cmd"); - # remember link - $self->hyperlink([$line,$link]); - } - elsif($cmd =~ /[BCFIS]/) { - # add the guts - $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - } - elsif($cmd eq 'Z') { - if(length($contents->raw_text())) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Nonempty Z<>'}); - } - } - elsif($cmd eq 'X') { - my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - if($idx =~ /^\s*$/s) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Empty X<>'}); - } - else { - # remember this node - $self->idx($idx); - } - } - else { - # not reached - croak 'internal error'; - } - } - $text; -} - -# process a block of verbatim text -sub verbatim { - ## Nothing particular to check - my ($self, $paragraph, $line_num, $pod_para) = @_; - - $self->_preproc_par($paragraph); - - if($self->{_current_head1} eq 'NAME') { - my ($file, $line) = $pod_para->file_line; - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'Verbatim paragraph in NAME section' }); - } -} - -# process a block of regular text -sub textblock { - my ($self, $paragraph, $line_num, $pod_para) = @_; - my ($file, $line) = $pod_para->file_line; - - $self->_preproc_par($paragraph); - - # skip this paragraph if in a =begin block - unless($self->{_have_begin}) { - my $block = $self->interpolate_and_check($paragraph, $line,$file); - if($self->{_current_head1} eq 'NAME') { - if($block =~ /^\s*(\S+?)\s*[,-]/) { - # this is the canonical name - $self->{-name} = $1 unless(defined $self->{-name}); - } - } - } -} - -sub _preproc_par -{ - my $self = shift; - $_[0] =~ s/[\s\n]+$//; - if($_[0]) { - $self->{_commands_in_head}++; - $self->{_list_item_contents}++ if(defined $self->{_list_item_contents}); - if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) { - $self->{_list_stack}->[0]->{_has_par} = 1; - } - } -} - -1; - -__END__ - -=head1 AUTHOR - -Please report bugs using L<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/gnu/usr.bin/perl/lib/Pod/Escapes.pm b/gnu/usr.bin/perl/lib/Pod/Escapes.pm deleted file mode 100644 index de4d75a7b83..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Escapes/ChangeLog b/gnu/usr.bin/perl/lib/Pod/Escapes/ChangeLog deleted file mode 100644 index 11a9608cbe2..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Escapes/ChangeLog +++ /dev/null @@ -1,26 +0,0 @@ -Revision history for Perl extension Pod::Escapes - Time-stamp: "2004-05-07 15:44:30 ADT" - -2004-05-07 Sean M. Burke sburke@cpan.org - - * Release 1.04 -- adding support for E<x123> as an alternate form - for E<0x123>. Adding the function e2charnum nad the hash - %Name2character_number. - - Tests rearranged, and new ones added. - -2002-08-27 Sean M. Burke sburke@cpan.org - - * Release 1.03 -- previous version mistakenly thought that "x4f" - was the syntax for hex escapes in Pod. Perlpod says it's 0x4f, so - Pod::Escapes has been changed to support this syntax instead - (instead!). - -2001-12-14 Sean M. Burke sburke@cpan.org - - * Release 1.02 -- added %Name2character_number and e2charnum, at - the suggestion of Tim Jenness. - -2001-10-24 Sean M. Burke sburke@cpan.org - - * Release 1.01 -- first release version diff --git a/gnu/usr.bin/perl/lib/Pod/Escapes/README b/gnu/usr.bin/perl/lib/Pod/Escapes/README deleted file mode 100644 index d044647b14a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Escapes/README +++ /dev/null @@ -1,91 +0,0 @@ -README for Pod::Escapes - Time-stamp: "2004-04-27 19:55:10 ADT" - -NAME - Pod::Escapes -- for resolving Pod E<...> sequences - -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... - -DESCRIPTION - This module provides things that are useful in decoding Pod E<...> - sequences. Presumably, it should be used only by Pod parsers and/or - formatters. - - By default, Pod::Escapes exports none of its symbols. But you can request - any of them to be exported. Either request them individually, as with `use - Pod::Escapes qw(symbolname symbolname2...);', or you can do `use - Pod::Escapes qw(:ALL);' to get all exportable symbols. - -[...] - -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. - -SEE ALSO - perlpod - - perlpodspec - - Text::Unidecode - -[...] - - -PREREQUISITES - -This suite requires Perl 5; I've only used it under Perl 5.004, so for -anything lower, you're on your own. - -Pod::Escapes doesn't use any nonstandard modules. - - -INSTALLATION - -You install Pod::Escapes, as you would install any perl module -library, by running these commands: - - perl Makefile.PL - make - make test - make install - -If you want to install a private copy of Pod::Escapes in your home -directory, then you should try to produce the initial Makefile with -something like this command: - - perl Makefile.PL LIB=~/perl - - -DOCUMENTATION - -POD-format documentation is included in Escapes.pm. POD is readable -with the 'perldoc' utility. See ChangeLog for recent changes. - - -MACPERL INSTALLATION NOTES - -Don't bother with the makefiles. Just make a Pod directory in your -MacPerl site_lib or lib directory, and move Escapes.pm into there. - - -SUPPORT - -Questions, bug reports, useful code bits, and suggestions for -Pod::Escapes should just be sent to me at sburke@cpan.org - - -AVAILABILITY - -The latest version of Pod::Escapes is available from the -Comprehensive Perl Archive Network (CPAN). Visit -<http://www.perl.com/CPAN/> to find a CPAN site near you. diff --git a/gnu/usr.bin/perl/lib/Pod/Escapes/t/01_about_verbose.t b/gnu/usr.bin/perl/lib/Pod/Escapes/t/01_about_verbose.t deleted file mode 100644 index 61bc627ce13..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Escapes/t/01_about_verbose.t +++ /dev/null @@ -1,93 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - -require 5; -# Time-stamp: "2004-04-27 19:44:49 ADT" - -# Summary of, well, things. - -use Test; -BEGIN {plan tests => 2}; - -ok 1; - -use Pod::Escapes (); - -#chdir "t" if -e "t"; - -{ - my @out; - push @out, - "\n\nPerl v", - defined($^V) ? sprintf('%vd', $^V) : $], - " under $^O ", - (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) - ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), - (defined $MacPerl::Version) - ? ("(MacPerl version $MacPerl::Version)") : (), - "\n" - ; - - # Ugly code to walk the symbol tables: - my %v; - my @stack = (''); # start out in %:: - my $this; - my $count = 0; - my $pref; - while(@stack) { - $this = shift @stack; - die "Too many packages?" if ++$count > 1000; - next if exists $v{$this}; - next if $this eq 'main'; # %main:: is %:: - - #print "Peeking at $this => ${$this . '::VERSION'}\n"; - - if(defined ${$this . '::VERSION'} ) { - $v{$this} = ${$this . '::VERSION'} - } elsif( - defined *{$this . '::ISA'} or defined &{$this . '::import'} - or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) - # If it has an ISA, an import, or any subs... - ) { - # It's a class/module with no version. - $v{$this} = undef; - } else { - # It's probably an unpopulated package. - ## $v{$this} = '...'; - } - - $pref = length($this) ? "$this\::" : ''; - push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'}; - #print "Stack: @stack\n"; - } - push @out, " Modules in memory:\n"; - delete @v{'', '[none]'}; - foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { - $indent = ' ' x (2 + ($p =~ tr/:/:/)); - push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; - } - push @out, sprintf "[at %s (local) / %s (GMT)]\n", - scalar(gmtime), scalar(localtime); - my $x = join '', @out; - $x =~ s/^/#/mg; - print $x; -} - -print "# Running", - (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", - "#\n", -; - -print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; - -print "# \%INC:\n"; -foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { - print "# [$x] = [", $INC{$x} || '', "]\n"; -} - -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Escapes/t/10_main.t b/gnu/usr.bin/perl/lib/Pod/Escapes/t/10_main.t deleted file mode 100644 index b42205c70f5..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Escapes/t/10_main.t +++ /dev/null @@ -1,120 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - -# Time-stamp: "2004-05-07 15:43:11 ADT" - -use strict; -use Test; - -my @them; -BEGIN { plan('tests' => 63) }; -BEGIN { print "# Perl version $] under $^O\n" } - -use Pod::Escapes qw(:ALL); -ok 1; - -eval " binmode(STDOUT, ':utf8') "; - -print "# Pod::Escapes version $Pod::Escapes::VERSION\n"; -print "# I'm ", (chr(65) eq 'A') ? '' : 'not ', "in ASCII world.\n"; -print "#\n#------------------------\n#\n"; - -foreach my $quotie (qw( \n \r \cm \cj \t \f \b \a \e )) { - my $val = eval "\"$quotie\""; - if($@) { - ok 0; - print "# Error in evalling quotie \"$quotie\"\n"; - } elsif(!defined $val) { - ok 0; - print "# \"$quotie\" is undef!?\n"; - } else { - ok 1; - print "# \"$quotie\" is ", ord($val), "\n"; - } -} - -print "#\n#------------------------\n#\n"; - -print "# 'A' tests...\n"; -ok e2char('65'), 'A'; -ok e2char('x41'), 'A'; -ok e2char('x041'), 'A'; -ok e2char('x0041'), 'A'; -ok e2char('x00041'), 'A'; -ok e2char('0101'), 'A'; -ok e2char('00101'), 'A'; -ok e2char('000101'), 'A'; -ok e2char('0000101'), 'A'; - -print "# '<' tests...\n"; -ok e2char('lt'), '<'; -ok e2char('60'), '<'; -ok e2char('074'), '<'; -ok e2char('0074'), '<'; -ok e2char('00074'), '<'; -ok e2char('000074'), '<'; - -ok e2char('x3c'), '<'; -ok e2char('x3C'), '<'; -ok e2char('x03c'), '<'; -ok e2char('x003c'), '<'; -ok e2char('x0003c'), '<'; -ok e2char('x00003c'), '<'; -ok e2char('0x3c'), '<'; -ok e2char('0x3C'), '<'; -ok e2char('0x03c'), '<'; -ok e2char('0x003c'), '<'; -ok e2char('0x0003c'), '<'; -ok e2char('0x00003c'), '<'; - -ok e2char('65') ne e2char('lt'); - -print "# eacute tests...\n"; -ok defined e2char('eacute'); - -print "# eacute is <", e2char('eacute'), "> which is code ", - ord(e2char('eacute')), "\n"; - -ok e2char('eacute'), e2char('233'); -ok e2char('eacute'), e2char('0351'); -ok e2char('eacute'), e2char('xe9'); -ok e2char('eacute'), e2char('xE9'); - -print "# pi tests...\n"; -ok defined e2char('pi'); - -print "# pi is <", e2char('pi'), "> which is code ", - ord(e2char('pi')), "\n"; - -ok e2char('pi'), e2char('960'); -ok e2char('pi'), e2char('01700'); -ok e2char('pi'), e2char('001700'); -ok e2char('pi'), e2char('0001700'); -ok e2char('pi'), e2char('x3c0'); -ok e2char('pi'), e2char('x3C0'); -ok e2char('pi'), e2char('x03C0'); -ok e2char('pi'), e2char('x003C0'); -ok e2char('pi'), e2char('x0003C0'); - - -print "# various hash tests...\n"; - -ok scalar keys %Name2character; -ok defined $Name2character{'eacute'}; -ok $Name2character{'lt'} eq '<'; - -ok scalar keys %Latin1Code_to_fallback; -ok defined $Latin1Code_to_fallback{233}; - -ok scalar keys %Latin1Char_to_fallback; -ok defined $Latin1Char_to_fallback{chr(233)}; - -ok scalar keys %Code2USASCII; -ok defined $Code2USASCII{65}; -ok $Code2USASCII{65} eq 'A'; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Escapes/t/15_name2charnum.t b/gnu/usr.bin/perl/lib/Pod/Escapes/t/15_name2charnum.t deleted file mode 100644 index 2ce1fa019fc..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Escapes/t/15_name2charnum.t +++ /dev/null @@ -1,87 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - -# Time-stamp: "2004-04-27 19:53:22 ADT" - -use strict; -use Test; - -my @them; -BEGIN { plan('tests' => 41) }; -BEGIN { print "# Perl version $] under $^O\n" } - -use Pod::Escapes qw(:ALL); -ok 1; - -eval " binmode(STDOUT, ':utf8') "; - -print "# Pod::Escapes version $Pod::Escapes::VERSION\n"; -print "# I'm ", (chr(65) eq 'A') ? '' : 'not ', "in ASCII world.\n"; -print "#\n#------------------------\n#\n"; - -print "# 'A' tests...\n"; -ok e2charnum('65'), '65'; -ok e2charnum('x41'), '65'; -ok e2charnum('x041'), '65'; -ok e2charnum('x0041'), '65'; -ok e2charnum('x00041'), '65'; -ok e2charnum('0101'), '65'; -ok e2charnum('00101'), '65'; -ok e2charnum('000101'), '65'; -ok e2charnum('0000101'), '65'; - -print "# '<' tests...\n"; -ok e2charnum('lt'), '60'; -ok e2charnum('60'), '60'; -ok e2charnum('074'), '60'; -ok e2charnum('0074'), '60'; -ok e2charnum('00074'), '60'; -ok e2charnum('000074'), '60'; -ok e2charnum('x3c'), '60'; -ok e2charnum('x3C'), '60'; -ok e2charnum('x03c'), '60'; -ok e2charnum('x003c'), '60'; -ok e2charnum('x0003c'), '60'; -ok e2charnum('x00003c'), '60'; - -ok e2charnum('65') ne e2charnum('lt'); - -print "# eacute tests...\n"; -ok defined e2charnum('eacute'); - -print "# eacute is <", e2charnum('eacute'), "> which is code ", - ord(e2charnum('eacute')), "\n"; - -ok e2charnum('eacute'), e2charnum('233'); -ok e2charnum('eacute'), e2charnum('0351'); -ok e2charnum('eacute'), e2charnum('xe9'); -ok e2charnum('eacute'), e2charnum('xE9'); - -print "# pi tests...\n"; -ok defined e2charnum('pi'); - -print "# pi is <", e2charnum('pi'), "> which is code ", - e2charnum('pi'), "\n"; - -ok e2charnum('pi'), e2charnum('960'); -ok e2charnum('pi'), e2charnum('01700'); -ok e2charnum('pi'), e2charnum('001700'); -ok e2charnum('pi'), e2charnum('0001700'); -ok e2charnum('pi'), e2charnum('x3c0'); -ok e2charnum('pi'), e2charnum('x3C0'); -ok e2charnum('pi'), e2charnum('x03C0'); -ok e2charnum('pi'), e2charnum('x003C0'); -ok e2charnum('pi'), e2charnum('x0003C0'); - - -print "# %Name2character_number test...\n"; - -ok scalar keys %Name2character_number; -ok defined $Name2character_number{'eacute'}; -ok $Name2character_number{'lt'} eq '60'; - -# End diff --git a/gnu/usr.bin/perl/lib/Pod/Find.pm b/gnu/usr.bin/perl/lib/Pod/Find.pm deleted file mode 100644 index 8d1103b6a1f..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Find.pm +++ /dev/null @@ -1,535 +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 strict; - -use vars qw($VERSION); -$VERSION = '1.35'; ## Current version of this package -require 5.005; ## requires this Perl version or later -use Carp; - -BEGIN { - if ($] < 5.006) { - require Symbol; - import Symbol; - } -} - -############################################################################# - -=head1 NAME - -Pod::Find - find POD documents in directory trees - -=head1 SYNOPSIS - - use Pod::Find qw(pod_find simplify_name); - my %pods = pod_find({ -verbose => 1, -inc => 1 }); - foreach(keys %pods) { - print "found library POD `$pods{$_}' in $_\n"; - } - - print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n"; - - $location = pod_where( { -inc => 1 }, "Pod::Find" ); - -=head1 DESCRIPTION - -B<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 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 included in I<@INC> by the Perl interpreter itself. - -=back - -=cut - -# return a hash of the POD files found -# first argument may be a hashref (options), -# rest is a list of directories to search recursively -sub pod_find -{ - my %opts; - if(ref $_[0]) { - %opts = %{shift()}; - } - - $opts{-verbose} ||= 0; - $opts{-perl} ||= 0; - - my (@search) = @_; - - if($opts{-script}) { - require Config; - push(@search, $Config::Config{scriptdir}) - if -d $Config::Config{scriptdir}; - $opts{-perl} = 1; - } - - if($opts{-inc}) { - if ($^O eq 'MacOS') { - # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS - my @new_INC = @INC; - for (@new_INC) { - if ( $_ eq '.' ) { - $_ = ':'; - } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) { - $_ = ':'. $_; - } else { - $_ =~ s{^\./}{:}; - } - } - push(@search, grep($_ ne File::Spec->curdir, @new_INC)); - } else { - push(@search, grep($_ ne File::Spec->curdir, @INC)); - } - - $opts{-perl} = 1; - } - - if($opts{-perl}) { - require Config; - # this code simplifies the POD name for Perl modules: - # * remove "site_perl" - # * remove e.g. "i586-linux" (from 'archname') - # * remove e.g. 5.00503 - # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) - - # Mac OS: - # * remove ":?site_perl:" - # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod) - - if ($^O eq 'MacOS') { - $SIMPLIFY_RX = - qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!; - } else { - $SIMPLIFY_RX = - qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!; - } - } - - my %dirs_visited; - my %pods; - my %names; - my $pwd = cwd(); - - foreach my $try (@search) { - unless(File::Spec->file_name_is_absolute($try)) { - # make path absolute - $try = File::Spec->catfile($pwd,$try); - } - # simplify path - # on VMS canonpath will vmsify:[the.path], but File::Find::find - # wants /unixy/paths - $try = File::Spec->canonpath($try) if ($^O ne 'VMS'); - $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS'); - my $name; - if(-f $try) { - if($name = _check_and_extract_name($try, $opts{-verbose})) { - _check_for_duplicates($try, $name, \%names, \%pods); - } - next; - } - my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!; - File::Find::find( sub { - my $item = $File::Find::name; - if(-d) { - if($item =~ m{/(?:RCS|CVS|SCCS|\.svn)$}) { - $File::Find::prune = 1; - return; - } - elsif($dirs_visited{$item}) { - warn "Directory '$item' already seen, skipping.\n" - if($opts{-verbose}); - $File::Find::prune = 1; - return; - } - else { - $dirs_visited{$item} = 1; - } - if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) { - $File::Find::prune = 1; - warn "Perl $] version mismatch on $_, skipping.\n" - if($opts{-verbose}); - } - return; - } - if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { - _check_for_duplicates($item, $name, \%names, \%pods); - } - }, $try); # end of File::Find::find - } - chdir $pwd; - return %pods; -} - -sub _check_for_duplicates { - my ($file, $name, $names_ref, $pods_ref) = @_; - if($$names_ref{$name}) { - warn "Duplicate POD found (shadowing?): $name ($file)\n"; - warn ' Already seen in ', - join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; - } - else { - $$names_ref{$name} = 1; - } - return $$pods_ref{$file} = $name; -} - -sub _check_and_extract_name { - my ($file, $verbose, $root_rx) = @_; - - # check extension or executable flag - # this involves testing the .bat extension on Win32! - unless(-f $file && -T $file && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) { - return; - } - - return unless contains_pod($file,$verbose); - - # strip non-significant path components - # TODO what happens on e.g. Win32? - my $name = $file; - if(defined $root_rx) { - $name =~ s/$root_rx//s; - $name =~ s/$SIMPLIFY_RX//s if(defined $SIMPLIFY_RX); - } - else { - if ($^O eq 'MacOS') { - $name =~ s/^.*://s; - } else { - $name =~ s{^.*/}{}s; - } - } - _simplify($name); - $name =~ s{/+}{::}g; - if ($^O eq 'MacOS') { - $name =~ s{:+}{::}g; # : -> :: - } else { - $name =~ s{/+}{::}g; # / -> :: - } - return $name; -} - -=head2 C<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); - return $str; -} - -# internal sub only -sub _simplify { - # strip Perl's own extensions - $_[0] =~ s/\.(pod|pm|plx?)\z//i; - # strip meaningless extensions on Win32 and OS/2 - $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i); - # strip meaningless extensions on VMS - $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS'); -} - -# contribution from Tim Jenness <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; -} - -=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 - my $podfh; - if ($] < 5.006) { - $podfh = gensym(); - } - - unless(open($podfh,"<$file")) { - warn "Error: $file is unreadable: $!\n"; - return; - } - - local $/ = undef; - my $pod = <$podfh>; - close($podfh) || die "Error closing $file: $!\n"; - unless($pod =~ /^=(head\d|pod|over|item|cut)\b/m) { - warn "No POD in $file, skipping.\n" - if($verbose); - return 0; - } - - return 1; -} - -=head1 AUTHOR - -Please report bugs using L<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/gnu/usr.bin/perl/lib/Pod/InputObjects.pm b/gnu/usr.bin/perl/lib/Pod/InputObjects.pm deleted file mode 100644 index 13a86188bcb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/InputObjects.pm +++ /dev/null @@ -1,936 +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 strict; - -use vars qw($VERSION); -$VERSION = '1.31'; ## 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 - -############################################################################# - -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 && !(ref $ptree[0]) && !(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/gnu/usr.bin/perl/lib/Pod/LaTeX.pm b/gnu/usr.bin/perl/lib/Pod/LaTeX.pm deleted file mode 100644 index c50ee9e4f04..00000000000 --- a/gnu/usr.bin/perl/lib/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 automaatically. - -=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.8 2009/10/12 18:24:42 millert Exp $ - -=end __PRIVATE__ - -=cut - -1; diff --git a/gnu/usr.bin/perl/lib/Pod/Man.pm b/gnu/usr.bin/perl/lib/Pod/Man.pm deleted file mode 100644 index ea4703b541a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Man.pm +++ /dev/null @@ -1,1750 +0,0 @@ -# Pod::Man -- Convert POD data to formatted *roff input. -# -# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -# 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); - -$VERSION = '2.22'; - -# 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 not 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, @_); - - # Send errors to stderr if requested. - if ($$self{stderr}) { - $self->no_errata_section (1); - $self->complain_stderr (1); - delete $$self{stderr}; - } - - # 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}; - - # Cleanup just tidies up a few things, telling *roff that the hyphens are - # hard, putting a bit of space between consecutive underscores, and - # escaping backslashes. Be careful not to mangle our character - # translations by doing this before processing character translation. - if ($cleanup) { - $text =~ s/\\/\\e/g; - $text =~ s/-/\\-/g; - $text =~ s/_(?=_)/_\\|/g; - } - - # Normally we do character translation, but we won't even do that in - # <Data> blocks or if UTF-8 output is desired. - if ($convert && !$$self{utf8} && ASCII) { - $text =~ s/([^\x00-\x7F])/$ESCAPES{ord ($1)} || "X"/eg; - } - - # 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; - $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; - } - - # If we were given the utf8 option, set an output encoding on our file - # handle. Wrap in an eval in case we're using a version of Perl too old - # to understand this. - # - # This is evil because it changes the global state of a file handle that - # we may not own. However, we can't just blindly encode all output, since - # there may be a pre-applied output encoding (such as from PERL_UNICODE) - # and then we would double-encode. This seems to be the least bad - # approach. - if ($$self{utf8}) { - eval { binmode ($$self{output_fh}, ':encoding(UTF-8)') }; - } - - # 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; - } elsif ($dirs[$i] eq 'lib' && $dirs[$i + 1] && $dirs[0] eq 'ext') { - $cut = $i + 1; - } - } - 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 (!$$self{utf8}); - - # 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 ('.SS', $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 -- hopefully we can assume UTF-8 and just leave well enough alone. -@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; - -############################################################################## -# Premable -############################################################################## - -# The following is the static preamble which starts all *roff output we -# generate. Most is 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@. However, the second part, which -# defines the accent marks, is only used if $escapes is set to true. -sub preamble_template { - my ($self, $accents) = @_; - my $preamble = <<'----END OF PREAMBLE----'; -.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 (.SS), 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 -.. -.\} -----END OF PREAMBLE---- - - if ($accents) { - $preamble .= <<'----END OF PREAMBLE----' -.\" -.\" 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 - } - return $preamble; -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Man - Convert POD data to formatted *roff input - -=for stopwords -en em ALLCAPS teeny fixedbold fixeditalic fixedbolditalic stderr utf8 -UTF-8 Allbery Sean Burke Ossanna Solaris formatters troff uppercased -Christiansen - -=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 -C<STDIN> for input). - -Pod::Man assumes that your *roff formatters have a fixed-width font named -C<CW>. If yours is called something else (like C<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 underscores, 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 C<STDIN>), and the date will be formatted as -C<YYYY-MM-DD>. - -=item fixed - -The fixed-width font to use for verbatim text and code. Defaults to -C<CW>. Some systems may want C<CR> instead. Only matters for B<troff> -output. - -=item fixedbold - -Bold version of the fixed-width font. Defaults to C<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 C<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 C<CB>. Some -systems (such as Solaris) have this font available as C<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 C<.pm> in which -case section 3 will be selected. - -=item stderr - -Send error messages about invalid POD to standard error instead of -appending a POD ERRORS section to the generated *roff output. - -=item utf8 - -By default, Pod::Man produces the most conservative possible *roff output -to try to ensure that it will work with as many different *roff -implementations as possible. Many *roff implementations cannot handle -non-ASCII characters, so this means all non-ASCII characters are converted -either to a *roff escape sequence that tries to create a properly accented -character (at least for troff output) or to C<X>. - -If this option is set, Pod::Man will instead output UTF-8. If your *roff -implementation can handle it, this is the best output format to use and -avoids corruption of documents containing non-ASCII characters. However, -be warned that *roff source with literal UTF-8 characters is not supported -by many implementations and may even result in segfaults and other bad -behavior. - -Be aware that, when using this option, the input encoding of your POD -source must be properly declared unless it is US-ASCII or Latin-1. POD -input without an C<=encoding> command will be assumed to be in Latin-1, -and if it's actually in UTF-8, the output will be double-encoded. See -L<perlpod(1)> for more information on the C<=encoding> command. - -=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 C<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 - -Encoding handling assumes that PerlIO is available and does not work -properly if it isn't. The C<utf8> option is therefore not supported -unless Perl is built with PerlIO support. - -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 -toward 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 - -If Pod::Man is given the C<utf8> option, the encoding of its output file -handle will be forced to UTF-8 if possible, overriding any existing -encoding. This will be done even if the file handle is not created by -Pod::Man and was passed in from outside. This maintains consistency -regardless of PERL_UNICODE and other settings. - -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, 2008, 2009 -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/gnu/usr.bin/perl/lib/Pod/ParseLink.pm b/gnu/usr.bin/perl/lib/Pod/ParseLink.pm deleted file mode 100644 index 7cb2d656f64..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/ParseLink.pm +++ /dev/null @@ -1,182 +0,0 @@ -# Pod::ParseLink -- Parse an L<> formatting code in POD text. -# -# Copyright 2001, 2008 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); - -$VERSION = '1.09'; - -############################################################################## -# 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 - -=for stopwords -markup Allbery URL - -=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 C<url>, C<pod>, or C<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 backward -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, 2008 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/gnu/usr.bin/perl/lib/Pod/ParseUtils.pm b/gnu/usr.bin/perl/lib/Pod/ParseUtils.pm deleted file mode 100644 index f3c7ef46779..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/ParseUtils.pm +++ /dev/null @@ -1,855 +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 strict; - -use vars qw($VERSION); -$VERSION = '1.36'; ## 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 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; - } - - ## 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(/^($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(/^(.*?)\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(/^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $/ix) { - ($alttext,$node) = ($1,$2); - $type = 'hyperlink'; - } - - # non-standard: Hyperlink - elsif(/^(\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 { - return $_[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(); - } - return $_[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(); - } - return $_[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(); - } - return $_[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(); - $node =~ s/\|/E<verbar>/g; - $node =~ 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"; - } - return $link; -} - -sub _invalid_link { - my ($msg) = @_; - # this sets @_ - #eval { die "$msg\n" }; - #chomp $@; - $@ = $msg; # this seems to work, too! - return; -} - -#----------------------------------------------------------------------------- -# 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 $_; - } - } - return; -} - -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 - } - } - return; -} - -=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/gnu/usr.bin/perl/lib/Pod/Parser.pm b/gnu/usr.bin/perl/lib/Pod/Parser.pm deleted file mode 100644 index c807f3fbade..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Parser.pm +++ /dev/null @@ -1,1829 +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 strict; - -## These "variables" are used as local "glob aliases" for performance -use vars qw($VERSION @ISA %myData %myOpts @input_stack); -$VERSION = '1.37'; ## 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 preprocessing 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 diagnostics; -use Pod::InputObjects; -use Carp; -use Exporter; -BEGIN { - if ($] < 5.006) { - require Symbol; - import Symbol; - } -} -@ISA = qw(Exporter); - -############################################################################# - -=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,%params) = @_; - my $class = ref($this) || $this; - ## Any remaining arguments are treated as initial values for the - ## hash that is used to represent this object. - 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 ($sself, $iseq) = @_; - my $args = join('', $iseq->parse_tree->children); - return $sself->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 carp($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 the last paragraph ended in whitespace, and we're not between verbatim blocks, carp - if ($myData{_WHITESPACE} and $myOpts{'-warnings'} - and not ($text =~ /^\s+/ and ($myData{_PREVIOUS}||"") eq "verbatim")) { - my $errorsub = $self->errorsub(); - my $line = $line_num - 1; - my $errmsg = "*** WARNING: line containing nothing but whitespace". - " in paragraph at line $line in file $myData{_INFILE}\n"; - (ref $errorsub) and &{$errorsub}($errmsg) - or (defined $errorsub) and $self->$errorsub($errmsg) - or carp($errmsg); - } - - if (length $cmd) { - ## A command paragraph - $self->command($cmd, $text, $line_num, $pod_para); - $myData{_PREVIOUS} = $cmd; - } - elsif ($text =~ /^\s+/) { - ## Indented text - must be a verbatim paragraph - $self->verbatim($text, $line_num, $pod_para); - $myData{_PREVIOUS} = "verbatim"; - } - else { - ## Looks like an ordinary block of text - $self->textblock($text, $line_num, $pod_para); - $myData{_PREVIOUS} = "textblock"; - } - - # Update the whitespace for the next time around - $myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\Z/m ? 1 : 0; - - 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)); - - ## 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. Filehandle references, -or objects that support the regular IO operations (like C<E<lt>$fhE<gt>> -or C<$fh-<Egt>getline>) are also accepted; the handles must already be -opened. - -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, filehandle references or objects that support the regular -IO operations (like C<print>, e.g. L<IO::String>) are also accepted; -the object must already be opened. - -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<carp> -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 carp($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<carp> 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> - -=head1 LICENSE - -Pod-Parser is free software; you can redistribute it and/or modify it -under the terms of the Artistic License distributed with Perl version -5.000 or (at your option) any later version. Please refer to the -Artistic License that came with your Perl distribution for more -details. If your version of Perl was not distributed under the -terms of the Artistic License, than you may distribute PodParser -under the same terms as Perl itself. - -=cut - -1; -# vim: ts=4 sw=4 et diff --git a/gnu/usr.bin/perl/lib/Pod/Perldoc.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc.pm deleted file mode 100644 index 592d74e97da..00000000000 --- a/gnu/usr.bin/perl/lib/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-suppressible warnings from 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("mandoc") 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/gnu/usr.bin/perl/lib/Pod/Perldoc/BaseTo.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/BaseTo.pm deleted file mode 100644 index 6ca2a8c7e54..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/GetOptsOO.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/GetOptsOO.pm deleted file mode 100644 index b29aeb10906..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToChecker.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToChecker.pm deleted file mode 100644 index c60290d6502..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToMan.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToMan.pm deleted file mode 100644 index 43191222376..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToNroff.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToNroff.pm deleted file mode 100644 index d0568605068..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToPod.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToPod.pm deleted file mode 100644 index bccbfcadbd6..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToRtf.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToRtf.pm deleted file mode 100644 index 25e609e313a..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToText.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToText.pm deleted file mode 100644 index 2eb9e0644ac..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToTk.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToTk.pm deleted file mode 100644 index 39459629503..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/ToXml.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc/ToXml.pm deleted file mode 100644 index dd0d15cc10b..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Perldoc/t/01_about_verbose.t b/gnu/usr.bin/perl/lib/Pod/Perldoc/t/01_about_verbose.t deleted file mode 100644 index eb2f411fe9a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Perldoc/t/01_about_verbose.t +++ /dev/null @@ -1,87 +0,0 @@ - -require 5; -# Time-stamp: "2004-04-09 18:02:36 ADT" - -# Summary of, well, things. - -use Test; -BEGIN {plan tests => 2}; - -ok 1; - -use Pod::Perldoc; - -#chdir "t" if -e "t"; - -{ - my @out; - push @out, - "\n\nPerl v", - defined($^V) ? sprintf('%vd', $^V) : $], - " under $^O ", - (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) - ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), - (defined $MacPerl::Version) - ? ("(MacPerl version $MacPerl::Version)") : (), - "\n" - ; - - # Ugly code to walk the symbol tables: - my %v; - my @stack = (''); # start out in %:: - my $this; - my $count = 0; - my $pref; - while(@stack) { - $this = shift @stack; - die "Too many packages?" if ++$count > 1000; - next if exists $v{$this}; - next if $this eq 'main'; # %main:: is %:: - - #print "Peeking at $this => ${$this . '::VERSION'}\n"; - - if(defined ${$this . '::VERSION'} ) { - $v{$this} = ${$this . '::VERSION'} - } elsif( - defined *{$this . '::ISA'} or defined &{$this . '::import'} - or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) - # If it has an ISA, an import, or any subs... - ) { - # It's a class/module with no version. - $v{$this} = undef; - } else { - # It's probably an unpopulated package. - ## $v{$this} = '...'; - } - - $pref = length($this) ? "$this\::" : ''; - push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'}; - #print "Stack: @stack\n"; - } - push @out, " Modules in memory:\n"; - delete @v{'', '[none]'}; - foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { - $indent = ' ' x (2 + ($p =~ tr/:/:/)); - push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; - } - push @out, sprintf "[at %s (local) / %s (GMT)]\n", - scalar(gmtime), scalar(localtime); - my $x = join '', @out; - $x =~ s/^/#/mg; - print $x; -} - -print "# Running", - (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", - "#\n", -; - -print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; - -print "# \%INC:\n"; -foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { - print "# [$x] = [", $INC{$x} || '', "]\n"; -} - -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Perldoc/t/checkerbasic.t b/gnu/usr.bin/perl/lib/Pod/Perldoc/t/checkerbasic.t deleted file mode 100644 index c47dcedc64a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Perldoc/t/checkerbasic.t +++ /dev/null @@ -1,9 +0,0 @@ - -use Test; -BEGIN {plan tests => 2}; -ok 1; -require Pod::Perldoc::ToChecker; -$Pod::Perldoc::VERSION - and print "# Pod::Perldoc version $Pod::Perldoc::VERSION\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Perldoc/t/perldocbasic.t b/gnu/usr.bin/perl/lib/Pod/Perldoc/t/perldocbasic.t deleted file mode 100644 index 6f6b9984d7d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Perldoc/t/perldocbasic.t +++ /dev/null @@ -1,9 +0,0 @@ - -use Test; -BEGIN {plan tests => 3}; -ok 1; -require Pod::Perldoc; -ok($Pod::Perldoc::VERSION) - and print "# Pod::Perldoc version $Pod::Perldoc::VERSION\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Perldoc/t/textbasic.t b/gnu/usr.bin/perl/lib/Pod/Perldoc/t/textbasic.t deleted file mode 100644 index 6814267ec84..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Perldoc/t/textbasic.t +++ /dev/null @@ -1,9 +0,0 @@ - -use Test; -BEGIN {plan tests => 2}; -ok 1; -require Pod::Perldoc::ToText; -$Pod::Perldoc::VERSION - and print "# Pod::Perldoc version $Pod::Perldoc::VERSION\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/PlainText.pm b/gnu/usr.bin/perl/lib/Pod/PlainText.pm deleted file mode 100644 index 310d57d8bb3..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/PlainText.pm +++ /dev/null @@ -1,743 +0,0 @@ -# Pod::PlainText -- Convert POD data to formatted ASCII text. -# $Id: PlainText.pm,v 1.7 2009/10/13 01:25:48 millert 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; -use strict; - -require 5.005; - -use Carp qw(carp croak); -use Pod::Select (); - -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.04'; - -BEGIN { - if ($] < 5.006) { - require Symbol; - import Symbol; - } -} - -############################################################################ -# 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. - - return $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'); - if (defined $$self{ITEM}) { - $self->item ("\n"); - local $_ = "\n"; - $self->output($_) if($command eq 'back'); - } - $command = 'cmd_' . $command; - return $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; - return $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}; - if($$self{VERBATIM}) { - $self->output($_[0]); - return; - } - 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/s; - 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; - return $_; -} - - -############################################################################ -# 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+$//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+$//s; - $_ = $self->interpolate ($_, shift); - if ($$self{alt}) { - $self->output ("\n== $_ ==\n\n"); - } else { - $_ .= "\n" if $$self{loose}; - $self->output (' ' x ($$self{indent} / 2) . $_ . "\n"); - } -} - -# third level heading - not strictly perlpodspec compliant -sub cmd_head3 { - my $self = shift; - local $_ = shift; - s/\s+$//s; - $_ = $self->interpolate ($_, shift); - if ($$self{alt}) { - $self->output ("\n= $_ =\n"); - } else { - $_ .= "\n" if $$self{loose}; - $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+$//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; - } - return $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 carp '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/; - 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{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 { $_[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]) { - my $infh; - if ($] < 5.006) { - $infh = gensym(); - } - unless (open ($infh, $_[0])) { - croak ("Can't open $_[0] for reading: $!\n"); - } - $_[0] = $infh; - return $parser->parse_from_filehandle (@_); - } else { - return $parser->parse_from_file (@_); - } -} - -sub begin_pod { - my $self = shift; - $$self{EXCLUDE} = 0; - $$self{VERBATIM} = 0; -} - -############################################################################ -# 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<=headN> headings. -If set to false (the default), no blank line is printed after C<=headN>. -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/gnu/usr.bin/perl/lib/Pod/Plainer.pm b/gnu/usr.bin/perl/lib/Pod/Plainer.pm deleted file mode 100644 index 373e8d090af..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Select.pm b/gnu/usr.bin/perl/lib/Pod/Select.pm deleted file mode 100644 index 2d16d54fad9..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Select.pm +++ /dev/null @@ -1,746 +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 strict; - -use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections); -$VERSION = '1.36'; ## 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 diagnostics; -use Carp; -use Pod::Parser 1.04; - -@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_ - -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 - -sub select { - my ($self, @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) { - 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 - for my $spec (@sections) { - if ( defined($_ = _compile_section_spec($spec)) ) { - ## Store them in our sections array - push(@selected_sections, $_); - } - else { - carp qq{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; - return $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; - return $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 explicitly 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}); - - ## 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 - for my $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. - ##------------------------------------------------------ - my $match = 1; - for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { - my $regex = $section_spec->[$i]; - my $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 "m{$_}"; ## check regex syntax - if ($@) { - ++$bad_regexs; - carp qq{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/gnu/usr.bin/perl/lib/Pod/Simple.pm b/gnu/usr.bin/perl/lib/Pod/Simple.pm deleted file mode 100644 index 1e325724a5d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple.pm +++ /dev/null @@ -1,1536 +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.07'; - -@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:...> - # Ltext|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 - my $ell = $treelet->[$i]; - DEBUG > 1 and print "Ogling L node $ell\n"; - - # bitch if it's empty - if( @{$ell} == 2 - or (@{$ell} == 3 and $ell->[2] eq '') - ) { - $self->whine( $start_line, "An empty L<>" ); - $treelet->[$i] = 'L<>'; # just make it a text node - next; # and move on - } - - # Catch URLs: - - # there are a number of possible cases: - # 1) text node containing url: http://foo.com - # -> [ 'http://foo.com' ] - # 2) text node containing url and text: foo|http://foo.com - # -> [ 'foo|http://foo.com' ] - # 3) text node containing url start: mailto:xE<at>foo.com - # -> [ 'mailto:x', [ E ... ], 'foo.com' ] - # 4) text node containing url start and text: foo|mailto:xE<at>foo.com - # -> [ 'foo|mailto:x', [ E ... ], 'foo.com' ] - # 5) other nodes containing text and url start: OE<39>Malley|http://foo.com - # -> [ 'O', [ E ... ], 'Malley', '|http://foo.com' ] - # ... etc. - - # anything before the url is part of the text. - # anything after it is part of the url. - # the url text node itself may contain parts of both. - - if (my ($url_index, $text_part, $url_part) = - # grep is no good here; we want to bail out immediately so that we can - # use $1, $2, etc. without having to do the match twice. - sub { - for (2..$#$ell) { - next if ref $ell->[$_]; - next unless $ell->[$_] =~ m/^(?:([^|]*)\|)?(\w+:[^:\s]\S*)$/s; - return ($_, $1, $2); - } - return; - }->() - ) { - $ell->[1]{'type'} = 'url'; - - my @text = @{$ell}[2..$url_index-1]; - push @text, $text_part if defined $text_part; - - my @url = @{$ell}[$url_index+1..$#$ell]; - unshift @url, $url_part; - - unless (@text) { - $ell->[1]{'content-implicit'} = 'yes'; - @text = @url; - } - - $ell->[1]{to} = Pod::Simple::LinkSection->new( - @url == 1 - ? $url[0] - : [ '', {}, @url ], - ); - - splice @$ell, 2, $#$ell, @text; - - next; - } - - # Catch some very simple and/or common cases - if(@{$ell} == 3 and ! ref $ell->[2]) { - my $it = $ell->[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"; - $ell->[1]{'type'} = 'man'; - # This's the only place where man links can get made. - $ell->[1]{'content-implicit'} = 'yes'; - $ell->[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"; - $ell->[1]{'type'} = 'pod'; - $ell->[1]{'content-implicit'} = 'yes'; - $ell->[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_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 = ref $class && $class->isa(__PACKAGE__) ? $class : $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/gnu/usr.bin/perl/lib/Pod/Simple.pod b/gnu/usr.bin/perl/lib/Pod/Simple.pod deleted file mode 100644 index a58217336a1..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple.pod +++ /dev/null @@ -1,226 +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: - -=over - -=item * Allison Randal C<allison@perl.org> - -=item * Hans Dieter Pearcey C<hdp@cpan.org> - -=back - -=cut - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/BlackBox.pm b/gnu/usr.bin/perl/lib/Pod/Simple/BlackBox.pm deleted file mode 100644 index 4804973a2e6..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/BlackBox.pm +++ /dev/null @@ -1,1919 +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; - } - - my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/; - $para->[1]{'title'} = $title if ($title); - $para->[1]{'target'} = $target; # without any ':' - $content = $target; # strip off the title - - $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](?!<) - ) - | - # whitespace is ok, but we don't want to eat the whitespace before - # a multiple-bracket end code. - # NOTE: we may still have problems with e.g. S<< >> - (?: - \s(?!\s*>{2,}) - ) - )+ - ) - ) - /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/gnu/usr.bin/perl/lib/Pod/Simple/ChangeLog b/gnu/usr.bin/perl/lib/Pod/Simple/ChangeLog deleted file mode 100644 index 8c1e1d7b92c..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/ChangeLog +++ /dev/null @@ -1,292 +0,0 @@ -# ChangeLog for Pod::Simple dist -#--------------------------------------------------------------------------- - -2008-06-04 Allison Randal <allison@perl.org> - * Release 3.07 - - Fix module dependencies, make HTML::Entities optional and require - Test::More. - -2008-06-03 Allison Randal <allison@perl.org> - * Release 3.06 - - Fix bugs related to passing $1 to File::Spec, reported by Andrew Hamlin and - John McNamara. - - Applied a suggested fix from Kevin Ryde to return a successful exit - code when Pod::Simple::HTML is run from the command line. - - Fix handling of complex L<URL> entries, thanks to tests supplied in RT#4896. - - Fix incorrect handling of S<> entries made up of entirely whitespace, thanks - to test case from Andreas Koenig. - - Launch Pod::Simple::XHTML, an XHTML compliant, more easily extensible - HTML formatter. - - Add feature to parse additional text after =begin target as a block - title, requested by Adam Kennedy. - - Thanks to Hans Dieter Pearcey for applying patches, resolving bugs, - and generally getting ready for the release. - -2007-03-03 Allison Randal <allison@perl.org> - * Release 3.05 - - Standardized all test files on 8.3 naming scheme for Perl core. - - Applied test patches from Jerry Hedden for Perl core when - Encode not installed. - - Applied test patch from Ken Williams for 5.005_04 compatibility. - - Applied a patch from Christopher Madsen to fix architecture - directory searches on Gentoo. - - Fixed a failing search test on Debian-based distributions caused - by Debian stripping Pod documentation out of core modules. - (Three cheers to the CPAN testers and James Ponza for sending - enough reports that I could work out the pattern.) - -2006-01-18 Allison Randal <allison@perl.org> - * Release 3.04 - - Applied test patches for Perl core integration from Steve Peters. - - Added a 'reinit' method to Pod::Simple::BlackBox for Russ Allbery - so Pod::Man can provide backward compatibility to existing users - (such as Module::Build and ExtUtils::MakeMaker). - - Applied patch for extracting case-preserved package names on VMS - from Craig Berry. - -2005-11-21 Allison Randal <allison@perl.org> - * Release 3.03 - - Applied whitespace patches for Pod::Man and Pod::Text from - Russ Allbery. - - Applied validation patches to Pod::Simple::HTML from Graham Barr. - -2004-05-24 Sean M. Burke <sburke@cpan.org> - * Release 3.02 - - Just fixing some typos in the CSS generated by Pod::Simple:HTMLBatch. - - -2004-05-24 Sean M. Burke <sburke@cpan.org> - * Release 3.01 - - No big changes to the main modules, but there's many changes to - the important Pod::Simple::HTML module. - - Also, new modules: - Pod::Simple::HTMLBatch - Pod::Simple::HTMLLegacy - Pod::Simple::Progress - Pod::Simple::Search - and tests for these (well, most). - - Some prettying up of the Makefile.PL. - - The test 00about.t is a bit more careful and verbose now. - - The docs are still incomplete, esp. for Pod::Simple::HTML and - Pod::Simple::HTMLBatch, which I hope to improve quite soon. - - - -2004-05-07 Sean M. Burke <sburke@cpan.org> - * Release 2.06 - - Allison Randal brilliantly refactors a huge monolithic sub in - Blackbox.pm. Code is now actually sanely readable! - - I add the new option-attributes fullstop_space_harden and - codes_in_verbatim, and the two methods abandon_output_string and - abandon_output_fh. Not yet documented. - - New test fullstop_spaces.t and new corpus document - greek_iso_8859_7.pod. - - Another version should be forthcoming in a few days that has the - new Pod::Simple::HTML stuff in it. - - Note to self: document =extend and =encoding in perlpodspec ASAP! - - -2003-11-04 Sean M. Burke <sburke@cpan.org> - * Release 2.05 -- bugfix version - - In an attempt to stop Perl 5.6 versions from going completely - crazy, I've tried to basically turn off all Unicode/utf8 support - under 5.6. Under 5.8 and above, Unicode should work fine, and - under 5.6, all Unicode characters should be replaced with a little - "can't render" symbol, either a "" or a "?". - Many many thanks to Jarkko Hietaniemi for helping out. - - (Works under 5.005 now too?) - -2003-10-10 Sean M. Burke <sburke@cpan.org> - * Release 2.04 -- minor bugfix version - - * Added some code to insulate Pod::Simple to runtime changes in - the value of $/. Thanks to Iain Truskett for catching this. - * Added FILENO method to TiedOutFH.pm, to work quietly under some - perls. Thanks to Jochen Stenzel for catching this. - * Fixed some tests that erroneously failed under some 5.6's - because of chdir()s in *.t files messing up @INC Thanks to many - who caught this, including Rocco Caputo. - -2003-09-07 Sean M. Burke <sburke@cpan.org> - * Release 2.03 -- minor upgrade - * A =head[1234] command now closes any currently open =over, and - warns. - * Fixing a few obscure bugs, including one to do with the - Makefile. - * Added some tests for those bugs. - -2003-09-02 Sean M. Burke <sburke@cpan.org> - * Release 2.02 -- fixing a testing bug - * Autrijus Tang found a silly bug of mine in corpustest.t's - testing of corpus/t/nonesuch.txt. Fixed, - * I add encoding_nonesuch.t to test corpus/t/nonesuch.txt better. - - -2003-09-01 Sean M. Burke <sburke@cpan.org> - * Release 2.01 - * Moved all version numbers up to 2.01 for reasons of Tibetan - numerology. - - * Implemented =encoding. Thanks a million to Jarkko, Autrijus, - Dan Kogai, and many others for their help, patience, and - encouragement. - - It's not yet documented, but see ./t/corpus/*.txt for examples at - least. - - * Added 'use utf8' to all the modules. Byebye perl-5.005 - compatibility, hello decent perl-5.6 compatibility. - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -2003-09-01 Sean M. Burke <sburke@cpan.org> - * Release 0.98 - * At Michael Schwern's suggestion, a list that begins with a - "=item [number]" line where number isn't a 1, is no longer - treated as an error, but instead is silently coerced into being a - text-item list, just as if it were "=item wubble" or whatever. - -2003-08-12 Sean M. Burke <sburke@cpan.org> - * Release 0.97 - * Loooking goooooood. Not smelling so much like beta anymore! - * I think this might be the last version before I go - putting "use utf8" all over the place. - - * Added placefolders for "=encoding" support. If you use - "=encoding", you'll get an error about "not yet implemented" - instead of "unknown directive". - - * Rewrote Pod::Simple::Pullparser's get_title, and added - get_version, get_author, and get_description. Documented them. - Thanks to Graham Barr for contributing an initial get_title and - then being patient while I seemed to do nothing with it for months - on end! - - * More tests. - - Otherwise just minor changes since last version: - * Fixed error in Pod::Simple::RTF. - * Added new but undocumented methods to Pod::Simple: - unaccept_directive(s) unaccept_target(s) unaccept_code(s) - * Corrected '=back without =open' error to '=back without =over' - * A little tweaking to the _verbatim_format code. - * Dump routines may use \x{NN} instead of \xNN format. - * Pod::Simple::HTML now uses VerbatimFormatted - * A few changes ot DEBUG messages -- nothing you'd normally see. - -2002-11-19 Sean M. Burke <sburke@cpan.org> - * Release 0.96 - * Still kinda sorta beta. - - * Much much more docs in this version. Only a few feature - changes: - - * Added any_errata_seen to Pod::Simple. Should've been in there - ages ago. Oops! - * Fixed some errors in the experimental VerbatimFormatted code. - * Added is_tagname / is_tag to Pod::Simple::PullParserStartToken - and Pod::Simple::PullParserEndToken - * Added RTFDEFLANG stuff to Pod::Simple::RTF. - -2002-11-10 Sean M. Burke <sburke@cpan.org> - * Release 0.95 - * Beta release. Much documentation still to write, many features - still to add. The APIs might change in future versions. - - * Now including perlpod and perlpodspec in the dist. - - * Pod::Simple -- added parse_from_file - * Pod::Simple::RTF -- minor style changes, and minor change to the - RTF-wrapping logic. - * Pod::Simple::BlackBox -- a =cut opening a block is no longer a - fatal(ish) error. - * Pod::Simple::BlackBox -- added experimental new - VerbatimFormatted stuff. - - -2002-10-16 Sean M. Burke <sburke@cpan.org> - * Release 0.94 - * Beta release. Much documentation still to write, many features - still to add. The APIs might change in future versions. - - * Pod::Simple::RTF -- minor style tweaks - * Pod::Simple::PullParserEndToken and ::PullParserStartToken -- - added ->tag as an alias for ->tagname. - * Pod::Simple and Pod::Simple::BlackBox -- added tolerance for - "=item * Foo" as a variant syntax for "=item *\n\nFoo". Tests - added/changed accordingly. - * Pod::Simple::HTML -- added <a name="..."> stuff, and a hack at - doing something with X<...>'s. - - -2002-09-29 Sean M. Burke <sburke@cpan.org> - * Release 0.93 - * Beta release. Much documentation still to write, many features - still to add. The APIs might change in future versions. - - * Pod::Simple -- added errors_seen attribute - * Pod::Simple::HTML -- added support for =for HTML ... directives, - and =extend directives. - * Oh, and I added Pod::Simple::RTF in 0.92 but forgot to note it - until now. - -2002-09-29 Sean M. Burke <sburke@cpan.org> - * Release 0.92 - * Beta release. Much documentation still to write, many features - still to add. The APIs might change in future versions. - - * Fixing bungled distribution. - -2002-09-29 Sean M. Burke <sburke@cpan.org> - * Release 0.91 - * Beta release. Much documentation still to write, many features - still to add. The APIs might change in future versions. - - * Pod::Simple::PullParserTextToken -- added 'text_r' - - * Pod::Simple::PullParser -- added 'get_title' and - 'get_title_short' to - - * Pod::Simple -- corrected wording of "Format for second =extend - parameter" error message. - - * Pod::PullParser -- made its filter() run as intended, like - Pod::Simple's filter. - - * Pod::Subclassing -- more docs - -2002-09-11 Sean M. Burke <sburke@cpan.org> - * Release 0.90 - * Beta release. Much documentation still to write, many features - still to add. The APIs might change in future versions. diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/Checker.pm b/gnu/usr.bin/perl/lib/Pod/Simple/Checker.pm deleted file mode 100644 index 0d01f50ec2f..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/Debug.pm b/gnu/usr.bin/perl/lib/Pod/Simple/Debug.pm deleted file mode 100644 index b00e58daba8..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/DumpAsText.pm b/gnu/usr.bin/perl/lib/Pod/Simple/DumpAsText.pm deleted file mode 100644 index e678e42fa18..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/DumpAsXML.pm b/gnu/usr.bin/perl/lib/Pod/Simple/DumpAsXML.pm deleted file mode 100644 index fe0c1662e5d..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/HTML.pm b/gnu/usr.bin/perl/lib/Pod/Simple/HTML.pm deleted file mode 100644 index a4dbbc17d05..00000000000 --- a/gnu/usr.bin/perl/lib/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 { Pod::Simple::HTML->parse_from_file(@ARGV); exit 0 } - # 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/gnu/usr.bin/perl/lib/Pod/Simple/HTMLBatch.pm b/gnu/usr.bin/perl/lib/Pod/Simple/HTMLBatch.pm deleted file mode 100644 index cb26cabf378..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/HTMLLegacy.pm b/gnu/usr.bin/perl/lib/Pod/Simple/HTMLLegacy.pm deleted file mode 100644 index f78de90144f..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/LinkSection.pm b/gnu/usr.bin/perl/lib/Pod/Simple/LinkSection.pm deleted file mode 100644 index 14c3ba85d27..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/Methody.pm b/gnu/usr.bin/perl/lib/Pod/Simple/Methody.pm deleted file mode 100644 index 2ad607e61b4..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/Progress.pm b/gnu/usr.bin/perl/lib/Pod/Simple/Progress.pm deleted file mode 100644 index bc42a952dc3..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/PullParser.pm b/gnu/usr.bin/perl/lib/Pod/Simple/PullParser.pm deleted file mode 100644 index 15d973134cf..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/PullParserEndToken.pm b/gnu/usr.bin/perl/lib/Pod/Simple/PullParserEndToken.pm deleted file mode 100644 index 7b219f8660d..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/PullParserStartToken.pm b/gnu/usr.bin/perl/lib/Pod/Simple/PullParserStartToken.pm deleted file mode 100644 index 9ead50d96ef..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/PullParserTextToken.pm b/gnu/usr.bin/perl/lib/Pod/Simple/PullParserTextToken.pm deleted file mode 100644 index 2d1a1d7dc45..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/PullParserToken.pm b/gnu/usr.bin/perl/lib/Pod/Simple/PullParserToken.pm deleted file mode 100644 index 9ec3659f4ed..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/README b/gnu/usr.bin/perl/lib/Pod/Simple/README deleted file mode 100644 index 3be9a63a6ca..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/README +++ /dev/null @@ -1,7 +0,0 @@ - Time-stamp: "2003-09-01 23:10:23 ADT" - -This is a late-beta release of Pod::Simple, the module-suite for -parsing Pod. - -There are still some gaps in the documentation, and Pod::Simple::HTML -isn't yet all that it should be. diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/RTF.pm b/gnu/usr.bin/perl/lib/Pod/Simple/RTF.pm deleted file mode 100644 index de2a7b32d64..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/Search.pm b/gnu/usr.bin/perl/lib/Pod/Simple/Search.pm deleted file mode 100644 index 980b3b7739c..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/SimpleTree.pm b/gnu/usr.bin/perl/lib/Pod/Simple/SimpleTree.pm deleted file mode 100644 index 64dd155104a..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/Subclassing.pod b/gnu/usr.bin/perl/lib/Pod/Simple/Subclassing.pod deleted file mode 100644 index d4ee6943444..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/Text.pm b/gnu/usr.bin/perl/lib/Pod/Simple/Text.pm deleted file mode 100644 index df82c0784c8..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/TextContent.pm b/gnu/usr.bin/perl/lib/Pod/Simple/TextContent.pm deleted file mode 100644 index 3675b005ef1..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/TiedOutFH.pm b/gnu/usr.bin/perl/lib/Pod/Simple/TiedOutFH.pm deleted file mode 100644 index b031fe5869b..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/Transcode.pm b/gnu/usr.bin/perl/lib/Pod/Simple/Transcode.pm deleted file mode 100644 index 434f963388b..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/TranscodeDumb.pm b/gnu/usr.bin/perl/lib/Pod/Simple/TranscodeDumb.pm deleted file mode 100644 index d5eb7e5fb8c..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/TranscodeSmart.pm b/gnu/usr.bin/perl/lib/Pod/Simple/TranscodeSmart.pm deleted file mode 100644 index 3fc26a4a260..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/XHTML.pm b/gnu/usr.bin/perl/lib/Pod/Simple/XHTML.pm deleted file mode 100644 index d130faaa964..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/XHTML.pm +++ /dev/null @@ -1,400 +0,0 @@ -=pod - -=head1 NAME - -Pod::Simple::XHTML -- format Pod as validating XHTML - -=head1 SYNOPSIS - - use Pod::Simple::XHTML; - - my $parser = Pod::Simple::XHTML->new(); - - ... - - $parser->parse_file('path/to/file.pod'); - -=head1 DESCRIPTION - -This class is a formatter that takes Pod and renders it as XHTML -validating HTML. - -This is a subclass of L<Pod::Simple::Methody> and inherits all its -methods. The implementation is entirely different than -L<Pod::Simple::HTML>, but it largely preserves the same interface. - -=cut - -package Pod::Simple::XHTML; -use strict; -use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES ); -$VERSION = '3.04'; -use Carp (); -use Pod::Simple::Methody (); -@ISA = ('Pod::Simple::Methody'); - -BEGIN { - $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1"; -} - -my %entities = ( - q{>} => 'gt', - q{<} => 'lt', - q{'} => '#39', - q{"} => 'quot', - q{&} => 'amp', -); - -sub encode_entities { - return HTML::Entities::encode_entities( $_[0] ) if $HAS_HTML_ENTITIES; - my $str = $_[0]; - my $ents = join '', keys %entities; - $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge; - return $str; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -=head1 METHODS - -Pod::Simple::XHTML offers a number of methods that modify the format of -the HTML output. Call these after creating the parser object, but before -the call to C<parse_file>: - - my $parser = Pod::PseudoPod::HTML->new(); - $parser->set_optional_param("value"); - $parser->parse_file($file); - -=head2 perldoc_url_prefix - -In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what -to put before the "Foo%3a%3aBar". The default value is -"http://search.cpan.org/perldoc?". - -=head2 perldoc_url_postfix - -What to put after "Foo%3a%3aBar" in the URL. This option is not set by -default. - -=head2 title_prefix, title_postfix - -What to put before and after the title in the head. The values should -already be &-escaped. - -=head2 html_css - - $parser->html_css('path/to/style.css'); - -The URL or relative path of a CSS file to include. This option is not -set by default. - -=head2 html_javascript - -The URL or relative path of a JavaScript file to pull in. This option is -not set by default. - -=head2 html_doctype - -A document type tag for the file. This option is not set by default. - -=head2 html_header_tags - -Additional arbitrary HTML tags for the header of the document. The -default value is just a content type header tag: - - <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"> - -Add additional meta tags here, or blocks of inline CSS or JavaScript -(wrapped in the appropriate tags). - -=head2 default_title - -Set a default title for the page if no title can be determined from the -content. The value of this string should already be &-escaped. - -=head2 force_title - -Force a title for the page (don't try to determine it from the content). -The value of this string should already be &-escaped. - -=head2 html_header, html_footer - -Set the HTML output at the beginning and end of each file. The default -header includes a title, a doctype tag (if C<html_doctype> is set), a -content tag (customized by C<html_header_tags>), a tag for a CSS file -(if C<html_css> is set), and a tag for a Javascript file (if -C<html_javascript> is set). The default footer simply closes the C<html> -and C<body> tags. - -The options listed above customize parts of the default header, but -setting C<html_header> or C<html_footer> completely overrides the -built-in header or footer. These may be useful if you want to use -template tags instead of literal HTML headers and footers or are -integrating converted POD pages in a larger website. - -If you want no headers or footers output in the HTML, set these options -to the empty string. - -=head2 index - -TODO -- Not implemented. - -Whether to add a table-of-contents at the top of each page (called an -index for the sake of tradition). - - -=cut - -__PACKAGE__->_accessorize( - 'perldoc_url_prefix', - 'perldoc_url_postfix', - 'title_prefix', 'title_postfix', - 'html_css', - 'html_javascript', - 'html_doctype', - 'html_header_tags', - 'title', # Used internally for the title extracted from the content - 'default_title', - 'force_title', - 'html_header', - 'html_footer', - 'index', - '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 -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -=head1 SUBCLASSING - -If the standard options aren't enough, you may want to subclass -Pod::Simple::XHMTL. These are the most likely candidates for methods -you'll want to override when subclassing. - -=cut - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - $new->{'output_fh'} ||= *STDOUT{IO}; - $new->accept_targets( 'html', 'HTML' ); - $new->perldoc_url_prefix('http://search.cpan.org/perldoc?'); - $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">'); - $new->nix_X_codes(1); - $new->codes_in_verbatim(1); - $new->{'scratch'} = ''; - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -=head2 handle_text - -This method handles the body of text within any element: it's the body -of a paragraph, or everything between a "=begin" tag and the -corresponding "=end" tag, or the text within an L entity, etc. You would -want to override this if you are adding a custom element type that does -more than just display formatted text. Perhaps adding a way to generate -HTML tables from an extended version of POD. - -So, let's say you want add a custom element called 'foo'. In your -subclass's C<new> method, after calling C<SUPER::new> you'd call: - - $new->accept_targets_as_text( 'foo' ); - -Then override the C<start_for> method in the subclass to check for when -"$flags->{'target'}" is equal to 'foo' and set a flag that marks that -you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the -C<handle_text> method to check for the flag, and pass $text to your -custom subroutine to construct the HTML output for 'foo' elements, -something like: - - sub handle_text { - my ($self, $text) = @_; - if ($self->{'in_foo'}) { - $self->{'scratch'} .= build_foo_html($text); - } else { - $self->{'scratch'} .= $text; - } - } - -=cut - -sub handle_text { - # escape special characters in HTML (<, >, &, etc) - $_[0]{'scratch'} .= $_[0]{'in_verbatim'} ? encode_entities( $_[1] ) : $_[1] -} - -sub start_Para { $_[0]{'scratch'} = '<p>' } -sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>'; $_[0]{'in_verbatim'} = 1} - -sub start_head1 { $_[0]{'scratch'} = '<h1>' } -sub start_head2 { $_[0]{'scratch'} = '<h2>' } -sub start_head3 { $_[0]{'scratch'} = '<h3>' } -sub start_head4 { $_[0]{'scratch'} = '<h4>' } - -sub start_item_bullet { $_[0]{'scratch'} = '<li>' } -sub start_item_number { $_[0]{'scratch'} = "<li>$_[1]{'number'}. " } -sub start_item_text { $_[0]{'scratch'} = '<li>' } - -sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } -sub start_over_text { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } -sub start_over_block { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } -sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit } - -sub end_over_bullet { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit } -sub end_over_text { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit } -sub end_over_block { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit } -sub end_over_number { $_[0]{'scratch'} .= '</ol>'; $_[0]->emit } - -# . . . . . Now the actual formatters: - -sub end_Para { $_[0]{'scratch'} .= '</p>'; $_[0]->emit } -sub end_Verbatim { - $_[0]{'scratch'} .= '</code></pre>'; - $_[0]{'in_verbatim'} = 0; - $_[0]->emit; -} - -sub end_head1 { $_[0]{'scratch'} .= '</h1>'; $_[0]->emit } -sub end_head2 { $_[0]{'scratch'} .= '</h2>'; $_[0]->emit } -sub end_head3 { $_[0]{'scratch'} .= '</h3>'; $_[0]->emit } -sub end_head4 { $_[0]{'scratch'} .= '</h4>'; $_[0]->emit } - -sub end_item_bullet { $_[0]{'scratch'} .= '</li>'; $_[0]->emit } -sub end_item_number { $_[0]{'scratch'} .= '</li>'; $_[0]->emit } -sub end_item_text { $_[0]->emit } - -# This handles =begin and =for blocks of all kinds. -sub start_for { - my ($self, $flags) = @_; - $self->{'scratch'} .= '<div'; - $self->{'scratch'} .= ' class="'.$flags->{'target'}.'"' if ($flags->{'target'}); - $self->{'scratch'} .= '>'; - $self->emit; - -} -sub end_for { - my ($self) = @_; - $self->{'scratch'} .= '</div>'; - $self->emit; -} - -sub start_Document { - my ($self) = @_; - if (defined $self->html_header) { - $self->{'scratch'} .= $self->html_header; - $self->emit unless $self->html_header eq ""; - } else { - my ($doctype, $title, $metatags); - $doctype = $self->html_doctype || ''; - $title = $self->force_title || $self->title || $self->default_title || ''; - $metatags = $self->html_header_tags || ''; - if ($self->html_css) { - $metatags .= "\n<link rel='stylesheet' href='" . - $self->html_css . "' type='text/css'>"; - } - if ($self->html_javascript) { - $metatags .= "\n<script type='text/javascript' src='" . - $self->html_javascript . "'></script>"; - } - $self->{'scratch'} .= <<"HTML"; -$doctype -<html> -<head> -<title>$title</title> -$metatags -</head> -<body> -HTML - $self->emit; - } -} - -sub end_Document { - my ($self) = @_; - if (defined $self->html_footer) { - $self->{'scratch'} .= $self->html_footer; - $self->emit unless $self->html_footer eq ""; - } else { - $self->{'scratch'} .= "</body>\n</html>"; - $self->emit; - } -} - -# Handling code tags -sub start_B { $_[0]{'scratch'} .= '<b>' } -sub end_B { $_[0]{'scratch'} .= '</b>' } - -sub start_C { $_[0]{'scratch'} .= '<code>' } -sub end_C { $_[0]{'scratch'} .= '</code>' } - -sub start_E { $_[0]{'scratch'} .= '&' } -sub end_E { $_[0]{'scratch'} .= ';' } - -sub start_F { $_[0]{'scratch'} .= '<i>' } -sub end_F { $_[0]{'scratch'} .= '</i>' } - -sub start_I { $_[0]{'scratch'} .= '<i>' } -sub end_I { $_[0]{'scratch'} .= '</i>' } - -sub start_L { - my ($self, $flags) = @_; - my $url; - if ($flags->{'type'} eq 'url') { - $url = $flags->{'to'}; - } elsif ($flags->{'type'} eq 'pod') { - $url .= $self->perldoc_url_prefix || ''; - $url .= $flags->{'to'} || ''; - $url .= '/' . $flags->{'section'} if ($flags->{'section'}); - $url .= $self->perldoc_url_postfix || ''; -# require Data::Dumper; -# print STDERR Data::Dumper->Dump([$flags]); - } - - $self->{'scratch'} .= '<a href="'. $url . '">'; -} -sub end_L { $_[0]{'scratch'} .= '</a>' } - -sub start_S { $_[0]{'scratch'} .= '<nobr>' } -sub end_S { $_[0]{'scratch'} .= '</nobr>' } - -sub emit { - my($self) = @_; - my $out = $self->{'scratch'} . "\n"; - print {$self->{'output_fh'}} $out, "\n"; - $self->{'scratch'} = ''; - return; -} - -# Bypass built-in E<> handling to preserve entity encoding -sub _treat_Es {} - -1; - -__END__ - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::Methody> - -=head1 COPYRIGHT - -Copyright (c) 2003-2005 Allison Randal. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. The full text of the license -can be found in the LICENSE file included with this module. - -This library 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 - -Allison Randal <allison@perl.org> - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/XMLOutStream.pm b/gnu/usr.bin/perl/lib/Pod/Simple/XMLOutStream.pm deleted file mode 100644 index 1e7ec15d9a7..00000000000 --- a/gnu/usr.bin/perl/lib/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/gnu/usr.bin/perl/lib/Pod/Simple/t/00about.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/00about.t deleted file mode 100644 index e5e7038e385..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/00about.t +++ /dev/null @@ -1,123 +0,0 @@ - -require 5; -# Time-stamp: "2004-05-23 19:48:32 ADT" - -# Summary of, well, things. - -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -my @modules; -BEGIN { - @modules = qw( - -Pod::Escapes - -Pod::Simple -Pod::Simple::BlackBox Pod::Simple::Checker Pod::Simple::DumpAsText -Pod::Simple::DumpAsXML Pod::Simple::HTML Pod::Simple::HTMLBatch -Pod::Simple::HTMLLegacy Pod::Simple::LinkSection Pod::Simple::Methody -Pod::Simple::Progress Pod::Simple::PullParser -Pod::Simple::PullParserEndToken Pod::Simple::PullParserStartToken -Pod::Simple::PullParserTextToken Pod::Simple::PullParserToken -Pod::Simple::RTF Pod::Simple::Search Pod::Simple::SimpleTree -Pod::Simple::Text Pod::Simple::TextContent Pod::Simple::TiedOutFH -Pod::Simple::Transcode Pod::Simple::XMLOutStream - - ); - plan tests => 2 + @modules; -}; - -ok 1; - -#chdir "t" if -e "t"; -foreach my $m (@modules) { - print "# Loading $m ...\n"; - eval "require $m;"; - unless($@) { ok 1; next } - my $e = $@; - $e =~ s/\s+$//s; - $e =~ s/[\n\r]+/\n# > /; - print "# Error while trying to load $m --\n# > $e\n"; - ok 0; -} - -{ - my @out; - push @out, - "\n\nPerl v", - defined($^V) ? sprintf('%vd', $^V) : $], - " under $^O ", - (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) - ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), - (defined $MacPerl::Version) - ? ("(MacPerl version $MacPerl::Version)") : (), - "\n" - ; - - # Ugly code to walk the symbol tables: - my %v; - my @stack = (''); # start out in %:: - my $this; - my $count = 0; - my $pref; - while(@stack) { - $this = shift @stack; - die "Too many packages?" if ++$count > 1000; - next if exists $v{$this}; - next if $this eq 'main'; # %main:: is %:: - - #print "Peeking at $this => ${$this . '::VERSION'}\n"; - no strict 'refs'; - if( defined ${$this . '::VERSION'} ) { - $v{$this} = ${$this . '::VERSION'} - } elsif( - defined *{$this . '::ISA'} or defined &{$this . '::import'} - or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) - # If it has an ISA, an import, or any subs... - ) { - # It's a class/module with no version. - $v{$this} = undef; - } else { - # It's probably an unpopulated package. - ## $v{$this} = '...'; - } - - $pref = length($this) ? "$this\::" : ''; - push @stack, map m/^(.+)::$/ ? "$pref$1" : (), - do { no strict 'refs'; keys %{$this . '::'} }; - #print "Stack: @stack\n"; - } - push @out, " Modules in memory:\n"; - delete @v{'', '[none]'}; - foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { - my $indent = ' ' x (2 + ($p =~ tr/:/:/)); - push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; - } - push @out, sprintf "[at %s (local) / %s (GMT)]\n", - scalar(gmtime), scalar(localtime); - my $x = join '', @out; - $x =~ s/^/#/mg; - print $x; -} - -print "# Running", - (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", - "#\n", -; - -print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; - -print "# \%INC:\n"; -foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { - print "# [$x] = [", $INC{$x} || '', "]\n"; -} - -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/20_skip.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/20_skip.t deleted file mode 100644 index c06220e8c29..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/20_skip.t +++ /dev/null @@ -1,19 +0,0 @@ -# 20 skip under 5.8 -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -print "1..2\n"; - print "# Running under Perl v $]\n"; -if($] < 5.008) { - print "ok 1 # Skip under Perl before 5.8 ($])\n"; -} else { - print "ok 1\n"; - print "# ^ not skipping\n"; -} - -print "ok 2\n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/ac_d.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/ac_d.t deleted file mode 100644 index 398456d236a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/ac_d.t +++ /dev/null @@ -1,93 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 14 }; - -#use Pod::Simple::Debug (6); - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - -#sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - -my $x = 'Pod::Simple::XMLOutStream'; - -ok 1; - -print "# Testing exceptions being thrown...\n"; - -eval { $x->new->accept_directive('head1') }; -if($@) { ok 1 } # print " # Good: exception thrown: $@\n" } -else { ok 0,1, 'No exception thrown!' } - -eval { $x->new->accept_directive('I like pie') }; -if($@) { ok 1 } # print " # Good: exception thrown: $@\n" } -else { ok 0,1, 'No exception thrown!' } - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# print "Testing basic directive behavior...\n"; - -sub Pd { shift->accept_directive_as_data( 'freepies') } -sub Pv { shift->accept_directive_as_verbatim( 'freepies') } -sub Pp { shift->accept_directive_as_processed('freepies') } - -ok( $x->_out( "\n=freepies Mmmmpie\n\n") => '/POD ERROR/' ); - -ok( $x->_out(\&Pp, "\n=freepies Mmmmpie\n\n"), - '<Document><freepies>Mmmmpie</freepies></Document>' -); -ok( $x->_out(\&Pv, "\n=freepies Mmmmpie\n\n"), - '<Document><freepies xml:space="preserve">Mmmmpie</freepies></Document>' -); -ok( $x->_out(\&Pd, "\n=freepies Mmmmpie\n\n"), - '<Document><freepies xml:space="preserve">Mmmmpie</freepies></Document>' -); - -# print "Testing more complex directive behavior...\n"; - -ok( $x->_out(\&Pp, "\n=freepies Mmmmpie \n\tI<is good>! \n\n"), - '<Document><freepies>Mmmmpie <I>is good</I>!</freepies></Document>' -); -ok( $x->_out(\&Pd, "\n=freepies Mmmmpie \n\tI<is good>! \n\n"), - qq{<Document><freepies xml:space="preserve">Mmmmpie \n\tI<is good>! </freepies></Document>} -); -ok( $x->_out(\&Pv, "\n=freepies Mmmmpie \n\tI<is good>! \n\n"), - qq{<Document><freepies xml:space="preserve">Mmmmpie \n I<is good>! </freepies></Document>} -); - -# print "Testing within larger documents...\n"; - - -ok( $x->_out(\&Pp, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI<is good>! \n\nGoody!"), - '<Document><head1>NAME</head1><Para>Pie Consortium -- me gustan pasteles</Para><freepies>Mmmmpie <I>is good</I>!</freepies><Para>Goody!</Para></Document>' -); -ok( $x->_out(\&Pd, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI<is good>! \n\nGoody!"), - qq{<Document><head1>NAME</head1><Para>Pie Consortium -- me gustan pasteles</Para><freepies xml:space="preserve">Mmmmpie \n\tI<is good>! </freepies><Para>Goody!</Para></Document>} -); -ok( $x->_out(\&Pv, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI<is good>! \n\nGoody!"), - qq{<Document><head1>NAME</head1><Para>Pie Consortium -- me gustan pasteles</Para><freepies xml:space="preserve">Mmmmpie \n I<is good>! </freepies><Para>Goody!</Para></Document>} -); - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/accept01.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/accept01.t deleted file mode 100644 index 5c739e29d52..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/accept01.t +++ /dev/null @@ -1,95 +0,0 @@ -# Testing accept_codes -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 13 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; -sub accept_N { $_[0]->accept_codes('N') } - -print "# Some sanity tests...\n"; -ok( $x->_out( "=pod\n\nI like pie.\n"), # without acceptor - '<Document><Para>I like pie.</Para></Document>' -); -ok( $x->_out( \&accept_N, "=pod\n\nI like pie.\n"), - '<Document><Para>I like pie.</Para></Document>' -); -ok( $x->_out( "=pod\n\nB<foo\t>\n"), # without acceptor - '<Document><Para><B>foo </B></Para></Document>' -); -ok( $x->_out( \&accept_N, "=pod\n\nB<foo\t>\n"), - '<Document><Para><B>foo </B></Para></Document>' -); - -print "# Some real tests...\n"; - -ok( $x->_out( \&accept_N, "=pod\n\nN<foo\t>\n"), - '<Document><Para><N>foo </N></Para></Document>' -); -ok( $x->_out( \&accept_N, "=pod\n\nB<N<foo\t>>\n"), - '<Document><Para><B><N>foo </N></B></Para></Document>' -); -ok( $x->_out( "=pod\n\nB<N<foo\t>>\n") # without the mutor - ne '<Document><Para><B><N>foo </N></B></Para></Document>' - # make sure it DOESN'T pass thru the N<...> when not accepted -); -ok( $x->_out( \&accept_N, "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"), - '<Document><Para><B>pie<F>zorch</F><N>foo</N><I>pling</I></B></Para></Document>' -); - -print "# Tests of nonacceptance...\n"; - -sub starts_with { - my($large, $small) = @_; - print("# supahstring is undef\n"), - return '' unless defined $large; - print("# supahstring $large is smaller than target-starter $small\n"), - return '' if length($large) < length($small); - if( substr($large, 0, length($small)) eq $small ) { - #print "# Supahstring $large\n# indeed starts with $small\n"; - return 1; - } else { - print "# Supahstring $large\n# !starts w/ $small\n"; - return ''; - } -} - - -ok( starts_with( $x->_out( "=pod\n\nB<N<foo\t>>\n"), # without the mutor - '<Document><Para><B>foo </B></Para>' - # make sure it DOESN'T pass thru the N<...>, when not accepted -)); - -ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"), # !mutor - '<Document><Para><B>pie<F>zorch</F>foo<I>pling</I></B></Para>' - # make sure it DOESN'T pass thru the N<...>, when not accepted -)); - -ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<C<foo>>I<pling>>\n"), # !mutor - '<Document><Para><B>pie<F>zorch</F><C>foo</C><I>pling</I></B></Para>' - # make sure it DOESN'T pass thru the N<...>, when not accepted -)); - - - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/accept05.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/accept05.t deleted file mode 100644 index d346de507cc..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/accept05.t +++ /dev/null @@ -1,143 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 24 }; - -#use Pod::Simple::Debug (2); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; -sub accept_Q { $_[0]->accept_codes('Q') } -sub accept_prok { $_[0]->accept_codes('prok') } -sub accept_zing_prok { $_[0]->accept_codes('zing:prok') } -sub accept_zing_superprok { $_[0]->accept_codes('z.i_ng:Prok-12') } -sub accept_zing_superduperprok { - $_[0]->accept_codes('A'); - $_[0]->accept_codes('z.i_ng:Prok-12'); -} - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -print "# Some sanity tests...\n"; -ok( $x->_out( "=pod\n\nI like pie.\n"), - '<Document><Para>I like pie.</Para></Document>' -); -ok( $x->_out( "=extend N C Y,W\n\nI like pie.\n"), - '<Document><Para>I like pie.</Para></Document>' -); -ok( $x->_out( "=extend N C,F Y,W\n\nI like pie.\n"), - '<Document><Para>I like pie.</Para></Document>' -); -ok( $x->_out( "=extend N C,F,I Y,W\n\nI like pie.\n"), - '<Document><Para>I like pie.</Para></Document>' -); - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -print "## OK, actually trying to use an extended code...\n"; - -print "# extending but not accepted (so hitting fallback)\n"; - -ok( $x->_out( "=extend N B Y,W\n\nI N<like> pie.\n"), - '<Document><Para>I <B>like</B> pie.</Para></Document>' -); -ok( $x->_out( "=extend N B,I Y,W\n\nI N<like> pie.\n"), - '<Document><Para>I <B><I>like</I></B> pie.</Para></Document>' -); -ok( $x->_out( "=extend N C,B,I Y,W\n\nI N<like> pie.\n"), - '<Document><Para>I <C><B><I>like</I></B></C> pie.</Para></Document>' -); - - - -print "# extending to one-letter accepted (not hitting fallback)\n"; - -ok( $x->_out( \&accept_Q, "=extend N B Y,Q,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <Q>like</Q> pie.</Para></Document>' -); -ok( $x->_out( \&accept_Q, "=extend N B,I Y,Q,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <Q>like</Q> pie.</Para></Document>' -); -ok( $x->_out( \&accept_Q, "=extend N C,B,I Y,Q,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <Q>like</Q> pie.</Para></Document>' -); - - - -print "# extending to many-letter accepted (not hitting fallback)\n"; - -ok( $x->_out( \&accept_prok, "=extend N B Y,prok,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <prok>like</prok> pie.</Para></Document>' -); -ok( $x->_out( \&accept_prok, "=extend N B,I Y,prok,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <prok>like</prok> pie.</Para></Document>' -); -ok( $x->_out( \&accept_prok, "=extend N C,B,I Y,prok,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <prok>like</prok> pie.</Para></Document>' -); - - - -print "# extending to :-containing, many-letter accepted (not hitting fallback)\n"; - -ok( $x->_out( \&accept_zing_prok, "=extend N B Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>' -); -ok( $x->_out( \&accept_zing_prok, "=extend N B,I Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>' -); -ok( $x->_out( \&accept_zing_prok, "=extend N C,B,I Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>' -); - - - - -print "# extending to _:-0-9-containing, many-letter accepted (not hitting fallback)\n"; - -ok( $x->_out( \&accept_zing_superprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>' -); -ok( $x->_out( \&accept_zing_superprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>' -); -ok( $x->_out( \&accept_zing_superprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>' -); - - - -print "#\n# Testing acceptance order\n"; - -ok( $x->_out( \&accept_zing_superduperprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>' -); -ok( $x->_out( \&accept_zing_superduperprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>' -); -ok( $x->_out( \&accept_zing_superduperprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"), - '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>' -); - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/basic.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/basic.t deleted file mode 100644 index 0b9cefd3611..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/basic.t +++ /dev/null @@ -1,95 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 30 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -require Pod::Simple::BlackBox; -ok 1; - -require Pod::Simple; ok 1; - -Pod::Simple->VERSION(.90); ok 1; - -#print "# Pod::Simple version $Pod::Simple::VERSION\n"; - -require Pod::Simple::DumpAsXML; ok 1; - -require Pod::Simple::XMLOutStream; ok 1; - -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -print "# Simple identity tests...\n"; - -&ok( e "", "" ); -&ok( e "\n", "", ); -&ok( e "\n", "\n", ); -&ok( e "puppies\n\n\n\n", "", ); - - -print "# Contentful identity tests...\n"; - -&ok( e "=pod\n\nFoo\n", "=pod\n\nFoo\n" ); -&ok( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\n\n\nFoo\n\n\n" ); -&ok( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\nFoo\n" ); - -# Now with some more newlines -&ok( e "\n\n=pod\n\nFoo\n", "\n\n=pod\n\nFoo\n" ); -&ok( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\n\n\nFoo\n\n\n" ); -&ok( e "=pod\n\n\n\nFoo\n\n\n", "\n\n=pod\n\nFoo\n" ); - - -&ok( e "=head1 Foo\n", "=head1 Foo\n" ); -&ok( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n\n=cut\n" ); -&ok( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n" ); - -# Now just add some newlines... -&ok( e "\n\n\n\n=head1 Foo\n", "\n\n\n\n=head1 Foo\n" ); -&ok( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n\n=cut\n" ); -&ok( e "=head1 Foo\n\n=cut\n", "\n\n\n\n=head1 Foo\n" ); - - -print "# Simple XMLification tests...\n"; - -ok( Pod::Simple::XMLOutStream->_out("\n\n\nprint \$^T;\n\n\n"), - qq{<Document\ncontentless="1"></Document>} - # make sure the contentless flag is set -); -ok( Pod::Simple::XMLOutStream->_out("\n\n"), - qq{<Document\ncontentless="1"></Document>} - # make sure the contentless flag is set -); -ok( Pod::Simple::XMLOutStream->_out("\n"), - qq{<Document\ncontentless="1"></Document>} - # make sure the contentless flag is set -); -ok( Pod::Simple::XMLOutStream->_out(""), - qq{<Document\ncontentless="1"></Document>} - # make sure the contentless flag is set -); - -ok( Pod::Simple::XMLOutStream->_out('', '<Document></Document>' ) ); - -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nFoo\n"), - '<Document><Para>Foo</Para></Document>' -); - -ok( Pod::Simple::XMLOutStream->_out("=head1 Chacha\n\nFoo\n"), - '<Document><head1>Chacha</head1><Para>Foo</Para></Document>' -); - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/begin.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/begin.t deleted file mode 100644 index 3b40095d228..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/begin.t +++ /dev/null @@ -1,462 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 62 }; - -my $d; -#use Pod::Simple::Debug (\$d, 0); - - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -sub moj {$_[0]->accept_target('mojojojo')} -sub mojtext {$_[0]->accept_target_as_text('mojojojo')} -sub any {$_[0]->accept_target_as_text('*')} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -print "# Testing non-matching complaint...\n"; -{ - -my $out; -ok( ($out = $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nStuff\n\n=end blorp\n\nYup.\n")) - =~ m/POD ERRORS/ -) or print "# Didn't contain POD ERRORS:\n# $out\n"; - -ok( ($out = $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nStuff\n\n=end :blorp\n\nYup.\n")) - =~ m/POD ERRORS/ -) or print "# Didn't contain POD ERRORS:\n# $out\n"; -ok( ($out = $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n=begin :zaz\n\nStuff\n\n=end :blorp\n\nYup.\n")) - =~ m/POD ERRORS/ -) or print "# Didn't contain POD ERRORS:\n# $out\n"; - -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -print "# Testing some trivial cases of non-acceptance...\n"; - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nStuff\n\n=end mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\nStuff\n\n=end mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\nStuff\n\n=end :mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n Stuff\n\n=end mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\n Stuff\n\n=end mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\n Stuff\n\n=end :mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI<Stuff>\n\n=end mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\nI<Stuff>\n\n=end mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\nI<Stuff>\n\n=end :mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - - - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nStuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\nStuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\nStuff\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n Stuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\n Stuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\n Stuff\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI<Stuff>\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\nI<Stuff>\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\nI<Stuff>\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# Testing matching because of negated non-acceptance...\n"; -#$d = 5; -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!crunk" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!crunk" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nstuff\n\n=end !mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!mojojojo" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nI<stuff>\n\n=end !mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!mojojojo" target_matching="!"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !:mojojojo\n\nI<stuff>\n\n=end !:mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!:mojojojo" target_matching="!"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin :!mojojojo \n\nI<stuff>\n\n=end :!mojojojo \t \n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":!mojojojo" target_matching="!"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !crunk,zaz\n\nstuff\n\n=end !crunk,zaz\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!crunk,zaz" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!crunk" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!crunk" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!crunk" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nstuff\n\n=end !mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!mojojojo" target_matching="!"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nI<stuff>\n\n\n=end !mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!mojojojo" target_matching="!"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !psketti,mojojojo,crunk\n\n\nI<stuff>\n\n=end !psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!psketti,mojojojo,crunk" target_matching="!"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=begin !:psketti,mojojojo,crunk\n\nI<stuff>\n\n=end !:psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!:psketti,mojojojo,crunk" target_matching="!"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# Testing accept_target + simple ...\n"; -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI<stuff>\n\n=end mojojojo \n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI<stuff>\n\n=end psketti,mojojojo,crunk \n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); - -print "# Testing accept_target_as_text + simple ...\n"; -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI<stuff>\n\n=end mojojojo \n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI<stuff>\n\n=end psketti,mojojojo,crunk \n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); - -print "# Testing accept_target + two simples ...\n"; -#$d = 10; -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI<stuff>\n\nHm, B<things>!\n\n=end mojojojo\n\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data><Data xml:space="preserve">Hm, B<things>!</Data></for><Para>Yup.</Para></Document>' -); - -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI<stuff>\n\nHm, B<things>!\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data><Data xml:space="preserve">Hm, B<things>!</Data></for><Para>Yup.</Para></Document>' -); - -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nI<stuff>\n\nHm, B<things>!\n\n=end :mojojojo\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":mojojojo" target_matching="mojojojo"><Para><I>stuff</I></Para><Para>Hm, <B>things</B>!</Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI<stuff>\n\nHm, B<things>!\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I></Para><Para>Hm, <B>things</B>!</Para></for><Para>Yup.</Para></Document>' -); - -print "# Testing accept_target_as_text + two simples ...\n"; - -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI<stuff>\n\nHm, B<things>!\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I></Para><Para>Hm, <B>things</B>!</Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI<stuff>\n\nHm, B<things>!\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I></Para><Para>Hm, <B>things</B>!</Para></for><Para>Yup.</Para></Document>' -); - - - -print "# Testing accept_target + two simples, latter with leading whitespace ...\n"; -#$d = 10; - -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI<stuff>\n\n Hm, B<things>!\nTrala.\n\n=end mojojojo\n\n\nYup.\n"), - qq{<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data><Data xml:space="preserve"> Hm, B<things>!\nTrala.\n</Data></for><Para>Yup.</Para></Document>} -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI<stuff>\n\n Hm, B<things>!\nTrala.\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - qq{<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data><Data xml:space="preserve"> Hm, B<things>!\nTrala.\n</Data></for><Para>Yup.</Para></Document>} -); - -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI<stuff>\n\n Hm, B<things>!\nTrala.\n\n\n=end mojojojo\n\n\nYup.\n"), - qq{<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data><Data xml:space="preserve"> Hm, B<things>!\nTrala.\n\n</Data></for><Para>Yup.</Para></Document>} -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI<stuff>\n\n Hm, B<things>!\nTrala.\n\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), - qq{<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data><Data xml:space="preserve"> Hm, B<things>!\nTrala.\n\n</Data></for><Para>Yup.</Para></Document>} -); - - -print "# Testing :-target and accept_target + two simples, latter with leading whitespace ...\n"; - -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nI<stuff>\nTrala!\n\n Hm, B<things>!\nTrala.\n\n=end :mojojojo\n\nYup.\n"), - qq{<Document><Para>I like pie.</Para><for target=":mojojojo" target_matching="mojojojo"><Para><I>stuff</I> Trala!</Para><Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.</Verbatim></for><Para>Yup.</Para></Document>} -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI<stuff>\nTrala!\n\n Hm, B<things>!\nTrala.\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), - qq{<Document><Para>I like pie.</Para><for target=":psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I> Trala!</Para><Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.</Verbatim></for><Para>Yup.</Para></Document>} -); - -print "# now with accept_target_as_text\n"; -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI<stuff>\nTrala!\n\n Hm, B<things>!\nTrala.\n\n=end mojojojo\n\nYup.\n"), - qq{<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Para><I>stuff</I> Trala!</Para><Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.</Verbatim></for><Para>Yup.</Para></Document>} -); -ok( $x->_out( \&mojtext, join "\n\n" => - "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk", - "I<stuff>\nTrala!", - " Hm, B<things>!\nTrala.", - "=end psketti,mojojojo,crunk", - "Yup.\n" - ), - qq{<Document><Para>I like pie.</Para>}. - qq{<for target="psketti,mojojojo,crunk" target_matching="mojojojo">}. - qq{<Para><I>stuff</I> Trala!</Para>}. - qq{<Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.</Verbatim>}. - qq{</for><Para>Yup.</Para></Document>} -); - -print "# Now with five paragraphs (p,v,v,p,p) and accept_target_as_text\n"; - -ok( $x->_out( \&mojtext, join "\n\n" => - "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk", - "I<stuff>\nTrala!", - " Hm, B<things>!\nTrala.", - " Oh, F<< dodads >>!\nHurf.", - "Boing C<spr-\t\n\t\t\toink>\n Blorg!", - "Woohah S<thwack\nwoohah>squim!", - "=end psketti,mojojojo,crunk", - "Yup.\n" - ), - qq{<Document><Para>I like pie.</Para>}. - qq{<for target="psketti,mojojojo,crunk" target_matching="mojojojo">}. - qq{<Para><I>stuff</I> Trala!</Para>}. - qq{<Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.\n\n}. - qq{ Oh, F<< dodads >>!\nHurf.</Verbatim>}. - qq{<Para>Boing <C>spr- oink</C> Blorg!</Para>}. - qq{<Para>Woohah <S>thwack woohah</S>squim!</Para>}. - qq{</for><Para>Yup.</Para></Document>} -); - - - -print "#\n# Now nested begin...end regions...\n"; - -sub mojprok { shift->accept_targets(qw{mojojojo prok}) } - -ok( $x->_out( \&mojprok, join "\n\n" => - "=pod\n\nI like pie.", - "=begin :psketti,mojojojo,crunk", - "I<stuff>\nTrala!", - " Hm, B<things>!\nTrala.", - " Oh, F<< dodads >>!\nHurf.", - "Boing C<spr-\t\n\t\t\toink>\n Blorg!", - "=begin :prok", - "Woohah S<thwack\nwoohah>squim!", - "=end :prok", - "ZubZ<>aaz.", - "=end :psketti,mojojojo,crunk", - "Yup.\n" - ), - qq{<Document><Para>I like pie.</Para>}. - qq{<for target=":psketti,mojojojo,crunk" target_matching="mojojojo">}. - qq{<Para><I>stuff</I> Trala!</Para>}. - qq{<Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.\n\n}. - qq{ Oh, F<< dodads >>!\nHurf.</Verbatim>}. - qq{<Para>Boing <C>spr- oink</C> Blorg!</Para>}. - qq{<for target=":prok" target_matching="prok">}. - qq{<Para>Woohah <S>thwack woohah</S>squim!</Para>}. - qq{</for>}. - qq{<Para>Zubaaz.</Para>}. - qq{</for>}. - qq{<Para>Yup.</Para></Document>} -); - - -print "# a little more complex this time...\n"; - -ok( $x->_out( \&mojprok, join "\n\n" => - "=pod\n\nI like pie.", - "=begin :psketti,mojojojo,crunk", - "I<stuff>\nTrala!", - " Hm, B<things>!\nTrala.", - " Oh, F<< dodads >>!\nHurf.", - "Boing C<spr-\t\n\t\t\toink>\n Blorg!", - "=begin :prok", - " Blorp, B<things>!\nTrala.", - " Khh, F<< dodads >>!\nHurf.", - "Woohah S<thwack\nwoohah>squim!", - "=end :prok", - "ZubZ<>aaz.", - "=end :psketti,mojojojo,crunk", - "Yup.\n" - ), - qq{<Document><Para>I like pie.</Para>}. - qq{<for target=":psketti,mojojojo,crunk" target_matching="mojojojo">}. - qq{<Para><I>stuff</I> Trala!</Para>}. - qq{<Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.\n\n}. - qq{ Oh, F<< dodads >>!\nHurf.</Verbatim>}. - qq{<Para>Boing <C>spr- oink</C> Blorg!</Para>}. - qq{<for target=":prok" target_matching="prok">}. - qq{<Verbatim xml:space="preserve"> Blorp, B<things>!\nTrala.\n\n}. - qq{ Khh, F<< dodads >>!\nHurf.</Verbatim>}. - qq{<Para>Woohah <S>thwack woohah</S>squim!</Para>}. - qq{</for>}. - qq{<Para>Zubaaz.</Para>}. - qq{</for>}. - qq{<Para>Yup.</Para></Document>} -); - - -$d = 10; -print "# Now with nesting where inner region is non-resolving...\n"; - -ok( $x->_out( \&mojprok, join "\n\n" => - "=pod\n\nI like pie.", - "=begin :psketti,mojojojo,crunk", - "I<stuff>\nTrala!", - " Hm, B<things>!\nTrala.", - " Oh, F<< dodads >>!\nHurf.", - "Boing C<spr-\t\n\t\t\toink>\n Blorg!", - "=begin prok", - " Blorp, B<things>!\nTrala.", - " Khh, F<< dodads >>!\nHurf.", - "Woohah S<thwack\nwoohah>squim!", - "=end prok", - "ZubZ<>aaz.", - "=end :psketti,mojojojo,crunk", - "Yup.\n" - ), - qq{<Document><Para>I like pie.</Para>}. - qq{<for target=":psketti,mojojojo,crunk" target_matching="mojojojo">}. - qq{<Para><I>stuff</I> Trala!</Para>}. - qq{<Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.\n\n}. - qq{ Oh, F<< dodads >>!\nHurf.</Verbatim>}. - qq{<Para>Boing <C>spr- oink</C> Blorg!</Para>}. - qq{<for target="prok" target_matching="prok">}. - qq{<Data xml:space="preserve"> Blorp, B<things>!\nTrala.\n\n}. - qq{ Khh, F<< dodads >>!\nHurf.\n</Data>}. - qq{<Data xml:space="preserve">Woohah S<thwack\nwoohah>squim!</Data>}. - qq{</for>}. - qq{<Para>Zubaaz.</Para>}. - qq{</for>}. - qq{<Para>Yup.</Para></Document>} -); - - - -print "# Now a begin...end with a non-resolving for inside\n"; - -ok( $x->_out( \&mojprok, join "\n\n" => - "=pod\n\nI like pie.", - "=begin :psketti,mojojojo,crunk", - "I<stuff>\nTrala!", - " Hm, B<things>!\nTrala.", - " Oh, F<< dodads >>!\nHurf.", - "Boing C<spr-\t\n\t\t\toink>\n Blorg!", - "=for prok" - . " Blorp, B<things>!\nTrala.\n Khh, F<< dodads >>!\nHurf.", - "ZubZ<>aaz.", - "=end :psketti,mojojojo,crunk", - "Yup.\n" - ), - qq{<Document><Para>I like pie.</Para>}. - qq{<for target=":psketti,mojojojo,crunk" target_matching="mojojojo">}. - qq{<Para><I>stuff</I> Trala!</Para>}. - qq{<Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.\n\n}. - qq{ Oh, F<< dodads >>!\nHurf.</Verbatim>}. - qq{<Para>Boing <C>spr- oink</C> Blorg!</Para>}. - qq{<for target="prok" target_matching="prok">}. - qq{<Data xml:space="preserve">Blorp, B<things>!\nTrala.\n}. - qq{ Khh, F<< dodads >>!\nHurf.</Data>}. - qq{</for>}. - qq{<Para>Zubaaz.</Para>}. - qq{</for>}. - qq{<Para>Yup.</Para></Document>} -); - - - - -print "# Now a begin...end with a resolving for inside\n"; - -ok( $x->_out( \&mojprok, join "\n\n" => - "=pod\n\nI like pie.", - "=begin :psketti,mojojojo,crunk", - "I<stuff>\nTrala!", - " Hm, B<things>!\nTrala.", - " Oh, F<< dodads >>!\nHurf.", - "Boing C<spr-\t\n\t\t\toink>\n Blorg!", - "=for :prok" - . " Blorp, B<things>!\nTrala.\n Khh, F<< dodads >>!\nHurf.", - "ZubZ<>aaz.", - "=end :psketti,mojojojo,crunk", - "Yup.\n" - ), - qq{<Document><Para>I like pie.</Para>}. - qq{<for target=":psketti,mojojojo,crunk" target_matching="mojojojo">}. - qq{<Para><I>stuff</I> Trala!</Para>}. - qq{<Verbatim xml:space="preserve"> Hm, B<things>!\nTrala.\n\n}. - qq{ Oh, F<< dodads >>!\nHurf.</Verbatim>}. - qq{<Para>Boing <C>spr- oink</C> Blorg!</Para>}. - qq{<for target=":prok" target_matching="prok">}. - qq{<Para>Blorp, <B>things</B>! Trala. Khh, }. - qq{<F>dodads</F>! Hurf.</Para>}. - qq{</for>}. - qq{<Para>Zubaaz.</Para>}. - qq{</for>}. - qq{<Para>Yup.</Para></Document>} -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# Testing matching of begin block titles\n"; -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo Title\n\nstuff\n\n=end mojojojo \n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo" title="Title"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>' -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/cbacks.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/cbacks.t deleted file mode 100644 index 4c15c82f7ec..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/cbacks.t +++ /dev/null @@ -1,83 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 8 }; - -my $d; -#use Pod::Simple::Debug (\$d, 0); - -ok 1; - -use Pod::Simple::XMLOutStream; -use Pod::Simple::DumpAsXML; -use Pod::Simple::DumpAsText; - -my @from = ( - 'Pod::Simple::XMLOutStream' - => '<Document><head1>I LIKE PIE</head1></Document>', - - 'Pod::Simple::DumpAsXML' - => "<Document>\n <head1>\n I LIKE PIE\n </head1>\n</Document>\n", - - 'Pod::Simple::DumpAsText' - => "++Document\n ++head1\n * \"I LIKE PIE\"\n --head1\n--Document\n", - -); - - -# Might as well test all the classes... -while(@from) { - my($x => $expected) = splice(@from, 0,2); - my $more = ''; - print "#Testing via class $x, version ", $x->VERSION(), "\n"; - my $p = $x->new; - my($got, $exp); - ok scalar($got = $x->_out( - # Mutor: - sub { - $_[0]->code_handler(sub { $more .= $_[1] . ":" . $_[0] . "\n" } ); - $_[0]->cut_handler( sub { $more .= "~" . $_[1] . ":" . $_[0]. "\n" } ); - } => join "\n", - "", - "\t# This is handy...", - "=head1 I LIKE PIE", - "", - "=cut", - "use Test::Harness;", - "runtests(sort glob 't/*.t');", - "", - "", - )) - => scalar($exp = $expected); - ; - unless($got eq $exp) { - print '# Got vs exp:\n# ', Pod::Simple::BlackBox::pretty($got), - "\n# ",Pod::Simple::BlackBox::pretty($exp),"\n"; - } - - ok scalar($got = $more), scalar($exp = join "\n" => - "1:", - "2:\t# This is handy...", - "~5:=cut", - "6:use Test::Harness;", - "7:runtests(sort glob 't/*.t');", - "8:", - "", - ); - unless($got eq $exp) { - print '# Got vs exp:\n# ', Pod::Simple::BlackBox::pretty($got), - "\n# ",Pod::Simple::BlackBox::pretty($exp),"\n"; - } -} - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/chunking.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/chunking.t deleted file mode 100644 index f51766dd7b0..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/chunking.t +++ /dev/null @@ -1,49 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -#use Pod::Simple::Debug (2); - -use strict; -use Test; -BEGIN { plan tests => 11 }; - - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -ok( Pod::Simple::XMLOutStream->_out("=head1 =head1"), - '<Document><head1>=head1</head1></Document>' -); - -ok( Pod::Simple::XMLOutStream->_out("\n=head1 =head1"), - '<Document><head1>=head1</head1></Document>' -); - -ok( Pod::Simple::XMLOutStream->_out("\n=head1 =head1\n"), - '<Document><head1>=head1</head1></Document>' -); - -ok( Pod::Simple::XMLOutStream->_out("\n=head1 =head1\n\n"), - '<Document><head1>=head1</head1></Document>' -); - -&ok(e "\n=head1 =head1\n\n" , "\n=head1 =head1\n\n"); - -&ok(e "\n=head1\n=head1\n\n", "\n=head1 =head1\n\n"); - -&ok(e "\n=pod\n\nCha cha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); -&ok(e "\n=pod\n\nCha\tcha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); -&ok(e "\n=pod\n\nCha\ncha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/closeys.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/closeys.t deleted file mode 100644 index 683ce13ff38..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/closeys.t +++ /dev/null @@ -1,39 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 3 }; - -my $d; -#use Pod::Simple::Debug (\$d,0); -#use Pod::Simple::Debug (10); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::XMLOutStream::->_duo(\&nowhine, @_) } - -sub nowhine { -# $_[0]->{'no_whining'} = 1; - $_[0]->accept_targets("*"); -} - -&ok(e( -"=begin :foo\n\n=begin :bar\n\nZaz\n\n", -"=begin :foo\n\n=begin :bar\n\nZaz\n\n=end :bar\n\n=end :foo\n\n", -)); - - -print "# Ending ", __FILE__, "\n"; -ok 1; - -__END__ - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus.t deleted file mode 100644 index 291edd649a9..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus.t +++ /dev/null @@ -1,183 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } - - use Config; - if ($Config::Config{'extensions'} !~ /\bEncode\b/) { - print "1..0 # Skip: Encode was not built\n"; - exit 0; - } -} - -#use Pod::Simple::Debug (10); -use Test qw(plan ok skip); - -use File::Spec; -#use utf8; -use strict; -my(@testfiles, %xmlfiles, %wouldxml); -#use Pod::Simple::Debug (10); -BEGIN { - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - my @bits; - if(-e( File::Spec::->catdir( @bits = - source_path('corpus') ) ) ) - { - # OK - print "# 1Bits: @bits\n"; - } elsif( -e (File::Spec::->catdir( @bits = - (File::Spec::->curdir, 'corpus') ) ) - ) { - # OK - print "# 2Bits: @bits\n"; - } elsif ( -e (File::Spec::->catdir( @bits = - (File::Spec::->curdir, 't', 'corpus') ) ) - ) { - # OK - print "# 3Bits: @bits\n"; - } else { - die "Can't find the corpusdir"; - } - my $corpusdir = File::Spec::->catdir( @bits); - print "#Corpusdir: $corpusdir\n"; - - opendir(INDIR, $corpusdir) or die "Can't opendir corpusdir : $!"; - my @f = map File::Spec::->catfile(@bits, $_), readdir(INDIR); - closedir(INDIR); - my %f; - @f{@f} = (); - foreach my $maybetest (sort @f) { - my $xml = $maybetest; - $xml =~ s/\.(txt|pod)$/\.xml/is or next; - $wouldxml{$maybetest} = $xml; - push @testfiles, $maybetest; - foreach my $x ($xml, uc($xml), lc($xml)) { - next unless exists $f{$x}; - $xmlfiles{$maybetest} = $x; - last; - } - } - die "Too few test files (".@testfiles.")" unless @ARGV or @testfiles > 20; - - @testfiles = @ARGV if @ARGV and !grep !m/\.txt/, @ARGV; - - plan tests => (2 + 2*@testfiles - 1); -} - -my $HACK = 1; -#@testfiles = ('nonesuch.txt'); - -ok 1; - -my $skippy = ($] < 5.008) ? "skip because perl ($]) pre-dates v5.8.0" : 0; -if($skippy) { - print "# This is just perl v$], so I'm skipping many many tests.\n"; -} - -{ - my @x = @testfiles; - print "# Files to test:\n"; - while(@x) { print "# ", join(' ', splice @x,0,3), "\n" } -} - -require Pod::Simple::DumpAsXML; - - -foreach my $f (@testfiles) { - my $xml = $xmlfiles{$f}; - if($xml) { - print "#\n#To test $f against $xml\n"; - } else { - print "#\n# $f has no xml to test it against\n"; - } - - my $outstring; - eval { - my $p = Pod::Simple::DumpAsXML->new; - $p->output_string( \$outstring ); - $p->parse_file( $f ); - undef $p; - }; - - if($@) { - my $x = "#** Couldn't parse $f:\n $@"; - $x =~ s/([\n\r]+)/\n#** /g; - print $x, "\n"; - ok 0; - ok 0; - next; - } else { - print "# OK, parsing $f generated ", length($outstring), " bytes\n"; - ok 1; - } - - die "Null outstring?" unless $outstring; - - next if $f =~ /nonesuch/; - - # foo.xml.out is not a portable filename. foo.xml_out may be a bit more portable - - my $outfilename = ($HACK > 1) ? $wouldxml{$f} : "$wouldxml{$f}_out"; - if($HACK) { - open OUT, ">$outfilename" or die "Can't write-open $outfilename: $!\n"; - binmode(OUT); - print OUT $outstring; - close(OUT); - } - unless($xml) { - print "# (no comparison done)\n"; - ok 1; - next; - } - - open(IN, "<$xml") or die "Can't read-open $xml: $!"; - #binmode(IN); - local $/; - my $xmlsource = <IN>; - close(IN); - - print "# There's errata!\n" if $outstring =~ m/start_line="-321"/; - - if( - $xmlsource eq $outstring - or do { - $xmlsource =~ s/[\n\r]+/\n/g; - $outstring =~ s/[\n\r]+/\n/g; - $xmlsource eq $outstring; - } - ) { - print "# (Perfect match to $xml)\n"; - unlink $outfilename unless $outfilename =~ m/\.xml$/is; - ok 1; - next; - } - - if($skippy) { - skip $skippy, 0; - } else { - print "# $outfilename and $xml don't match!\n"; - ok 0; - } - -} - - -print "#\n# I've been using Encode v", - $Encode::VERSION ? $Encode::VERSION : "(NONE)", "\n"; -print "# Byebye\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jp.txt.packed b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jp.txt.packed deleted file mode 100644 index 9ff9cda0077..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jp.txt.packed +++ /dev/null @@ -1,52 +0,0 @@ -######################################################################### -This is a binary file that was packed with the 'uupacktool.pl' which -is included in the Perl distribution. - -To unpack this file use the following command: - - uupacktool.pl -u 2202jp.txt.packed 2202jp.txt - -To recreate it use the following command: - - uupacktool.pl -p 2202jp.txt 2202jp.txt.packed - -Created at Thu Mar 22 13:31:40 2007 -######################################################################### -__UU__ -M#0H-"CUH96%D,2!.04U%#0H-"FAA:6MU+6ES;S(P,C)J<"`M+2!A('1E<W0@ -M2F%P86YE<V4@9&]C=6UE;G0@:6X@:7-O+3(P,C(M:G`-"@T*/6AE860Q($1% -M4T-225!424].#0H-"CUE;F-O9&EN9R!I<V\M,C`R,BUJ<`T*#0I4:&ES(&ES -M(&$@=&5S="!0;V0@9&]C=6UE;G0@:6X@25-/+3(R,#(M2E`N("!)=',@8V]N -M=&5N="!I<R!S;VUE#0I*87!A;F5S92!H86EK=2!B>2!F86UO=7,@<&]E=',N -M#0H-"@T*/6AE860R($U!5%-53R!"05-(3R`H&R1"/CY(>$=./E8;*$(@,38T -M-"`M(#$V.30I(#H-"@T*&R1".$5#4R1D,S\D2"13.7XD8#]E)$XR.QLH0@T* -M#0HH9G5R=6EK92!Y82`O(&MA=V%Z=2!T;V)I:V]M=2`O(&UI>G4@;F\@;W1O -M*0T*#0I!<R!V97)B871I;3H-"@T*("`;)$(X14-3)&0S/R1()%,Y?B1@/V4D -M3C([&RA"#0H-"@T*#0H]:&5A9#(@64]302!"55-/3B`H&R1"33\\54ES0CP; -M*$(Q-S$V("T@,3<X,RD-"@T*&R1"2GU(+$XD,2LQ0"1H)#LD3#(T0S`D*R1* -M&RA"#0H-"BAH;R!H86-H:7)I("\@86UA9W5M;R!Y;W-E;G4@+R!B;W1A;B!K -M86YA*0T*#0I!<R!V97)B871I;3H-"@T*("`;)$)*?4@L3B0Q*S%`)&@D.R1, -M,C1#,"0K)$H;*$(-"@T*/6AE860R($U!4T%/2T$@4TA)2TD@*!LD0D`U,BP[ -M4C4L&RA"(#$X-C<@+2`Q.3`R*0T*#0H;)$(D)"1!)$\D1"1.,&Q.6$=R)#<] -M521.2FL;*$(-"@T**&EC:&EH871S=2!N;R`O(&EC:&ER:6X@<VAI<F]S:&D@ -M+R!H87)U;F\@:W5R92D-"@T*07,@=F5R8F%T:6TZ#0H-"B`@&R1")"0D021/ -M)$0D3C!L3EA'<B0W/54D3DIK&RA"#0H-"ALD0DT^3#\D)"0O)%`D+R0K)"(D -M:TQK0SLD-QLH0@T*#0HH>6]M96D@+R!I:W5B86MU:V$@87)U("\@>6\@;6EJ -M:6MA<VAI*0T*#0H@(!LD0DT^3#\D)"0O)%`D+R0K)"(D:TQK0SLD-QLH0@T* -M#0H]:&5A9#$@05,@02!,25-4#0H-"CUO=F5R#0H-"CUI=&5M($U!5%-53R!" -M05-(3R`H&R1"/CY(>$=./E8;*$(@,38T-"`M(#$V.30I(#H-"@T*&R1".$5# -M4R1D,S\D2"13.7XD8#]E)$XR.QLH0@T*#0HH9G5R=6EK92!Y82`O(&MA=V%Z -M=2!T;V)I:V]M=2`O(&UI>G4@;F\@;W1O*0T*#0I!<R!V97)B871I;3H-"@T* -M("`;)$(X14-3)&0S/R1()%,Y?B1@/V4D3C([&RA"#0H-"@T*#0H]:71E;2!9 -M3U-!($)54T].("@;)$)-/SQ527-"/!LH0C$W,38@+2`Q-S@S*0T*#0H;)$)* -M?4@L3B0Q*S%`)&@D.R1,,C1#,"0K)$H;*$(-"@T**&AO(&AA8VAI<FD@+R!A -M;6%G=6UO('EO<V5N=2`O(&)O=&%N(&MA;F$I#0H-"D%S('9E<F)A=&EM.@T* -M#0H@(!LD0DI]2"Q.)#$K,4`D:"0[)$PR-$,P)"LD2ALH0@T*#0H]:71E;2!- -M05-!3TM!(%-(24M)("@;)$)`-3(L.U(U+!LH0B`Q.#8W("T@,3DP,BD-"@T* -M&R1")"0D021/)$0D3C!L3EA'<B0W/54D3DIK&RA"#0H-"BAI8VAI:&%T<W4@ -M;F\@+R!I8VAI<FEN('-H:7)O<VAI("\@:&%R=6YO(&MU<F4I#0H-"D%S('9E -M<F)A=&EM.@T*#0H@(!LD0B0D)$$D3R1$)$XP;$Y81W(D-SU5)$Y*:QLH0@T* -M#0H;)$)-/DP_)"0D+R10)"\D*R0B)&M,:T,[)#<;*$(-"@T**'EO;65I("\@ -M:6MU8F%K=6MA(&%R=2`O('EO(&UI:FEK87-H:2D-"@T*("`;)$)-/DP_)"0D -M+R10)"\D*R0B)&M,:T,[)#<;*$(-"@T*/6)A8VL-"@T*6V5N9%T-"@T*/6-U -'=`T*#0H-"@`` diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jp.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jp.xml deleted file mode 100644 index e0304954d4b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jp.xml +++ /dev/null @@ -1,133 +0,0 @@ -<Document start_line="3"> - <head1 start_line="3"> - NAME - </head1> - <Para start_line="5"> - haiku-iso2022jp -- a test Japanese document in iso-2022-jp - </Para> - <head1 start_line="7"> - DESCRIPTION - </head1> - <Para start_line="11"> - This is a test Pod document in ISO-2202-JP. Its content - is some Japanese haiku by famous poets. - </Para> - <head2 start_line="15"> - MATSUO BASHO (松尾芭蕉 1644 - 1694) - : - </head2> - <Para start_line="17"> - 古池や蛙とび込む水の音 - </Para> - <Para start_line="19"> - (furuike ya / kawazu tobikomu / mizu no oto) - </Para> - <Para start_line="21"> - As verbatim: - </Para> - <VerbatimFormatted start_line="23" xml:space="preserve"> - 古池や蛙とび込む水の音 - </VerbatimFormatted> - <head2 start_line="27"> - YOSA BUSON (与謝蕪村1716 - 1783) - </head2> - <Para start_line="29"> - 方八里雨雲よせぬ牡丹かな - </Para> - <Para start_line="31"> - (ho hachiri / amagumo yosenu / botan kana) - </Para> - <Para start_line="33"> - As verbatim: - </Para> - <VerbatimFormatted start_line="35" xml:space="preserve"> - 方八里雨雲よせぬ牡丹かな - </VerbatimFormatted> - <head2 start_line="37"> - MASAOKA SHIKI (正岡子規 1867 - 1902) - </head2> - <Para start_line="39"> - いちはつの一輪白し春の暮 - </Para> - <Para start_line="41"> - (ichihatsu no / ichirin shiroshi / haruno kure) - </Para> - <Para start_line="43"> - As verbatim: - </Para> - <VerbatimFormatted start_line="45" xml:space="preserve"> - いちはつの一輪白し春の暮 - </VerbatimFormatted> - <Para start_line="47"> - 余命いくばくかある夜短し - </Para> - <Para start_line="49"> - (yomei / ikubakuka aru / yo mijikashi) - </Para> - <VerbatimFormatted start_line="51" xml:space="preserve"> - 余命いくばくかある夜短し - </VerbatimFormatted> - <head1 start_line="53"> - AS A LIST - </head1> - <over-text indent="4" start_line="55"> - <item-text start_line="57"> - MATSUO BASHO (松尾芭蕉 1644 - 1694) - : - </item-text> - <Para start_line="59"> - 古池や蛙とび込む水の音 - </Para> - <Para start_line="61"> - (furuike ya / kawazu tobikomu / mizu no oto) - </Para> - <Para start_line="63"> - As verbatim: - </Para> - <VerbatimFormatted start_line="65" xml:space="preserve"> - 古池や蛙とび込む水の音 - </VerbatimFormatted> - <item-text start_line="69"> - YOSA BUSON (与謝蕪村1716 - 1783) - </item-text> - <Para start_line="71"> - 方八里雨雲よせぬ牡丹かな - </Para> - <Para start_line="73"> - (ho hachiri / amagumo yosenu / botan kana) - </Para> - <Para start_line="75"> - As verbatim: - </Para> - <VerbatimFormatted start_line="77" xml:space="preserve"> - 方八里雨雲よせぬ牡丹かな - </VerbatimFormatted> - <item-text start_line="79"> - MASAOKA SHIKI (正岡子規 1867 - 1902) - </item-text> - <Para start_line="81"> - いちはつの一輪白し春の暮 - </Para> - <Para start_line="83"> - (ichihatsu no / ichirin shiroshi / haruno kure) - </Para> - <Para start_line="85"> - As verbatim: - </Para> - <VerbatimFormatted start_line="87" xml:space="preserve"> - いちはつの一輪白し春の暮 - </VerbatimFormatted> - <Para start_line="89"> - 余命いくばくかある夜短し - </Para> - <Para start_line="91"> - (yomei / ikubakuka aru / yo mijikashi) - </Para> - <VerbatimFormatted start_line="93" xml:space="preserve"> - 余命いくばくかある夜短し - </VerbatimFormatted> - </over-text> - <Para start_line="97"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpx.txt.packed b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpx.txt.packed deleted file mode 100644 index df173d446a3..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpx.txt.packed +++ /dev/null @@ -1,52 +0,0 @@ -######################################################################### -This is a binary file that was packed with the 'uupacktool.pl' which -is included in the Perl distribution. - -To unpack this file use the following command: - - uupacktool.pl -u 2202jpx.txt.packed 2202jpx.txt - -To recreate it use the following command: - - uupacktool.pl -p 2202jpx.txt 2202jpx.txt.packed - -Created at Thu Mar 22 13:32:14 2007 -######################################################################### -__UU__ -M#0H-"CUH96%D,2!.04U%#0H-"FAA:6MU+6ES;S(P,C)J<"`M+2!A('1E<W0@ -M2F%P86YE<V4@9&]C=6UE;G0@:6X@:7-O+3(P,C(M:G`-"@T*/6AE860Q($1% -M4T-225!424].#0H-"CUE;F-O9&EN9R!I<V\M,C`R,BUJ<`T*#0I4:&ES(&ES -M(&$@=&5S="!0;V0@9&]C=6UE;G0@:6X@25-/+3(R,#(M2E`N("!)=',@8V]N -M=&5N="!I<R!S;VUE#0I*87!A;F5S92!H86EK=2!B>2!F86UO=7,@<&]E=',N -M#0H-"@T*/6AE860R($U!5%-53R!"05-(3R`H&R1"/CY(>$=./E8;*$(@,38T -M-"`M(#$V.30I(#H-"@T*&R1".$5#4R1D,S\D2"13.7XD8#]E)$XR.QLH0@T* -M#0HH9G5R=6EK92!Y82`O(&MA=V%Z=2!T;V)I:V]M=2`O(&UI>G4@;F\@;W1O -M*0T*#0I!<R!V97)B871I;3H-"@T*("`;)$(X14-3)&0S/R1()%,Y?B1@/V4D -M3C([&RA"#0H-"@T*#0H]:&5A9#(@64]302!"55-/3B`H&R1"33\\54ES0CP; -M*$(Q-S$V("T@,3<X,RD-"@T*&R1"2GU(+$XD,2LQ0"1H)#LD3#(T0S`D*R1* -M&RA"#0H-"BAH;R!H86-H:7)I("\@86UA9W5M;R!Y;W-E;G4@+R!B;W1A;B!K -M86YA*0T*#0I!<R!V97)B871I;3H-"@T*("`;)$)*?4@L3B0Q*S%`)&@D.R1, -M,C1#,"0K)$H;*$(-"@T*/6AE860R($U!4T%/2T$@4TA)2TD@*!LD0D`U,BP[ -M4C4L&RA"(#$X-C<@+2`Q.3`R*0T*#0H;)$(D)"1!)$\D1"1.,&Q.6$=R)#<] -M521.2FL;*$(-"@T**&EC:&EH871S=2!N;R`O(&EC:&ER:6X@<VAI<F]S:&D@ -M+R!H87)U;F\@:W5R92D-"@T*07,@=F5R8F%T:6TZ#0H-"B`@&R1")"0D021/ -M)$0D3C!L3EA'<B0W/54D3DIK&RA"#0H-"ALD0DT^3#\D)"0O)%`D+R0K)"(D -M:TQK0SLD-QLH0@T*#0HH>6]M96D@+R!I:W5B86MU:V$@87)U("\@>6\@;6EJ -M:6MA<VAI*0T*#0H@(!LD0DT^3#\D)"0O)%`D+R0K)"(D:TQK0SLD-QLH0@T* -M#0H]:&5A9#$@05,@02!,25-4#0H-"CUO=F5R#0H-"CUI=&5M($U!5%-53R!" -M05-(3R`H&R1"/CY(>$=./E8;*$(@,38T-"`M(#$V.30I(#H-"@T*&R1".$5# -M4R1D,S\D2"13.7XD8#]E)$XR.QLH0@T*#0HH9G5R=6EK92!Y82`O(&MA=V%Z -M=2!T;V)I:V]M=2`O(&UI>G4@;F\@;W1O*0T*#0I!<R!V97)B871I;3H-"@T* -M("`;)$(X14-3)&0S/R1()%,Y?B1@/V4D3C([&RA"#0H-"@T*#0H]:71E;2!9 -M3U-!($)54T].("@;)$)-/SQ527-"/!LH0C$W,38@+2`Q-S@S*0T*#0H;)$)* -M?4@L3B0Q*S%`)&@D.R1,,C1#,"0K)$H;*$(-"@T**&AO(&AA8VAI<FD@+R!A -M;6%G=6UO('EO<V5N=2`O(&)O=&%N(&MA;F$I#0H-"D%S('9E<F)A=&EM.@T* -M#0H@(!LD0DI]2"Q.)#$K,4`D:"0[)$PR-$,P)"LD2ALH0@T*#0H]:71E;2!- -M05-!3TM!(%-(24M)("@;)$)`-3(L.U(U+!LH0B`Q.#8W("T@,3DP,BD-"@T* -M&R1")"0D021/)$0D3C!L3EA'<B0W/54D3DIK&RA"#0H-"BAI8VAI:&%T<W4@ -M;F\@+R!I8VAI<FEN('-H:7)O<VAI("\@:&%R=6YO(&MU<F4I#0H-"D%S('9E -M<F)A=&EM.@T*#0H@(!LD0B0D)$$D3R1$)$XP;$Y81W(D-SU5)$Y*:QLH0@T* -M#0H;)$)-/DP_)"0D+R10)"\D*R0B)&M,:T,[)#<;*$(-"@T**'EO;65I("\@ -M:6MU8F%K=6MA(&%R=2`O('EO(&UI:FEK87-H:2D-"@T*("`;)$)-/DP_)"0D -M+R10)"\D*R0B)&M,:T,[)#<;*$(-"@T*/6)A8VL-"@T*+F5N9"X-"@T*/6-U -'=`T*#0H-"@`` diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpx.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpx.xml deleted file mode 100644 index 57cb4ceadca..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpx.xml +++ /dev/null @@ -1,133 +0,0 @@ -<Document start_line="3"> - <head1 start_line="3"> - NAME - </head1> - <Para start_line="5"> - haiku-iso2022jp -- a test Japanese document in iso-2022-jp - </Para> - <head1 start_line="7"> - DESCRIPTION - </head1> - <Para start_line="11"> - This is a test Pod document in ISO-2202-JP. Its content - is some Japanese haiku by famous poets. - </Para> - <head2 start_line="15"> - MATSUO BASHO (松尾芭蕉 1644 - 1694) - : - </head2> - <Para start_line="17"> - 古池や蛙とび込む水の音 - </Para> - <Para start_line="19"> - (furuike ya / kawazu tobikomu / mizu no oto) - </Para> - <Para start_line="21"> - As verbatim: - </Para> - <VerbatimFormatted start_line="23" xml:space="preserve"> - 古池や蛙とび込む水の音 - </VerbatimFormatted> - <head2 start_line="27"> - YOSA BUSON (与謝蕪村1716 - 1783) - </head2> - <Para start_line="29"> - 方八里雨雲よせぬ牡丹かな - </Para> - <Para start_line="31"> - (ho hachiri / amagumo yosenu / botan kana) - </Para> - <Para start_line="33"> - As verbatim: - </Para> - <VerbatimFormatted start_line="35" xml:space="preserve"> - 方八里雨雲よせぬ牡丹かな - </VerbatimFormatted> - <head2 start_line="37"> - MASAOKA SHIKI (正岡子規 1867 - 1902) - </head2> - <Para start_line="39"> - いちはつの一輪白し春の暮 - </Para> - <Para start_line="41"> - (ichihatsu no / ichirin shiroshi / haruno kure) - </Para> - <Para start_line="43"> - As verbatim: - </Para> - <VerbatimFormatted start_line="45" xml:space="preserve"> - いちはつの一輪白し春の暮 - </VerbatimFormatted> - <Para start_line="47"> - 余命いくばくかある夜短し - </Para> - <Para start_line="49"> - (yomei / ikubakuka aru / yo mijikashi) - </Para> - <VerbatimFormatted start_line="51" xml:space="preserve"> - 余命いくばくかある夜短し - </VerbatimFormatted> - <head1 start_line="53"> - AS A LIST - </head1> - <over-text indent="4" start_line="55"> - <item-text start_line="57"> - MATSUO BASHO (松尾芭蕉 1644 - 1694) - : - </item-text> - <Para start_line="59"> - 古池や蛙とび込む水の音 - </Para> - <Para start_line="61"> - (furuike ya / kawazu tobikomu / mizu no oto) - </Para> - <Para start_line="63"> - As verbatim: - </Para> - <VerbatimFormatted start_line="65" xml:space="preserve"> - 古池や蛙とび込む水の音 - </VerbatimFormatted> - <item-text start_line="69"> - YOSA BUSON (与謝蕪村1716 - 1783) - </item-text> - <Para start_line="71"> - 方八里雨雲よせぬ牡丹かな - </Para> - <Para start_line="73"> - (ho hachiri / amagumo yosenu / botan kana) - </Para> - <Para start_line="75"> - As verbatim: - </Para> - <VerbatimFormatted start_line="77" xml:space="preserve"> - 方八里雨雲よせぬ牡丹かな - </VerbatimFormatted> - <item-text start_line="79"> - MASAOKA SHIKI (正岡子規 1867 - 1902) - </item-text> - <Para start_line="81"> - いちはつの一輪白し春の暮 - </Para> - <Para start_line="83"> - (ichihatsu no / ichirin shiroshi / haruno kure) - </Para> - <Para start_line="85"> - As verbatim: - </Para> - <VerbatimFormatted start_line="87" xml:space="preserve"> - いちはつの一輪白し春の暮 - </VerbatimFormatted> - <Para start_line="89"> - 余命いくばくかある夜短し - </Para> - <Para start_line="91"> - (yomei / ikubakuka aru / yo mijikashi) - </Para> - <VerbatimFormatted start_line="93" xml:space="preserve"> - 余命いくばくかある夜短し - </VerbatimFormatted> - </over-text> - <Para start_line="97"> - .end. - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpy.txt.packed b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpy.txt.packed deleted file mode 100644 index fb960e24932..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpy.txt.packed +++ /dev/null @@ -1,52 +0,0 @@ -######################################################################### -This is a binary file that was packed with the 'uupacktool.pl' which -is included in the Perl distribution. - -To unpack this file use the following command: - - uupacktool.pl -u 2202jpy.txt.packed 2202jpy.txt - -To recreate it use the following command: - - uupacktool.pl -p 2202jpy.txt 2202jpy.txt.packed - -Created at Thu Mar 22 13:32:29 2007 -######################################################################### -__UU__ -M#0H]:&5A9#$@3D%-10T*#0IH86EK=2UI<V\R,#(R:G`@+2T@82!T97-T($IA -M<&%N97-E(&1O8W5M96YT(&EN(&ES;RTR,#(R+6IP#0H-"CUH96%D,2!$15-# -M4DE05$E/3@T*#0H]96YC;V1I;F<@:7-O+3(P,C(M:G`-"@T*5&AI<R!I<R!A -M('1E<W0@4&]D(&1O8W5M96YT(&EN($E33RTR,C`R+4I0+B`@271S(&-O;G1E -M;G0@:7,@<V]M90T*2F%P86YE<V4@:&%I:W4@8GD@9F%M;W5S('!O971S+@T* -M#0H-"CUH96%D,B!-051354\@0D%32$\@*!LD0CX^2'A'3CY6&RA"(#$V-#0@ -M+2`Q-CDT*2`Z#0H-"ALD0CA%0U,D9#,_)$@D4SE^)&`_921.,CL;*$(-"@T* -M*&9U<G5I:V4@>6$@+R!K87=A>G4@=&]B:6MO;74@+R!M:7IU(&YO(&]T;RD- -M"@T*07,@=F5R8F%T:6TZ#0H-"B`@&R1".$5#4R1D,S\D2"13.7XD8#]E)$XR -M.QLH0@T*#0H-"@T*/6AE860R(%E/4T$@0E533TX@*!LD0DT_/%5)<T(\&RA" -M,3<Q-B`M(#$W.#,I#0H-"ALD0DI]2"Q.)#$K,4`D:"0[)$PR-$,P)"LD2ALH -M0@T*#0HH:&\@:&%C:&ER:2`O(&%M86=U;6\@>6]S96YU("\@8F]T86X@:V%N -M82D-"@T*07,@=F5R8F%T:6TZ#0H-"B`@&R1"2GU(+$XD,2LQ0"1H)#LD3#(T -M0S`D*R1*&RA"#0H-"CUH96%D,B!-05-!3TM!(%-(24M)("@;)$)`-3(L.U(U -M+!LH0B`Q.#8W("T@,3DP,BD-"@T*&R1")"0D021/)$0D3C!L3EA'<B0W/54D -M3DIK&RA"#0H-"BAI8VAI:&%T<W4@;F\@+R!I8VAI<FEN('-H:7)O<VAI("\@ -M:&%R=6YO(&MU<F4I#0H-"D%S('9E<F)A=&EM.@T*#0H@(!LD0B0D)$$D3R1$ -M)$XP;$Y81W(D-SU5)$Y*:QLH0@T*#0H;)$)-/DP_)"0D+R10)"\D*R0B)&M, -M:T,[)#<;*$(-"@T**'EO;65I("\@:6MU8F%K=6MA(&%R=2`O('EO(&UI:FEK -M87-H:2D-"@T*("`;)$)-/DP_)"0D+R10)"\D*R0B)&M,:T,[)#<;*$(-"@T* -M/6AE860Q($%3($$@3$E35`T*#0H];W9E<@T*#0H]:71E;2!-051354\@0D%3 -M2$\@*!LD0CX^2'A'3CY6&RA"(#$V-#0@+2`Q-CDT*2`Z#0H-"ALD0CA%0U,D -M9#,_)$@D4SE^)&`_921.,CL;*$(-"@T**&9U<G5I:V4@>6$@+R!K87=A>G4@ -M=&]B:6MO;74@+R!M:7IU(&YO(&]T;RD-"@T*07,@=F5R8F%T:6TZ#0H-"B`@ -M&R1".$5#4R1D,S\D2"13.7XD8#]E)$XR.QLH0@T*#0H-"@T*/6ET96T@64]3 -M02!"55-/3B`H&R1"33\\54ES0CP;*$(Q-S$V("T@,3<X,RD-"@T*&R1"2GU( -M+$XD,2LQ0"1H)#LD3#(T0S`D*R1*&RA"#0H-"BAH;R!H86-H:7)I("\@86UA -M9W5M;R!Y;W-E;G4@+R!B;W1A;B!K86YA*0T*#0I!<R!V97)B871I;3H-"@T* -M("`;)$)*?4@L3B0Q*S%`)&@D.R1,,C1#,"0K)$H;*$(-"@T*/6ET96T@34%3 -M04]+02!32$E+22`H&R1"0#4R+#M2-2P;*$(@,3@V-R`M(#$Y,#(I#0H-"ALD -M0B0D)$$D3R1$)$XP;$Y81W(D-SU5)$Y*:QLH0@T*#0HH:6-H:6AA='-U(&YO -M("\@:6-H:7)I;B!S:&ER;W-H:2`O(&AA<G5N;R!K=7)E*0T*#0I!<R!V97)B -M871I;3H-"@T*("`;)$(D)"1!)$\D1"1.,&Q.6$=R)#<]521.2FL;*$(-"@T* -M&R1"33Y,/R0D)"\D4"0O)"LD(B1K3&M#.R0W&RA"#0H-"BAY;VUE:2`O(&EK -M=6)A:W5K82!A<G4@+R!Y;R!M:6II:V%S:&DI#0H-"B`@&R1"33Y,/R0D)"\D -M4"0O)"LD(B1K3&M#.R0W&RA"#0H-"CUB86-K#0H-"B)E;F0B#0H-"CUC=70- -'"@T*#0H-"@`` diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpy.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpy.xml deleted file mode 100644 index 23d51e1ebbc..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpy.xml +++ /dev/null @@ -1,133 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - haiku-iso2022jp -- a test Japanese document in iso-2022-jp - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="10"> - This is a test Pod document in ISO-2202-JP. Its content - is some Japanese haiku by famous poets. - </Para> - <head2 start_line="14"> - MATSUO BASHO (松尾芭蕉 1644 - 1694) - : - </head2> - <Para start_line="16"> - 古池や蛙とび込む水の音 - </Para> - <Para start_line="18"> - (furuike ya / kawazu tobikomu / mizu no oto) - </Para> - <Para start_line="20"> - As verbatim: - </Para> - <VerbatimFormatted start_line="22" xml:space="preserve"> - 古池や蛙とび込む水の音 - </VerbatimFormatted> - <head2 start_line="26"> - YOSA BUSON (与謝蕪村1716 - 1783) - </head2> - <Para start_line="28"> - 方八里雨雲よせぬ牡丹かな - </Para> - <Para start_line="30"> - (ho hachiri / amagumo yosenu / botan kana) - </Para> - <Para start_line="32"> - As verbatim: - </Para> - <VerbatimFormatted start_line="34" xml:space="preserve"> - 方八里雨雲よせぬ牡丹かな - </VerbatimFormatted> - <head2 start_line="36"> - MASAOKA SHIKI (正岡子規 1867 - 1902) - </head2> - <Para start_line="38"> - いちはつの一輪白し春の暮 - </Para> - <Para start_line="40"> - (ichihatsu no / ichirin shiroshi / haruno kure) - </Para> - <Para start_line="42"> - As verbatim: - </Para> - <VerbatimFormatted start_line="44" xml:space="preserve"> - いちはつの一輪白し春の暮 - </VerbatimFormatted> - <Para start_line="46"> - 余命いくばくかある夜短し - </Para> - <Para start_line="48"> - (yomei / ikubakuka aru / yo mijikashi) - </Para> - <VerbatimFormatted start_line="50" xml:space="preserve"> - 余命いくばくかある夜短し - </VerbatimFormatted> - <head1 start_line="52"> - AS A LIST - </head1> - <over-text indent="4" start_line="54"> - <item-text start_line="56"> - MATSUO BASHO (松尾芭蕉 1644 - 1694) - : - </item-text> - <Para start_line="58"> - 古池や蛙とび込む水の音 - </Para> - <Para start_line="60"> - (furuike ya / kawazu tobikomu / mizu no oto) - </Para> - <Para start_line="62"> - As verbatim: - </Para> - <VerbatimFormatted start_line="64" xml:space="preserve"> - 古池や蛙とび込む水の音 - </VerbatimFormatted> - <item-text start_line="68"> - YOSA BUSON (与謝蕪村1716 - 1783) - </item-text> - <Para start_line="70"> - 方八里雨雲よせぬ牡丹かな - </Para> - <Para start_line="72"> - (ho hachiri / amagumo yosenu / botan kana) - </Para> - <Para start_line="74"> - As verbatim: - </Para> - <VerbatimFormatted start_line="76" xml:space="preserve"> - 方八里雨雲よせぬ牡丹かな - </VerbatimFormatted> - <item-text start_line="78"> - MASAOKA SHIKI (正岡子規 1867 - 1902) - </item-text> - <Para start_line="80"> - いちはつの一輪白し春の暮 - </Para> - <Para start_line="82"> - (ichihatsu no / ichirin shiroshi / haruno kure) - </Para> - <Para start_line="84"> - As verbatim: - </Para> - <VerbatimFormatted start_line="86" xml:space="preserve"> - いちはつの一輪白し春の暮 - </VerbatimFormatted> - <Para start_line="88"> - 余命いくばくかある夜短し - </Para> - <Para start_line="90"> - (yomei / ikubakuka aru / yo mijikashi) - </Para> - <VerbatimFormatted start_line="92" xml:space="preserve"> - 余命いくばくかある夜短し - </VerbatimFormatted> - </over-text> - <Para start_line="96"> - "end" - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpz.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpz.txt deleted file mode 100644 index 230fd2ba9da..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpz.txt +++ /dev/null @@ -1,14 +0,0 @@ -
-=head1 NAME
-
-haiku-iso2022jp -- a test Japanese document in iso-2022-jp
-
-=head1 DESCRIPTION
-
-=encoding iso-2022-jp
-
-This is a test Pod document in ISO-2202-JP.
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpz.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpz.xml deleted file mode 100644 index 734ed6f5d81..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/2202jpz.xml +++ /dev/null @@ -1,14 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - haiku-iso2022jp -- a test Japanese document in iso-2022-jp - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="10"> - This is a test Pod document in ISO-2202-JP. - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/8859_7.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/8859_7.pod deleted file mode 100644 index 9596f8f69e7..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/8859_7.pod +++ /dev/null @@ -1,33 +0,0 @@ - -=encoding iso-8859-7 - -=head1 NAME - - -- - -=head1 DESCRIPTION - - ' , - , ' , - -, ' - ' . - - , - , - - ' - . - -, - , - - . - ' , . - -=cut - - -The above is the Olympic Hymn, by Kostis Palamas. -Yup, it's in Greek. - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/8859_7.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/8859_7.xml deleted file mode 100644 index ffbf0d08556..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/8859_7.xml +++ /dev/null @@ -1,59 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - Ολυμπιακός - Ύμνος -- Κωστής - Παλαμάς - </Para> - <head1 start_line="8"> - DESCRIPTION - </head1> - <Para start_line="10"> - Αρχαίο Πνεύμ' - αθάνατον, αγνέ - πατέρα του - ωραίου, του - μεγάλου και - τ' αληθινού, - </Para> - <Para start_line="13"> - κατέβα, φανερώσου - κι άστραψ' εδώ - πέρα στη δόξα - της δικής σου - γης και τ' ουρανού. - </Para> - <Para start_line="16"> - Στο δρόμο και - στο πάλεμα - και στο λιθάρι, - στων ευγενών - Αγώνων λάμψε - την ορμή, - </Para> - <Para start_line="19"> - και με τ' αμάραντο - στεφάνωσε κλωνάρι - και σιδερένιο - πλάσε κι άξιο - το κορμί. - </Para> - <Para start_line="22"> - Κάμποι, βουνά - και πέλαγα - φέγγουν μαζί - σου σαν ένας - λευκοπόρφυρος - μέγας ναός, - </Para> - <Para start_line="25"> - και τρέχει - στο ναό εδώ - προσκυνητής - σου. Αρχαίο - Πνεύμ' αθάνατο, - κάθε λαός. - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/cp1256.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/cp1256.txt deleted file mode 100644 index 9a79bc0eda0..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/cp1256.txt +++ /dev/null @@ -1,39 +0,0 @@ -
-=head1 NAME
-
-buniya1256 -- test document: a paragraph in Arabic as CP-1256
-
-=head1 DESCRIPTION
-
-This Pod document is a paragraph in Arabic from "The Five Pillars of Islam"
-as CP-1256.
-
-=encoding cp1256
-
- :
-
-
-
-
-
-. .
-
-And now as a real single paragraph:
-
- :
-
-
-. .
-
-And now as a verbatim paragraph:
-
- :
-
-
- . .
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/cp1256.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/cp1256.xml deleted file mode 100644 index deacfd6c85b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/cp1256.xml +++ /dev/null @@ -1,98 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - buniya1256 -- test document: a paragraph in Arabic as CP-1256 - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="8"> - This Pod document is a paragraph in Arabic from "The - Five Pillars of Islam" as CP-1256. - </Para> - <Para start_line="13"> - وعن عمارة - بن حزم قال - قال رسول الله - صلى الله عليه - وسلم: - </Para> - <Para start_line="15"> - اربع فرضهن - الله عز وجل - في الاسلام - فمن جاء بثلاث - لم يغنين عنه - </Para> - <Para start_line="17"> - شيئا حتى يأتي - بهن جميعا - الصلاة والزكاة - وصيام رمضان - وحج - </Para> - <Para start_line="19"> - البيت. رواه - احمد والطبراني - في الكبير - وفي اسناده - ابن لهيعة. - </Para> - <Para start_line="21"> - And now as a real single paragraph: - </Para> - <Para start_line="23"> - وعن عمارة - بن حزم قال - قال رسول الله - صلى الله عليه - وسلم: اربع - فرضهن الله - عز وجل في الاسلام - فمن جاء بثلاث - لم يغنين عنه - شيئا حتى يأتي - بهن جميعا - الصلاة والزكاة - وصيام رمضان - وحج البيت. - رواه احمد - والطبراني - في الكبير - وفي اسناده - ابن لهيعة. - </Para> - <Para start_line="28"> - And now as a verbatim paragraph: - </Para> - <VerbatimFormatted start_line="30" xml:space="preserve"> - وعن عمارة - بن حزم قال - قال رسول الله - صلى الله عليه - وسلم: - - اربع فرضهن - الله عز وجل - في الاسلام - فمن جاء بثلاث - لم يغنين عنه - - شيئا حتى يأتي - بهن جميعا - الصلاة والزكاة - وصيام رمضان - وحج - - البيت. رواه - احمد والطبراني - في الكبير - وفي اسناده - ابن لهيعة. - </VerbatimFormatted> - <Para start_line="35"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_cont.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_cont.txt deleted file mode 100644 index 51b83208ca6..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_cont.txt +++ /dev/null @@ -1,22 +0,0 @@ -
-We have deliberately contradictory =encoding statements here.
-This should generate errata.
-
-=encoding koi8-r
-
-=head1 NAME
-
- -- Fet's "When you were reading"
-
-=head1 TEXT
-
-=encoding Shift-JIS
-
-(This is a test Pod pocument in KOI8-R.)
-
-15 1887
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_cont.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_cont.xml deleted file mode 100644 index 4f4995f925c..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_cont.xml +++ /dev/null @@ -1,42 +0,0 @@ -<Document start_line="5"> - <head1 start_line="7"> - NAME - </head1> - <Para start_line="9"> - Когда читала - ты мучительные - строки -- Fet's - "When you were reading" - </Para> - <head1 start_line="11"> - TEXT - </head1> - <Para start_line="15"> - (This is a test Pod pocument in KOI8-R.) - </Para> - <Para start_line="17"> - 15 февраля 1887 - </Para> - <Para start_line="19"> - [end] - </Para> - <head1 errata="1" start_line="-321"> - POD ERRORS - </head1> - <Para errata="1" start_line="-321"> - Hey! - <B> - The above document had some coding errors, which are explained - below: - </B> - </Para> - <over-text errata="1" indent="4" start_line="-321"> - <item-text start_line="-321"> - Around line 13: - </item-text> - <Para start_line="-321"> - Couldn't do =encoding Shift-JIS: Encoding is already - set to koi8-r - </Para> - </over-text> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_dup.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_dup.txt deleted file mode 100644 index 92e95eb2644..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_dup.txt +++ /dev/null @@ -1,56 +0,0 @@ -
-We have deliberately reduntant =encoding statements here.
-This should generate no errata.
-
-=encoding koi8-r
-
-=head1 NAME
-
- -- Fet's "When you were reading"
-
-=head1 TEXT
-
-(This is a test Pod pocument in KOI8-R.)
-
- , /
- /
- ,- /
- ?
-
- ! , , /
- , /
- /
- .
-
- , /
- ,- /
- : /
- !
-
-15 1887
-
-And now, as a verbatim section:
-
- ,
-
- ,-
- ?
-
- ! , ,
- ,
-
- .
-
-=encoding koi8-r
-
- ,
- ,-
- :
- !
-
- 15 1887
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_dup.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_dup.xml deleted file mode 100644 index c33277deb04..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/fet_dup.xml +++ /dev/null @@ -1,121 +0,0 @@ -<Document start_line="5"> - <head1 start_line="7"> - NAME - </head1> - <Para start_line="9"> - Когда читала - ты мучительные - строки -- Fet's - "When you were reading" - </Para> - <head1 start_line="11"> - TEXT - </head1> - <Para start_line="13"> - (This is a test Pod pocument in KOI8-R.) - </Para> - <Para start_line="15"> - Когда читала - ты мучительные - строки, / Где - сердца звучный - пыл сиянье - льет кругом - / И страсти - роковой вздымаются - потоки,- / Не - вспомнила - ль о чем? - </Para> - <Para start_line="20"> - Я верить не - хочу! Когда - в степи, как - диво, / В полночной - темноте безвременно - горя, / Вдали - перед тобой - прозрачно - и красиво - / Вставала - вдругзаря. - </Para> - <Para start_line="25"> - И в эту красоту - невольно - взор тянуло, - / В тот величавый - блеск за темный - весь предел,- - / Ужель ничто - тебе в то время - не шепнуло: - / Там человек - сгорел! - </Para> - <Para start_line="30"> - 15 февраля 1887 - </Para> - <Para start_line="32"> - And now, as a verbatim section: - </Para> - <VerbatimFormatted start_line="34" xml:space="preserve"> - Когда читала - ты мучительные - строки, - - Где сердца - звучный пыл - сиянье льет - кругом - - И страсти - роковой вздымаются - потоки,- - - Не вспомнила - ль о чем? - - - - Я верить не - хочу! Когда - в степи, как - диво, - - В полночной - темноте безвременно - горя, - - Вдали перед - тобой прозрачно - и красиво - - Вставала - вдругзаря. - </VerbatimFormatted> - <VerbatimFormatted start_line="46" xml:space="preserve"> - И в эту красоту - невольно - взор тянуло, - - В тот величавый - блеск за темный - весь предел,- - - Ужель ничто - тебе в то время - не шепнуло: - - Там человек - сгорел! - - - - 15 февраля - 1887 - </VerbatimFormatted> - <Para start_line="53"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/iso6.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/iso6.txt deleted file mode 100644 index 0152bd3c000..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/iso6.txt +++ /dev/null @@ -1,39 +0,0 @@ -
-=head1 NAME
-
-buniya-iso-6 -- test document: a paragraph in Arabic as ISO-8859-6
-
-=head1 DESCRIPTION
-
-This document is a paragraph in Arabic from "The Five Pillars of Islam"
-as ISO-8859-6.
-
-=encoding iso-8859-6
-
- :
-
-
-
-
-
-. .
-
-And now as a real single paragraph:
-
- :
-
-
-. .
-
-And now as a verbatim paragraph:
-
- :
-
-
- . .
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/iso6.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/iso6.xml deleted file mode 100644 index b597324087a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/iso6.xml +++ /dev/null @@ -1,100 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - buniya-iso-6 -- test document: a paragraph in Arabic as - ISO-8859-6 - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="8"> - This document is a paragraph in Arabic from "The Five - Pillars of Islam" as ISO-8859-6. - </Para> - <Para start_line="13"> - وعن عمارة - بن حزم قال - قال رسول الله - صلى الله عليه - وسلم: - </Para> - <Para start_line="15"> - اربع فرضهن - الله عز وجل - في الاسلام - فمن جاء بثلاث - لم يغنين عنه - </Para> - <Para start_line="17"> - شيئا حتى يأتي - بهن جميعا - الصلاة والزكاة - وصيام رمضان - وحج - </Para> - <Para start_line="19"> - البيت. رواه - احمد والطبراني - في الكبير - وفي اسناده - ابن لهيعة. - </Para> - <Para start_line="21"> - And now as a real single paragraph: - </Para> - <Para start_line="23"> - وعن عمارة - بن حزم قال - قال رسول الله - صلى الله عليه - وسلم: اربع - فرضهن الله - عز وجل في الاسلام - فمن جاء بثلاث - لم يغنين عنه - شيئا حتى يأتي - بهن جميعا - الصلاة والزكاة - وصيام رمضان - وحج البيت. - رواه احمد - والطبراني - في الكبير - وفي اسناده - ابن لهيعة. - </Para> - <Para start_line="28"> - And now as a verbatim paragraph: - </Para> - <VerbatimFormatted start_line="30" xml:space="preserve"> - وعن عمارة - بن حزم قال - قال رسول الله - صلى الله عليه - وسلم: - - اربع فرضهن - الله عز وجل - في الاسلام - فمن جاء بثلاث - لم يغنين عنه - - شيئا حتى يأتي - بهن جميعا - الصلاة والزكاة - وصيام رمضان - وحج - - البيت. رواه - احمد والطبراني - في الكبير - وفي اسناده - ابن لهيعة. - - </VerbatimFormatted> - <Para start_line="35"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/koi8r.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/koi8r.txt deleted file mode 100644 index ce314e46f7e..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/koi8r.txt +++ /dev/null @@ -1,51 +0,0 @@ -
-=encoding koi8-r
-
-=head1 NAME
-
- -- Fet's "When you were reading"
-
-=head1 TEXT
-
-(This is a test Pod pocument in KOI8-R.)
-
- , /
- /
- ,- /
- ?
-
- ! , , /
- , /
- /
- .
-
- , /
- ,- /
- : /
- !
-
-15 1887
-
-And now, as a verbatim section:
-
- ,
-
- ,-
- ?
-
- ! , ,
- ,
-
- .
-
- ,
- ,-
- :
- !
-
- 15 1887
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/koi8r.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/koi8r.xml deleted file mode 100644 index 94331d7e4d7..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/koi8r.xml +++ /dev/null @@ -1,122 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - Когда читала - ты мучительные - строки -- Fet's - "When you were reading" - </Para> - <head1 start_line="8"> - TEXT - </head1> - <Para start_line="10"> - (This is a test Pod pocument in KOI8-R.) - </Para> - <Para start_line="12"> - Когда читала - ты мучительные - строки, / Где - сердца звучный - пыл сиянье - льет кругом - / И страсти - роковой вздымаются - потоки,- / Не - вспомнила - ль о чем? - </Para> - <Para start_line="17"> - Я верить не - хочу! Когда - в степи, как - диво, / В полночной - темноте безвременно - горя, / Вдали - перед тобой - прозрачно - и красиво - / Вставала - вдругзаря. - </Para> - <Para start_line="22"> - И в эту красоту - невольно - взор тянуло, - / В тот величавый - блеск за темный - весь предел,- - / Ужель ничто - тебе в то время - не шепнуло: - / Там человек - сгорел! - </Para> - <Para start_line="27"> - 15 февраля 1887 - </Para> - <Para start_line="29"> - And now, as a verbatim section: - </Para> - <VerbatimFormatted start_line="31" xml:space="preserve"> - Когда читала - ты мучительные - строки, - - Где сердца - звучный пыл - сиянье льет - кругом - - И страсти - роковой вздымаются - потоки,- - - Не вспомнила - ль о чем? - - - - Я верить не - хочу! Когда - в степи, как - диво, - - В полночной - темноте безвременно - горя, - - Вдали перед - тобой прозрачно - и красиво - - Вставала - вдругзаря. - - - - И в эту красоту - невольно - взор тянуло, - - В тот величавый - блеск за темный - весь предел,- - - Ужель ничто - тебе в то время - не шепнуло: - - Там человек - сгорел! - - - - 15 февраля - 1887 - </VerbatimFormatted> - <Para start_line="48"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38.txt deleted file mode 100644 index efd01ee07da..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38.txt +++ /dev/null @@ -1,37 +0,0 @@ -=encoding big5
-
-=head1 ѤlDwg@TQK -- Big5 (Chinese) encoding test
-
-WwwAOHwQ
-UwwAOHLwC
-WwLӵLHQ
-UwLӦHC
-WӵLHQ
-WqӦHC
-W§ӲAhcuӥC
-
-GDӦZwAwӦZAӦZqAqӦZ§C§̡AHAӶäC
-eѪ̡ADءAӷMlC
-OHjVҩ~pA~Q~A~ءC
-GhC
-
-And as a verbatim section:
-
- WwwAOHwQ
- UwwAOHLwC
- WwLӵLHQ
- UwLӦHC
- WӵLHQ
- WqӦHC
- W§ӲAhcuӥC
-
- GDӦZwAwӦZAӦZqAqӦZ§C§̡AHAӶäC
- eѪ̡ADءAӷMlC
- OHjVҩ~pA~Q~A~ءC
- GhC
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38.xml deleted file mode 100644 index 5ff72513abf..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38.xml +++ /dev/null @@ -1,52 +0,0 @@ -<Document start_line="1"> - <head1 start_line="3"> - 老子道德經 三十八章 - -- Big5 (Chinese) encoding test - </head1> - <Para start_line="5"> - 上德不德，是以有德﹔ - 下德不失德，是以無德。 - 上德無為而無以為﹔ - 下德無為而有以為。 - 上仁為之而無以為﹔ - 上義為之而有以為。 - 上禮為之而莫之應，則攘臂而扔之。 - </Para> - <Para start_line="13"> - 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 - 前識者，道之華，而愚之始。 - 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 - 故去彼取此。 - </Para> - <Para start_line="18"> - And as a verbatim section: - </Para> - <VerbatimFormatted start_line="20" xml:space="preserve"> - 上德不德，是以有德﹔ - - 下德不失德，是以無德。 - - 上德無為而無以為﹔ - - 下德無為而有以為。 - - 上仁為之而無以為﹔ - - 上義為之而有以為。 - - 上禮為之而莫之應，則攘臂而扔之。 - - - - 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 - - 前識者，道之華，而愚之始。 - - 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 - - 故去彼取此。 - </VerbatimFormatted> - <Para start_line="33"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38b.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38b.txt deleted file mode 100644 index 8193d21b50a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38b.txt +++ /dev/null @@ -1,37 +0,0 @@ -=encoding big5-eten
-
-=head1 ѤlDwg@TQK -- Big5 (Chinese) encoding test
-
-WwwAOHwQ
-UwwAOHLwC
-WwLӵLHQ
-UwLӦHC
-WӵLHQ
-WqӦHC
-W§ӲAhcuӥC
-
-GDӦZwAwӦZAӦZqAqӦZ§C§̡AHAӶäC
-eѪ̡ADءAӷMlC
-OHjVҩ~pA~Q~A~ءC
-GhC
-
-And as a verbatim section:
-
- WwwAOHwQ
- UwwAOHLwC
- WwLӵLHQ
- UwLӦHC
- WӵLHQ
- WqӦHC
- W§ӲAhcuӥC
-
- GDӦZwAwӦZAӦZqAqӦZ§C§̡AHAӶäC
- eѪ̡ADءAӷMlC
- OHjVҩ~pA~Q~A~ءC
- GhC
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38b.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38b.xml deleted file mode 100644 index 5ff72513abf..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38b.xml +++ /dev/null @@ -1,52 +0,0 @@ -<Document start_line="1"> - <head1 start_line="3"> - 老子道德經 三十八章 - -- Big5 (Chinese) encoding test - </head1> - <Para start_line="5"> - 上德不德，是以有德﹔ - 下德不失德，是以無德。 - 上德無為而無以為﹔ - 下德無為而有以為。 - 上仁為之而無以為﹔ - 上義為之而有以為。 - 上禮為之而莫之應，則攘臂而扔之。 - </Para> - <Para start_line="13"> - 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 - 前識者，道之華，而愚之始。 - 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 - 故去彼取此。 - </Para> - <Para start_line="18"> - And as a verbatim section: - </Para> - <VerbatimFormatted start_line="20" xml:space="preserve"> - 上德不德，是以有德﹔ - - 下德不失德，是以無德。 - - 上德無為而無以為﹔ - - 下德無為而有以為。 - - 上仁為之而無以為﹔ - - 上義為之而有以為。 - - 上禮為之而莫之應，則攘臂而扔之。 - - - - 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 - - 前識者，道之華，而愚之始。 - - 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 - - 故去彼取此。 - </VerbatimFormatted> - <Para start_line="33"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38p.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38p.pod deleted file mode 100644 index 477c785a3e4..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38p.pod +++ /dev/null @@ -1,46 +0,0 @@ -
-=encoding big5
-
-=head1 NAME
-
-ѤlDwg@TQK -- Big5 (Chinese) encoding test
-
-=head1 DESCRIPTION
-
-This is a test Pod document in the Big5 encoding. Its content is
-the 38th canto from the I<Dao De Jing>.
-
-=head2 ѤlDwg@TQK
-
-WwwAOHwQ
-UwwAOHLwC
-WwLӵLHQ
-UwLӦHC
-WӵLHQ
-WqӦHC
-W§ӲAhcuӥC
-
-GDӦZwAwӦZAӦZqAqӦZ§C§̡AHAӶäC
-eѪ̡ADءAӷMlC
-OHjVҩ~pA~Q~A~ءC
-GhC
-
-And as a verbatim section:
-
- WwwAOHwQ
- UwwAOHLwC
- WwLӵLHQ
- UwLӦHC
- WӵLHQ
- WqӦHC
- W§ӲAhcuӥC
-
- GDӦZwAwӦZAӦZqAqӦZ§C§̡AHAӶäC
- eѪ̡ADءAӷMlC
- OHjVҩ~pA~Q~A~ءC
- GhC
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38p.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38p.xml deleted file mode 100644 index bae00f25d48..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/laozi38p.xml +++ /dev/null @@ -1,69 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - 老子道德經 三十八章 - -- Big5 (Chinese) encoding test - </Para> - <head1 start_line="8"> - DESCRIPTION - </head1> - <Para start_line="10"> - This is a test Pod document in the Big5 encoding. Its content - is the 38th canto from the - <I> - Dao De Jing - </I> - . - </Para> - <head2 start_line="13"> - 老子道德經 三十八章 - </head2> - <Para start_line="15"> - 上德不德，是以有德﹔ - 下德不失德，是以無德。 - 上德無為而無以為﹔ - 下德無為而有以為。 - 上仁為之而無以為﹔ - 上義為之而有以為。 - 上禮為之而莫之應，則攘臂而扔之。 - </Para> - <Para start_line="23"> - 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 - 前識者，道之華，而愚之始。 - 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 - 故去彼取此。 - </Para> - <Para start_line="28"> - And as a verbatim section: - </Para> - <VerbatimFormatted start_line="30" xml:space="preserve"> - 上德不德，是以有德﹔ - - 下德不失德，是以無德。 - - 上德無為而無以為﹔ - - 下德無為而有以為。 - - 上仁為之而無以為﹔ - - 上義為之而有以為。 - - 上禮為之而莫之應，則攘臂而扔之。 - - - - 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 - - 前識者，道之華，而愚之始。 - - 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 - - 故去彼取此。 - </VerbatimFormatted> - <Para start_line="43"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1fr.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1fr.txt deleted file mode 100644 index 19f53e1a6fb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1fr.txt +++ /dev/null @@ -1,38 +0,0 @@ -
-=encoding iso-8859-1
-
-=head1 NAME
-
-French-Latin-1 -- explicitly Latin-1 test document in French
-
-=head1 DESCRIPTION
-
-This is a test Pod document in Latin-1. Its content is the last two
-paragraphs of Baudelaire's I<Le Joujou du pauvre>.
-
-A travers ces barreaux symboliques sparant deux mondes, la grande route
-et le chteau, l'enfant pauvre montrait l'enfant riche son propre
-joujou, que celui-ci examinait avidement comme un objet rare et inconnu.
-Or, ce joujou, que le petit souillon agaait, agitait et secouait dans
-une bote grille, c'tait un rat vivantE<160>! Les parents, par conomie
-sans doute, avaient tir le joujou de la vie elle-mme.
-
-Et les deux enfants se riaient l'un l'autre fraternellement, avec des
-dents d'une I<gale> blancheur.
-
-=head2 As Verbatim
-
- A travers ces barreaux symboliques sparant deux mondes, la grande route
- et le chteau, l'enfant pauvre montrait l'enfant riche son propre
- joujou, que celui-ci examinait avidement comme un objet rare et inconnu.
- Or, ce joujou, que le petit souillon agaait, agitait et secouait dans
- une bote grille, c'tait un rat vivant! Les parents, par conomie
- sans doute, avaient tir le joujou de la vie elle-mme.
-
- Et les deux enfants se riaient l'un l'autre fraternellement, avec des
- dents d'une gale blancheur.
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1fr.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1fr.xml deleted file mode 100644 index 017ae6abf77..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1fr.xml +++ /dev/null @@ -1,70 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - French-Latin-1 -- explicitly Latin-1 test document in French - </Para> - <head1 start_line="8"> - DESCRIPTION - </head1> - <Para start_line="10"> - This is a test Pod document in Latin-1. Its content is the - last two paragraphs of Baudelaire's - <I> - Le Joujou du pauvre - </I> - . - </Para> - <Para start_line="13"> - A travers ces barreaux symboliques séparant deux mondes, - la grande route et le château, l'enfant pauvre - montrait à l'enfant riche son propre joujou, que - celui-ci examinait avidement comme un objet rare et inconnu. - Or, ce joujou, que le petit souillon agaçait, agitait - et secouait dans une boîte grillée, c'était - un rat vivant -   - ! Les parents, par économie sans doute, avaient tiré - le joujou de la vie elle-même. - </Para> - <Para start_line="20"> - Et les deux enfants se riaient l'un à l'autre - fraternellement, avec des dents d'une - <I> - égale - </I> - blancheur. - </Para> - <head2 start_line="23"> - As Verbatim - </head2> - <VerbatimFormatted start_line="25" xml:space="preserve"> - A travers ces barreaux symboliques séparant deux mondes, - la grande route - - et le château, l'enfant pauvre montrait à - l'enfant riche son propre - - joujou, que celui-ci examinait avidement comme un objet - rare et inconnu. - - Or, ce joujou, que le petit souillon agaçait, agitait - et secouait dans - - une boîte grillée, c'était un rat vivant ! - Les parents, par économie - - sans doute, avaient tiré le joujou de la vie elle-même. - - - - Et les deux enfants se riaient l'un à l'autre - fraternellement, avec des - - dents d'une égale blancheur. - </VerbatimFormatted> - <Para start_line="35"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1frim.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1frim.txt deleted file mode 100644 index 470836890f4..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1frim.txt +++ /dev/null @@ -1,36 +0,0 @@ -
-=head1 NAME
-
-French-Latin-1 -- implicitly Latin-1 test document in French
-
-=head1 DESCRIPTION
-
-This is a test Pod document in Latin-1. Its content is the last two
-paragraphs of Baudelaire's I<Le Joujou du pauvre>.
-
-A travers ces barreaux symboliques sparant deux mondes, la grande route
-et le chteau, l'enfant pauvre montrait l'enfant riche son propre
-joujou, que celui-ci examinait avidement comme un objet rare et inconnu.
-Or, ce joujou, que le petit souillon agaait, agitait et secouait dans
-une bote grille, c'tait un rat vivantE<160>! Les parents, par conomie
-sans doute, avaient tir le joujou de la vie elle-mme.
-
-Et les deux enfants se riaient l'un l'autre fraternellement, avec des
-dents d'une I<gale> blancheur.
-
-=head2 As Verbatim
-
- A travers ces barreaux symboliques sparant deux mondes, la grande route
- et le chteau, l'enfant pauvre montrait l'enfant riche son propre
- joujou, que celui-ci examinait avidement comme un objet rare et inconnu.
- Or, ce joujou, que le petit souillon agaait, agitait et secouait dans
- une bote grille, c'tait un rat vivant! Les parents, par conomie
- sans doute, avaient tir le joujou de la vie elle-mme.
-
- Et les deux enfants se riaient l'un l'autre fraternellement, avec des
- dents d'une gale blancheur.
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1frim.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1frim.xml deleted file mode 100644 index ffbbdb05ac6..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/lat1frim.xml +++ /dev/null @@ -1,70 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - French-Latin-1 -- implicitly Latin-1 test document in French - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="8"> - This is a test Pod document in Latin-1. Its content is the - last two paragraphs of Baudelaire's - <I> - Le Joujou du pauvre - </I> - . - </Para> - <Para start_line="11"> - A travers ces barreaux symboliques séparant deux mondes, - la grande route et le château, l'enfant pauvre - montrait à l'enfant riche son propre joujou, que - celui-ci examinait avidement comme un objet rare et inconnu. - Or, ce joujou, que le petit souillon agaçait, agitait - et secouait dans une boîte grillée, c'était - un rat vivant -   - ! Les parents, par économie sans doute, avaient tiré - le joujou de la vie elle-même. - </Para> - <Para start_line="18"> - Et les deux enfants se riaient l'un à l'autre - fraternellement, avec des dents d'une - <I> - égale - </I> - blancheur. - </Para> - <head2 start_line="21"> - As Verbatim - </head2> - <VerbatimFormatted start_line="23" xml:space="preserve"> - A travers ces barreaux symboliques séparant deux mondes, - la grande route - - et le château, l'enfant pauvre montrait à - l'enfant riche son propre - - joujou, que celui-ci examinait avidement comme un objet - rare et inconnu. - - Or, ce joujou, que le petit souillon agaçait, agitait - et secouait dans - - une boîte grillée, c'était un rat vivant ! - Les parents, par économie - - sans doute, avaient tiré le joujou de la vie elle-même. - - - - Et les deux enfants se riaient l'un à l'autre - fraternellement, avec des - - dents d'une égale blancheur. - </VerbatimFormatted> - <Para start_line="33"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/nonesuch.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/nonesuch.txt deleted file mode 100644 index 7d6fc0a5827..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/nonesuch.txt +++ /dev/null @@ -1,11 +0,0 @@ -=encoding blorpy
-
-=head1 nonesuch -- Document in an unknown encoding
-
-Blorp.
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/nonesuch.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/nonesuch.xml deleted file mode 100644 index c6d7efb6eeb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/nonesuch.xml +++ /dev/null @@ -1,49 +0,0 @@ -<Document start_line="1"> - <head1 start_line="3"> - nonesuch -- Document in an unknown encoding - </head1> - <Para start_line="5"> - Blorp. - </Para> - <Para start_line="7"> - [end] - </Para> - <head1 errata="1" start_line="-321"> - POD ERRORS - </head1> - <Para errata="1" start_line="-321"> - Hey! - <B> - The above document had some coding errors, which are explained - below: - </B> - </Para> - <over-text errata="1" indent="4" start_line="-321"> - <item-text start_line="-321"> - Around line 1: - </item-text> - <Para start_line="-321"> - This document probably does not appear as it should, because - its "=encoding blorpy" line calls for an unsupported - encoding. [Encode.pm v1.98's supported encodings are: - 7bit-jis AdobeStandardEncoding AdobeSymbol AdobeZdingbat - ascii ascii-ctrl big5-eten big5-hkscs cp1006 cp1026 cp1047 - cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 - cp1258 cp37 cp424 cp437 cp500 cp737 cp775 cp850 cp852 cp855 - cp856 cp857 cp860 cp861 cp862 cp863 cp864 cp865 cp866 cp869 - cp874 cp875 cp932 cp936 cp949 cp950 dingbats euc-cn euc-jp - euc-kr gb12345-raw gb2312-raw gsm0338 hp-roman8 hz iso-2022-jp - iso-2022-jp-1 iso-2022-kr iso-8859-1 iso-8859-10 iso-8859-11 - iso-8859-13 iso-8859-14 iso-8859-15 iso-8859-16 iso-8859-2 - iso-8859-3 iso-8859-4 iso-8859-5 iso-8859-6 iso-8859-7 iso-8859-8 - iso-8859-9 iso-ir-165 jis0201-raw jis0208-raw jis0212-raw - johab koi8-f koi8-r koi8-u ksc5601-raw MacArabic MacCentralEurRoman - MacChineseSimp MacChineseTrad MacCroatian MacCyrillic MacDingbats - MacFarsi MacGreek MacHebrew MacIcelandic MacJapanese MacKorean - MacRoman MacRomanian MacRumanian MacSami MacSymbol MacThai - MacTurkish MacUkrainian MIME-B MIME-Header MIME-Q nextstep - null posix-bc shiftjis symbol UCS-2BE UCS-2LE UTF-16 UTF-16BE - UTF-16LE UTF-32 UTF-32BE UTF-32LE UTF-7 utf8 viscii] - </Para> - </over-text> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/pasternak_cp1251.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/pasternak_cp1251.txt deleted file mode 100644 index 4d8f7a09a6d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/pasternak_cp1251.txt +++ /dev/null @@ -1,108 +0,0 @@ -
-=encoding cp1251
-
-=head1 NAME
-
- -- Pasternak Russian test file (cp1251)
-
-=head1 TEXT
-
-(This is a test Pod pocument in cp1251.)
-
- .
-
-, /
- . /
- , /
- .
-
- /
- , /
- /
- .
-
- /
- . /
- , /
- .
-
- /
- , /
- , , /
- .
-
- /
- , /
- /
- .
-
- /
- . /
- , /
- .
-
- , /
- /
-, , /
-. /
-
- , /
- /
- , /
- .
-
--- , 1946
-
-
-=head2 As Preformatted
-
-And now as a preformatted section:
-
- .
-
- ,
- .
- ,
- .
-
-
- ,
-
- .
-
-
- .
- ,
- .
-
-
- ,
- , ,
- .
-
-
- ,
-
- .
-
-
- .
- ,
- .
-
- ,
-
- , ,
- .
-
- ,
-
- ,
- .
-
- -- , 1946
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/pasternak_cp1251.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/pasternak_cp1251.xml deleted file mode 100644 index 2276551b31c..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/pasternak_cp1251.xml +++ /dev/null @@ -1,211 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - Зимняя ночь - -- Pasternak Russian test file (cp1251) - </Para> - <head1 start_line="8"> - TEXT - </head1> - <Para start_line="10"> - (This is a test Pod pocument in cp1251.) - </Para> - <Para start_line="12"> - Зимняя ночь. - </Para> - <Para start_line="14"> - Мело, мело - по всей земле - / Во все пределы. - / Свеча горела - на столе, / Свеча - горела. - </Para> - <Para start_line="19"> - Как летом - роем мошкора - / Летит на пламя, - / Слетались - хлопья со - двора / К оконной - раме. - </Para> - <Para start_line="24"> - Метель лепила - на столе / Кружки - и стрелы. / Свеча - горела на - столе, / Свеча - горела. - </Para> - <Para start_line="29"> - На озаренный - потолок / Ложились - тени, / Скрещенья - рук, скркщенья - ног, / Судьбы - скрещенья. - </Para> - <Para start_line="34"> - И падали два - башмачка - / Со стуком - на пол, / И воск - слезами с - ночника / На - платье капал. - </Para> - <Para start_line="39"> - И все терялось - в снежной - мгле / Седой - и белой. / Свеча - горела на - столе, / Свеча - горела. - </Para> - <Para start_line="44"> - На свечку - дуло из угла, - / И жар соблазна - / Вздымал, как - ангел, два - крыла / Крестообразно. - / - </Para> - <Para start_line="49"> - Мело весь - месяц в феврале, - / И то и дело - / Свеча горела - на столе, / Свеча - горела. - </Para> - <Para start_line="54"> - -- Борис Пастернак, - 1946 - </Para> - <head2 start_line="57"> - As Preformatted - </head2> - <Para start_line="59"> - And now as a preformatted section: - </Para> - <VerbatimFormatted start_line="61" xml:space="preserve"> - Зимняя ночь. - - - - Мело, мело - по всей земле - - Во все пределы. - - Свеча горела - на столе, - - Свеча горела. - - - - Как летом - роем мошкора - - Летит на пламя, - - Слетались - хлопья со - двора - - К оконной - раме. - - - - Метель лепила - на столе - - Кружки и стрелы. - - Свеча горела - на столе, - - Свеча горела. - - - - На озаренный - потолок - - Ложились - тени, - - Скрещенья - рук, скркщенья - ног, - - Судьбы скрещенья. - - - - И падали два - башмачка - - Со стуком - на пол, - - И воск слезами - с ночника - - На платье - капал. - - - - И все терялось - в снежной - мгле - - Седой и белой. - - Свеча горела - на столе, - - Свеча горела. - - - - На свечку - дуло из угла, - - И жар соблазна - - Вздымал, как - ангел, два - крыла - - Крестообразно. - - - - Мело весь - месяц в феврале, - - И то и дело - - Свеча горела - на столе, - - Свеча горела. - - - - -- Борис Пастернак, - 1946 - </VerbatimFormatted> - <Para start_line="105"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain.txt deleted file mode 100644 index 4b7d7d9296a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain.txt +++ /dev/null @@ -1,20 +0,0 @@ -
-=head1 NAME
-
-simple_text_document -- an implicitly US-ASCII test document.
-
-=head1 TEXT
-
-The quick brown fox jumps over the lazy dog.
-
-Military Intelligence Yukon rhosts penrep Weekly World News DSD Time
-Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP
-
-CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage
-KGB ^? 737 1080H 1080H Satellite imagery smuggle
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain.xml deleted file mode 100644 index 05dc732ee5a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain.xml +++ /dev/null @@ -1,26 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - simple_text_document -- an implicitly US-ASCII test document. - </Para> - <head1 start_line="6"> - TEXT - </head1> - <Para start_line="8"> - The quick brown fox jumps over the lazy dog. - </Para> - <Para start_line="10"> - Military Intelligence Yukon rhosts penrep Weekly World News - DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA - CCS DEVGRP - </Para> - <Para start_line="13"> - CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex - garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle - </Para> - <Para start_line="16"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_explicit.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_explicit.txt deleted file mode 100644 index a465ac2ed75..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_explicit.txt +++ /dev/null @@ -1,22 +0,0 @@ -
-=encoding ascii
-
-=head1 NAME
-
-simple_text_document -- an explicitly US-ASCII test document.
-
-=head1 TEXT
-
-The quick brown fox jumps over the lazy dog.
-
-Military Intelligence Yukon rhosts penrep Weekly World News DSD Time
-Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP
-
-CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage
-KGB ^? 737 1080H 1080H Satellite imagery smuggle
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_explicit.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_explicit.xml deleted file mode 100644 index 1db06b81f8d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_explicit.xml +++ /dev/null @@ -1,26 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - simple_text_document -- an explicitly US-ASCII test document. - </Para> - <head1 start_line="8"> - TEXT - </head1> - <Para start_line="10"> - The quick brown fox jumps over the lazy dog. - </Para> - <Para start_line="12"> - Military Intelligence Yukon rhosts penrep Weekly World News - DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA - CCS DEVGRP - </Para> - <Para start_line="15"> - CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex - garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle - </Para> - <Para start_line="18"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_latin1.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_latin1.txt deleted file mode 100644 index 4d185bbb058..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_latin1.txt +++ /dev/null @@ -1,24 +0,0 @@ -
-#Doesn't actually use any of the Latin-1 bytes.
-
-=encoding iso-8859-1
-
-=head1 NAME
-
-simple_text_document -- an explicitly Latin-1 (ASCII subset) test document
-
-=head1 TEXT
-
-The quick brown fox jumps over the lazy dog.
-
-Military Intelligence Yukon rhosts penrep Weekly World News DSD Time
-Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP
-
-CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage
-KGB ^? 737 1080H 1080H Satellite imagery smuggle
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_latin1.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_latin1.xml deleted file mode 100644 index 74f9baeb739..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_latin1.xml +++ /dev/null @@ -1,27 +0,0 @@ -<Document start_line="4"> - <head1 start_line="6"> - NAME - </head1> - <Para start_line="8"> - simple_text_document -- an explicitly Latin-1 (ASCII subset) - test document - </Para> - <head1 start_line="10"> - TEXT - </head1> - <Para start_line="12"> - The quick brown fox jumps over the lazy dog. - </Para> - <Para start_line="14"> - Military Intelligence Yukon rhosts penrep Weekly World News - DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA - CCS DEVGRP - </Para> - <Para start_line="17"> - CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex - garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle - </Para> - <Para start_line="20"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_utf8.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_utf8.txt deleted file mode 100644 index f3e6932bb05..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_utf8.txt +++ /dev/null @@ -1,24 +0,0 @@ -
-#Doesn't actually use any of the utf8 bytes.
-
-=encoding utf8
-
-=head1 NAME
-
-simple_text_document -- an explicitly UTF8 (ASCII subset) test document
-
-=head1 TEXT
-
-The quick brown fox jumps over the lazy dog.
-
-Military Intelligence Yukon rhosts penrep Weekly World News DSD Time
-Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP
-
-CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage
-KGB ^? 737 1080H 1080H Satellite imagery smuggle
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_utf8.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_utf8.xml deleted file mode 100644 index f78846b54ac..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/plain_utf8.xml +++ /dev/null @@ -1,27 +0,0 @@ -<Document start_line="4"> - <head1 start_line="6"> - NAME - </head1> - <Para start_line="8"> - simple_text_document -- an explicitly UTF8 (ASCII subset) - test document - </Para> - <head1 start_line="10"> - TEXT - </head1> - <Para start_line="12"> - The quick brown fox jumps over the lazy dog. - </Para> - <Para start_line="14"> - Military Intelligence Yukon rhosts penrep Weekly World News - DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA - CCS DEVGRP - </Para> - <Para start_line="17"> - CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex - garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle - </Para> - <Para start_line="20"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/polish_utf8.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/polish_utf8.txt deleted file mode 100644 index 969f8ba4a11..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/polish_utf8.txt +++ /dev/null @@ -1,69 +0,0 @@ -
-=encoding utf8
-
-=head1 NAME
-
-WŚRÓD NOCNEJ CISZY -- explicitly utf8 test document in Polish
-
-=head1 DESCRIPTION
-
-This is a test Pod document in UTF8. Its content is the lyrics to
-the Polish Christmas carol "Wśród nocnej ciszy".
-
-Wśród nocnej ciszy głos się rozchodzi: /
-Wstańcie, pasterze, Bóg się nam rodzi! /
-Czym prędzej się wybierajcie, /
-Do Betlejem pospieszajcie /
-Przywitać Pana.
-
-Poszli, znaleźli Dzieciątko w żłobie /
-Z wszystkimi znaki danymi sobie. /
-Jako Bogu cześć Mu dali, /
-A witając zawołali /
-Z wielkiej radości:
-
-Ach, witaj Zbawco z dawno żądany, /
-Wiele tysięcy lat wyglądany /
-Na Ciebie króle, prorocy /
-Czekali, a Tyś tej nocy /
-Nam się objawił.
-
-I my czekamy na Ciebie, Pana, /
-A skoro przyjdziesz na głos kapłana, /
-Padniemy na twarz przed Tobą, /
-Wierząc, żeś jest pod osłoną /
-Chleba i wina.
-
-=head2 As Verbatim
-
-And now as verbatim text:
-
- Wśród nocnej ciszy głos się rozchodzi:
- Wstańcie, pasterze, Bóg się nam rodzi!
- Czym prędzej się wybierajcie,
- Do Betlejem pospieszajcie
- Przywitać Pana.
-
- Poszli, znaleźli Dzieciątko w żłobie
- Z wszystkimi znaki danymi sobie.
- Jako Bogu cześć Mu dali,
- A witając zawołali
- Z wielkiej radości:
-
- Ach, witaj Zbawco z dawno żądany,
- Wiele tysięcy lat wyglądany
- Na Ciebie króle, prorocy
- Czekali, a Tyś tej nocy
- Nam się objawił.
-
- I my czekamy na Ciebie, Pana,
- A skoro przyjdziesz na głos kapłana,
- Padniemy na twarz przed Tobą,
- Wierząc, żeś jest pod osłoną
- Chleba i wina.
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/polish_utf8.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/polish_utf8.xml deleted file mode 100644 index 1aa77ec0295..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/polish_utf8.xml +++ /dev/null @@ -1,94 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - WŚRÓD NOCNEJ CISZY -- explicitly utf8 test document - in Polish - </Para> - <head1 start_line="8"> - DESCRIPTION - </head1> - <Para start_line="10"> - This is a test Pod document in UTF8. Its content is the - lyrics to the Polish Christmas carol "Wśród - nocnej ciszy". - </Para> - <Para start_line="13"> - Wśród nocnej ciszy głos się rozchodzi: - / Wstańcie, pasterze, Bóg się nam rodzi! - / Czym prędzej się wybierajcie, / Do Betlejem - pospieszajcie / Przywitać Pana. - </Para> - <Para start_line="19"> - Poszli, znaleźli Dzieciątko w żłobie - / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć - Mu dali, / A witając zawołali / Z wielkiej radości: - </Para> - <Para start_line="25"> - Ach, witaj Zbawco z dawno żądany, / Wiele tysięcy - lat wyglądany / Na Ciebie króle, prorocy / Czekali, - a Tyś tej nocy / Nam się objawił. - </Para> - <Para start_line="31"> - I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na głos - kapłana, / Padniemy na twarz przed Tobą, / Wierząc, - żeś jest pod osłoną / Chleba i wina. - </Para> - <head2 start_line="37"> - As Verbatim - </head2> - <Para start_line="39"> - And now as verbatim text: - </Para> - <VerbatimFormatted start_line="41" xml:space="preserve"> - Wśród nocnej ciszy głos się rozchodzi: - - Wstańcie, pasterze, Bóg się nam rodzi! - - Czym prędzej się wybierajcie, - - Do Betlejem pospieszajcie - - Przywitać Pana. - - - - Poszli, znaleźli Dzieciątko w żłobie - - Z wszystkimi znaki danymi sobie. - - Jako Bogu cześć Mu dali, - - A witając zawołali - - Z wielkiej radości: - - - - Ach, witaj Zbawco z dawno żądany, - - Wiele tysięcy lat wyglądany - - Na Ciebie króle, prorocy - - Czekali, a Tyś tej nocy - - Nam się objawił. - - - - I my czekamy na Ciebie, Pana, - - A skoro przyjdziesz na głos kapłana, - - Padniemy na twarz przed Tobą, - - Wierząc, żeś jest pod osłoną - - Chleba i wina. - </VerbatimFormatted> - <Para start_line="65"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/s2763_sjis.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/s2763_sjis.txt deleted file mode 100644 index d495734922b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/s2763_sjis.txt +++ /dev/null @@ -1,48 +0,0 @@ -
-=encoding shiftjis
-
-=head1 NAME
-
-^S2763 -- test document in Shift-JIS
-
-=head1 DESCRIPTION
-
-This is a test Pod document in Shift-JIS. Its content is
-some uninteresting product specs I found on the Net.
-
-It's an textitem list:
-
-=over
-
-=item ^
-
-S2763
-
-=item
-
-GZ4 _CNCbN~[v 12V 10W~1
-
-=item @
-
-E295 E365 E76mm
-
-=item
-
-8.0kg
-
-=item ގ
-
-@A~AA}Cgd@KX
-
-=item i
-
-76,000~ivEgX݁j
-
-=back
-
-2001N103ijJn
-
-[end]
-
-=cut
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/s2763_sjis.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/s2763_sjis.xml deleted file mode 100644 index 55a4fd00274..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/s2763_sjis.xml +++ /dev/null @@ -1,64 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - 型番S2763 -- test document in Shift-JIS - </Para> - <head1 start_line="8"> - DESCRIPTION - </head1> - <Para start_line="10"> - This is a test Pod document in Shift-JIS. Its content is - some uninteresting product specs I found on the Net. - </Para> - <Para start_line="13"> - It's an textitem list: - </Para> - <over-text indent="4" start_line="15"> - <item-text start_line="17"> - 型番 - </item-text> - <Para start_line="19"> - S2763 - </Para> - <item-text start_line="21"> - 光源 - </item-text> - <Para start_line="23"> - GZ4 ダイクロイックミラーランプ - 12V 10W×1 - </Para> - <item-text start_line="25"> - 寸法 - </item-text> - <Para start_line="27"> - 高・295 幅・365 奥・76mm - </Para> - <item-text start_line="29"> - 質量 - </item-text> - <Para start_line="31"> - 8.0kg - </Para> - <item-text start_line="33"> - 材質 - </item-text> - <Para start_line="35"> - 樹脂 アルミ、アルマイト仕上 - ガラス - </Para> - <item-text start_line="37"> - 価格 - </item-text> - <Para start_line="39"> - 76,000円（ランプ・トランス込み） - </Para> - </over-text> - <Para start_line="43"> - 2001年10月3日（水）発売開始 - </Para> - <Para start_line="45"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/thai_iso11.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/thai_iso11.txt deleted file mode 100644 index 9fdcdab5619..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/thai_iso11.txt +++ /dev/null @@ -1,64 +0,0 @@ -
-=head1 NAME
-
-Khun::Thong::Dang -- a test Thai document in ISO-8859-11
-
-=head1 DESCRIPTION
-
-=encoding iso-8859-11
-
-This is a test Pod document in ISO-8859-11. Its content is a poem to (by?)
-Khun Thong Dang (Ҿ), the pet of Bhumibol, the King of
-Thailand.
-
-As four flowed paragraphs:
-
- Ѻ伷 /
-з§...ͧҾԶ¶ /
- §༴§ /
-зСس蹴ǧҹ
-
- ءҾ /
-͡Ӥ /
-ҡ繤سͧᴧѡѡҹ /
-ҤºԾ
-
- ѵحçԡҾԡ /
-ɰǵʧ /
-з ʼͧͧʡ /
-ؤźҷҧҧ
-
- ԴͧҪѹѹ /
-蹤褧ʧ /
-ôҪɮҡͧ /
-зѺǹء
-
-=head2 Verbatim Section
-
-And as a verbatim section:
-
- Ѻ伷
- з§...ͧҾԶ¶
- §༴§
- зСس蹴ǧҹ
-
- ءҾ
- ͡Ӥ
- ҡ繤سͧᴧѡѡҹ
- ҤºԾ
-
- ѵحçԡҾԡ
- ɰǵʧ
- з ʼͧͧʡ
- ؤźҷҧҧ
-
- ԴͧҪѹѹ
- 蹤褧ʧ
- ôҪɮҡͧ
- зѺǹء
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/thai_iso11.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/thai_iso11.xml deleted file mode 100644 index a9f4bb7a6eb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus/thai_iso11.xml +++ /dev/null @@ -1,93 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - Khun::Thong::Dang -- a test Thai document in ISO-8859-11 - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="10"> - This is a test Pod document in ISO-8859-11. Its content - is a poem to (by?) Khun Thong Dang (ภาพมิ่งมงคล), - the pet of Bhumibol, the King of Thailand. - </Para> - <Para start_line="14"> - As four flowed paragraphs: - </Para> - <Para start_line="16"> - ๏ พระเมตตาแจ่มจับใจไผทสยาม - / พระทัยงาม...มองภาพถ่ายมิถ่ายถอน - / เกล้าฯ น้อมเกล้าฯ - พจน์เรียงเผดียงกลอน - / สื่อสะท้อนพระการุณย์อุ่นดวงมาน๚ - </Para> - <Para start_line="21"> - ๏ ทุกภาพมิ่งมงคลยลแล้วยิ้ม - / เอื้ออกอิ่มล้ำค่ามหาศาล - / อยากเป็นคุณทองแดงนักจักอยู่งาน - / เฝ้าคลอเคลียบทมาลย์พระภูมิพล๚ - </Para> - <Para start_line="26"> - ๏ พระหัตถ์บุญทรงเบิกหล้าพลิกหล้าเขียว - / พระโอษฐ์เรียวตรัสห้ามสงครามฉล - / พระทัย ธ โอภาสผ่องถ่องสกล - / พระยุคลบาทย่างสืบสร้างไทย๚ - </Para> - <Para start_line="31"> - ๏ น้อมเกล้าเทิดองค์ราชันศรันย์ศรี - / บารมีหมื่นคู่คงอสงไขย - / กรรดิราชกฤษฎาก้องหล้าไกล - / ปลื้มประทับถ้วนทุกใจแห่งไท้เอย๚ะ๛ - </Para> - <head2 start_line="36"> - Verbatim Section - </head2> - <Para start_line="38"> - And as a verbatim section: - </Para> - <VerbatimFormatted start_line="40" xml:space="preserve"> - ๏ พระเมตตาแจ่มจับใจไผทสยาม - - พระทัยงาม...มองภาพถ่ายมิถ่ายถอน - - เกล้าฯ น้อมเกล้าฯ - พจน์เรียงเผดียงกลอน - - สื่อสะท้อนพระการุณย์อุ่นดวงมาน๚ - - - - ๏ ทุกภาพมิ่งมงคลยลแล้วยิ้ม - - เอื้ออกอิ่มล้ำค่ามหาศาล - - อยากเป็นคุณทองแดงนักจักอยู่งาน - - เฝ้าคลอเคลียบทมาลย์พระภูมิพล๚ - - - - ๏ พระหัตถ์บุญทรงเบิกหล้าพลิกหล้าเขียว - - พระโอษฐ์เรียวตรัสห้ามสงครามฉล - - พระทัย ธ โอภาสผ่องถ่องสกล - - พระยุคลบาทย่างสืบสร้างไทย๚ - - - - ๏ น้อมเกล้าเทิดองค์ราชันศรันย์ศรี - - บารมีหมื่นคู่คงอสงไขย - - กรรดิราชกฤษฎาก้องหล้าไกล - - ปลื้มประทับถ้วนทุกใจแห่งไท้เอย๚ะ๛ - </VerbatimFormatted> - <Para start_line="60"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/fiqhakbar_iso6.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/fiqhakbar_iso6.txt deleted file mode 100644 index db124abbeeb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/fiqhakbar_iso6.txt +++ /dev/null @@ -1,84 +0,0 @@ - -=encoding iso-8859-6 - -=head1 NAME - - -- test document: "al-Fiqh al-Akbar" as ISO-8859-6 - -=head1 DESCRIPTION - -This document is Abu Hanifah's "al-Fiqh al-Akbar" as ISO-8859-6, presented -as an item-number list: - - - - - -=over - -=item 1 - - . - -=item 2 - - . - -=item 3 - - . - -=item 4 - - . - -=item 5 - - . - -=item 6 - - . - -=item 7 - - . - -=item 8 - - . - -=item 9 - - . - -=item 10 - - . - -=back - -And now run together as a paragraph: - - . - . - . - . - . - . - . - . - . - . - -And now the first three as a verbatim section: - - . - . - . - -[end] - -=cut - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/fiqhakbar_iso6.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/fiqhakbar_iso6.xml deleted file mode 100644 index 1ff04978d20..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/fiqhakbar_iso6.xml +++ /dev/null @@ -1,168 +0,0 @@ -<Document start_line="2"> - <head1 start_line="4"> - NAME - </head1> - <Para start_line="6"> - متن الفقه - الاكبر -- test document: - "al-Fiqh al-Akbar" as ISO-8859-6 - </Para> - <head1 start_line="8"> - DESCRIPTION - </head1> - <Para start_line="10"> - This document is Abu Hanifah's "al-Fiqh al-Akbar" - as ISO-8859-6, presented as an item-number list: - </Para> - <Para start_line="13"> - متن الفقه - الاكبر - </Para> - <Para start_line="15"> - المنسوب الى - ابي حنيفة - النعمان بن - ثابت - </Para> - <over-number indent="4" start_line="17"> - <item-number number="1" start_line="19"> - لا نكفر أحدا - بذنب ولا ننفي - أحدا من الايمان - . - </item-number> - <item-number number="2" start_line="23"> - إنا نأمر بالمعروف - وننهي عن المنكر - . - </item-number> - <item-number number="3" start_line="27"> - واعلم أن ما - أصابك لم يكن - ليخطئك ، وما - أخطأك لم يكن - ليصيبك . - </item-number> - <item-number number="4" start_line="31"> - لا نتبرأ من - أحد من أصحاب - رسول الله - صلى الله عليه - وسلم ولا يتوالى - أحد دون أحد - . - </item-number> - <item-number number="5" start_line="35"> - إنا نرد أمر - عثمان وعلي - الى الله وهو - عالم السر - والخفيات - . - </item-number> - <item-number number="6" start_line="39"> - الفقه في الدين - أفضل من الفقه - في العلم . - </item-number> - <item-number number="7" start_line="43"> - واختلاف الامة - رحمة . - </item-number> - <item-number number="8" start_line="47"> - من آمن بجميع - ما يؤمر به - الا أنه قال - لا أعرف موسى - وعيسى عليهما - السلام أمن - المرسلين - أم من غير المرسلين - فإنه يكفر - . - </item-number> - <item-number number="9" start_line="51"> - من قال لا أعرف - الله أفي السماء - أم في الارض - فقد كفر . - </item-number> - <item-number number="10" start_line="55"> - من قال لا أعرف - عذاب القبر - فهو من الطبقة - الجهمية والهالكية - . - </item-number> - </over-number> - <Para start_line="61"> - And now run together as a paragraph: - </Para> - <Para start_line="63"> - لا نكفر أحدا - بذنب ولا ننفي - أحدا من الايمان - . إنا نأمر بالمعروف - وننهي عن المنكر - . واعلم أن ما - أصابك لم يكن - ليخطئك ، وما - أخطأك لم يكن - ليصيبك . لا - نتبرأ من أحد - من أصحاب رسول - الله صلى الله - عليه وسلم - ولا يتوالى - أحد دون أحد - . إنا نرد أمر - عثمان وعلي - الى الله وهو - عالم السر - والخفيات - . الفقه في الدين - أفضل من الفقه - في العلم . واختلاف - الامة رحمة - . من آمن بجميع - ما يؤمر به - الا أنه قال - لا أعرف موسى - وعيسى عليهما - السلام أمن - المرسلين - أم من غير المرسلين - فإنه يكفر - . من قال لا أعرف - الله أفي السماء - أم في الارض - فقد كفر . من - قال لا أعرف - عذاب القبر - فهو من الطبقة - الجهمية والهالكية - . - </Para> - <Para start_line="74"> - And now the first three as a verbatim section: - </Para> - <VerbatimFormatted start_line="76" xml:space="preserve"> - لا نكفر أحدا - بذنب ولا ننفي - أحدا من الايمان - . - - إنا نأمر بالمعروف - وننهي عن المنكر - . - - واعلم أن ما - أصابك لم يكن - ليخطئك ، وما - أخطأك لم يكن - ليصيبك . - </VerbatimFormatted> - <Para start_line="80"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_implicit_utf8.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_implicit_utf8.txt deleted file mode 100644 index 54c41599ee4..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_implicit_utf8.txt +++ /dev/null @@ -1,67 +0,0 @@ - -=head1 NAME - -WŚRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish - -=head1 DESCRIPTION - -This is a test Pod document in UTF8. Its content is the lyrics to -the Polish Christmas carol "Wśród nocnej ciszy". - -Wśród nocnej ciszy głos się rozchodzi: / -Wstańcie, pasterze, Bóg się nam rodzi! / -Czym prędzej się wybierajcie, / -Do Betlejem pospieszajcie / -Przywitać Pana. - -Poszli, znaleźli Dzieciątko w żłobie / -Z wszystkimi znaki danymi sobie. / -Jako Bogu cześć Mu dali, / -A witając zawołali / -Z wielkiej radości: - -Ach, witaj Zbawco z dawno żądany, / -Wiele tysięcy lat wyglądany / -Na Ciebie króle, prorocy / -Czekali, a Tyś tej nocy / -Nam się objawił. - -I my czekamy na Ciebie, Pana, / -A skoro przyjdziesz na głos kapłana, / -Padniemy na twarz przed Tobą, / -Wierząc, żeś jest pod osłoną / -Chleba i wina. - -=head2 As Verbatim - -And now as verbatim text: - - Wśród nocnej ciszy głos się rozchodzi: - Wstańcie, pasterze, Bóg się nam rodzi! - Czym prędzej się wybierajcie, - Do Betlejem pospieszajcie - Przywitać Pana. - - Poszli, znaleźli Dzieciątko w żłobie - Z wszystkimi znaki danymi sobie. - Jako Bogu cześć Mu dali, - A witając zawołali - Z wielkiej radości: - - Ach, witaj Zbawco z dawno żądany, - Wiele tysięcy lat wyglądany - Na Ciebie króle, prorocy - Czekali, a Tyś tej nocy - Nam się objawił. - - I my czekamy na Ciebie, Pana, - A skoro przyjdziesz na głos kapłana, - Padniemy na twarz przed Tobą, - Wierząc, żeś jest pod osłoną - Chleba i wina. - -[end] - -=cut - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf16be_bom.txt.packed b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf16be_bom.txt.packed deleted file mode 100644 index bf333c899bb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf16be_bom.txt.packed +++ /dev/null @@ -1,83 +0,0 @@ -######################################################################### -This is a binary file that was packed with the 'uupacktool.pl' which -is included in the Perl distribution. - -To unpack this file use the following command: - - uupacktool.pl -u polish_utf16be_bom.txt.packed polish_utf16be_bom.txt - -To recreate it use the following command: - - uupacktool.pl -p polish_utf16be_bom.txt polish_utf16be_bom.txt.packed - -Created at Thu Mar 22 13:56:57 2007 -######################################################################### -__UU__ -M_O\`#0`*`#T`:`!E`&$`9``Q`"``3@!!`$T`10`-``H`#0`*`%<!6@!2`-,` -M1``@`$X`3P!#`$X`10!*`"``0P!)`%,`6@!9`"``+0`M`"``:0!M`'``;`!I -M`&,`:0!T`&P`>0`@`'4`=`!F`#@`(`!T`&4`<P!T`"``9`!O`&,`=0!M`&4` -M;@!T`"``:0!N`"``4`!O`&P`:0!S`&@`#0`*``T`"@`]`&@`90!A`&0`,0`@ -M`$0`10!3`$,`4@!)`%``5`!)`$\`3@`-``H`#0`*`%0`:`!I`',`(`!I`',` -M(`!A`"``=`!E`',`=``@`%``;P!D`"``9`!O`&,`=0!M`&4`;@!T`"``:0!N -M`"``50!4`$8`.``N`"``(`!)`'0`<P`@`&,`;P!N`'0`90!N`'0`(`!I`',` -M(`!T`&@`90`@`&P`>0!R`&D`8P!S`"``=`!O``T`"@!T`&@`90`@`%``;P!L -M`&D`<P!H`"``0P!H`'(`:0!S`'0`;0!A`',`(`!C`&$`<@!O`&P`(``B`%<! -M6P!R`/,`9``@`&X`;P!C`&X`90!J`"``8P!I`',`>@!Y`"(`+@`-``H`#0`* -M`%<!6P!R`/,`9``@`&X`;P!C`&X`90!J`"``8P!I`',`>@!Y`"``9P%"`&\` -M<P`@`',`:0$9`"``<@!O`'H`8P!H`&\`9`!Z`&D`.@`@`"\`#0`*`%<`<P!T -M`&$!1`!C`&D`90`L`"``<`!A`',`=`!E`'(`>@!E`"P`(`!"`/,`9P`@`',` -M:0$9`"``;@!A`&T`(`!R`&\`9`!Z`&D`(0`@`"\`#0`*`$,`>@!Y`&T`(`!P -M`'(!&0!D`'H`90!J`"``<P!I`1D`(`!W`'D`8@!I`&4`<@!A`&H`8P!I`&4` -M+``@`"\`#0`*`$0`;P`@`$(`90!T`&P`90!J`&4`;0`@`'``;P!S`'``:0!E -M`',`>@!A`&H`8P!I`&4`(``O``T`"@!0`'(`>@!Y`'<`:0!T`&$!!P`@`%`` -M80!N`&$`+@`-``H`#0`*`%``;P!S`'H`;`!I`"P`(`!Z`&X`80!L`&4!>@!L -M`&D`(`!$`'H`:0!E`&,`:0$%`'0`:P!O`"``=P`@`7P!0@!O`&(`:0!E`"`` -M+P`-``H`6@`@`'<`<P!Z`'D`<P!T`&L`:0!M`&D`(`!Z`&X`80!K`&D`(`!D -M`&$`;@!Y`&T`:0`@`',`;P!B`&D`90`N`"``+P`-``H`2@!A`&L`;P`@`$(` -M;P!G`'4`(`!C`'H`90%;`0<`(`!-`'4`(`!D`&$`;`!I`"P`(``O``T`"@!! -M`"``=P!I`'0`80!J`04`8P`@`'H`80!W`&\!0@!A`&P`:0`@`"\`#0`*`%H` -M(`!W`&D`90!L`&L`:0!E`&H`(`!R`&$`9`!O`5L`8P!I`#H`#0`*``T`"@!! -M`&,`:``L`"``=P!I`'0`80!J`"``6@!B`&$`=P!C`&\`(`!Z`"``9`!A`'<` -M;@!O`"`!?`$%`&0`80!N`'D`+``@`"\`#0`*`%<`:0!E`&P`90`@`'0`>0!S -M`&D!&0!C`'D`(`!L`&$`=``@`'<`>0!G`&P!!0!D`&$`;@!Y`"``+P`-``H` -M3@!A`"``0P!I`&4`8@!I`&4`(`!K`'(`\P!L`&4`+``@`'``<@!O`'(`;P!C -M`'D`(``O``T`"@!#`'H`90!K`&$`;`!I`"P`(`!A`"``5`!Y`5L`(`!T`&4` -M:@`@`&X`;P!C`'D`(``O``T`"@!.`&$`;0`@`',`:0$9`"``;P!B`&H`80!W -M`&D!0@`N``T`"@`-``H`20`@`&T`>0`@`&,`>@!E`&L`80!M`'D`(`!N`&$` -M(`!#`&D`90!B`&D`90`L`"``4`!A`&X`80`L`"``+P`-``H`00`@`',`:P!O -M`'(`;P`@`'``<@!Z`'D`:@!D`'H`:0!E`',`>@`@`&X`80`@`&<!0@!O`',` -M(`!K`&$`<`%"`&$`;@!A`"P`(``O``T`"@!0`&$`9`!N`&D`90!M`'D`(`!N -M`&$`(`!T`'<`80!R`'H`(`!P`'(`>@!E`&0`(`!4`&\`8@$%`"P`(``O``T` -M"@!7`&D`90!R`'H!!0!C`"P`(`%\`&4!6P`@`&H`90!S`'0`(`!P`&\`9``@ -M`&\`<P%"`&\`;@$%`"``+P`-``H`0P!H`&P`90!B`&$`(`!I`"``=P!I`&X` -M80`N``T`"@`-``H`/0!H`&4`80!D`#(`(`!!`',`(`!6`&4`<@!B`&$`=`!I -M`&T`#0`*``T`"@!!`&X`9``@`&X`;P!W`"``80!S`"``=@!E`'(`8@!A`'0` -M:0!M`"``=`!E`'@`=``Z``T`"@`-``H`(``@`%<!6P!R`/,`9``@`&X`;P!C -M`&X`90!J`"``8P!I`',`>@!Y`"``9P%"`&\`<P`@`',`:0$9`"``<@!O`'H` -M8P!H`&\`9`!Z`&D`.@`-``H`(``@`%<`<P!T`&$!1`!C`&D`90`L`"``<`!A -M`',`=`!E`'(`>@!E`"P`(`!"`/,`9P`@`',`:0$9`"``;@!A`&T`(`!R`&\` -M9`!Z`&D`(0`-``H`(``@`$,`>@!Y`&T`(`!P`'(!&0!D`'H`90!J`"``<P!I -M`1D`(`!W`'D`8@!I`&4`<@!A`&H`8P!I`&4`+``-``H`(``@`$0`;P`@`$(` -M90!T`&P`90!J`&4`;0`@`'``;P!S`'``:0!E`',`>@!A`&H`8P!I`&4`#0`* -M`"``(`!0`'(`>@!Y`'<`:0!T`&$!!P`@`%``80!N`&$`+@`-``H`#0`*`"`` -M(`!0`&\`<P!Z`&P`:0`L`"``>@!N`&$`;`!E`7H`;`!I`"``1`!Z`&D`90!C -M`&D!!0!T`&L`;P`@`'<`(`%\`4(`;P!B`&D`90`-``H`(``@`%H`(`!W`',` -M>@!Y`',`=`!K`&D`;0!I`"``>@!N`&$`:P!I`"``9`!A`&X`>0!M`&D`(`!S -M`&\`8@!I`&4`+@`-``H`(``@`$H`80!K`&\`(`!"`&\`9P!U`"``8P!Z`&4! -M6P$'`"``30!U`"``9`!A`&P`:0`L``T`"@`@`"``00`@`'<`:0!T`&$`:@$% -M`&,`(`!Z`&$`=P!O`4(`80!L`&D`#0`*`"``(`!:`"``=P!I`&4`;`!K`&D` -M90!J`"``<@!A`&0`;P%;`&,`:0`Z``T`"@`-``H`(``@`$$`8P!H`"P`(`!W -M`&D`=`!A`&H`(`!:`&(`80!W`&,`;P`@`'H`(`!D`&$`=P!N`&\`(`%\`04` -M9`!A`&X`>0`L``T`"@`@`"``5P!I`&4`;`!E`"``=`!Y`',`:0$9`&,`>0`@ -M`&P`80!T`"``=P!Y`&<`;`$%`&0`80!N`'D`#0`*`"``(`!.`&$`(`!#`&D` -M90!B`&D`90`@`&L`<@#S`&P`90`L`"``<`!R`&\`<@!O`&,`>0`-``H`(``@ -M`$,`>@!E`&L`80!L`&D`+``@`&$`(`!4`'D!6P`@`'0`90!J`"``;@!O`&,` -M>0`-``H`(``@`$X`80!M`"``<P!I`1D`(`!O`&(`:@!A`'<`:0%"`"X`#0`* -M``T`"@`@`"``20`@`&T`>0`@`&,`>@!E`&L`80!M`'D`(`!N`&$`(`!#`&D` -M90!B`&D`90`L`"``4`!A`&X`80`L``T`"@`@`"``00`@`',`:P!O`'(`;P`@ -M`'``<@!Z`'D`:@!D`'H`:0!E`',`>@`@`&X`80`@`&<!0@!O`',`(`!K`&$` -M<`%"`&$`;@!A`"P`#0`*`"``(`!0`&$`9`!N`&D`90!M`'D`(`!N`&$`(`!T -M`'<`80!R`'H`(`!P`'(`>@!E`&0`(`!4`&\`8@$%`"P`#0`*`"``(`!7`&D` -M90!R`'H!!0!C`"P`(`%\`&4!6P`@`&H`90!S`'0`(`!P`&\`9``@`&\`<P%" -M`&\`;@$%``T`"@`@`"``0P!H`&P`90!B`&$`(`!I`"``=P!I`&X`80`N``T` -K"@`-``H`6P!E`&X`9`!=``T`"@`-``H`/0!C`'4`=``-``H`#0`*``T`"@`` diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf16le_bom.txt.packed b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf16le_bom.txt.packed deleted file mode 100644 index d7d3a19eba0..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf16le_bom.txt.packed +++ /dev/null @@ -1,83 +0,0 @@ -######################################################################### -This is a binary file that was packed with the 'uupacktool.pl' which -is included in the Perl distribution. - -To unpack this file use the following command: - - uupacktool.pl -u polish_utf16le_bom.txt.packed polish_utf16le_bom.txt - -To recreate it use the following command: - - uupacktool.pl -p polish_utf16le_bom.txt polish_utf16le_bom.txt.packed - -Created at Thu Mar 22 14:01:47 2007 -######################################################################### -__UU__ -M__X-``H`/0!H`&4`80!D`#$`(`!.`$$`30!%``T`"@`-``H`5P!:`5(`TP!$ -M`"``3@!/`$,`3@!%`$H`(`!#`$D`4P!:`%D`(``M`"T`(`!I`&T`<`!L`&D` -M8P!I`'0`;`!Y`"``=0!T`&8`.``@`'0`90!S`'0`(`!D`&\`8P!U`&T`90!N -M`'0`(`!I`&X`(`!0`&\`;`!I`',`:``-``H`#0`*`#T`:`!E`&$`9``Q`"`` -M1`!%`%,`0P!2`$D`4`!4`$D`3P!.``T`"@`-``H`5`!H`&D`<P`@`&D`<P`@ -M`&$`(`!T`&4`<P!T`"``4`!O`&0`(`!D`&\`8P!U`&T`90!N`'0`(`!I`&X` -M(`!5`%0`1@`X`"X`(``@`$D`=`!S`"``8P!O`&X`=`!E`&X`=``@`&D`<P`@ -M`'0`:`!E`"``;`!Y`'(`:0!C`',`(`!T`&\`#0`*`'0`:`!E`"``4`!O`&P` -M:0!S`&@`(`!#`&@`<@!I`',`=`!M`&$`<P`@`&,`80!R`&\`;``@`"(`5P!; -M`7(`\P!D`"``;@!O`&,`;@!E`&H`(`!C`&D`<P!Z`'D`(@`N``T`"@`-``H` -M5P!;`7(`\P!D`"``;@!O`&,`;@!E`&H`(`!C`&D`<P!Z`'D`(`!G`$(!;P!S -M`"``<P!I`!D!(`!R`&\`>@!C`&@`;P!D`'H`:0`Z`"``+P`-``H`5P!S`'0` -M80!$`6,`:0!E`"P`(`!P`&$`<P!T`&4`<@!Z`&4`+``@`$(`\P!G`"``<P!I -M`!D!(`!N`&$`;0`@`'(`;P!D`'H`:0`A`"``+P`-``H`0P!Z`'D`;0`@`'`` -M<@`9`60`>@!E`&H`(`!S`&D`&0$@`'<`>0!B`&D`90!R`&$`:@!C`&D`90`L -M`"``+P`-``H`1`!O`"``0@!E`'0`;`!E`&H`90!M`"``<`!O`',`<`!I`&4` -M<P!Z`&$`:@!C`&D`90`@`"\`#0`*`%``<@!Z`'D`=P!I`'0`80`'`2``4`!A -M`&X`80`N``T`"@`-``H`4`!O`',`>@!L`&D`+``@`'H`;@!A`&P`90!Z`6P` -M:0`@`$0`>@!I`&4`8P!I``4!=`!K`&\`(`!W`"``?`%"`6\`8@!I`&4`(``O -M``T`"@!:`"``=P!S`'H`>0!S`'0`:P!I`&T`:0`@`'H`;@!A`&L`:0`@`&0` -M80!N`'D`;0!I`"``<P!O`&(`:0!E`"X`(``O``T`"@!*`&$`:P!O`"``0@!O -M`&<`=0`@`&,`>@!E`%L!!P$@`$T`=0`@`&0`80!L`&D`+``@`"\`#0`*`$$` -M(`!W`&D`=`!A`&H`!0%C`"``>@!A`'<`;P!"`6$`;`!I`"``+P`-``H`6@`@ -M`'<`:0!E`&P`:P!I`&4`:@`@`'(`80!D`&\`6P%C`&D`.@`-``H`#0`*`$$` -M8P!H`"P`(`!W`&D`=`!A`&H`(`!:`&(`80!W`&,`;P`@`'H`(`!D`&$`=P!N -M`&\`(`!\`04!9`!A`&X`>0`L`"``+P`-``H`5P!I`&4`;`!E`"``=`!Y`',` -M:0`9`6,`>0`@`&P`80!T`"``=P!Y`&<`;``%`60`80!N`'D`(``O``T`"@!. -M`&$`(`!#`&D`90!B`&D`90`@`&L`<@#S`&P`90`L`"``<`!R`&\`<@!O`&,` -M>0`@`"\`#0`*`$,`>@!E`&L`80!L`&D`+``@`&$`(`!4`'D`6P$@`'0`90!J -M`"``;@!O`&,`>0`@`"\`#0`*`$X`80!M`"``<P!I`!D!(`!O`&(`:@!A`'<` -M:0!"`2X`#0`*``T`"@!)`"``;0!Y`"``8P!Z`&4`:P!A`&T`>0`@`&X`80`@ -M`$,`:0!E`&(`:0!E`"P`(`!0`&$`;@!A`"P`(``O``T`"@!!`"``<P!K`&\` -M<@!O`"``<`!R`'H`>0!J`&0`>@!I`&4`<P!Z`"``;@!A`"``9P!"`6\`<P`@ -M`&L`80!P`$(!80!N`&$`+``@`"\`#0`*`%``80!D`&X`:0!E`&T`>0`@`&X` -M80`@`'0`=P!A`'(`>@`@`'``<@!Z`&4`9``@`%0`;P!B``4!+``@`"\`#0`* -M`%<`:0!E`'(`>@`%`6,`+``@`'P!90!;`2``:@!E`',`=``@`'``;P!D`"`` -M;P!S`$(!;P!N``4!(``O``T`"@!#`&@`;`!E`&(`80`@`&D`(`!W`&D`;@!A -M`"X`#0`*``T`"@`]`&@`90!A`&0`,@`@`$$`<P`@`%8`90!R`&(`80!T`&D` -M;0`-``H`#0`*`$$`;@!D`"``;@!O`'<`(`!A`',`(`!V`&4`<@!B`&$`=`!I -M`&T`(`!T`&4`>`!T`#H`#0`*``T`"@`@`"``5P!;`7(`\P!D`"``;@!O`&,` -M;@!E`&H`(`!C`&D`<P!Z`'D`(`!G`$(!;P!S`"``<P!I`!D!(`!R`&\`>@!C -M`&@`;P!D`'H`:0`Z``T`"@`@`"``5P!S`'0`80!$`6,`:0!E`"P`(`!P`&$` -M<P!T`&4`<@!Z`&4`+``@`$(`\P!G`"``<P!I`!D!(`!N`&$`;0`@`'(`;P!D -M`'H`:0`A``T`"@`@`"``0P!Z`'D`;0`@`'``<@`9`60`>@!E`&H`(`!S`&D` -M&0$@`'<`>0!B`&D`90!R`&$`:@!C`&D`90`L``T`"@`@`"``1`!O`"``0@!E -M`'0`;`!E`&H`90!M`"``<`!O`',`<`!I`&4`<P!Z`&$`:@!C`&D`90`-``H` -M(``@`%``<@!Z`'D`=P!I`'0`80`'`2``4`!A`&X`80`N``T`"@`-``H`(``@ -M`%``;P!S`'H`;`!I`"P`(`!Z`&X`80!L`&4`>@%L`&D`(`!$`'H`:0!E`&,` -M:0`%`70`:P!O`"``=P`@`'P!0@%O`&(`:0!E``T`"@`@`"``6@`@`'<`<P!Z -M`'D`<P!T`&L`:0!M`&D`(`!Z`&X`80!K`&D`(`!D`&$`;@!Y`&T`:0`@`',` -M;P!B`&D`90`N``T`"@`@`"``2@!A`&L`;P`@`$(`;P!G`'4`(`!C`'H`90!; -M`0<!(`!-`'4`(`!D`&$`;`!I`"P`#0`*`"``(`!!`"``=P!I`'0`80!J``4! -M8P`@`'H`80!W`&\`0@%A`&P`:0`-``H`(``@`%H`(`!W`&D`90!L`&L`:0!E -M`&H`(`!R`&$`9`!O`%L!8P!I`#H`#0`*``T`"@`@`"``00!C`&@`+``@`'<` -M:0!T`&$`:@`@`%H`8@!A`'<`8P!O`"``>@`@`&0`80!W`&X`;P`@`'P!!0%D -M`&$`;@!Y`"P`#0`*`"``(`!7`&D`90!L`&4`(`!T`'D`<P!I`!D!8P!Y`"`` -M;`!A`'0`(`!W`'D`9P!L``4!9`!A`&X`>0`-``H`(``@`$X`80`@`$,`:0!E -M`&(`:0!E`"``:P!R`/,`;`!E`"P`(`!P`'(`;P!R`&\`8P!Y``T`"@`@`"`` -M0P!Z`&4`:P!A`&P`:0`L`"``80`@`%0`>0!;`2``=`!E`&H`(`!N`&\`8P!Y -M``T`"@`@`"``3@!A`&T`(`!S`&D`&0$@`&\`8@!J`&$`=P!I`$(!+@`-``H` -M#0`*`"``(`!)`"``;0!Y`"``8P!Z`&4`:P!A`&T`>0`@`&X`80`@`$,`:0!E -M`&(`:0!E`"P`(`!0`&$`;@!A`"P`#0`*`"``(`!!`"``<P!K`&\`<@!O`"`` -M<`!R`'H`>0!J`&0`>@!I`&4`<P!Z`"``;@!A`"``9P!"`6\`<P`@`&L`80!P -M`$(!80!N`&$`+``-``H`(``@`%``80!D`&X`:0!E`&T`>0`@`&X`80`@`'0` -M=P!A`'(`>@`@`'``<@!Z`&4`9``@`%0`;P!B``4!+``-``H`(``@`%<`:0!E -M`'(`>@`%`6,`+``@`'P!90!;`2``:@!E`',`=``@`'``;P!D`"``;P!S`$(! -M;P!N``4!#0`*`"``(`!#`&@`;`!E`&(`80`@`&D`(`!W`&D`;@!A`"X`#0`* -K``T`"@!;`&4`;@!D`%T`#0`*``T`"@`]`&,`=0!T``T`"@`-``H`#0`*```` diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom.txt deleted file mode 100644 index d15a122fe68..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom.txt +++ /dev/null @@ -1,67 +0,0 @@ -
-=head1 NAME
-
-WŚRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish
-
-=head1 DESCRIPTION
-
-This is a test Pod document in UTF8. Its content is the lyrics to
-the Polish Christmas carol "Wśród nocnej ciszy".
-
-Wśród nocnej ciszy głos się rozchodzi: /
-Wstańcie, pasterze, Bóg się nam rodzi! /
-Czym prędzej się wybierajcie, /
-Do Betlejem pospieszajcie /
-Przywitać Pana.
-
-Poszli, znaleźli Dzieciątko w żłobie /
-Z wszystkimi znaki danymi sobie. /
-Jako Bogu cześć Mu dali, /
-A witając zawołali /
-Z wielkiej radości:
-
-Ach, witaj Zbawco z dawno żądany, /
-Wiele tysięcy lat wyglądany /
-Na Ciebie króle, prorocy /
-Czekali, a Tyś tej nocy /
-Nam się objawił.
-
-I my czekamy na Ciebie, Pana, /
-A skoro przyjdziesz na głos kapłana, /
-Padniemy na twarz przed Tobą, /
-Wierząc, żeś jest pod osłoną /
-Chleba i wina.
-
-=head2 As Verbatim
-
-And now as verbatim text:
-
- Wśród nocnej ciszy głos się rozchodzi:
- Wstańcie, pasterze, Bóg się nam rodzi!
- Czym prędzej się wybierajcie,
- Do Betlejem pospieszajcie
- Przywitać Pana.
-
- Poszli, znaleźli Dzieciątko w żłobie
- Z wszystkimi znaki danymi sobie.
- Jako Bogu cześć Mu dali,
- A witając zawołali
- Z wielkiej radości:
-
- Ach, witaj Zbawco z dawno żądany,
- Wiele tysięcy lat wyglądany
- Na Ciebie króle, prorocy
- Czekali, a Tyś tej nocy
- Nam się objawił.
-
- I my czekamy na Ciebie, Pana,
- A skoro przyjdziesz na głos kapłana,
- Padniemy na twarz przed Tobą,
- Wierząc, żeś jest pod osłoną
- Chleba i wina.
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom.xml deleted file mode 100644 index 08a114555dc..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom.xml +++ /dev/null @@ -1,101 +0,0 @@ -<Document start_line="2"> - <head1 start_line="2"> - NAME - </head1> - <Para start_line="4"> - WÅšRÓD NOCNEJ CISZY -- implicitly utf8 - test document in Polish - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="8"> - This is a test Pod document in UTF8. Its content is the - lyrics to the Polish Christmas carol "WÅ›ród - nocnej ciszy". - </Para> - <Para start_line="11"> - WÅ›ród nocnej ciszy gÅ‚os - siÄ™ rozchodzi: / WstaÅ„cie, pasterze, - Bóg siÄ™ nam rodzi! / Czym prÄ™dzej - siÄ™ wybierajcie, / Do Betlejem pospieszajcie - / Przywitać Pana. - </Para> - <Para start_line="17"> - Poszli, znaleźli DzieciÄ tko w żłobie - / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć - Mu dali, / A witajÄ c zawoÅ‚ali / Z wielkiej - radoÅ›ci: - </Para> - <Para start_line="23"> - Ach, witaj Zbawco z dawno Å¼Ä dany, / Wiele - tysiÄ™cy lat wyglÄ dany / Na Ciebie króle, - prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ - objawiÅ‚. - </Para> - <Para start_line="29"> - I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os - kapÅ‚ana, / Padniemy na twarz przed TobÄ - , / WierzÄ c, żeÅ› jest pod osÅ‚onÄ - / Chleba i wina. - </Para> - <head2 start_line="35"> - As Verbatim - </head2> - <Para start_line="37"> - And now as verbatim text: - </Para> - <VerbatimFormatted start_line="39" xml:space="preserve"> - WÅ›ród nocnej ciszy gÅ‚os - siÄ™ rozchodzi: - - WstaÅ„cie, pasterze, Bóg siÄ™ - nam rodzi! - - Czym prÄ™dzej siÄ™ wybierajcie, - - Do Betlejem pospieszajcie - - Przywitać Pana. - - - - Poszli, znaleźli DzieciÄ…tko w żłobie - - Z wszystkimi znaki danymi sobie. - - Jako Bogu cześć Mu dali, - - A witajÄ…c zawoÅ‚ali - - Z wielkiej radoÅ›ci: - - - - Ach, witaj Zbawco z dawno żądany, - - Wiele tysiÄ™cy lat wyglÄ…dany - - Na Ciebie króle, prorocy - - Czekali, a TyÅ› tej nocy - - Nam siÄ™ objawiÅ‚. - - - - I my czekamy na Ciebie, Pana, - - A skoro przyjdziesz na gÅ‚os kapÅ‚ana, - - Padniemy na twarz przed TobÄ…, - - WierzÄ…c, żeÅ› jest pod - osÅ‚onÄ… - - Chleba i wina. - </VerbatimFormatted> - <Para start_line="63"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom2.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom2.txt deleted file mode 100644 index 20b04105383..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom2.txt +++ /dev/null @@ -1,67 +0,0 @@ -=head1 NAME
-
-
-WŚRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish
-
-=head1 DESCRIPTION
-
-This is a test Pod document in UTF8. Its content is the lyrics to
-the Polish Christmas carol "Wśród nocnej ciszy".
-
-Wśród nocnej ciszy głos się rozchodzi: /
-Wstańcie, pasterze, Bóg się nam rodzi! /
-Czym prędzej się wybierajcie, /
-Do Betlejem pospieszajcie /
-Przywitać Pana.
-
-Poszli, znaleźli Dzieciątko w żłobie /
-Z wszystkimi znaki danymi sobie. /
-Jako Bogu cześć Mu dali, /
-A witając zawołali /
-Z wielkiej radości:
-
-Ach, witaj Zbawco z dawno żądany, /
-Wiele tysięcy lat wyglądany /
-Na Ciebie króle, prorocy /
-Czekali, a Tyś tej nocy /
-Nam się objawił.
-
-I my czekamy na Ciebie, Pana, /
-A skoro przyjdziesz na głos kapłana, /
-Padniemy na twarz przed Tobą, /
-Wierząc, żeś jest pod osłoną /
-Chleba i wina.
-
-=head2 As Verbatim
-
-And now as verbatim text:
-
- Wśród nocnej ciszy głos się rozchodzi:
- Wstańcie, pasterze, Bóg się nam rodzi!
- Czym prędzej się wybierajcie,
- Do Betlejem pospieszajcie
- Przywitać Pana.
-
- Poszli, znaleźli Dzieciątko w żłobie
- Z wszystkimi znaki danymi sobie.
- Jako Bogu cześć Mu dali,
- A witając zawołali
- Z wielkiej radości:
-
- Ach, witaj Zbawco z dawno żądany,
- Wiele tysięcy lat wyglądany
- Na Ciebie króle, prorocy
- Czekali, a Tyś tej nocy
- Nam się objawił.
-
- I my czekamy na Ciebie, Pana,
- A skoro przyjdziesz na głos kapłana,
- Padniemy na twarz przed Tobą,
- Wierząc, żeś jest pod osłoną
- Chleba i wina.
-
-[end]
-
-=cut
-
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom2.xml b/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom2.xml deleted file mode 100644 index 8439ea1590c..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/corpus2/polish_utf8_bom2.xml +++ /dev/null @@ -1,101 +0,0 @@ -<Document start_line="1"> - <head1 start_line="1"> - NAME - </head1> - <Para start_line="4"> - WÅšRÓD NOCNEJ CISZY -- implicitly utf8 - test document in Polish - </Para> - <head1 start_line="6"> - DESCRIPTION - </head1> - <Para start_line="8"> - This is a test Pod document in UTF8. Its content is the - lyrics to the Polish Christmas carol "WÅ›ród - nocnej ciszy". - </Para> - <Para start_line="11"> - WÅ›ród nocnej ciszy gÅ‚os - siÄ™ rozchodzi: / WstaÅ„cie, pasterze, - Bóg siÄ™ nam rodzi! / Czym prÄ™dzej - siÄ™ wybierajcie, / Do Betlejem pospieszajcie - / Przywitać Pana. - </Para> - <Para start_line="17"> - Poszli, znaleźli DzieciÄ tko w żłobie - / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć - Mu dali, / A witajÄ c zawoÅ‚ali / Z wielkiej - radoÅ›ci: - </Para> - <Para start_line="23"> - Ach, witaj Zbawco z dawno Å¼Ä dany, / Wiele - tysiÄ™cy lat wyglÄ dany / Na Ciebie króle, - prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ - objawiÅ‚. - </Para> - <Para start_line="29"> - I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os - kapÅ‚ana, / Padniemy na twarz przed TobÄ - , / WierzÄ c, żeÅ› jest pod osÅ‚onÄ - / Chleba i wina. - </Para> - <head2 start_line="35"> - As Verbatim - </head2> - <Para start_line="37"> - And now as verbatim text: - </Para> - <VerbatimFormatted start_line="39" xml:space="preserve"> - WÅ›ród nocnej ciszy gÅ‚os - siÄ™ rozchodzi: - - WstaÅ„cie, pasterze, Bóg siÄ™ - nam rodzi! - - Czym prÄ™dzej siÄ™ wybierajcie, - - Do Betlejem pospieszajcie - - Przywitać Pana. - - - - Poszli, znaleźli DzieciÄ…tko w żłobie - - Z wszystkimi znaki danymi sobie. - - Jako Bogu cześć Mu dali, - - A witajÄ…c zawoÅ‚ali - - Z wielkiej radoÅ›ci: - - - - Ach, witaj Zbawco z dawno żądany, - - Wiele tysiÄ™cy lat wyglÄ…dany - - Na Ciebie króle, prorocy - - Czekali, a TyÅ› tej nocy - - Nam siÄ™ objawiÅ‚. - - - - I my czekamy na Ciebie, Pana, - - A skoro przyjdziesz na gÅ‚os kapÅ‚ana, - - Padniemy na twarz przed TobÄ…, - - WierzÄ…c, żeÅ› jest pod - osÅ‚onÄ… - - Chleba i wina. - </VerbatimFormatted> - <Para start_line="63"> - [end] - </Para> -</Document> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/encod01.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/encod01.t deleted file mode 100644 index 4fe9b9f238d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/encod01.t +++ /dev/null @@ -1,74 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -#use Pod::Simple::Debug (10); -use Test; -use File::Spec; -#use utf8; -use strict; -#use Pod::Simple::Debug (10); - -BEGIN { plan tests => 6 } - -use Pod::Simple; -use Pod::Simple::DumpAsXML; - -my $thefile; - - -BEGIN { - - # Find the path to the test source files. This requires some fiddling when -# these tests are run as part of Perl core. -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't', 'corpus'); - return File::Spec->catfile ($dir, $file); - } else { - return $file; - } -} - if( -e - ($thefile = source_path('nonesuch.txt')) - #or (print("# Nope, not $thefile\n"), 0) - ) { - # okay, - - } elsif( -e - ($thefile = File::Spec::->catfile( File::Spec::->curdir, 'corpus', 'nonesuch.txt' )) - #or (print("# Nope, not $thefile\n"), 0) - ) { - # okay, - } elsif (-e - ($thefile = File::Spec::->catfile( File::Spec::->curdir, 't', 'corpus', 'nonesuch.txt' )) - #or (print("# Nope, not $thefile\n"), 0) - ) { - # okay, - } else { - die "Can't find the corpus directory\n Aborting"; - } - -} - -print "# Testing that $thefile parses right.\n"; -my $outstring; -{ - my $p = Pod::Simple::DumpAsXML->new; - $p->output_string( \$outstring ); - $p->parse_file( $thefile ); - undef $p; -} -ok 1 ; # make sure it parsed at all -ok( $outstring && length($outstring) ); # make sure it parsed to something. -#print $outstring; -ok( $outstring =~ m/Blorp/ ); -ok( $outstring =~ m/errata/ ); -ok( $outstring =~ m/unsupported/ ); -ok 1; diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/encod02.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/encod02.t deleted file mode 100644 index de75ef0fa20..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/encod02.t +++ /dev/null @@ -1,76 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 4 }; - -#use Pod::Simple::Debug (5); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; - -{ -my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ - -=encoding koi8-r - -=head1 NAME - - -- Fet's "When you were reading" - -=cut - -} ); - - -if(grep m/Unknown directive/i, @output_lines ) { - ok 0; - print "# I saw an Unknown directive warning here! :\n", - map("#==> $_\n", @output_lines), "#\n#\n"; -} else { - ok 1; -} - -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -print "# Now a control group, to make sure that =fishbladder DOES\n", - "# cause an 'unknown directive' error...\n"; - -{ -my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ - -=fishbladder - -=head1 NAME - -Fet's "When you were reading" - -=cut - -} ); - - -if(grep m/Unknown directive/i, @output_lines ) { - ok 1; -} else { - ok 0; - print "# But I didn't see an Unknows directive warning here! :\n", - map("#==> $_\n", @output_lines), "#\n#\n"; -} - -} - - - -print "#\n# And one for the road...\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/encod03.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/encod03.t deleted file mode 100644 index a058ce7b846..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/encod03.t +++ /dev/null @@ -1,76 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 4 }; - -#use Pod::Simple::Debug (5); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; - -{ -my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ - -=encoding koi8-r - -=head1 NAME - -Bippitty Boppity Boo -- Yormp - -=cut - -} ); - - -if(grep m/Unknown directive/i, @output_lines ) { - ok 0; - print "# I saw an Unknown directive warning here! :\n", - map("#==> $_\n", @output_lines), "#\n#\n"; -} else { - ok 1; -} - -} - -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -print "# Now a control group, to make sure that =fishbladder DOES\n", - "# cause an 'unknown directive' error...\n"; - -{ -my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ - -=fishbladder - -=head1 NAME - -Fet's "When you were reading" - -=cut - -} ); - - -if(grep m/Unknown directive/i, @output_lines ) { - ok 1; -} else { - ok 0; - print "# But I didn't see an Unknows directive warning here! :\n", - map("#==> $_\n", @output_lines), "#\n#\n"; -} - -} - - - -print "#\n# And one for the road...\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/end_over.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/end_over.t deleted file mode 100644 index ca61b030136..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/end_over.t +++ /dev/null @@ -1,49 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 5 }; - -my $d; -#use Pod::Simple::Debug (\$d,0); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::XMLOutStream::->_duo(\&nowhine, @_) } - -sub nowhine { - $_[0]->{'no_whining'} = 1; -} - -&ok(e( -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head1 SVUP\n\nMyup.", -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head1 SVUP\n\nMyup.", -)); - -&ok(e( -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head2 SVUP\n\nMyup.", -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head2 SVUP\n\nMyup.", -)); - -&ok(e( -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head3 SVUP\n\nMyup.", -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head3 SVUP\n\nMyup.", -)); - -&ok(e( -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head4 SVUP\n\nMyup.", -"=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head4 SVUP\n\nMyup.", -)); - - -__END__ - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes.t deleted file mode 100644 index 02e2a27ee1b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes.t +++ /dev/null @@ -1,112 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 18 }; - -#use Pod::Simple::Debug (5); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -print "# With weird leading whitespace...\n"; -# With weird whitespace -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nI<foo>\n"), - '<Document><Para><I>foo</I></Para></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nB< foo>\n"), - '<Document><Para><B> foo</B></Para></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nB<\tfoo>\n"), - '<Document><Para><B> foo</B></Para></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nB<\nfoo>\n"), - '<Document><Para><B> foo</B></Para></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nB<foo>\n"), - '<Document><Para><B>foo</B></Para></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nB<foo\t>\n"), - '<Document><Para><B>foo </B></Para></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nB<foo\n>\n"), - '<Document><Para><B>foo </B></Para></Document>' -); - - -print "#\n# Tests for wedges outside of formatting codes...\n"; -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\nX < 3 and N > 19\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\nX E<lt> 3 and N E<gt> 19\n") -); - - -print "# A complex test with internal whitespace...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nI<foo>B< bar>C<baz >F< quux\t?>\n"), - '<Document><Para><I>foo</I><B> bar</B><C>baz </C><F> quux ?</F></Para></Document>' -); - - -print "# Without any nesting...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<a>C<b>I<c>B<d>X<e>\n"), - '<Document><Para><F>a</F><C>b</C><I>c</I><B>d</B><X>e</X></Para></Document>' -); - -print "# Without any nesting, but with Z's...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>F<a>C<b>I<c>B<d>X<e>\n"), - '<Document><Para><F>a</F><C>b</C><I>c</I><B>d</B><X>e</X></Para></Document>' -); - - -print "# With lots of nesting, and Z's...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>F<C<Z<>foo> I<bar>> B<X<thingZ<>>baz>\n"), - '<Document><Para><F><C>foo</C> <I>bar</I></F> <B><X>thing</X>baz</B></Para></Document>' -); - - - -print "#\n# *** Now testing different numbers of wedges ***\n"; -print "# Without any nesting...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< a >>C<<< b >>>I<<<< c >>>>B<< d >>X<< e >>\n"), - '<Document><Para><F>a</F><C>b</C><I>c</I><B>d</B><X>e</X></Para></Document>' -); - -print "# Without any nesting, but with Z's, and odder whitespace...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>b >>>I<<<< c >>>>B<< d \t >>X<<\ne >>\n"), - '<Document><Para><F>a</F><C>b</C><I>c</I><B>d</B><X>e</X></Para></Document>' -); - -print "# With nesting and Z's, and odder whitespace...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>bZ<>B<< d \t >>X<<\ne >> >>>I<<<< c >>>>\n"), - '<Document><Para><F>a</F><C>b<B>d</B><X>e</X></C><I>c</I></Para></Document>' -); - - -print "# Misc...\n"; -ok( Pod::Simple::XMLOutStream->_out( - "=pod\n\nI like I<PIE> with B<cream> and Stuff and N < 3 and X<< things >> hoohah\n" -."And I<pie is B<also> a happy time>.\n" -."And B<I<<< I like pie >>>.>\n" -) => -"<Document><Para>I like <I>PIE</I> with <B>cream</B> and Stuff and N < 3 and <X>things</X> hoohah " -."And <I>pie is <B>also</B> a happy time</I>. " -."And <B><I>I like pie</I>.</B></Para></Document>" -); - - - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_e.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_e.t deleted file mode 100644 index 80b71b326ef..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_e.t +++ /dev/null @@ -1,98 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 20 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; - -print "# Pod::Simple version $Pod::Simple::VERSION\n"; - -print "# Pod::Escapes version $Pod::Escapes::VERSION\n", - if $Pod::Escapes::VERSION; -# Presumably that's the library being used - - -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -&ok( e "", "" ); -&ok( e "\n", "", ); - - -print "# Testing some basic mnemonic E sequences...\n"; - -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<lt>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1<2") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<gt>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1>2") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<verbar>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1|2") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<sol>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1/2\n") -); - - -print "# Testing some more mnemonic E sequences...\n"; - -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<apos>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1'2") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<quot>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1\"2") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1&2"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1E<amp>2\n") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<eacute>2"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1E<233>2\n") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<infin>2"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1E<8734>2\n") -); - -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<lchevron>2"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1E<171>2\n") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<rchevron>2"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1E<187>2\n") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<laquo>2"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1E<171>2\n") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<raquo>2"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1E<187>2\n") -); - - - -print "# Testing numeric E sequences...\n"; -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<0101>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<65>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") -); -&ok( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<0x41>2\n"), - Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") -); - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_l.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_l.t deleted file mode 100644 index 7865a08e9d8..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_l.t +++ /dev/null @@ -1,433 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 99 }; - -#use Pod::Simple::Debug (10); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } -my $x = 'Pod::Simple::XMLOutStream'; - -print "##### Testing L codes via x class $x...\n"; - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - -print "# Simple/moderate L<stuff> tests...\n"; - -ok($x->_out(qq{=pod\n\nL<Net::Ping>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); - -ok($x->_out(qq{=pod\n\nL<crontab(5)>\n}), - '<Document><Para><L content-implicit="yes" to="crontab(5)" type="man">crontab(5)</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL<Net::Ping/Ping-pong>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL<Net::Ping/"Ping-pong">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"Object Methods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</Object Methods>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"Object Methods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); - - -print "# Complex L<stuff> tests...\n"; -print "# Ents in the middle...\n"; - -ok($x->_out(qq{=pod\n\nL<Net::Ping>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Net::Ping/Ping-E<112>ong>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Net::Ping/"Ping-E<112>ong">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"Object E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</Object E<77>ethods>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"Object E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); - - - -print "# Ents in the middle and at the start...\n"; - -ok($x->_out(qq{=pod\n\nL<E<78>et::Ping>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::Ping/Ping-E<112>ong>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::Ping/"Ping-E<112>ong">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"E<79>bject E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</E<79>bject E<77>ethods>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"E<79>bject E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); - - -print "# Ents in the middle and at the start and at the end...\n"; - -ok($x->_out(qq{=pod\n\nL<E<78>et::PinE<103>>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::PinE<103>/Ping-E<112>onE<103>>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::PinE<103>/"Ping-E<112>onE<103>">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"E<79>bject E<77>ethodE<115>">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</E<79>bject E<77>ethodE<115>>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"E<79>bject E<77>ethodE<115>">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); - - -print "# Even more complex L<stuff> tests...\n"; - - -print "# Ents in the middle...\n"; - -ok($x->_out(qq{=pod\n\nL<Net::Ping>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Net::Ping/Ping-E<112>ong>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Net::Ping/"Ping-E<112>ong">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"Object E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</Object E<77>ethods>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"Object E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"Object Methods"</L></Para></Document>' -); - - -########################################################################### - -print "# VERY complex L sequences...\n"; -print "# Ents in the middle and at the start...\n"; - - -ok($x->_out(qq{=pod\n\nL<Net::Ping>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Net::Ping/Ping-B<E<112>ong>>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-<B>pong</B>" in Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Net::Ping/"Ping-B<E<112>ong>">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-<B>pong</B>" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"B<Object> E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</B<Object> E<77>ethods>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"B<Object> E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); - - - -print "# Ents in the middle and at the start...\n"; - -ok($x->_out(qq{=pod\n\nL<E<78>et::Ping>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::Ping/Ping-B<E<112>ong>>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-<B>pong</B>" in Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::Ping/"Ping-B<E<112>ong>">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-<B>pong</B>" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"B<E<79>bject> E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</B<E<79>bject> E<77>ethods>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"B<E<79>bject> E<77>ethods">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); - - -print "# Ents in the middle and at the start and at the end...\n"; - -ok($x->_out(qq{=pod\n\nL<E<78>et::PinE<103>>\n}), - '<Document><Para><L content-implicit="yes" to="Net::Ping" type="pod">Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::PinE<103>/Ping-B<E<112>onE<103>>>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-<B>pong</B>" in Net::Ping</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<E<78>et::PinE<103>/"Ping-B<E<112>onE<103>>">\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-<B>pong</B>" in Net::Ping</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL</"B<E<79>bject> E<77>ethodE<115>">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL</B<E<79>bject> E<77>ethodE<115>>\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<"B<E<79>bject> E<77>ethodE<115>">\n}), - '<Document><Para><L content-implicit="yes" section="Object Methods" type="pod">"<B>Object</B> Methods"</L></Para></Document>' -); - - -########################################################################### - -print "#\n# L<url> tests...\n"; - -ok( $x->_out(qq{=pod\n\nL<news:comp.lang.perl.misc>\n}), - '<Document><Para><L content-implicit="yes" to="news:comp.lang.perl.misc" type="url">news:comp.lang.perl.misc</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<http://www.perl.com>\n}), - '<Document><Para><L content-implicit="yes" to="http://www.perl.com" type="url">http://www.perl.com</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/>\n}), - '<Document><Para><L content-implicit="yes" to="http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/" type="url">http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/</L></Para></Document>' -); - -print "# L<url> tests with entities...\n"; - -ok( $x->_out(qq{=pod\n\nL<news:compE<46>lang.perl.misc>\n}), - '<Document><Para><L content-implicit="yes" to="news:comp.lang.perl.misc" type="url">news:comp.lang.perl.misc</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<http://wwwE<46>perl.com>\n}), - '<Document><Para><L content-implicit="yes" to="http://www.perl.com" type="url">http://www.perl.com</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<http://wwwE<46>perl.com/CPAN/authors/id/S/SB/SBURKE/>\n}), - '<Document><Para><L content-implicit="yes" to="http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/" type="url">http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<http://wwwE<46>perl.com/CPAN/authors/id/S/SB/SBURKEE<47>>\n}), - '<Document><Para><L content-implicit="yes" to="http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/" type="url">http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/</L></Para></Document>' -); - - -########################################################################### - - -print "# L<text|stuff> tests...\n"; - -ok($x->_out(qq{=pod\n\nL<things|crontab(5)>\n}), - '<Document><Para><L to="crontab(5)" type="man">things</L></Para></Document>' -); -ok($x->_out(qq{=pod\n\nL<things|crontab(5)/ENVIRONMENT>\n}), - '<Document><Para><L section="ENVIRONMENT" to="crontab(5)" type="man">things</L></Para></Document>' -); -ok($x->_out(qq{=pod\n\nL<things|crontab(5)/"ENVIRONMENT">\n}), - '<Document><Para><L section="ENVIRONMENT" to="crontab(5)" type="man">things</L></Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nL<Perl Error Messages|perldiag>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl Error Messages</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Perl\nError\nMessages|perldiag>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl Error Messages</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Perl\nError\t Messages|perldiag>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl Error Messages</L></Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nL<SWITCH statements|perlsyn/"Basic BLOCKs and Switch Statements">\n}), - '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH statements</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<SWITCH statements|perlsyn/Basic BLOCKs and Switch Statements>\n}), - '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH statements</L></Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nL<the various attributes|/"Member Data">\n}), - '<Document><Para><L section="Member Data" type="pod">the various attributes</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<the various attributes|/Member Data>\n}), - '<Document><Para><L section="Member Data" type="pod">the various attributes</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<the various attributes|"Member Data">\n}), - '<Document><Para><L section="Member Data" type="pod">the various attributes</L></Para></Document>' -); - - -print "#\n# Now some very complex L<text|stuff> tests...\n"; - - -ok( $x->_out(qq{=pod\n\nL<Perl B<Error E<77>essages>|perldiag>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Perl\nB<Error\nE<77>essages>|perldiag>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<Perl\nB<Error\t E<77>essages>|perldiag>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nL<SWITCH B<E<115>tatements>|perlsyn/"Basic I<BLOCKs> and Switch StatementE<115>">\n}), - '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<SWITCH B<E<115>tatements>|perlsyn/Basic I<BLOCKs> and Switch StatementE<115>>\n}), - '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nL<the F<various> attributes|/"Member Data">\n}), - '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<the F<various> attributes|/Member Data>\n}), - '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<the F<various> attributes|"Member Data">\n}), - '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>' -); - - -print "#\n# Now some very complex L<text|stuff> tests with variant syntax...\n"; - - -ok( $x->_out(qq{=pod\n\nL<< Perl B<<< Error E<77>essages >>>|perldiag >>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>\n}), - '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>\n}), - '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>\n}), - '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/"Member Data" >>>\n}), - '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/Member Data >>>\n}), - '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>' -); -ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|"Member Data" >>>\n}), - '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>' -); - -########################################################################### - -print "#\n# Now some very complex L<text|stuff> tests with variant syntax and text around it...\n"; - - -ok( $x->_out(qq{=pod\n\nI like L<< Perl B<<< Error E<77>essages >>>|perldiag >>.\n}), - '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>.\n}), - '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>.\n}), - '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>.\n}), - '<Document><Para>I like <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>.\n}), - '<Document><Para>I like <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L>.</Para></Document>' -); - - -ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/"Member Data" >>>.\n}), - '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/Member Data >>>.\n}), - '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|"Member Data" >>>.\n}), - '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>' -); - -ok( $x->_out(qq{=pod\n\nI like L<<< B<text>s|http://text.com >>>.\n}), -'<Document><Para>I like <L to="http://text.com" type="url"><B>text</B>s</L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<<< text|https://text.com/1/2 >>>.\n}), -'<Document><Para>I like <L to="https://text.com/1/2" type="url">text</L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<<< I<text>|http://text.com >>>.\n}), -'<Document><Para>I like <L to="http://text.com" type="url"><I>text</I></L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<<< C<text>|http://text.com >>>.\n}), -'<Document><Para>I like <L to="http://text.com" type="url"><C>text</C></L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<<< I<tI<eI<xI<t>>>>|mailto:earlE<64>text.com >>>.\n}), -'<Document><Para>I like <L to="mailto:earl@text.com" type="url"><I>t<I>e<I>x<I>t</I></I></I></I></L>.</Para></Document>' -); -ok( $x->_out(qq{=pod\n\nI like L<<< textZ<>|http://text.com >>>.\n}), -'<Document><Para>I like <L to="http://text.com" type="url">text</L>.</Para></Document>' -); - - - - -# -# TODO: S testing. -# - -########################################################################### - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_s.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_s.t deleted file mode 100644 index 14866873d18..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/fcodes_s.t +++ /dev/null @@ -1,107 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 14 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -my $x = 'Pod::Simple::XMLOutStream'; -sub e ($$) { $x->_duo(@_) } - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -print "# S as such...\n"; - -ok( $x->_out("=pod\n\nI like S<bric-a-brac>.\n"), - => '<Document><Para>I like <S>bric-a-brac</S>.</Para></Document>' ); -ok( $x->_out("=pod\n\nI like S<bric-a-brac a gogo >.\n"), - => '<Document><Para>I like <S>bric-a-brac a gogo </S>.</Para></Document>' ); -ok( $x->_out("=pod\n\nI like S<< bric-a-brac a gogo >>.\n"), - => '<Document><Para>I like <S>bric-a-brac a gogo</S>.</Para></Document>' ); - -my $unless_ascii = (chr(65) eq 'A') ? '' : - "Skip because not in ASCIIland"; - -skip( $unless_ascii, - $x->_out( sub { $_[0]->nbsp_for_S(1) }, - "=pod\n\nI like S<bric-a-brac a gogo>.\n"), -'<Document><Para>I like bric-a-brac a gogo.</Para></Document>' -); -skip( $unless_ascii, - $x->_out( sub { $_[0]->nbsp_for_S(1) }, - qq{=pod\n\nI like S<L</"bric-a-brac a gogo">>.\n}), -'<Document><Para>I like <L content-implicit="yes" section="bric-a-brac a gogo" type="pod">"bric-a-brac a gogo"</L>.</Para></Document>' -); -skip( $unless_ascii, - $x->_out( sub { $_[0]->nbsp_for_S(1) }, - qq{=pod\n\nI like S<L<Stuff like that|/"bric-a-brac a gogo">>.\n}), -'<Document><Para>I like <L section="bric-a-brac a gogo" type="pod">Stuff like that</L>.</Para></Document>' -); -skip( $unless_ascii, - $x->_out( sub { $_[0]->nbsp_for_S(1) }, - qq{=pod\n\nI like S<L<Stuff I<like that>|/"bric-a-brac a gogo">>.\n}), -'<Document><Para>I like <L section="bric-a-brac a gogo" type="pod">Stuff <I>like that</I></L>.</Para></Document>' -); - -&ok( $x->_duo( sub { $_[0]->nbsp_for_S(1) }, - "=pod\n\nI like S<bric-a-brac a gogo>.\n", - "=pod\n\nI like bric-a-bracE<160>aE<160>gogo.\n", -)); -&ok( - map {my $z = $_; $z =~ s/content-implicit="yes" //g; $z } - $x->_duo( sub { $_[0]->nbsp_for_S(1) }, - qq{=pod\n\nI like S<L</"bric-a-brac a gogo">>.\n}, - qq{=pod\n\nI like L<"bric-a-bracE<160>aE<160>gogo"|/"bric-a-brac a gogo">.\n}, -)); -&ok( $x->_duo( sub { $_[0]->nbsp_for_S(1) }, - qq{=pod\n\nI like S<L<Stuff like that|"bric-a-brac a gogo">>.\n}, - qq{=pod\n\nI like L<StuffE<160>likeE<160>that|"bric-a-brac a gogo">.\n}, -)); -&ok( - map {my $z = $_; $z =~ s/content-implicit="yes" //g; $z } - $x->_duo( sub { $_[0]->nbsp_for_S(1) }, - qq{=pod\n\nI like S<L<Stuff I<like that>|"bric-a-brac a gogo">>.\n}, - qq{=pod\n\nI like L<StuffE<160>I<likeE<160>that>|"bric-a-brac a gogo">.\n}, -)); - -use Pod::Simple::Text; -$x = Pod::Simple::Text->new; -$x->preserve_whitespace(1); -# RT#25679 -ok( - $x->_out(<<END -=head1 The Tk::mega manpage showed me how C<< SE<lt> E<gt> foo >> is being rendered - -Both pod2text and pod2man S< > lose the rest of the line - -=head1 Do they always S< > lose the rest of the line? - -=cut -END - ), - <<END -The Tk::mega manpage showed me how S< > foo is being rendered - - Both pod2text and pod2man lose the rest of the line - -Do they always lose the rest of the line? - -END -); - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/for.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/for.t deleted file mode 100644 index 158cdc2b581..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/for.t +++ /dev/null @@ -1,107 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 21 }; - -#use Pod::Simple::Debug (5); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -sub moj {shift->accept_target('mojojojo')} -sub mojtext {shift->accept_target_as_text('mojojojo')} -sub any {shift->accept_target('*')} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -ok( $x->_out( "=pod\n\nI like pie.\n\n=for mojojojo stuff\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk stuff\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - -print "# Testing accept_target ...\n"; - -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for crunk stuff\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for :mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":mojojojo" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); - -print "# Testing accept_target_as_text ...\n"; - -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for :mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":mojojojo" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":psketti,mojojojo,crunk" target_matching="mojojojo"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); - - - -print "# Testing accept_target(*) ...\n"; - -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="*"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="*"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="psketti,mojojojo,crunk" target_matching="*"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for :mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":mojojojo" target_matching="*"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":psketti,mojojojo,crunk" target_matching="*"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); - - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/fornot.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/fornot.t deleted file mode 100644 index 863b00aa6e2..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/fornot.t +++ /dev/null @@ -1,109 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 21 }; - -#use Pod::Simple::Debug (5); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -sub moj {shift->accept_target( 'mojojojo')} -sub mojtext {shift->accept_target_as_text('mojojojo')} -sub any {shift->accept_target( '*' )} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -ok( $x->_out( "=pod\n\nI like pie.\n\n=for mojojojo stuff\n\n=for !mojojojo bzarcho\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!mojojojo" target_matching="!"><Data xml:space="preserve">bzarcho</Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk stuff\n\n=for !psketti,mojojojo,crunk bzarcho\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!psketti,mojojojo,crunk" target_matching="!"><Data xml:space="preserve">bzarcho</Data></for><Para>Yup.</Para></Document>' -); - -ok( $x->_out( "=pod\n\nI like pie.\n\n=for :mojojojo stuff\n\n=for :!mojojojo bzarcho\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":!mojojojo" target_matching="!"><Para>bzarcho</Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk stuff\n\n=for :!psketti,mojojojo,crunk bzarcho\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":!psketti,mojojojo,crunk" target_matching="!"><Para>bzarcho</Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for :mojojojo stuff\n\n=for :!mojojojo I<bzarcho>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":!mojojojo" target_matching="!"><Para><I>bzarcho</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk stuff\n\n=for :!psketti,mojojojo,crunk I<bzarcho>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target=":!psketti,mojojojo,crunk" target_matching="!"><Para><I>bzarcho</I></Para></for><Para>Yup.</Para></Document>' -); - - -print "# ( Now just swapping '!' and ':' )\n"; -ok( $x->_out( "=pod\n\nI like pie.\n\n=for :mojojojo stuff\n\n=for !:mojojojo bzarcho\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!:mojojojo" target_matching="!"><Para>bzarcho</Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk stuff\n\n=for !:psketti,mojojojo,crunk bzarcho\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!:psketti,mojojojo,crunk" target_matching="!"><Para>bzarcho</Para></for><Para>Yup.</Para></Document>' -); - - -print "# Testing accept_target ...\n"; - -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for !mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for !psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for :!mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - -print "# Testing accept_target_as_text ...\n"; - -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for !mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for !psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for :!mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>' -); - - -print "# Testing accept_target(*) ...\n"; - -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!mojojojo" target_matching="!"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!mojojojo" target_matching="!"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!psketti,mojojojo,crunk" target_matching="!"><Data xml:space="preserve">I<stuff></Data></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !:mojojojo I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!:mojojojo" target_matching="!"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); -ok( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !:psketti,mojojojo,crunk I<stuff>\n\nYup.\n"), - '<Document><Para>I like pie.</Para><for target="!:psketti,mojojojo,crunk" target_matching="!"><Para><I>stuff</I></Para></for><Para>Yup.</Para></Document>' -); - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/fullstop.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/fullstop.t deleted file mode 100644 index 0f021744c05..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/fullstop.t +++ /dev/null @@ -1,57 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 11 }; - -#use Pod::Simple::Debug (6); - -print "# Hi, I'm ", __FILE__, "\n"; -ok 1; - -use Pod::Simple; -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -&ok( e "", "" ); -&ok( e "\n", "", ); - -die unless ok !! Pod::Simple::XMLOutStream->can('fullstop_space_harden'); -sub harden { $_[0]->fullstop_space_harden(1) } - -print "# Test that \". \" always compacts without the hardening on...\n"; - -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\nShe set me a message about the M.D. I\ncalled back!\n"), - qq{<Document><Para>She set me a message about the M.D. I called back!</Para></Document>} -); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\nShe set me a message about the M.D. I called back!\n"), - qq{<Document><Para>She set me a message about the M.D. I called back!</Para></Document>} -); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\nShe set me a message about the M.D.\nI called back!\n"), - qq{<Document><Para>She set me a message about the M.D. I called back!</Para></Document>} -); - - -print "# Now testing with the hardening on...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&harden, "\n=pod\n\nShe set me a message about the M.D. I\ncalled back!\n"), - qq{<Document><Para>She set me a message about the M.D.  I called back!</Para></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&harden, "\n=pod\n\nShe set me a message about the M.D. I called back!\n"), - qq{<Document><Para>She set me a message about the M.D. I called back!</Para></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&harden, "\n=pod\n\nShe set me a message about the M.D.\nI called back!\n"), - qq{<Document><Para>She set me a message about the M.D. I called back!</Para></Document>} -); - - -print "# Byebye\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/heads.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/heads.t deleted file mode 100644 index bd04ce3ba25..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/heads.t +++ /dev/null @@ -1,92 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 19 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - - -print "# Simple tests for head1 - head4...\n"; -ok( Pod::Simple::XMLOutStream->_out("\n=head1 Chacha\n\n"), - '<Document><head1>Chacha</head1></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("\n=head2 Chacha\n\n"), - '<Document><head2>Chacha</head2></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("\n=head3 Chacha\n\n"), - '<Document><head3>Chacha</head3></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("\n=head4 Chacha\n\n"), - '<Document><head4>Chacha</head4></Document>' -); - -print "# Testing whitespace equivalence...\n"; - -&ok(e "\n=head1 Chacha\n\n", "\n=head1 Chacha\n\n"); -&ok(e "\n=head1 Chacha\n\n", "\n=head1\tChacha\n\n"); -&ok(e "\n=head1 Chacha\n\n", "\n=head1\tChacha \n\n"); - - - -ok( Pod::Simple::XMLOutStream->_out("=head1 Chachacha"), - '<Document><head1>Chachacha</head1></Document>' -); - - -print "# Testing whitespace variance ...\n"; -ok( Pod::Simple::XMLOutStream->_out("=head1 Cha cha cha \n"), - '<Document><head1>Cha cha cha</head1></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=head1 Cha cha\tcha \n"), - '<Document><head1>Cha cha cha</head1></Document>' -); - - - - -print "# Testing head2, head3, head4 more...\n"; - -ok( Pod::Simple::XMLOutStream->_out("=head2 Cha cha\tcha \n"), - '<Document><head2>Cha cha cha</head2></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=head3 Cha cha\tcha \n"), - '<Document><head3>Cha cha cha</head3></Document>' -); -ok( Pod::Simple::XMLOutStream->_out("=head4 Cha cha\tcha \n"), - '<Document><head4>Cha cha cha</head4></Document>' -); - -print "# Testing entity expansion...\n"; - -ok( Pod::Simple::XMLOutStream->_out("=head4 fooE<64>bar!\n"), - Pod::Simple::XMLOutStream->_out("\n=head4 foo\@bar!\n\n"), -); - -# TODO: a mode so that DumpAsXML can ask for all contiguous string -# sequences to be fused? -# &ok( e "=head4 fooE<64>bar!\n", "\n=head4 foo\@bar!\n\n"); - -print "# Testing formatting sequences...\n"; - -# True only if the sequences resolve, as they should... -&ok( e "=head4 C<foobar!>\n", "\n=head4 C<< foobar! >>\n\n"); -&ok( e "=head4 C<foobar!>\n", "\n\n=head4 C<<< foobar! >>>\n"); -&ok( e "=head4 C<foobar!>\n", "\n=head4 C<< foobar!\n\t>>\n\n"); - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/html01.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/html01.t deleted file mode 100644 index 9d1afe5cde5..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/html01.t +++ /dev/null @@ -1,77 +0,0 @@ -# t/html-para.t - -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 8 }; - -#use Pod::Simple::Debug (10); - -use Pod::Simple::HTML; - -sub x ($) { Pod::Simple::HTML->_out( - sub{ $_[0]->bare_output(1) }, - "=pod\n\n$_[0]", -) } - -ok( x( -q{ -=pod - -This is a paragraph - -=cut -}), - qq{\n<p>This is a paragraph</p>\n}, - "paragraph building" -); - - -ok( x(qq{=pod\n\nThis is a paragraph}), - qq{\n<p>This is a paragraph</p>\n}, - "paragraph building" -); - - -ok( x(qq{This is a paragraph}), - qq{\n<p>This is a paragraph</p>\n}, - "paragraph building" -); - - - -ok(x( -'=head1 This is a heading') - => q{/\s*<h1><a[^<>]+>This\s+is\s+a\s+heading</a></h1>\s*$/}, - "heading building" -); - -ok(x( -'=head2 This is a heading too') - => q{/\s*<h2><a[^<>]+>This\s+is\s+a\s+heading\s+too</a></h2>\s*$/}, - "heading building" -); - -ok(x( -'=head3 Also, this is a heading') - => q{/\s*<h3><a[^<>]+>Also,\s+this\s+is\s+a\s+heading</a></h3>\s*$/}, - "heading building" -); - - -ok(x( -'=head4 This, too, is a heading') - => q{/\s*<h4><a[^<>]+>This,\s+too,\s+is\s+a\s+heading</a></h4>\s*$/}, - "heading building" -); - - -print "# And one for the road...\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/html02.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/html02.t deleted file mode 100644 index f00507c9310..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/html02.t +++ /dev/null @@ -1,40 +0,0 @@ -# t/html-styles.t - -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -#use Pod::Simple::Debug (10); - -use strict; -use Test; -BEGIN { plan tests => 7}; -use Pod::Simple::HTML; - -sub x ($) { Pod::Simple::HTML->_out( - sub{ $_[0]->bare_output(1) }, - "=pod\n\n$_[0]", -) } - -ok 1; - -my @pairs = ( -[ "I<italicized>" => qq{\n<p><i>italicized</i></p>\n} ], -[ 'B<bolded>' => qq{\n<p><b>bolded</b></p>\n} ], -[ 'C<code>' => qq{\n<p><code>code</code></p>\n} ], -[ 'F</tmp/foo>' => qq{\n<p><em>/tmp/foo</em></p>\n} ], -[ 'F</tmp/foo>' => qq{\n<p><em>/tmp/foo</em></p>\n} ], -); - - -foreach( @pairs ) { - print "# Testing pod source $$_[0] ...\n" unless $_->[0] =~ m/\n/; - ok( x($_->[0]), $_->[1] ) -} -print "# And one for the road...\n"; -ok 1; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/html03.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/html03.t deleted file mode 100644 index 43b37183898..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/html03.t +++ /dev/null @@ -1,35 +0,0 @@ -# t/html-para.t - -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 7 }; - -#use Pod::Simple::Debug (10); - -use Pod::Simple::HTML; - -sub x ($) { Pod::Simple::HTML->_out( - #sub{ $_[0]->bare_output(1) }, - "=pod\n\n$_[0]", -) } - - -# make sure empty file => empty output - -ok 1; -ok( x(''),'', "Contentlessness" ); -ok( x(qq{=pod\n\nThis is a paragraph}) =~ m{<title></title>}i ); -ok( x(qq{This is a paragraph}) =~ m{<title></title>}i ); -ok( x(qq{=head1 Prok\n\nThis is a paragraph}) =~ m{<title>Prok</title>}i ); -ok( x(qq{=head1 NAME\n\nProk -- stuff\n\nThis}), q{/<title>Prok</title>/} ); - -print "# And one for the road...\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/htmlbat.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/htmlbat.t deleted file mode 100644 index 497f0e57d50..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/htmlbat.t +++ /dev/null @@ -1,97 +0,0 @@ -# Testing HTMLBatch -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -# Time-stamp: "2004-05-24 02:07:47 ADT" -use strict; - -#sub Pod::Simple::HTMLBatch::DEBUG () {5}; - -use Test; -BEGIN { plan tests => 8 } - -require Pod::Simple::HTMLBatch;; - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -my $t_dir; -my $corpus_dir; - -foreach my $t_maybe ( - File::Spec->catdir( File::Spec->updir(), 'lib','Pod','Simple','t'), - File::Spec->catdir( $cwd ), - File::Spec->catdir( $cwd, 't' ), - 'OHSNAP' -) { - die "Can't find the test corpus" if $t_maybe eq 'OHSNAP'; - next unless -e $t_maybe; - - $t_dir = $t_maybe; - $corpus_dir = File::Spec->catdir( $t_maybe, 'testlib1' ); - next unless -e $corpus_dir; - last; -} -print "# OK, found the test corpus as $corpus_dir\n"; -ok 1; - -my $outdir; -while(1) { - my $rand = sprintf "%05x", rand( 0x100000 ); - $outdir = File::Spec->catdir( $t_dir, "delme-$rand-out" ); - last unless -e $outdir; -} - -END { - use File::Path; - rmtree $outdir, 0, 0; -} - -ok 1; -print "# Output dir: $outdir\n"; - -mkdir $outdir, 0777 or die "Can't mkdir $outdir: $!"; - -print "# Converting $corpus_dir => $outdir\n"; -my $conv = Pod::Simple::HTMLBatch->new; -$conv->verbose(0); -$conv->batch_convert( [$corpus_dir], $outdir ); -ok 1; -print "# OK, back from converting.\n"; - -my @files; -use File::Find; -find( sub { push @files, $File::Find::name; return }, $outdir ); - -{ - my $long = ( grep m/zikzik\./i, @files )[0]; - ok($long) or print "# How odd, no zikzik file in $outdir!?\n"; - if($long) { - $long =~ s{zikzik\.html?$}{}s; - for(@files) { substr($_, 0, length($long)) = '' } - @files = grep length($_), @files; - } -} - -print "#Produced in $outdir ...\n"; -foreach my $f (sort @files) { - print "# $f\n"; -} -print "# (", scalar(@files), " items total)\n"; - -# Some minimal sanity checks: -ok scalar(grep m/\.css/i, @files) > 5; -ok scalar(grep m/\.html?/i, @files) > 5; -ok scalar grep m{squaa\W+Glunk.html?}i, @files; - -# use Pod::Simple; -# *pretty = \&Pod::Simple::BlackBox::pretty; - -print "# Bye from ", __FILE__, "\n"; -ok 1; diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/items.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/items.t deleted file mode 100644 index dcb695f3dd7..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/items.t +++ /dev/null @@ -1,226 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 24 }; - -my $d; -#use Pod::Simple::Debug (\$d,0); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; - -print "##### Tests for =item directives via class $x\n"; - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -print "#\n# Tests for simple =item *'s\n"; -ok( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-bullet indent="4"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); -ok( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-bullet indent="4"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); -ok( $x->_out("\n=over 10\n\n=item *\n\nStuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-bullet indent="10"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); -ok( $x->_out("\n=over\n\n=item *\n\nStuff\n=cut\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back"), - '<Document><over-bullet indent="4"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); - - - - -print "#\n# Tests for simple =item 1.'s\n"; -ok( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-number indent="4"><item-number number="1">Stuff</item-number><item-number number="2">Bar <I>baz</I>!</item-number></over-number></Document>' -); -ok( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=cut\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-number indent="4"><item-number number="1">Stuff</item-number><item-number number="2">Bar <I>baz</I>!</item-number></over-number></Document>' -); -# Now without a dot -ok( $x->_out("\n=over\n\n=item 1\n\nStuff\n\n=cut\n\nStuff\n\n=item 2\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-number indent="4"><item-number number="1">Stuff</item-number><item-number number="2">Bar <I>baz</I>!</item-number></over-number></Document>' -); -ok( $x->_out("\n=over\n\n=item 1\n\nStuff\n=cut\nStuff\n\n=item 2\n\nBar I<baz>!\n\n=back"), - '<Document><over-number indent="4"><item-number number="1">Stuff</item-number><item-number number="2">Bar <I>baz</I>!</item-number></over-number></Document>' -); - - - -print "#\n# Tests for =over blocks (without =items)\n"; -ok( $x->_out("\n=over\n\nStuff\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-block indent="4"><Para>Stuff</Para><Para>Bar <I>baz</I>!</Para></over-block></Document>' -); -ok( $x->_out("\n=over\n\n Stuff\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-block indent="4"><Verbatim xml:space="preserve"> Stuff</Verbatim><Para>Bar <I>baz</I>!</Para></over-block></Document>' -); -ok( $x->_out("\n=over\n\nBar I<baz>!\n\n Stuff\n\n=back\n\n"), - '<Document><over-block indent="4"><Para>Bar <I>baz</I>!</Para><Verbatim xml:space="preserve"> Stuff</Verbatim></over-block></Document>' -); - - - - -print "#\n# Tests for =item Text blocks...\n"; -ok( $x->_out("\n=over\n\n=item Foo\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I<baz>!\n\nQuux\n\n=back\n\n"), - '<Document><over-text indent="4"><item-text>Foo</item-text><Para>Stuff</Para><item-text>Bar <I>baz</I>!</item-text><Para>Quux</Para></over-text></Document>' -); -ok( $x->_out("\n=over\n\n=item Foo\n\n Stuff\n\tSnork\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I<baz>!\n\nQuux\n\n=back\n\n"), - qq{<Document><over-text indent="4"><item-text>Foo</item-text><Verbatim xml:space="preserve"> Stuff\n Snork</Verbatim>} - . qq{<item-text>Bar <I>baz</I>!</item-text><Para>Quux</Para></over-text></Document>} -); -ok( $x->_out("\n=over\n\n=item Foo\n\n Stuff\n\tSnork\n=cut\n\nCrunk\nZorp\n\n=item Bar I<baz>!\n\nQuux\n\n=back\n\n"), - qq{<Document><over-text indent="4"><item-text>Foo</item-text><Verbatim xml:space="preserve"> Stuff\n Snork</Verbatim>} - . qq{<item-text>Bar <I>baz</I>!</item-text><Para>Quux</Para></over-text></Document>} -); - - - -print "#\n# Test for mixed =item blocks...\n"; -ok( $x->_out("\n=over\n\n=item Foo\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), - qq{<Document><over-text indent="4"><item-text>Foo</item-text><Para>Stuff</Para>} - . qq{<item-text>2.</item-text><Para>Bar <I>baz</I>!</Para><Para>Quux</Para>} - . qq{<item-text>*</item-text><Para>Thwoong</Para></over-text></Document>} -); - -# ok( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), -# ok( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), - -print "#\n# Tests for indenting\n"; -ok( $x->_out("\n=over 19\n\n=item *\n\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-bullet indent="19"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); -ok( $x->_out("\n=over 19\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-number indent="19"><item-number number="1">Stuff</item-number><item-number number="2">Bar <I>baz</I>!</item-number></over-number></Document>' -); -ok( $x->_out("\n=over 19\n\nStuff\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-block indent="19"><Para>Stuff</Para><Para>Bar <I>baz</I>!</Para></over-block></Document>' -); -ok( $x->_out("\n=over 19\n\n=item Foo\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I<baz>!\n\nQuux\n\n=back\n\n"), - '<Document><over-text indent="19"><item-text>Foo</item-text><Para>Stuff</Para><item-text>Bar <I>baz</I>!</item-text><Para>Quux</Para></over-text></Document>' -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# Now testing nesting...\n"; -ok( $x->_out(join "\n\n", '', - '=over', - '=item *', - 'Stuff', - '=cut', - 'Stuff', - '=over', - '=item 1.', - '=item 2.', - 'Bar I<baz>!', - '=back', - '=item *', - 'Bar I<baz>!', - '=back', '' - ), join '', - '<Document>', - '<over-bullet indent="4">', - '<item-bullet>Stuff</item-bullet>', - '<over-number indent="4">', - '<item-number number="1"></item-number>', - '<item-number number="2">Bar <I>baz</I>!</item-number>', - '</over-number>', - '<item-bullet>Bar <I>baz</I>!</item-bullet>', - '</over-bullet></Document>' -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -ok( $x->_out( join "\n\n", '', '', - '=over', - '=item *', - 'Stuff', - '=cut', - 'Stuff', - '=over', - '=item 1.', - '=over 19', - 'Gleiven', - 'Squim F<.thingrc>!', - '=back', - '=item 2.', - 'Bar I<baz>!', - '=back', - '=item *', - 'Bar I<baz>!', - '=back', - '', '' - ), join '', - '<Document>', - '<over-bullet indent="4">', - '<item-bullet>Stuff</item-bullet>', - '<over-number indent="4">', - '<item-number number="1"></item-number>', - - '<over-block indent="19">', - '<Para>Gleiven</Para>', - '<Para>Squim <F>.thingrc</F>!</Para>', - '</over-block>', - - '<item-number number="2">Bar <I>baz</I>!</item-number>', - '</over-number>', - '<item-bullet>Bar <I>baz</I>!</item-bullet>', - '</over-bullet></Document>' -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -$d = 11; -print "# Now checking that document-end closes things right...\n"; - -ok( $x->_out( join "\n\n", '', '', - '=over', - '=item *', - 'Stuff', - '=cut', - 'Stuff', - '=over', - '=item 1.', - '=over 19', - 'Gleiven', - 'Squim F<.thingrc>!', - '', '' - ), join '', - '<Document>', - '<over-bullet indent="4">', - '<item-bullet>Stuff</item-bullet>', - '<over-number indent="4">', - '<item-number number="1"></item-number>', - - '<over-block indent="19">', - '<Para>Gleiven</Para>', - '<Para>Squim <F>.thingrc</F>!</Para>', - '</over-block>', - '</over-number>', - '</over-bullet></Document>' -); - - - -# TODO: more checking of coercion in nesting? - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/items02.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/items02.t deleted file mode 100644 index 125241f7626..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/items02.t +++ /dev/null @@ -1,44 +0,0 @@ -#!perl -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 4 }; - -my $d; -#use Pod::Simple::Debug (\$d,0); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; - -print "##### Tests for =item directives via class $x\n"; - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -print "#\n# Tests for =item [number] that are icky...\n"; -ok( $x->_out("\n=over\n\n=item 5\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4\n\nQuux\n\n=back\n\n"), - '<Document><over-text indent="4"><item-text>5</item-text><Para>Stuff</Para><item-text>4</item-text><Para>Quux</Para></over-text></Document>' -); - -ok( $x->_out("\n=over\n\n=item 5.\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4.\n\nQuux\n\n=back\n\n"), - '<Document><over-text indent="4"><item-text>5.</item-text><Para>Stuff</Para><item-text>4.</item-text><Para>Quux</Para></over-text></Document>' -); - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/itemstar.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/itemstar.t deleted file mode 100644 index 4e6ac41b66d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/itemstar.t +++ /dev/null @@ -1,51 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 6 }; - -#my $d; -#use Pod::Simple::Debug (3); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -my $x = 'Pod::Simple::XMLOutStream'; - -print "##### Tests for '=item * Foo' tolerance via class $x\n"; - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -print "#\n# Tests for simple =item *'s\n"; -ok( $x->_out("\n=over\n\n=item * Stuff\n\n=item * Bar I<baz>!\n\n=back\n\n"), - '<Document><over-bullet indent="4"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); -ok( $x->_out("\n=over\n\n=item * Stuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-bullet indent="4"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); -ok( $x->_out("\n=over 10\n\n=item * Stuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back\n\n"), - '<Document><over-bullet indent="10"><item-bullet>Stuff</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); -ok( $x->_out("\n=over\n\n=item * Stuff I<things\num> hoo!\n=cut\nStuff\n\n=item *\n\nBar I<baz>!\n\n=back"), - '<Document><over-bullet indent="4"><item-bullet>Stuff <I>things um</I> hoo!</item-bullet><item-bullet>Bar <I>baz</I>!</item-bullet></over-bullet></Document>' -); - - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk1.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/junk1.pod deleted file mode 100644 index 402880109ea..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk1.pod +++ /dev/null @@ -1,8 +0,0 @@ - -=cut - -=head9 I like pie - -B<pie is nice - -E<puppies> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk1o.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/junk1o.txt deleted file mode 100644 index 1b4559ac0f4..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk1o.txt +++ /dev/null @@ -1,13 +0,0 @@ -pie is nice E<puppies> - -POD ERRORS -Hey! The above document had some coding errors, which are explained below: - -Around line 2: - =cut found outside a pod block. Skipping to next block. -Around line 4: - Unknown directive: =head9 -Around line 6: - Unterminated B<...> sequence -Around line 8: - Unknown E content in E<puppies> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk2.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/junk2.pod deleted file mode 100644 index 696aabfbfae..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk2.pod +++ /dev/null @@ -1,6 +0,0 @@ - -=head9 I like pie - -B<pie is nice - -E<puppies> diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk2o.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/junk2o.txt deleted file mode 100644 index 5612c7d3a15..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/junk2o.txt +++ /dev/null @@ -1,13 +0,0 @@ -pie is nice - -E<puppies> - -POD ERRORS -Hey! The above document had some coding errors, which are explained below: -Around line 2: - Unknown directive: =head9 -Around line 4: - Unterminated B<...> sequence -Around line 6: - Unknown E content in E<puppies> - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/linkclas.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/linkclas.t deleted file mode 100644 index 5df3799b916..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/linkclas.t +++ /dev/null @@ -1,70 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -### Test the basic sanity of the link-section treelet class - -use strict; -use Test; -BEGIN { plan tests => 8 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::LinkSection; -use Pod::Simple::BlackBox; # for its pretty() - -my $bare_treelet = - ['B', {'pie' => 'no'}, - 'a', - ['C', {'bzrok' => 'plip'}, - 'b' - ], - 'c' - ] -; -my $treelet = Pod::Simple::LinkSection->new($bare_treelet); - -# Make sure they're not the same - -ok ref($bare_treelet), 'ARRAY'; -ok ref($treelet), 'Pod::Simple::LinkSection'; - -print "# Testing stringification...\n"; - -ok $treelet->stringify, 'abc'; # explicit -ok join('', $treelet), 'abc'; # implicit - - -print "# Testing non-coreferentiality...\n"; -{ - my @stack = ($bare_treelet); - my $this; - while(@stack) { - $this = shift @stack; - if(ref($this || '') eq 'ARRAY') { - push @stack, splice @$this; - push @$this, ("BAD!") x 3; - } elsif(ref($this || '') eq 'Pod::Simple::LinkSection') { - push @stack, splice @$this; - push @$this, ("BAD!") x 3; - } elsif(ref($this || '') eq 'HASH') { - %$this = (); - } - } - # These will fail if $treelet and $bare_treelet are coreferential, - # since we just conspicuously nuked $bare_treelet - - ok $treelet->stringify, 'abc'; # explicit - ok join('', $treelet), 'abc'; # implicit -} - - -print "# Byebye...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlcyg.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/perlcyg.pod deleted file mode 100644 index 6264a15788b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlcyg.pod +++ /dev/null @@ -1,592 +0,0 @@ -If you read this file _as_is_, just ignore the funny characters you -see. It is written in the POD format (see pod/perlpod.pod) which is -specially designed to be readable as is. - -=head1 NAME - -README.cygwin - Perl for Cygwin - -=head1 SYNOPSIS - -This document will help you configure, make, test and install Perl -on Cygwin. This document also describes features of Cygwin that will -affect how Perl behaves at runtime. - -B<NOTE:> There are pre-built Perl packages available for Cygwin and a -version of Perl is provided on the Cygwin CD. If you do not need to -customize the configuration, consider using one of these packages: - - http://cygutils.netpedia.net/ - -=head1 PREREQUISITES - -=head2 Cygwin = GNU+Cygnus+Windows (Don't leave UNIX without it) - -The Cygwin tools are ports of the popular GNU development tools for Win32 -platforms. They run thanks to the Cygwin library which provides the UNIX -system calls and environment these programs expect. More information -about this project can be found at: - - http://www.cygwin.com/ - -A recent net or commercial release of Cygwin is required. - -At the time this document was last updated, Cygwin 1.1.5 was current. - -B<NOTE:> At this point, minimal effort has been made to provide -compatibility with old (beta) Cygwin releases. The focus has been to -provide a high quality release and not worry about working around old -bugs. If you wish to use Perl with Cygwin B20.1 or earlier, consider -using perl5.005_03, which is available in source and binary form at -C<http://cygutils.netpedia.net/>. If there is significant demand, -a patch kit can be developed to port back to earlier Cygwin versions. - -=head2 Cygwin Configuration - -While building Perl some changes may be necessary to your Cygwin setup so -that Perl builds cleanly. These changes are B<not> required for normal -Perl usage. - -B<NOTE:> The binaries that are built will run on all Win32 versions. -They do not depend on your host system (Win9x/WinME, WinNT/Win2K) -or your Cygwin configuration (I<ntea>, I<ntsec>, binary/text mounts). -The only dependencies come from hard-coded pathnames like C</usr/local>. -However, your host system and Cygwin configuration will affect Perl's -runtime behavior (see L</"TEST">). - -=over 4 - -=item * C<PATH> - -Set the C<PATH> environment variable so that Configure finds the Cygwin -versions of programs. Any Windows directories should be removed or -moved to the end of your C<PATH>. - -=item * I<nroff> - -If you do not have I<nroff> (which is part of the I<groff> package), -Configure will B<not> prompt you to install I<man> pages. - -=item * Permissions - -On WinNT with either the I<ntea> or I<ntsec> C<CYGWIN> settings, directory -and file permissions may not be set correctly. Since the build process -creates directories and files, to be safe you may want to run a `C<chmod --R +w *>' on the entire Perl source tree. - -Also, it is a well known WinNT "feature" that files created by a login -that is a member of the I<Administrators> group will be owned by the -I<Administrators> group. Depending on your umask, you may find that you -can not write to files that you just created (because you are no longer -the owner). When using the I<ntsec> C<CYGWIN> setting, this is not an -issue because it "corrects" the ownership to what you would expect on -a UNIX system. - -=back - -=head1 CONFIGURE - -The default options gathered by Configure with the assistance of -F<hints/cygwin.sh> will build a Perl that supports dynamic loading -(which requires a shared F<libperl.dll>). - -This will run Configure and keep a record: - - ./Configure 2>&1 | tee log.configure - -If you are willing to accept all the defaults run Configure with B<-de>. -However, several useful customizations are available. - -=head2 Strip Binaries - -It is possible to strip the EXEs and DLLs created by the build process. -The resulting binaries will be significantly smaller. If you want the -binaries to be stripped, you can either add a B<-s> option when Configure -prompts you, - - Any additional ld flags (NOT including libraries)? [none] -s - Any special flags to pass to gcc to use dynamic linking? [none] -s - Any special flags to pass to ld2 to create a dynamically loaded library? - [none] -s - -or you can edit F<hints/cygwin.sh> and uncomment the relevant variables -near the end of the file. - -=head2 Optional Libraries - -Several Perl functions and modules depend on the existence of -some optional libraries. Configure will find them if they are -installed in one of the directories listed as being used for library -searches. Pre-built packages for most of these are available at -C<http://cygutils.netpedia.net/>. - -=over 4 - -=item * C<-lcrypt> - -The crypt package distributed with Cygwin is a Linux compatible 56-bit -DES crypt port by Corinna Vinschen. - -Alternatively, the crypt libraries in GNU libc have been ported to Cygwin. - -The DES based Ultra Fast Crypt port was done by Alexey Truhan: - - ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/cw32crypt-dist-0.tgz - -NOTE: There are various export restrictions on DES implementations, -see the glibc README for more details. - -The MD5 port was done by Andy Piper: - - ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/libcrypt.tgz - -=item * C<-lgdbm> (C<use GDBM_File>) - -GDBM is available for Cygwin. GDBM's ndbm/dbm compatibility feature -also makes C<NDBM_File> and C<ODBM_File> possible (although they add -little extra value). - -NOTE: The ndbm/dbm emulations only completely work on NTFS partitions. - -=item * C<-ldb> (C<use DB_File>) - -BerkeleyDB is available for Cygwin. Some details can be found in -F<ext/DB_File/DB_File.pm>. - -NOTE: The BerkeleyDB library only completely works on NTFS partitions. - -=item * C<-lcygipc> (C<use IPC::SysV>) - -A port of SysV IPC is available for Cygwin. - -NOTE: This has B<not> been extensively tested. In particular, -C<d_semctl_semun> is undefined because it fails a Configure test -and on Win9x the I<shm*()> functions seem to hang. It also creates -a compile time dependency because F<perl.h> includes F<<sys/ipc.h>> -and F<<sys/sem.h>> (which will be required in the future when compiling -CPAN modules). - -=back - -=head2 Configure-time Options - -The F<INSTALL> document describes several Configure-time options. Some of -these will work with Cygwin, others are not yet possible. Also, some of -these are experimental. You can either select an option when Configure -prompts you or you can define (undefine) symbols on the command line. - -=over 4 - -=item * C<-Uusedl> - -Undefining this symbol forces Perl to be compiled statically. - -=item * C<-Uusemymalloc> - -By default Perl uses the malloc() included with the Perl source. If you -want to force Perl to build with the system malloc() undefine this symbol. - -=item * C<-Dusemultiplicity> - -Multiplicity is required when embedding Perl in a C program and using -more than one interpreter instance. This works with the Cygwin port. - -=item * C<-Duseperlio> - -The PerlIO abstraction works with the Cygwin port. - -=item * C<-Duse64bitint> - -I<gcc> supports 64-bit integers. However, several additional long long -functions are necessary to use them within Perl (I<{strtol,strtoul}l>). -These are B<not> yet available with Cygwin. - -=item * C<-Duselongdouble> - -I<gcc> supports long doubles (12 bytes). However, several additional -long double math functions are necessary to use them within Perl -(I<{atan2,cos,exp,floor,fmod,frexp,isnan,log,modf,pow,sin,sqrt}l,strtold>). -These are B<not> yet available with Cygwin. - -=item * C<-Dusethreads> - -POSIX threads are B<not> yet implemented in Cygwin. - -=item * C<-Duselargefiles> - -Although Win32 supports large files, Cygwin currently uses 32-bit integers -for internal size and position calculations. - -=back - -=head2 Suspicious Warnings - -You may see some messages during Configure that seem suspicious. - -=over 4 - -=item * I<dlsym()> - -I<ld2> is needed to build dynamic libraries, but it does not exist -when dlsym() checking occurs (it is not created until `C<make>' runs). -You will see the following message: - - Checking whether your dlsym() needs a leading underscore ... - ld2: not found - I can't compile and run the test program. - I'm guessing that dlsym doesn't need a leading underscore. - -Since the guess is correct, this is not a problem. - -=item * Win9x and C<d_eofnblk> - -Win9x does not correctly report C<EOF> with a non-blocking read on a -closed pipe. You will see the following messages: - - But it also returns -1 to signal EOF, so be careful! - WARNING: you can't distinguish between EOF and no data! - - *** WHOA THERE!!! *** - The recommended value for $d_eofnblk on this machine was "define"! - Keep the recommended value? [y] - -At least for consistency with WinNT, you should keep the recommended -value. - -=item * Compiler/Preprocessor defines - -The following error occurs because of the Cygwin C<#define> of -C<_LONG_DOUBLE>: - - Guessing which symbols your C compiler and preprocessor define... - try.c:<line#>: parse error - -This failure does not seem to cause any problems. - -=back - -=head1 MAKE - -Simply run I<make> and wait: - - make 2>&1 | tee log.make - -=head2 Warnings - -Warnings like these are normal: - - warning: overriding commands for target <file> - warning: ignoring old commands for target <file> - - dllwrap: no export definition file provided - dllwrap: creating one, but that may not be what you want - -=head2 ld2 - -During `C<make>', I<ld2> will be created and installed in your $installbin -directory (where you said to put public executables). It does not -wait until the `C<make install>' process to install the I<ld2> script, -this is because the remainder of the `C<make>' refers to I<ld2> without -fully specifying its path and does this from multiple subdirectories. -The assumption is that $installbin is in your current C<PATH>. If this -is not the case `C<make>' will fail at some point. If this happens, -just manually copy I<ld2> from the source directory to somewhere in -your C<PATH>. - -=head1 TEST - -There are two steps to running the test suite: - - make test 2>&1 | tee log.make-test - - cd t;./perl harness 2>&1 | tee ../log.harness - -The same tests are run both times, but more information is provided when -running as `C<./perl harness>'. - -Test results vary depending on your host system and your Cygwin -configuration. If a test can pass in some Cygwin setup, it is always -attempted and explainable test failures are documented. It is possible -for Perl to pass all the tests, but it is more likely that some tests -will fail for one of the reasons listed below. - -=head2 File Permissions - -UNIX file permissions are based on sets of mode bits for -{read,write,execute} for each {user,group,other}. By default Cygwin -only tracks the Win32 read-only attribute represented as the UNIX file -user write bit (files are always readable, files are executable if they -have a F<.{com,bat,exe}> extension or begin with C<#!>, directories are -always readable and executable). On WinNT with the I<ntea> C<CYGWIN> -setting, the additional mode bits are stored as extended file attributes. -On WinNT with the I<ntsec> C<CYGWIN> setting, permissions use the standard -WinNT security descriptors and access control lists. Without one of -these options, these tests will fail: - - Failed Test List of failed - ------------------------------------ - io/fs.t 5, 7, 9-10 - lib/anydbm.t 2 - lib/db-btree.t 20 - lib/db-hash.t 16 - lib/db-recno.t 18 - lib/gdbm.t 2 - lib/ndbm.t 2 - lib/odbm.t 2 - lib/sdbm.t 2 - op/stat.t 9, 20 (.tmp not an executable extension) - -=head2 Hard Links - -FAT partitions do not support hard links (whereas NTFS does), in which -case Cygwin implements link() by copying the file. On remote (network) -drives Cygwin's stat() always sets C<st_nlink> to 1, so the link count -for remote directories and files is not available. In either case, -these tests will fail: - - Failed Test List of failed - ------------------------------------ - io/fs.t 4 - op/stat.t 3 - -=head2 Filetime Granularity - -On FAT partitions the filetime granularity is 2 seconds. The following -test will fail: - - Failed Test List of failed - ------------------------------------ - io/fs.t 18 - -=head2 Tainting Checks - -When Perl is running in taint mode, C<$ENV{PATH}> is considered tainted -and not used, so DLLs not in the default system directories will not -be found. While the tests are running you will see warnings popup from -the system with messages like: - - Win9x - Error Starting Program - A required .DLL file, CYGWIN1.DLL, was not found - - WinNT - perl.exe - Unable to Locate DLL - The dynamic link library cygwin1.dll could not be found in the - specified path ... - -Just click OK and ignore them. When running `C<make test>', 2 popups -occur. During `C<./perl harness>', 4 popups occur. Also, these tests -will fail: - - Failed Test List of failed - ------------------------------------ - op/taint.t 1, 3, 31, 37 - -Alternatively, you can copy F<cygwin1.dll> into the directory where the -tests run: - - cp /bin/cygwin1.dll t - -or one of the Windows system directories (although, this is B<not> -recommended). - -=head2 /etc/group - -Cygwin does not require F</etc/group>, in which case the F<op/grent.t> -test will be skipped. The check performed by F<op/grent.t> expects to -see entries that use the members field, otherwise this test will fail: - - Failed Test List of failed - ------------------------------------ - op/grent.t 1 - -=head2 Script Portability - -Cygwin does an outstanding job of providing UNIX-like semantics on top of -Win32 systems. However, in addition to the items noted above, there are -some differences that you should know about. This is a very brief guide -to portability, more information can be found in the Cygwin documentation. - -=over 4 - -=item * Pathnames - -Cygwin pathnames can be separated by forward (F</>) or backward (F<\>) -slashes. They may also begin with drive letters (F<C:>) or Universal -Naming Codes (F<//UNC>). DOS device names (F<aux>, F<con>, F<prn>, -F<com*>, F<lpt?>, F<nul>) are invalid as base filenames. However, they -can be used in extensions (e.g., F<hello.aux>). Names may contain all -printable characters except these: - - : * ? " < > | - -File names are case insensitive, but case preserving. A pathname that -contains a backslash or drive letter is a Win32 pathname (and not subject -to the translations applied to POSIX style pathnames). - -=item * Text/Binary - -When a file is opened it is in either text or binary mode. In text mode -a file is subject to CR/LF/Ctrl-Z translations. With Cygwin, the default -mode for an open() is determined by the mode of the mount that underlies -the file. Perl provides a binmode() function to set binary mode on files -that otherwise would be treated as text. sysopen() with the C<O_TEXT> -flag sets text mode on files that otherwise would be treated as binary: - - sysopen(FOO, "bar", O_WRONLY|O_CREAT|O_TEXT) - -lseek(), tell() and sysseek() only work with files opened in binary mode. - -The text/binary issue is covered at length in the Cygwin documentation. - -=item * F<.exe> - -The Cygwin stat(), lstat() and readlink() functions make the F<.exe> -extension transparent by looking for F<foo.exe> when you ask for F<foo> -(unless a F<foo> also exists). Cygwin does not require a F<.exe> -extension, but I<gcc> adds it automatically when building a program. -However, when accessing an executable as a normal file (e.g., I<cp> -in a makefile) the F<.exe> is not transparent. The I<install> included -with Cygwin automatically appends a F<.exe> when necessary. - -=item * chown() - -On WinNT chown() can change a file's user and group IDs. On Win9x chown() -is a no-op, although this is appropriate since there is no security model. - -=item * Miscellaneous - -File locking using the C<F_GETLK> command to fcntl() is a stub that -returns C<ENOSYS>. - -Win9x can not rename() an open file (although WinNT can). - -The Cygwin chroot() implementation has holes (it can not restrict file -access by native Win32 programs). - -=back - -=head1 INSTALL - -This will install Perl, including I<man> pages. - - make install | tee log.make-install - -NOTE: If C<STDERR> is redirected `C<make install>' will B<not> prompt -you to install I<perl> into F</usr/bin>. - -You may need to be I<Administrator> to run `C<make install>'. If you -are not, you must have write access to the directories in question. - -Information on installing the Perl documentation in HTML format can be -found in the F<INSTALL> document. - -=head1 MANIFEST - -These are the files in the Perl release that contain references to Cygwin. -These very brief notes attempt to explain the reason for all conditional -code. Hopefully, keeping this up to date will allow the Cygwin port to -be kept as clean as possible. - -=over 4 - -=item Documentation - - INSTALL README.cygwin README.win32 MANIFEST - Changes Changes5.005 Changes5.004 Changes5.6 - pod/perl.pod pod/perlport.pod pod/perlfaq3.pod - pod/perldelta.pod pod/perl5004delta.pod pod/perl56delta.pod - pod/perlhist.pod pod/perlmodlib.pod pod/buildtoc.PL pod/perltoc.pod - -=item Build, Configure, Make, Install - - cygwin/Makefile.SHs - cygwin/ld2.in - cygwin/perlld.in - ext/IPC/SysV/hints/cygwin.pl - ext/NDBM_File/hints/cygwin.pl - ext/ODBM_File/hints/cygwin.pl - hints/cygwin.sh - Configure - help finding hints from uname, - shared libperl required for dynamic loading - Makefile.SH - linklibperl - Porting/patchls - cygwin in port list - installman - man pages with :: translated to . - installperl - install dll/ld2/perlld, install to pods - makedepend.SH - uwinfix - -=item Tests - - t/io/tell.t - binmode - t/lib/b.t - ignore Cwd from os_extras - t/lib/glob-basic.t - Win32 directory list access differs from read mode - t/op/magic.t - $^X/symlink WORKAROUND, s/.exe// - t/op/stat.t - no /dev, skip Win32 ftCreationTime quirk - (cache manager sometimes preserves ctime of file - previously created and deleted), no -u (setuid) - -=item Compiled Perl Source - - EXTERN.h - __declspec(dllimport) - XSUB.h - __declspec(dllexport) - cygwin/cygwin.c - os_extras (getcwd, spawn) - perl.c - os_extras - perl.h - binmode - doio.c - win9x can not rename a file when it is open - pp_sys.c - do not define h_errno, pp_system with spawn - util.c - use setenv - -=item Compiled Module Source - - ext/POSIX/POSIX.xs - tzname defined externally - ext/SDBM_File/sdbm/pair.c - - EXTCONST needs to be redefined from EXTERN.h - ext/SDBM_File/sdbm/sdbm.c - - binary open - -=item Perl Modules/Scripts - - lib/Cwd.pm - hook to internal Cwd::cwd - lib/ExtUtils/MakeMaker.pm - - require MM_Cygwin.pm - lib/ExtUtils/MM_Cygwin.pm - - canonpath, cflags, manifypods, perl_archive - lib/File/Find.pm - on remote drives stat() always sets st_nlink to 1 - lib/File/Spec/Unix.pm - preserve //unc - lib/File/Temp.pm - no directory sticky bit - lib/perl5db.pl - use stdin not /dev/tty - utils/perldoc.PL - version comment - -=back - -=head1 BUGS - -When I<make> starts, it warns about overriding commands for F<perlmain.o>. - -`C<make clean>' does not remove library F<.def> or F<.exe.stackdump> -files. - -The I<ld2> script contains references to the source directory. You should -change these to $installbin after `C<make install>'. - -Support for swapping real and effective user and group IDs is incomplete. -On WinNT Cygwin provides setuid(), seteuid(), setgid() and setegid(). -However, additional Cygwin calls for manipulating WinNT access tokens -and security contexts are required. - -When building DLLs, `C<dllwrap --export-all-symbols>' is used to export -global symbols. It might be better to generate an explicit F<.def> file -(see F<makedef.pl>). Also, DLLs can now be build with `C<gcc -shared>'. - -=head1 AUTHORS - -Charles Wilson <cwilson@ece.gatech.edu>, -Eric Fifer <egf7@columbia.edu>, -alexander smishlajev <als@turnhere.com>, -Steven Morlock <newspost@morlock.net>, -Sebastien Barre <Sebastien.Barre@utc.fr>, -Teun Burgers <burgers@ecn.nl>. - -=head1 HISTORY - -Last updated: 9 November 2000 diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlcygo.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/perlcygo.txt deleted file mode 100644 index d834344d6fc..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlcygo.txt +++ /dev/null @@ -1,249 +0,0 @@ -NAME -README.cygwin - Perl for Cygwin -SYNOPSIS -This document will help you configure, make, test and install Perl on Cygwin. This document also describes features of Cygwin that will affect how Perl behaves at runtime. -NOTE: There are pre-built Perl packages available for Cygwin and a version of Perl is provided on the Cygwin CD. If you do not need to customize the configuration, consider using one of these packages: - http://cygutils.netpedia.net/ -PREREQUISITES -Cygwin = GNU+Cygnus+Windows (Don't leave UNIX without it) -The Cygwin tools are ports of the popular GNU development tools for Win32 platforms. They run thanks to the Cygwin library which provides the UNIX system calls and environment these programs expect. More information about this project can be found at: - http://www.cygwin.com/ -A recent net or commercial release of Cygwin is required. -At the time this document was last updated, Cygwin 1.1.5 was current. -NOTE: At this point, minimal effort has been made to provide compatibility with old (beta) Cygwin releases. The focus has been to provide a high quality release and not worry about working around old bugs. If you wish to use Perl with Cygwin B20.1 or earlier, consider using perl5.005_03, which is available in source and binary form at http://cygutils.netpedia.net/. If there is significant demand, a patch kit can be developed to port back to earlier Cygwin versions. -Cygwin Configuration -While building Perl some changes may be necessary to your Cygwin setup so that Perl builds cleanly. These changes are not required for normal Perl usage. -NOTE: The binaries that are built will run on all Win32 versions. They do not depend on your host system (Win9x/WinME, WinNT/Win2K) or your Cygwin configuration (ntea, ntsec, binary/text mounts). The only dependencies come from hard-coded pathnames like /usr/local. However, your host system and Cygwin configuration will affect Perl's runtime behavior (see "TEST"). -PATH -Set the PATH environment variable so that Configure finds the Cygwin versions of programs. Any Windows directories should be removed or moved to the end of your PATH. -nroff -If you do not have nroff (which is part of the groff package), Configure will not prompt you to install man pages. -Permissions -On WinNT with either the ntea or ntsec CYGWIN settings, directory and file permissions may not be set correctly. Since the build process creates directories and files, to be safe you may want to run a `chmod -R +w *' on the entire Perl source tree. -Also, it is a well known WinNT "feature" that files created by a login that is a member of the Administrators group will be owned by the Administrators group. Depending on your umask, you may find that you can not write to files that you just created (because you are no longer the owner). When using the ntsec CYGWIN setting, this is not an issue because it "corrects" the ownership to what you would expect on a UNIX system. -CONFIGURE -The default options gathered by Configure with the assistance of hints/cygwin.sh will build a Perl that supports dynamic loading (which requires a shared libperl.dll). -This will run Configure and keep a record: - ./Configure 2>&1 | tee log.configure -If you are willing to accept all the defaults run Configure with -de. However, several useful customizations are available. -Strip Binaries -It is possible to strip the EXEs and DLLs created by the build process. The resulting binaries will be significantly smaller. If you want the binaries to be stripped, you can either add a -s option when Configure prompts you, - Any additional ld flags (NOT including libraries)? [none] -s - Any special flags to pass to gcc to use dynamic linking? [none] -s - Any special flags to pass to ld2 to create a dynamically loaded library? - [none] -s -or you can edit hints/cygwin.sh and uncomment the relevant variables near the end of the file. -Optional Libraries -Several Perl functions and modules depend on the existence of some optional libraries. Configure will find them if they are installed in one of the directories listed as being used for library searches. Pre-built packages for most of these are available at http://cygutils.netpedia.net/. --lcrypt -The crypt package distributed with Cygwin is a Linux compatible 56-bit DES crypt port by Corinna Vinschen. -Alternatively, the crypt libraries in GNU libc have been ported to Cygwin. -The DES based Ultra Fast Crypt port was done by Alexey Truhan: - ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/cw32crypt-dist-0.tgz -NOTE: There are various export restrictions on DES implementations, see the glibc README for more details. -The MD5 port was done by Andy Piper: - ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/libcrypt.tgz --lgdbm (use GDBM_File) -GDBM is available for Cygwin. GDBM's ndbm/dbm compatibility feature also makes NDBM_File and ODBM_File possible (although they add little extra value). -NOTE: The ndbm/dbm emulations only completely work on NTFS partitions. --ldb (use DB_File) -BerkeleyDB is available for Cygwin. Some details can be found in ext/DB_File/DB_File.pm. -NOTE: The BerkeleyDB library only completely works on NTFS partitions. --lcygipc (use IPC::SysV) -A port of SysV IPC is available for Cygwin. -NOTE: This has not been extensively tested. In particular, d_semctl_semun is undefined because it fails a Configure test and on Win9x the shm*() functions seem to hang. It also creates a compile time dependency because perl.h includes <sys/ipc.h> and <sys/sem.h> (which will be required in the future when compiling CPAN modules). -Configure-time Options -The INSTALL document describes several Configure-time options. Some of these will work with Cygwin, others are not yet possible. Also, some of these are experimental. You can either select an option when Configure prompts you or you can define (undefine) symbols on the command line. --Uusedl -Undefining this symbol forces Perl to be compiled statically. --Uusemymalloc -By default Perl uses the malloc() included with the Perl source. If you want to force Perl to build with the system malloc() undefine this symbol. --Dusemultiplicity -Multiplicity is required when embedding Perl in a C program and using more than one interpreter instance. This works with the Cygwin port. --Duseperlio -The PerlIO abstraction works with the Cygwin port. --Duse64bitint -gcc supports 64-bit integers. However, several additional long long functions are necessary to use them within Perl ({strtol,strtoul}l). These are not yet available with Cygwin. --Duselongdouble -gcc supports long doubles (12 bytes). However, several additional long double math functions are necessary to use them within Perl ({atan2,cos,exp,floor,fmod,frexp,isnan,log,modf,pow,sin,sqrt}l,strtold). These are not yet available with Cygwin. --Dusethreads -POSIX threads are not yet implemented in Cygwin. --Duselargefiles -Although Win32 supports large files, Cygwin currently uses 32-bit integers for internal size and position calculations. -Suspicious Warnings -You may see some messages during Configure that seem suspicious. -dlsym() -ld2 is needed to build dynamic libraries, but it does not exist when dlsym() checking occurs (it is not created until `make' runs). You will see the following message: - Checking whether your dlsym() needs a leading underscore ... - ld2: not found - I can't compile and run the test program. - I'm guessing that dlsym doesn't need a leading underscore. -Since the guess is correct, this is not a problem. -Win9x and d_eofnblk -Win9x does not correctly report EOF with a non-blocking read on a closed pipe. You will see the following messages: - But it also returns -1 to signal EOF, so be careful! - WARNING: you can't distinguish between EOF and no data! - *** WHOA THERE!!! *** - The recommended value for $d_eofnblk on this machine was "define"! - Keep the recommended value? [y] -At least for consistency with WinNT, you should keep the recommended value. -Compiler/Preprocessor defines -The following error occurs because of the Cygwin #define of _LONG_DOUBLE: - Guessing which symbols your C compiler and preprocessor define... - try.c:<line#>: parse error -This failure does not seem to cause any problems. -MAKE -Simply run make and wait: - make 2>&1 | tee log.make -Warnings -Warnings like these are normal: - warning: overriding commands for target <file> - warning: ignoring old commands for target <file> - dllwrap: no export definition file provided - dllwrap: creating one, but that may not be what you want -ld2 -During `make', ld2 will be created and installed in your $installbin directory (where you said to put public executables). It does not wait until the `make install' process to install the ld2 script, this is because the remainder of the `make' refers to ld2 without fully specifying its path and does this from multiple subdirectories. The assumption is that $installbin is in your current PATH. If this is not the case `make' will fail at some point. If this happens, just manually copy ld2 from the source directory to somewhere in your PATH. -TEST -There are two steps to running the test suite: - make test 2>&1 | tee log.make-test - cd t;./perl harness 2>&1 | tee ../log.harness -The same tests are run both times, but more information is provided when running as `./perl harness'. -Test results vary depending on your host system and your Cygwin configuration. If a test can pass in some Cygwin setup, it is always attempted and explainable test failures are documented. It is possible for Perl to pass all the tests, but it is more likely that some tests will fail for one of the reasons listed below. -File Permissions -UNIX file permissions are based on sets of mode bits for {read,write,execute} for each {user,group,other}. By default Cygwin only tracks the Win32 read-only attribute represented as the UNIX file user write bit (files are always readable, files are executable if they have a .{com,bat,exe} extension or begin with #!, directories are always readable and executable). On WinNT with the ntea CYGWIN setting, the additional mode bits are stored as extended file attributes. On WinNT with the ntsec CYGWIN setting, permissions use the standard WinNT security descriptors and access control lists. Without one of these options, these tests will fail: - Failed Test List of failed - ------------------------------------ - io/fs.t 5, 7, 9-10 - lib/anydbm.t 2 - lib/db-btree.t 20 - lib/db-hash.t 16 - lib/db-recno.t 18 - lib/gdbm.t 2 - lib/ndbm.t 2 - lib/odbm.t 2 - lib/sdbm.t 2 - op/stat.t 9, 20 (.tmp not an executable extension) -Hard Links -FAT partitions do not support hard links (whereas NTFS does), in which case Cygwin implements link() by copying the file. On remote (network) drives Cygwin's stat() always sets st_nlink to 1, so the link count for remote directories and files is not available. In either case, these tests will fail: - Failed Test List of failed - ------------------------------------ - io/fs.t 4 - op/stat.t 3 -Filetime Granularity -On FAT partitions the filetime granularity is 2 seconds. The following test will fail: - Failed Test List of failed - ------------------------------------ - io/fs.t 18 -Tainting Checks -When Perl is running in taint mode, $ENV{PATH} is considered tainted and not used, so DLLs not in the default system directories will not be found. While the tests are running you will see warnings popup from the system with messages like: - Win9x - Error Starting Program - A required .DLL file, CYGWIN1.DLL, was not found - WinNT - perl.exe - Unable to Locate DLL - The dynamic link library cygwin1.dll could not be found in the - specified path ... -Just click OK and ignore them. When running `make test', 2 popups occur. During `./perl harness', 4 popups occur. Also, these tests will fail: - Failed Test List of failed - ------------------------------------ - op/taint.t 1, 3, 31, 37 -Alternatively, you can copy cygwin1.dll into the directory where the tests run: - cp /bin/cygwin1.dll t -or one of the Windows system directories (although, this is not recommended). -/etc/group -Cygwin does not require /etc/group, in which case the op/grent.t test will be skipped. The check performed by op/grent.t expects to see entries that use the members field, otherwise this test will fail: - Failed Test List of failed - ------------------------------------ - op/grent.t 1 -Script Portability -Cygwin does an outstanding job of providing UNIX-like semantics on top of Win32 systems. However, in addition to the items noted above, there are some differences that you should know about. This is a very brief guide to portability, more information can be found in the Cygwin documentation. -Pathnames -Cygwin pathnames can be separated by forward (/) or backward (\) slashes. They may also begin with drive letters (C:) or Universal Naming Codes (//UNC). DOS device names (aux, con, prn, com*, lpt?, nul) are invalid as base filenames. However, they can be used in extensions (e.g., hello.aux). Names may contain all printable characters except these: - : * ? " < > | -File names are case insensitive, but case preserving. A pathname that contains a backslash or drive letter is a Win32 pathname (and not subject to the translations applied to POSIX style pathnames). -Text/Binary -When a file is opened it is in either text or binary mode. In text mode a file is subject to CR/LF/Ctrl-Z translations. With Cygwin, the default mode for an open() is determined by the mode of the mount that underlies the file. Perl provides a binmode() function to set binary mode on files that otherwise would be treated as text. sysopen() with the O_TEXT flag sets text mode on files that otherwise would be treated as binary: - sysopen(FOO, "bar", O_WRONLY|O_CREAT|O_TEXT) -lseek(), tell() and sysseek() only work with files opened in binary mode. -The text/binary issue is covered at length in the Cygwin documentation. -.exe -The Cygwin stat(), lstat() and readlink() functions make the .exe extension transparent by looking for foo.exe when you ask for foo (unless a foo also exists). Cygwin does not require a .exe extension, but gcc adds it automatically when building a program. However, when accessing an executable as a normal file (e.g., cp in a makefile) the .exe is not transparent. The install included with Cygwin automatically appends a .exe when necessary. -chown() -On WinNT chown() can change a file's user and group IDs. On Win9x chown() is a no-op, although this is appropriate since there is no security model. -Miscellaneous -File locking using the F_GETLK command to fcntl() is a stub that returns ENOSYS. -Win9x can not rename() an open file (although WinNT can). -The Cygwin chroot() implementation has holes (it can not restrict file access by native Win32 programs). -INSTALL -This will install Perl, including man pages. - make install | tee log.make-install -NOTE: If STDERR is redirected `make install' will not prompt you to install perl into /usr/bin. -You may need to be Administrator to run `make install'. If you are not, you must have write access to the directories in question. -Information on installing the Perl documentation in HTML format can be found in the INSTALL document. -MANIFEST -These are the files in the Perl release that contain references to Cygwin. These very brief notes attempt to explain the reason for all conditional code. Hopefully, keeping this up to date will allow the Cygwin port to be kept as clean as possible. -Documentation - INSTALL README.cygwin README.win32 MANIFEST - Changes Changes5.005 Changes5.004 Changes5.6 - pod/perl.pod pod/perlport.pod pod/perlfaq3.pod - pod/perldelta.pod pod/perl5004delta.pod pod/perl56delta.pod - pod/perlhist.pod pod/perlmodlib.pod pod/buildtoc.PL pod/perltoc.pod -Build, Configure, Make, Install - cygwin/Makefile.SHs - cygwin/ld2.in - cygwin/perlld.in - ext/IPC/SysV/hints/cygwin.pl - ext/NDBM_File/hints/cygwin.pl - ext/ODBM_File/hints/cygwin.pl - hints/cygwin.sh - Configure - help finding hints from uname, - shared libperl required for dynamic loading - Makefile.SH - linklibperl - Porting/patchls - cygwin in port list - installman - man pages with :: translated to . - installperl - install dll/ld2/perlld, install to pods - makedepend.SH - uwinfix -Tests - t/io/tell.t - binmode - t/lib/b.t - ignore Cwd from os_extras - t/lib/glob-basic.t - Win32 directory list access differs from read mode - t/op/magic.t - $^X/symlink WORKAROUND, s/.exe// - t/op/stat.t - no /dev, skip Win32 ftCreationTime quirk - (cache manager sometimes preserves ctime of file - previously created and deleted), no -u (setuid) -Compiled Perl Source - EXTERN.h - __declspec(dllimport) - XSUB.h - __declspec(dllexport) - cygwin/cygwin.c - os_extras (getcwd, spawn) - perl.c - os_extras - perl.h - binmode - doio.c - win9x can not rename a file when it is open - pp_sys.c - do not define h_errno, pp_system with spawn - util.c - use setenv -Compiled Module Source - ext/POSIX/POSIX.xs - tzname defined externally - ext/SDBM_File/sdbm/pair.c - - EXTCONST needs to be redefined from EXTERN.h - ext/SDBM_File/sdbm/sdbm.c - - binary open -Perl Modules/Scripts - lib/Cwd.pm - hook to internal Cwd::cwd - lib/ExtUtils/MakeMaker.pm - - require MM_Cygwin.pm - lib/ExtUtils/MM_Cygwin.pm - - canonpath, cflags, manifypods, perl_archive - lib/File/Find.pm - on remote drives stat() always sets st_nlink to 1 - lib/File/Spec/Unix.pm - preserve //unc - lib/File/Temp.pm - no directory sticky bit - lib/perl5db.pl - use stdin not /dev/tty - utils/perldoc.PL - version comment -BUGS -When make starts, it warns about overriding commands for perlmain.o. -`make clean' does not remove library .def or .exe.stackdump files. -The ld2 script contains references to the source directory. You should change these to $installbin after `make install'. -Support for swapping real and effective user and group IDs is incomplete. On WinNT Cygwin provides setuid(), seteuid(), setgid() and setegid(). However, additional Cygwin calls for manipulating WinNT access tokens and security contexts are required. -When building DLLs, `dllwrap --export-all-symbols' is used to export global symbols. It might be better to generate an explicit .def file (see makedef.pl). Also, DLLs can now be build with `gcc -shared'. -AUTHORS -Charles Wilson <cwilson@ece.gatech.edu>, Eric Fifer <egf7@columbia.edu>, alexander smishlajev <als@turnhere.com>, Steven Morlock <newspost@morlock.net>, Sebastien Barre <Sebastien.Barre@utc.fr>, Teun Burgers <burgers@ecn.nl>. -HISTORY -Last updated: 9 November 2000 diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlfaq.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/perlfaq.pod deleted file mode 100644 index 49cae1a2093..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlfaq.pod +++ /dev/null @@ -1,814 +0,0 @@ -=head1 NAME - -perlfaq3 - Programming Tools ($Revision: 1.38 $, $Date: 1999/05/23 16:08:30 $) - -=head1 DESCRIPTION - -This section of the FAQ answers questions related to programmer tools -and programming support. - -=head2 How do I do (anything)? - -Have you looked at CPAN (see L<perlfaq2>)? The chances are that -someone has already written a module that can solve your problem. -Have you read the appropriate man pages? Here's a brief index: - - Basics perldata, perlvar, perlsyn, perlop, perlsub - Execution perlrun, perldebug - Functions perlfunc - Objects perlref, perlmod, perlobj, perltie - Data Structures perlref, perllol, perldsc - Modules perlmod, perlmodlib, perlsub - Regexes perlre, perlfunc, perlop, perllocale - Moving to perl5 perltrap, perl - Linking w/C perlxstut, perlxs, perlcall, perlguts, perlembed - Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html - (not a man-page but still useful) - -A crude table of contents for the Perl man page set is found in L<perltoc>. - -=head2 How can I use Perl interactively? - -The typical approach uses the Perl debugger, described in the -perldebug(1) man page, on an ``empty'' program, like this: - - perl -de 42 - -Now just type in any legal Perl code, and it will be immediately -evaluated. You can also examine the symbol table, get stack -backtraces, check variable values, set breakpoints, and other -operations typically found in symbolic debuggers. - -=head2 Is there a Perl shell? - -In general, no. The Shell.pm module (distributed with Perl) makes -Perl try commands which aren't part of the Perl language as shell -commands. perlsh from the source distribution is simplistic and -uninteresting, but may still be what you want. - -=head2 How do I debug my Perl programs? - -Have you tried C<use warnings> or used C<-w>? They enable warnings -to detect dubious practices. - -Have you tried C<use strict>? It prevents you from using symbolic -references, makes you predeclare any subroutines that you call as bare -words, and (probably most importantly) forces you to predeclare your -variables with C<my>, C<our>, or C<use vars>. - -Did you check the return values of each and every system call? The operating -system (and thus Perl) tells you whether they worked, and if not -why. - - open(FH, "> /etc/cantwrite") - or die "Couldn't write to /etc/cantwrite: $!\n"; - -Did you read L<perltrap>? It's full of gotchas for old and new Perl -programmers and even has sections for those of you who are upgrading -from languages like I<awk> and I<C>. - -Have you tried the Perl debugger, described in L<perldebug>? You can -step through your program and see what it's doing and thus work out -why what it's doing isn't what it should be doing. - -=head2 How do I profile my Perl programs? - -You should get the Devel::DProf module from the standard distribution -(or separately on CPAN) and also use Benchmark.pm from the standard -distribution. The Benchmark module lets you time specific portions of -your code, while Devel::DProf gives detailed breakdowns of where your -code spends its time. - -Here's a sample use of Benchmark: - - use Benchmark; - - @junk = `cat /etc/motd`; - $count = 10_000; - - timethese($count, { - 'map' => sub { my @a = @junk; - map { s/a/b/ } @a; - return @a - }, - 'for' => sub { my @a = @junk; - local $_; - for (@a) { s/a/b/ }; - return @a }, - }); - -This is what it prints (on one machine--your results will be dependent -on your hardware, operating system, and the load on your machine): - - Benchmark: timing 10000 iterations of for, map... - for: 4 secs ( 3.97 usr 0.01 sys = 3.98 cpu) - map: 6 secs ( 4.97 usr 0.00 sys = 4.97 cpu) - -Be aware that a good benchmark is very hard to write. It only tests the -data you give it and proves little about the differing complexities -of contrasting algorithms. - -=head2 How do I cross-reference my Perl programs? - -The B::Xref module, shipped with the new, alpha-release Perl compiler -(not the general distribution prior to the 5.005 release), can be used -to generate cross-reference reports for Perl programs. - - perl -MO=Xref[,OPTIONS] scriptname.plx - -=head2 Is there a pretty-printer (formatter) for Perl? - -There is no program that will reformat Perl as much as indent(1) does -for C. The complex feedback between the scanner and the parser (this -feedback is what confuses the vgrind and emacs programs) makes it -challenging at best to write a stand-alone Perl parser. - -Of course, if you simply follow the guidelines in L<perlstyle>, you -shouldn't need to reformat. The habit of formatting your code as you -write it will help prevent bugs. Your editor can and should help you -with this. The perl-mode or newer cperl-mode for emacs can provide -remarkable amounts of help with most (but not all) code, and even less -programmable editors can provide significant assistance. Tom swears -by the following settings in vi and its clones: - - set ai sw=4 - map! ^O {^M}^[O^T - -Now put that in your F<.exrc> file (replacing the caret characters -with control characters) and away you go. In insert mode, ^T is -for indenting, ^D is for undenting, and ^O is for blockdenting-- -as it were. If you haven't used the last one, you're missing -a lot. A more complete example, with comments, can be found at -http://www.perl.com/CPAN-local/authors/id/TOMC/scripts/toms.exrc.gz - -If you are used to using the I<vgrind> program for printing out nice code -to a laser printer, you can take a stab at this using -http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the -results are not particularly satisfying for sophisticated code. - -The a2ps at http://www.infres.enst.fr/%7Edemaille/a2ps/ does lots of things -related to generating nicely printed output of documents. - -=head2 Is there a ctags for Perl? - -There's a simple one at -http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do -the trick. And if not, it's easy to hack into what you want. - -=head2 Is there an IDE or Windows Perl Editor? - -Perl programs are just plain text, so any editor will do. - -If you're on Unix, you already have an IDE--Unix itself. The UNIX -philosophy is the philosophy of several small tools that each do one -thing and do it well. It's like a carpenter's toolbox. - -If you want a Windows IDE, check the following: - -=over 4 - -=item CodeMagicCD - -http://www.codemagiccd.com/ - -=item Komodo - -ActiveState's cross-platform, multi-language IDE has Perl support, -including a regular expression debugger and remote debugging -(http://www.ActiveState.com/Products/Komodo/index.html). -(Visual Perl, a Visual Studio.NET plug-in is currently (early 2001) -in beta (http://www.ActiveState.com/Products/VisualPerl/index.html)). - -=item The Object System - -(http://www.castlelink.co.uk/object_system/) is a Perl web -applications development IDE. - -=item PerlBuilder - -(http://www.solutionsoft.com/perl.htm) is an integrated development -environment for Windows that supports Perl development. - -=item Perl code magic - -(http://www.petes-place.com/codemagic.html). - -=item visiPerl+ - -http://helpconsulting.net/visiperl/, from Help Consulting. - -=back - -For editors: if you're on Unix you probably have vi or a vi clone already, -and possibly an emacs too, so you may not need to download anything. -In any emacs the cperl-mode (M-x cperl-mode) gives you perhaps the -best available Perl editing mode in any editor. - -For Windows editors: you can download an Emacs - -=over 4 - -=item GNU Emacs - -http://www.gnu.org/software/emacs/windows/ntemacs.html - -=item MicroEMACS - -http://members.nbci.com/uemacs/ - -=item XEmacs - -http://www.xemacs.org/Download/index.html - -=back - -or a vi clone such as - -=over 4 - -=item Elvis - -ftp://ftp.cs.pdx.edu/pub/elvis/ http://www.fh-wedel.de/elvis/ - -=item Vile - -http://vile.cx/ - -=item Vim - -http://www.vim.org/ - -win32: http://www.cs.vu.nl/%7Etmgil/vi.html - -=back - -For vi lovers in general, Windows or elsewhere: -http://www.thomer.com/thomer/vi/vi.html. - -nvi (http://www.bostic.com/vi/, available from CPAN in src/misc/) is -yet another vi clone, unfortunately not available for Windows, but in -UNIX platforms you might be interested in trying it out, firstly because -strictly speaking it is not a vi clone, it is the real vi, or the new -incarnation of it, and secondly because you can embed Perl inside it -to use Perl as the scripting language. nvi is not alone in this, -though: at least also vim and vile offer an embedded Perl. - -The following are Win32 multilanguage editor/IDESs that support Perl: - -=over 4 - -=item Codewright - -http://www.starbase.com/ - -=item MultiEdit - -http://www.MultiEdit.com/ - -=item SlickEdit - -http://www.slickedit.com/ - -=back - -There is also a toyedit Text widget based editor written in Perl -that is distributed with the Tk module on CPAN. The ptkdb -(http://world.std.com/~aep/ptkdb/) is a Perl/tk based debugger that -acts as a development environment of sorts. Perl Composer -(http://perlcomposer.sourceforge.net/vperl.html) is an IDE for Perl/Tk -GUI creation. - -In addition to an editor/IDE you might be interested in a more -powerful shell environment for Win32. Your options include - -=over 4 - -=item Bash - -from the Cygwin package (http://sources.redhat.com/cygwin/) - -=item Ksh - -from the MKS Toolkit (http://www.mks.com/), or the Bourne shell of -the U/WIN environment (http://www.research.att.com/sw/tools/uwin/) - -=item Tcsh - -ftp://ftp.astron.com/pub/tcsh/, see also -http://www.primate.wisc.edu/software/csh-tcsh-book/ - -=item Zsh - -ftp://ftp.blarg.net/users/amol/zsh/, see also http://www.zsh.org/ - -=back - -MKS and U/WIN are commercial (U/WIN is free for educational and -research purposes), Cygwin is covered by the GNU Public License (but -that shouldn't matter for Perl use). The Cygwin, MKS, and U/WIN all -contain (in addition to the shells) a comprehensive set of standard -UNIX toolkit utilities. - -If you're transferring text files between Unix and Windows using FTP -be sure to transfer them in ASCII mode so the ends of lines are -appropriately converted. - -On Mac OS the MacPerl Application comes with a simple 32k text editor -that behaves like a rudimentary IDE. In contrast to the MacPerl Application -the MPW Perl tool can make use of the MPW Shell itself as an editor (with -no 32k limit). - -=over 4 - -=item BBEdit and BBEdit Lite - -are text editors for Mac OS that have a Perl sensitivity mode -(http://web.barebones.com/). - -=item Alpha - -is an editor, written and extensible in Tcl, that nonetheless has -built in support for several popular markup and programming languages -including Perl and HTML (http://alpha.olm.net/). - -=back - -Pepper and Pe are programming language sensitive text editors for Mac -OS X and BeOS respectively (http://www.hekkelman.com/). - -=head2 Where can I get Perl macros for vi? - -For a complete version of Tom Christiansen's vi configuration file, -see http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/toms.exrc.gz , -the standard benchmark file for vi emulators. The file runs best with nvi, -the current version of vi out of Berkeley, which incidentally can be built -with an embedded Perl interpreter--see http://www.perl.com/CPAN/src/misc. - -=head2 Where can I get perl-mode for emacs? - -Since Emacs version 19 patchlevel 22 or so, there have been both a -perl-mode.el and support for the Perl debugger built in. These should -come with the standard Emacs 19 distribution. - -In the Perl source directory, you'll find a directory called "emacs", -which contains a cperl-mode that color-codes keywords, provides -context-sensitive help, and other nifty things. - -Note that the perl-mode of emacs will have fits with C<"main'foo"> -(single quote), and mess up the indentation and highlighting. You -are probably using C<"main::foo"> in new Perl code anyway, so this -shouldn't be an issue. - -=head2 How can I use curses with Perl? - -The Curses module from CPAN provides a dynamically loadable object -module interface to a curses library. A small demo can be found at the -directory http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/rep; -this program repeats a command and updates the screen as needed, rendering -B<rep ps axu> similar to B<top>. - -=head2 How can I use X or Tk with Perl? - -Tk is a completely Perl-based, object-oriented interface to the Tk toolkit -that doesn't force you to use Tcl just to get at Tk. Sx is an interface -to the Athena Widget set. Both are available from CPAN. See the -directory http://www.perl.com/CPAN/modules/by-category/08_User_Interfaces/ - -Invaluable for Perl/Tk programming are the Perl/Tk FAQ at -http://w4.lns.cornell.edu/%7Epvhp/ptk/ptkTOC.html , the Perl/Tk Reference -Guide available at -http://www.perl.com/CPAN-local/authors/Stephen_O_Lidie/ , and the -online manpages at -http://www-users.cs.umn.edu/%7Eamundson/perl/perltk/toc.html . - -=head2 How can I generate simple menus without using CGI or Tk? - -The http://www.perl.com/CPAN/authors/id/SKUNZ/perlmenu.v4.0.tar.gz -module, which is curses-based, can help with this. - -=head2 What is undump? - -See the next question on ``How can I make my Perl program run faster?'' - -=head2 How can I make my Perl program run faster? - -The best way to do this is to come up with a better algorithm. This -can often make a dramatic difference. Jon Bentley's book -``Programming Pearls'' (that's not a misspelling!) has some good tips -on optimization, too. Advice on benchmarking boils down to: benchmark -and profile to make sure you're optimizing the right part, look for -better algorithms instead of microtuning your code, and when all else -fails consider just buying faster hardware. - -A different approach is to autoload seldom-used Perl code. See the -AutoSplit and AutoLoader modules in the standard distribution for -that. Or you could locate the bottleneck and think about writing just -that part in C, the way we used to take bottlenecks in C code and -write them in assembler. Similar to rewriting in C, -modules that have critical sections can be written in C (for instance, the -PDL module from CPAN). - -In some cases, it may be worth it to use the backend compiler to -produce byte code (saving compilation time) or compile into C, which -will certainly save compilation time and sometimes a small amount (but -not much) execution time. See the question about compiling your Perl -programs for more on the compiler--the wins aren't as obvious as you'd -hope. - -If you're currently linking your perl executable to a shared I<libc.so>, -you can often gain a 10-25% performance benefit by rebuilding it to -link with a static libc.a instead. This will make a bigger perl -executable, but your Perl programs (and programmers) may thank you for -it. See the F<INSTALL> file in the source distribution for more -information. - -Unsubstantiated reports allege that Perl interpreters that use sfio -outperform those that don't (for I/O intensive applications). To try -this, see the F<INSTALL> file in the source distribution, especially -the ``Selecting File I/O mechanisms'' section. - -The undump program was an old attempt to speed up your Perl program -by storing the already-compiled form to disk. This is no longer -a viable option, as it only worked on a few architectures, and -wasn't a good solution anyway. - -=head2 How can I make my Perl program take less memory? - -When it comes to time-space tradeoffs, Perl nearly always prefers to -throw memory at a problem. Scalars in Perl use more memory than -strings in C, arrays take more than that, and hashes use even more. While -there's still a lot to be done, recent releases have been addressing -these issues. For example, as of 5.004, duplicate hash keys are -shared amongst all hashes using them, so require no reallocation. - -In some cases, using substr() or vec() to simulate arrays can be -highly beneficial. For example, an array of a thousand booleans will -take at least 20,000 bytes of space, but it can be turned into one -125-byte bit vector--a considerable memory savings. The standard -Tie::SubstrHash module can also help for certain types of data -structure. If you're working with specialist data structures -(matrices, for instance) modules that implement these in C may use -less memory than equivalent Perl modules. - -Another thing to try is learning whether your Perl was compiled with -the system malloc or with Perl's builtin malloc. Whichever one it -is, try using the other one and see whether this makes a difference. -Information about malloc is in the F<INSTALL> file in the source -distribution. You can find out whether you are using perl's malloc by -typing C<perl -V:usemymalloc>. - -=head2 Is it unsafe to return a pointer to local data? - -No, Perl's garbage collection system takes care of this. - - sub makeone { - my @a = ( 1 .. 10 ); - return \@a; - } - - for $i ( 1 .. 10 ) { - push @many, makeone(); - } - - print $many[4][5], "\n"; - - print "@many\n"; - -=head2 How can I free an array or hash so my program shrinks? - -You can't. On most operating systems, memory allocated to a program -can never be returned to the system. That's why long-running programs -sometimes re-exec themselves. Some operating systems (notably, -FreeBSD and Linux) allegedly reclaim large chunks of memory that is no -longer used, but it doesn't appear to happen with Perl (yet). The Mac -appears to be the only platform that will reliably (albeit, slowly) -return memory to the OS. - -We've had reports that on Linux (Redhat 5.1) on Intel, C<undef -$scalar> will return memory to the system, while on Solaris 2.6 it -won't. In general, try it yourself and see. - -However, judicious use of my() on your variables will help make sure -that they go out of scope so that Perl can free up that space for -use in other parts of your program. A global variable, of course, never -goes out of scope, so you can't get its space automatically reclaimed, -although undef()ing and/or delete()ing it will achieve the same effect. -In general, memory allocation and de-allocation isn't something you can -or should be worrying about much in Perl, but even this capability -(preallocation of data types) is in the works. - -=head2 How can I make my CGI script more efficient? - -Beyond the normal measures described to make general Perl programs -faster or smaller, a CGI program has additional issues. It may be run -several times per second. Given that each time it runs it will need -to be re-compiled and will often allocate a megabyte or more of system -memory, this can be a killer. Compiling into C B<isn't going to help -you> because the process start-up overhead is where the bottleneck is. - -There are two popular ways to avoid this overhead. One solution -involves running the Apache HTTP server (available from -http://www.apache.org/) with either of the mod_perl or mod_fastcgi -plugin modules. - -With mod_perl and the Apache::Registry module (distributed with -mod_perl), httpd will run with an embedded Perl interpreter which -pre-compiles your script and then executes it within the same address -space without forking. The Apache extension also gives Perl access to -the internal server API, so modules written in Perl can do just about -anything a module written in C can. For more on mod_perl, see -http://perl.apache.org/ - -With the FCGI module (from CPAN) and the mod_fastcgi -module (available from http://www.fastcgi.com/) each of your Perl -programs becomes a permanent CGI daemon process. - -Both of these solutions can have far-reaching effects on your system -and on the way you write your CGI programs, so investigate them with -care. - -See http://www.perl.com/CPAN/modules/by-category/15_World_Wide_Web_HTML_HTTP_CGI/ . - -A non-free, commercial product, ``The Velocity Engine for Perl'', -(http://www.binevolve.com/ or http://www.binevolve.com/velocigen/ ) -might also be worth looking at. It will allow you to increase the -performance of your Perl programs, running programs up to 25 times -faster than normal CGI Perl when running in persistent Perl mode or 4 -to 5 times faster without any modification to your existing CGI -programs. Fully functional evaluation copies are available from the -web site. - -=head2 How can I hide the source for my Perl program? - -Delete it. :-) Seriously, there are a number of (mostly -unsatisfactory) solutions with varying levels of ``security''. - -First of all, however, you I<can't> take away read permission, because -the source code has to be readable in order to be compiled and -interpreted. (That doesn't mean that a CGI script's source is -readable by people on the web, though--only by people with access to -the filesystem.) So you have to leave the permissions at the socially -friendly 0755 level. - -Some people regard this as a security problem. If your program does -insecure things and relies on people not knowing how to exploit those -insecurities, it is not secure. It is often possible for someone to -determine the insecure things and exploit them without viewing the -source. Security through obscurity, the name for hiding your bugs -instead of fixing them, is little security indeed. - -You can try using encryption via source filters (Filter::* from CPAN), -but any decent programmer will be able to decrypt it. You can try using -the byte code compiler and interpreter described below, but the curious -might still be able to de-compile it. You can try using the native-code -compiler described below, but crackers might be able to disassemble it. -These pose varying degrees of difficulty to people wanting to get at -your code, but none can definitively conceal it (true of every -language, not just Perl). - -If you're concerned about people profiting from your code, then the -bottom line is that nothing but a restrictive license will give you -legal security. License your software and pepper it with threatening -statements like ``This is unpublished proprietary software of XYZ Corp. -Your access to it does not give you permission to use it blah blah -blah.'' We are not lawyers, of course, so you should see a lawyer if -you want to be sure your license's wording will stand up in court. - -=head2 How can I compile my Perl program into byte code or C? - -Malcolm Beattie has written a multifunction backend compiler, -available from CPAN, that can do both these things. It is included -in the perl5.005 release, but is still considered experimental. -This means it's fun to play with if you're a programmer but not -really for people looking for turn-key solutions. - -Merely compiling into C does not in and of itself guarantee that your -code will run very much faster. That's because except for lucky cases -where a lot of native type inferencing is possible, the normal Perl -run-time system is still present and so your program will take just as -long to run and be just as big. Most programs save little more than -compilation time, leaving execution no more than 10-30% faster. A few -rare programs actually benefit significantly (even running several times -faster), but this takes some tweaking of your code. - -You'll probably be astonished to learn that the current version of the -compiler generates a compiled form of your script whose executable is -just as big as the original perl executable, and then some. That's -because as currently written, all programs are prepared for a full -eval() statement. You can tremendously reduce this cost by building a -shared I<libperl.so> library and linking against that. See the -F<INSTALL> podfile in the Perl source distribution for details. If -you link your main perl binary with this, it will make it minuscule. -For example, on one author's system, F</usr/bin/perl> is only 11k in -size! - -In general, the compiler will do nothing to make a Perl program smaller, -faster, more portable, or more secure. In fact, it can make your -situation worse. The executable will be bigger, your VM system may take -longer to load the whole thing, the binary is fragile and hard to fix, -and compilation never stopped software piracy in the form of crackers, -viruses, or bootleggers. The real advantage of the compiler is merely -packaging, and once you see the size of what it makes (well, unless -you use a shared I<libperl.so>), you'll probably want a complete -Perl install anyway. - -=head2 How can I compile Perl into Java? - -You can also integrate Java and Perl with the -Perl Resource Kit from O'Reilly and Associates. See -http://www.oreilly.com/catalog/prkunix/ . - -Perl 5.6 comes with Java Perl Lingo, or JPL. JPL, still in -development, allows Perl code to be called from Java. See jpl/README -in the Perl source tree. - -=head2 How can I get C<#!perl> to work on [MS-DOS,NT,...]? - -For OS/2 just use - - extproc perl -S -your_switches - -as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's -`extproc' handling). For DOS one should first invent a corresponding -batch file and codify it in C<ALTERNATIVE_SHEBANG> (see the -F<INSTALL> file in the source distribution for more information). - -The Win95/NT installation, when using the ActiveState port of Perl, -will modify the Registry to associate the C<.pl> extension with the -perl interpreter. If you install another port, perhaps even building -your own Win95/NT Perl from the standard sources by using a Windows port -of gcc (e.g., with cygwin or mingw32), then you'll have to modify -the Registry yourself. In addition to associating C<.pl> with the -interpreter, NT people can use: C<SET PATHEXT=%PATHEXT%;.PL> to let them -run the program C<install-linux.pl> merely by typing C<install-linux>. - -Macintosh Perl programs will have the appropriate Creator and -Type, so that double-clicking them will invoke the Perl application. - -I<IMPORTANT!>: Whatever you do, PLEASE don't get frustrated, and just -throw the perl interpreter into your cgi-bin directory, in order to -get your programs working for a web server. This is an EXTREMELY big -security risk. Take the time to figure out how to do it correctly. - -=head2 Can I write useful Perl programs on the command line? - -Yes. Read L<perlrun> for more information. Some examples follow. -(These assume standard Unix shell quoting rules.) - - # sum first and last fields - perl -lane 'print $F[0] + $F[-1]' * - - # identify text files - perl -le 'for(@ARGV) {print if -f && -T _}' * - - # remove (most) comments from C program - perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c - - # make file a month younger than today, defeating reaper daemons - perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' * - - # find first unused uid - perl -le '$i++ while getpwuid($i); print $i' - - # display reasonable manpath - echo $PATH | perl -nl -072 -e ' - s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}' - -OK, the last one was actually an Obfuscated Perl Contest entry. :-) - -=head2 Why don't Perl one-liners work on my DOS/Mac/VMS system? - -The problem is usually that the command interpreters on those systems -have rather different ideas about quoting than the Unix shells under -which the one-liners were created. On some systems, you may have to -change single-quotes to double ones, which you must I<NOT> do on Unix -or Plan9 systems. You might also have to change a single % to a %%. - -For example: - - # Unix - perl -e 'print "Hello world\n"' - - # DOS, etc. - perl -e "print \"Hello world\n\"" - - # Mac - print "Hello world\n" - (then Run "Myscript" or Shift-Command-R) - - # VMS - perl -e "print ""Hello world\n""" - -The problem is that none of these examples are reliable: they depend on the -command interpreter. Under Unix, the first two often work. Under DOS, -it's entirely possible that neither works. If 4DOS was the command shell, -you'd probably have better luck like this: - - perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" - -Under the Mac, it depends which environment you are using. The MacPerl -shell, or MPW, is much like Unix shells in its support for several -quoting variants, except that it makes free use of the Mac's non-ASCII -characters as control characters. - -Using qq(), q(), and qx(), instead of "double quotes", 'single -quotes', and `backticks`, may make one-liners easier to write. - -There is no general solution to all of this. It is a mess, pure and -simple. Sucks to be away from Unix, huh? :-) - -[Some of this answer was contributed by Kenneth Albanowski.] - -=head2 Where can I learn about CGI or Web programming in Perl? - -For modules, get the CGI or LWP modules from CPAN. For textbooks, -see the two especially dedicated to web stuff in the question on -books. For problems and questions related to the web, like ``Why -do I get 500 Errors'' or ``Why doesn't it run from the browser right -when it runs fine on the command line'', see these sources: - - WWW Security FAQ - http://www.w3.org/Security/Faq/ - - Web FAQ - http://www.boutell.com/faq/ - - CGI FAQ - http://www.webthing.com/tutorials/cgifaq.html - - HTTP Spec - http://www.w3.org/pub/WWW/Protocols/HTTP/ - - HTML Spec - http://www.w3.org/TR/REC-html40/ - http://www.w3.org/pub/WWW/MarkUp/ - - CGI Spec - http://www.w3.org/CGI/ - - CGI Security FAQ - http://www.go2net.com/people/paulp/cgi-security/safe-cgi.txt - -=head2 Where can I learn about object-oriented Perl programming? - -A good place to start is L<perltoot>, and you can use L<perlobj>, -L<perlboot>, and L<perlbot> for reference. Perltoot didn't come out -until the 5.004 release; you can get a copy (in pod, html, or -postscript) from http://www.perl.com/CPAN/doc/FMTEYEWTK/ . - -=head2 Where can I learn about linking C with Perl? [h2xs, xsubpp] - -If you want to call C from Perl, start with L<perlxstut>, -moving on to L<perlxs>, L<xsubpp>, and L<perlguts>. If you want to -call Perl from C, then read L<perlembed>, L<perlcall>, and -L<perlguts>. Don't forget that you can learn a lot from looking at -how the authors of existing extension modules wrote their code and -solved their problems. - -=head2 I've read perlembed, perlguts, etc., but I can't embed perl in -my C program; what am I doing wrong? - -Download the ExtUtils::Embed kit from CPAN and run `make test'. If -the tests pass, read the pods again and again and again. If they -fail, see L<perlbug> and send a bug report with the output of -C<make test TEST_VERBOSE=1> along with C<perl -V>. - -=head2 When I tried to run my script, I got this message. What does it -mean? - -A complete list of Perl's error messages and warnings with explanatory -text can be found in L<perldiag>. You can also use the splain program -(distributed with Perl) to explain the error messages: - - perl program 2>diag.out - splain [-v] [-p] diag.out - -or change your program to explain the messages for you: - - use diagnostics; - -or - - use diagnostics -verbose; - -=head2 What's MakeMaker? - -This module (part of the standard Perl distribution) is designed to -write a Makefile for an extension module from a Makefile.PL. For more -information, see L<ExtUtils::MakeMaker>. - -=head1 AUTHOR AND COPYRIGHT - -Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington. -All rights reserved. - -When included as an integrated part of the Standard Distribution -of Perl or of its documentation (printed or otherwise), this works is -covered under Perl's Artistic License. For separate distributions of -all or part of this FAQ outside of that, see L<perlfaq>. - -Irrespective of its distribution, all code examples here are in the public -domain. You are permitted and encouraged to use this code and any -derivatives thereof in your own programs for fun or for profit as you -see fit. A simple comment in the code giving credit to the FAQ would -be courteous but is not required. diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlfaqo.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/perlfaqo.txt deleted file mode 100644 index 11d73fc9b8f..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlfaqo.txt +++ /dev/null @@ -1,266 +0,0 @@ -NAME -perlfaq3 - Programming Tools ($Revision: 1.38 $, $Date: 1999/05/23 16:08:30 $) -DESCRIPTION -This section of the FAQ answers questions related to programmer tools and programming support. -How do I do (anything)? -Have you looked at CPAN (see perlfaq2)? The chances are that someone has already written a module that can solve your problem. Have you read the appropriate man pages? Here's a brief index: - Basics perldata, perlvar, perlsyn, perlop, perlsub - Execution perlrun, perldebug - Functions perlfunc - Objects perlref, perlmod, perlobj, perltie - Data Structures perlref, perllol, perldsc - Modules perlmod, perlmodlib, perlsub - Regexes perlre, perlfunc, perlop, perllocale - Moving to perl5 perltrap, perl - Linking w/C perlxstut, perlxs, perlcall, perlguts, perlembed - Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html - (not a man-page but still useful) -A crude table of contents for the Perl man page set is found in perltoc. -How can I use Perl interactively? -The typical approach uses the Perl debugger, described in the perldebug(1) man page, on an ``empty'' program, like this: - perl -de 42 -Now just type in any legal Perl code, and it will be immediately evaluated. You can also examine the symbol table, get stack backtraces, check variable values, set breakpoints, and other operations typically found in symbolic debuggers. -Is there a Perl shell? -In general, no. The Shell.pm module (distributed with Perl) makes Perl try commands which aren't part of the Perl language as shell commands. perlsh from the source distribution is simplistic and uninteresting, but may still be what you want. -How do I debug my Perl programs? -Have you tried use warnings or used -w? They enable warnings to detect dubious practices. -Have you tried use strict? It prevents you from using symbolic references, makes you predeclare any subroutines that you call as bare words, and (probably most importantly) forces you to predeclare your variables with my, our, or use vars. -Did you check the return values of each and every system call? The operating system (and thus Perl) tells you whether they worked, and if not why. - open(FH, "> /etc/cantwrite") - or die "Couldn't write to /etc/cantwrite: $!\n"; -Did you read perltrap? It's full of gotchas for old and new Perl programmers and even has sections for those of you who are upgrading from languages like awk and C. -Have you tried the Perl debugger, described in perldebug? You can step through your program and see what it's doing and thus work out why what it's doing isn't what it should be doing. -How do I profile my Perl programs? -You should get the Devel::DProf module from the standard distribution (or separately on CPAN) and also use Benchmark.pm from the standard distribution. The Benchmark module lets you time specific portions of your code, while Devel::DProf gives detailed breakdowns of where your code spends its time. -Here's a sample use of Benchmark: - use Benchmark; - @junk = `cat /etc/motd`; - $count = 10_000; - timethese($count, { - 'map' => sub { my @a = @junk; - map { s/a/b/ } @a; - return @a - }, - 'for' => sub { my @a = @junk; - local $_; - for (@a) { s/a/b/ }; - return @a }, - }); -This is what it prints (on one machine--your results will be dependent on your hardware, operating system, and the load on your machine): - Benchmark: timing 10000 iterations of for, map... - for: 4 secs ( 3.97 usr 0.01 sys = 3.98 cpu) - map: 6 secs ( 4.97 usr 0.00 sys = 4.97 cpu) -Be aware that a good benchmark is very hard to write. It only tests the data you give it and proves little about the differing complexities of contrasting algorithms. -How do I cross-reference my Perl programs? -The B::Xref module, shipped with the new, alpha-release Perl compiler (not the general distribution prior to the 5.005 release), can be used to generate cross-reference reports for Perl programs. - perl -MO=Xref[,OPTIONS] scriptname.plx -Is there a pretty-printer (formatter) for Perl? -There is no program that will reformat Perl as much as indent(1) does for C. The complex feedback between the scanner and the parser (this feedback is what confuses the vgrind and emacs programs) makes it challenging at best to write a stand-alone Perl parser. -Of course, if you simply follow the guidelines in perlstyle, you shouldn't need to reformat. The habit of formatting your code as you write it will help prevent bugs. Your editor can and should help you with this. The perl-mode or newer cperl-mode for emacs can provide remarkable amounts of help with most (but not all) code, and even less programmable editors can provide significant assistance. Tom swears by the following settings in vi and its clones: - set ai sw=4 - map! ^O {^M}^[O^T -Now put that in your .exrc file (replacing the caret characters with control characters) and away you go. In insert mode, ^T is for indenting, ^D is for undenting, and ^O is for blockdenting-- as it were. If you haven't used the last one, you're missing a lot. A more complete example, with comments, can be found at http://www.perl.com/CPAN-local/authors/id/TOMC/scripts/toms.exrc.gz -If you are used to using the vgrind program for printing out nice code to a laser printer, you can take a stab at this using http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the results are not particularly satisfying for sophisticated code. -The a2ps at http://www.infres.enst.fr/%7Edemaille/a2ps/ does lots of things related to generating nicely printed output of documents. -Is there a ctags for Perl? -There's a simple one at http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do the trick. And if not, it's easy to hack into what you want. -Is there an IDE or Windows Perl Editor? -Perl programs are just plain text, so any editor will do. -If you're on Unix, you already have an IDE--Unix itself. The UNIX philosophy is the philosophy of several small tools that each do one thing and do it well. It's like a carpenter's toolbox. -If you want a Windows IDE, check the following: -CodeMagicCD -http://www.codemagiccd.com/ -Komodo -ActiveState's cross-platform, multi-language IDE has Perl support, including a regular expression debugger and remote debugging (http://www.ActiveState.com/Products/Komodo/index.html). (Visual Perl, a Visual Studio.NET plug-in is currently (early 2001) in beta (http://www.ActiveState.com/Products/VisualPerl/index.html)). -The Object System -(http://www.castlelink.co.uk/object_system/) is a Perl web applications development IDE. -PerlBuilder -(http://www.solutionsoft.com/perl.htm) is an integrated development environment for Windows that supports Perl development. -Perl code magic -(http://www.petes-place.com/codemagic.html). -visiPerl+ -http://helpconsulting.net/visiperl/, from Help Consulting. -For editors: if you're on Unix you probably have vi or a vi clone already, and possibly an emacs too, so you may not need to download anything. In any emacs the cperl-mode (M-x cperl-mode) gives you perhaps the best available Perl editing mode in any editor. -For Windows editors: you can download an Emacs -GNU Emacs -http://www.gnu.org/software/emacs/windows/ntemacs.html -MicroEMACS -http://members.nbci.com/uemacs/ -XEmacs -http://www.xemacs.org/Download/index.html -or a vi clone such as -Elvis -ftp://ftp.cs.pdx.edu/pub/elvis/ http://www.fh-wedel.de/elvis/ -Vile -http://vile.cx/ -Vim -http://www.vim.org/ -win32: http://www.cs.vu.nl/%7Etmgil/vi.html -For vi lovers in general, Windows or elsewhere: http://www.thomer.com/thomer/vi/vi.html. -nvi (http://www.bostic.com/vi/, available from CPAN in src/misc/) is yet another vi clone, unfortunately not available for Windows, but in UNIX platforms you might be interested in trying it out, firstly because strictly speaking it is not a vi clone, it is the real vi, or the new incarnation of it, and secondly because you can embed Perl inside it to use Perl as the scripting language. nvi is not alone in this, though: at least also vim and vile offer an embedded Perl. -The following are Win32 multilanguage editor/IDESs that support Perl: -Codewright -http://www.starbase.com/ -MultiEdit -http://www.MultiEdit.com/ -SlickEdit -http://www.slickedit.com/ -There is also a toyedit Text widget based editor written in Perl that is distributed with the Tk module on CPAN. The ptkdb (http://world.std.com/~aep/ptkdb/) is a Perl/tk based debugger that acts as a development environment of sorts. Perl Composer (http://perlcomposer.sourceforge.net/vperl.html) is an IDE for Perl/Tk GUI creation. -In addition to an editor/IDE you might be interested in a more powerful shell environment for Win32. Your options include -Bash -from the Cygwin package (http://sources.redhat.com/cygwin/) -Ksh -from the MKS Toolkit (http://www.mks.com/), or the Bourne shell of the U/WIN environment (http://www.research.att.com/sw/tools/uwin/) -Tcsh -ftp://ftp.astron.com/pub/tcsh/, see also http://www.primate.wisc.edu/software/csh-tcsh-book/ -Zsh -ftp://ftp.blarg.net/users/amol/zsh/, see also http://www.zsh.org/ -MKS and U/WIN are commercial (U/WIN is free for educational and research purposes), Cygwin is covered by the GNU Public License (but that shouldn't matter for Perl use). The Cygwin, MKS, and U/WIN all contain (in addition to the shells) a comprehensive set of standard UNIX toolkit utilities. -If you're transferring text files between Unix and Windows using FTP be sure to transfer them in ASCII mode so the ends of lines are appropriately converted. -On Mac OS the MacPerl Application comes with a simple 32k text editor that behaves like a rudimentary IDE. In contrast to the MacPerl Application the MPW Perl tool can make use of the MPW Shell itself as an editor (with no 32k limit). -BBEdit and BBEdit Lite -are text editors for Mac OS that have a Perl sensitivity mode (http://web.barebones.com/). -Alpha -is an editor, written and extensible in Tcl, that nonetheless has built in support for several popular markup and programming languages including Perl and HTML (http://alpha.olm.net/). -Pepper and Pe are programming language sensitive text editors for Mac OS X and BeOS respectively (http://www.hekkelman.com/). -Where can I get Perl macros for vi? -For a complete version of Tom Christiansen's vi configuration file, see http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/toms.exrc.gz , the standard benchmark file for vi emulators. The file runs best with nvi, the current version of vi out of Berkeley, which incidentally can be built with an embedded Perl interpreter--see http://www.perl.com/CPAN/src/misc. -Where can I get perl-mode for emacs? -Since Emacs version 19 patchlevel 22 or so, there have been both a perl-mode.el and support for the Perl debugger built in. These should come with the standard Emacs 19 distribution. -In the Perl source directory, you'll find a directory called "emacs", which contains a cperl-mode that color-codes keywords, provides context-sensitive help, and other nifty things. -Note that the perl-mode of emacs will have fits with "main'foo" (single quote), and mess up the indentation and highlighting. You are probably using "main::foo" in new Perl code anyway, so this shouldn't be an issue. -How can I use curses with Perl? -The Curses module from CPAN provides a dynamically loadable object module interface to a curses library. A small demo can be found at the directory http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/rep; this program repeats a command and updates the screen as needed, rendering rep ps axu similar to top. -How can I use X or Tk with Perl? -Tk is a completely Perl-based, object-oriented interface to the Tk toolkit that doesn't force you to use Tcl just to get at Tk. Sx is an interface to the Athena Widget set. Both are available from CPAN. See the directory http://www.perl.com/CPAN/modules/by-category/08_User_Interfaces/ -Invaluable for Perl/Tk programming are the Perl/Tk FAQ at http://w4.lns.cornell.edu/%7Epvhp/ptk/ptkTOC.html , the Perl/Tk Reference Guide available at http://www.perl.com/CPAN-local/authors/Stephen_O_Lidie/ , and the online manpages at http://www-users.cs.umn.edu/%7Eamundson/perl/perltk/toc.html . -How can I generate simple menus without using CGI or Tk? -The http://www.perl.com/CPAN/authors/id/SKUNZ/perlmenu.v4.0.tar.gz module, which is curses-based, can help with this. -What is undump? -See the next question on ``How can I make my Perl program run faster?'' -How can I make my Perl program run faster? -The best way to do this is to come up with a better algorithm. This can often make a dramatic difference. Jon Bentley's book ``Programming Pearls'' (that's not a misspelling!) has some good tips on optimization, too. Advice on benchmarking boils down to: benchmark and profile to make sure you're optimizing the right part, look for better algorithms instead of microtuning your code, and when all else fails consider just buying faster hardware. -A different approach is to autoload seldom-used Perl code. See the AutoSplit and AutoLoader modules in the standard distribution for that. Or you could locate the bottleneck and think about writing just that part in C, the way we used to take bottlenecks in C code and write them in assembler. Similar to rewriting in C, modules that have critical sections can be written in C (for instance, the PDL module from CPAN). -In some cases, it may be worth it to use the backend compiler to produce byte code (saving compilation time) or compile into C, which will certainly save compilation time and sometimes a small amount (but not much) execution time. See the question about compiling your Perl programs for more on the compiler--the wins aren't as obvious as you'd hope. -If you're currently linking your perl executable to a shared libc.so, you can often gain a 10-25% performance benefit by rebuilding it to link with a static libc.a instead. This will make a bigger perl executable, but your Perl programs (and programmers) may thank you for it. See the INSTALL file in the source distribution for more information. -Unsubstantiated reports allege that Perl interpreters that use sfio outperform those that don't (for I/O intensive applications). To try this, see the INSTALL file in the source distribution, especially the ``Selecting File I/O mechanisms'' section. -The undump program was an old attempt to speed up your Perl program by storing the already-compiled form to disk. This is no longer a viable option, as it only worked on a few architectures, and wasn't a good solution anyway. -How can I make my Perl program take less memory? -When it comes to time-space tradeoffs, Perl nearly always prefers to throw memory at a problem. Scalars in Perl use more memory than strings in C, arrays take more than that, and hashes use even more. While there's still a lot to be done, recent releases have been addressing these issues. For example, as of 5.004, duplicate hash keys are shared amongst all hashes using them, so require no reallocation. -In some cases, using substr() or vec() to simulate arrays can be highly beneficial. For example, an array of a thousand booleans will take at least 20,000 bytes of space, but it can be turned into one 125-byte bit vector--a considerable memory savings. The standard Tie::SubstrHash module can also help for certain types of data structure. If you're working with specialist data structures (matrices, for instance) modules that implement these in C may use less memory than equivalent Perl modules. -Another thing to try is learning whether your Perl was compiled with the system malloc or with Perl's builtin malloc. Whichever one it is, try using the other one and see whether this makes a difference. Information about malloc is in the INSTALL file in the source distribution. You can find out whether you are using perl's malloc by typing perl -V:usemymalloc. -Is it unsafe to return a pointer to local data? -No, Perl's garbage collection system takes care of this. - sub makeone { - my @a = ( 1 .. 10 ); - return \@a; - } - for $i ( 1 .. 10 ) { - push @many, makeone(); - } - print $many[4][5], "\n"; - print "@many\n"; -How can I free an array or hash so my program shrinks? -You can't. On most operating systems, memory allocated to a program can never be returned to the system. That's why long-running programs sometimes re-exec themselves. Some operating systems (notably, FreeBSD and Linux) allegedly reclaim large chunks of memory that is no longer used, but it doesn't appear to happen with Perl (yet). The Mac appears to be the only platform that will reliably (albeit, slowly) return memory to the OS. -We've had reports that on Linux (Redhat 5.1) on Intel, undef $scalar will return memory to the system, while on Solaris 2.6 it won't. In general, try it yourself and see. -However, judicious use of my() on your variables will help make sure that they go out of scope so that Perl can free up that space for use in other parts of your program. A global variable, of course, never goes out of scope, so you can't get its space automatically reclaimed, although undef()ing and/or delete()ing it will achieve the same effect. In general, memory allocation and de-allocation isn't something you can or should be worrying about much in Perl, but even this capability (preallocation of data types) is in the works. -How can I make my CGI script more efficient? -Beyond the normal measures described to make general Perl programs faster or smaller, a CGI program has additional issues. It may be run several times per second. Given that each time it runs it will need to be re-compiled and will often allocate a megabyte or more of system memory, this can be a killer. Compiling into C isn't going to help you because the process start-up overhead is where the bottleneck is. -There are two popular ways to avoid this overhead. One solution involves running the Apache HTTP server (available from http://www.apache.org/) with either of the mod_perl or mod_fastcgi plugin modules. -With mod_perl and the Apache::Registry module (distributed with mod_perl), httpd will run with an embedded Perl interpreter which pre-compiles your script and then executes it within the same address space without forking. The Apache extension also gives Perl access to the internal server API, so modules written in Perl can do just about anything a module written in C can. For more on mod_perl, see http://perl.apache.org/ -With the FCGI module (from CPAN) and the mod_fastcgi module (available from http://www.fastcgi.com/) each of your Perl programs becomes a permanent CGI daemon process. -Both of these solutions can have far-reaching effects on your system and on the way you write your CGI programs, so investigate them with care. -See http://www.perl.com/CPAN/modules/by-category/15_World_Wide_Web_HTML_HTTP_CGI/ . -A non-free, commercial product, ``The Velocity Engine for Perl'', (http://www.binevolve.com/ or http://www.binevolve.com/velocigen/ ) might also be worth looking at. It will allow you to increase the performance of your Perl programs, running programs up to 25 times faster than normal CGI Perl when running in persistent Perl mode or 4 to 5 times faster without any modification to your existing CGI programs. Fully functional evaluation copies are available from the web site. -How can I hide the source for my Perl program? -Delete it. :-) Seriously, there are a number of (mostly unsatisfactory) solutions with varying levels of ``security''. -First of all, however, you can't take away read permission, because the source code has to be readable in order to be compiled and interpreted. (That doesn't mean that a CGI script's source is readable by people on the web, though--only by people with access to the filesystem.) So you have to leave the permissions at the socially friendly 0755 level. -Some people regard this as a security problem. If your program does insecure things and relies on people not knowing how to exploit those insecurities, it is not secure. It is often possible for someone to determine the insecure things and exploit them without viewing the source. Security through obscurity, the name for hiding your bugs instead of fixing them, is little security indeed. -You can try using encryption via source filters (Filter::* from CPAN), but any decent programmer will be able to decrypt it. You can try using the byte code compiler and interpreter described below, but the curious might still be able to de-compile it. You can try using the native-code compiler described below, but crackers might be able to disassemble it. These pose varying degrees of difficulty to people wanting to get at your code, but none can definitively conceal it (true of every language, not just Perl). -If you're concerned about people profiting from your code, then the bottom line is that nothing but a restrictive license will give you legal security. License your software and pepper it with threatening statements like ``This is unpublished proprietary software of XYZ Corp. Your access to it does not give you permission to use it blah blah blah.'' We are not lawyers, of course, so you should see a lawyer if you want to be sure your license's wording will stand up in court. -How can I compile my Perl program into byte code or C? -Malcolm Beattie has written a multifunction backend compiler, available from CPAN, that can do both these things. It is included in the perl5.005 release, but is still considered experimental. This means it's fun to play with if you're a programmer but not really for people looking for turn-key solutions. -Merely compiling into C does not in and of itself guarantee that your code will run very much faster. That's because except for lucky cases where a lot of native type inferencing is possible, the normal Perl run-time system is still present and so your program will take just as long to run and be just as big. Most programs save little more than compilation time, leaving execution no more than 10-30% faster. A few rare programs actually benefit significantly (even running several times faster), but this takes some tweaking of your code. -You'll probably be astonished to learn that the current version of the compiler generates a compiled form of your script whose executable is just as big as the original perl executable, and then some. That's because as currently written, all programs are prepared for a full eval() statement. You can tremendously reduce this cost by building a shared libperl.so library and linking against that. See the INSTALL podfile in the Perl source distribution for details. If you link your main perl binary with this, it will make it minuscule. For example, on one author's system, /usr/bin/perl is only 11k in size! -In general, the compiler will do nothing to make a Perl program smaller, faster, more portable, or more secure. In fact, it can make your situation worse. The executable will be bigger, your VM system may take longer to load the whole thing, the binary is fragile and hard to fix, and compilation never stopped software piracy in the form of crackers, viruses, or bootleggers. The real advantage of the compiler is merely packaging, and once you see the size of what it makes (well, unless you use a shared libperl.so), you'll probably want a complete Perl install anyway. -How can I compile Perl into Java? -You can also integrate Java and Perl with the Perl Resource Kit from O'Reilly and Associates. See http://www.oreilly.com/catalog/prkunix/ . -Perl 5.6 comes with Java Perl Lingo, or JPL. JPL, still in development, allows Perl code to be called from Java. See jpl/README in the Perl source tree. -How can I get #!perl to work on [MS-DOS,NT,...]? -For OS/2 just use - extproc perl -S -your_switches -as the first line in *.cmd file (-S due to a bug in cmd.exe's `extproc' handling). For DOS one should first invent a corresponding batch file and codify it in ALTERNATIVE_SHEBANG (see the INSTALL file in the source distribution for more information). -The Win95/NT installation, when using the ActiveState port of Perl, will modify the Registry to associate the .pl extension with the perl interpreter. If you install another port, perhaps even building your own Win95/NT Perl from the standard sources by using a Windows port of gcc (e.g., with cygwin or mingw32), then you'll have to modify the Registry yourself. In addition to associating .pl with the interpreter, NT people can use: SET PATHEXT=%PATHEXT%;.PL to let them run the program install-linux.pl merely by typing install-linux. -Macintosh Perl programs will have the appropriate Creator and Type, so that double-clicking them will invoke the Perl application. -IMPORTANT!: Whatever you do, PLEASE don't get frustrated, and just throw the perl interpreter into your cgi-bin directory, in order to get your programs working for a web server. This is an EXTREMELY big security risk. Take the time to figure out how to do it correctly. -Can I write useful Perl programs on the command line? -Yes. Read perlrun for more information. Some examples follow. (These assume standard Unix shell quoting rules.) - # sum first and last fields - perl -lane 'print $F[0] + $F[-1]' * - # identify text files - perl -le 'for(@ARGV) {print if -f && -T _}' * - # remove (most) comments from C program - perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c - # make file a month younger than today, defeating reaper daemons - perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' * - # find first unused uid - perl -le '$i++ while getpwuid($i); print $i' - # display reasonable manpath - echo $PATH | perl -nl -072 -e ' - s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}' -OK, the last one was actually an Obfuscated Perl Contest entry. :-) -Why don't Perl one-liners work on my DOS/Mac/VMS system? -The problem is usually that the command interpreters on those systems have rather different ideas about quoting than the Unix shells under which the one-liners were created. On some systems, you may have to change single-quotes to double ones, which you must NOT do on Unix or Plan9 systems. You might also have to change a single % to a %%. -For example: - # Unix - perl -e 'print "Hello world\n"' - # DOS, etc. - perl -e "print \"Hello world\n\"" - # Mac - print "Hello world\n" - (then Run "Myscript" or Shift-Command-R) - # VMS - perl -e "print ""Hello world\n""" -The problem is that none of these examples are reliable: they depend on the command interpreter. Under Unix, the first two often work. Under DOS, it's entirely possible that neither works. If 4DOS was the command shell, you'd probably have better luck like this: - perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" -Under the Mac, it depends which environment you are using. The MacPerl shell, or MPW, is much like Unix shells in its support for several quoting variants, except that it makes free use of the Mac's non-ASCII characters as control characters. -Using qq(), q(), and qx(), instead of "double quotes", 'single quotes', and `backticks`, may make one-liners easier to write. -There is no general solution to all of this. It is a mess, pure and simple. Sucks to be away from Unix, huh? :-) -[Some of this answer was contributed by Kenneth Albanowski.] -Where can I learn about CGI or Web programming in Perl? -For modules, get the CGI or LWP modules from CPAN. For textbooks, see the two especially dedicated to web stuff in the question on books. For problems and questions related to the web, like ``Why do I get 500 Errors'' or ``Why doesn't it run from the browser right when it runs fine on the command line'', see these sources: - WWW Security FAQ - http://www.w3.org/Security/Faq/ - Web FAQ - http://www.boutell.com/faq/ - CGI FAQ - http://www.webthing.com/tutorials/cgifaq.html - HTTP Spec - http://www.w3.org/pub/WWW/Protocols/HTTP/ - HTML Spec - http://www.w3.org/TR/REC-html40/ - http://www.w3.org/pub/WWW/MarkUp/ - CGI Spec - http://www.w3.org/CGI/ - CGI Security FAQ - http://www.go2net.com/people/paulp/cgi-security/safe-cgi.txt -Where can I learn about object-oriented Perl programming? -A good place to start is perltoot, and you can use perlobj, perlboot, and perlbot for reference. Perltoot didn't come out until the 5.004 release; you can get a copy (in pod, html, or postscript) from http://www.perl.com/CPAN/doc/FMTEYEWTK/ . -Where can I learn about linking C with Perl? [h2xs, xsubpp] -If you want to call C from Perl, start with perlxstut, moving on to perlxs, xsubpp, and perlguts. If you want to call Perl from C, then read perlembed, perlcall, and perlguts. Don't forget that you can learn a lot from looking at how the authors of existing extension modules wrote their code and solved their problems. -I've read perlembed, perlguts, etc., but I can't embed perl in my C program; what am I doing wrong? -Download the ExtUtils::Embed kit from CPAN and run `make test'. If the tests pass, read the pods again and again and again. If they fail, see perlbug and send a bug report with the output of make test TEST_VERBOSE=1 along with perl -V. -When I tried to run my script, I got this message. What does it mean? -A complete list of Perl's error messages and warnings with explanatory text can be found in perldiag. You can also use the splain program (distributed with Perl) to explain the error messages: - perl program 2>diag.out - splain [-v] [-p] diag.out -or change your program to explain the messages for you: - use diagnostics; -or - use diagnostics -verbose; -What's MakeMaker? -This module (part of the standard Perl distribution) is designed to write a Makefile for an extension module from a Makefile.PL. For more information, see ExtUtils::MakeMaker. -AUTHOR AND COPYRIGHT -Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington. All rights reserved. -When included as an integrated part of the Standard Distribution of Perl or of its documentation (printed or otherwise), this works is covered under Perl's Artistic License. For separate distributions of all or part of this FAQ outside of that, see perlfaq. -Irrespective of its distribution, all code examples here are in the public domain. You are permitted and encouraged to use this code and any derivatives thereof in your own programs for fun or for profit as you see fit. A simple comment in the code giving credit to the FAQ would be courteous but is not required.
\ No newline at end of file diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlvar.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/perlvar.pod deleted file mode 100644 index 765ff048250..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlvar.pod +++ /dev/null @@ -1,1234 +0,0 @@ -=head1 NAME - -perlvar - Perl predefined variables - -=head1 DESCRIPTION - -=head2 Predefined Names - -The following names have special meaning to Perl. Most -punctuation names have reasonable mnemonics, or analogs in the -shells. Nevertheless, if you wish to use long variable names, -you need only say - - use English; - -at the top of your program. This will alias all the short names to the -long names in the current package. Some even have medium names, -generally borrowed from B<awk>. - -If you don't mind the performance hit, variables that depend on the -currently selected filehandle may instead be set by calling an -appropriate object method on the IO::Handle object. (Summary lines -below for this contain the word HANDLE.) First you must say - - use IO::Handle; - -after which you may use either - - method HANDLE EXPR - -or more safely, - - HANDLE->method(EXPR) - -Each method returns the old value of the IO::Handle attribute. -The methods each take an optional EXPR, which if supplied specifies the -new value for the IO::Handle attribute in question. If not supplied, -most methods do nothing to the current value--except for -autoflush(), which will assume a 1 for you, just to be different. -Because loading in the IO::Handle class is an expensive operation, you should -learn how to use the regular built-in variables. - -A few of these variables are considered "read-only". This means that if -you try to assign to this variable, either directly or indirectly through -a reference, you'll raise a run-time exception. - -The following list is ordered by scalar variables first, then the -arrays, then the hashes. - -=over 8 - -=item $ARG - -=item $_ - -The default input and pattern-searching space. The following pairs are -equivalent: - - while (<>) {...} # equivalent only in while! - while (defined($_ = <>)) {...} - - /^Subject:/ - $_ =~ /^Subject:/ - - tr/a-z/A-Z/ - $_ =~ tr/a-z/A-Z/ - - chomp - chomp($_) - -Here are the places where Perl will assume $_ even if you -don't use it: - -=over 3 - -=item * - -Various unary functions, including functions like ord() and int(), as well -as the all file tests (C<-f>, C<-d>) except for C<-t>, which defaults to -STDIN. - -=item * - -Various list functions like print() and unlink(). - -=item * - -The pattern matching operations C<m//>, C<s///>, and C<tr///> when used -without an C<=~> operator. - -=item * - -The default iterator variable in a C<foreach> loop if no other -variable is supplied. - -=item * - -The implicit iterator variable in the grep() and map() functions. - -=item * - -The default place to put an input record when a C<< <FH> >> -operation's result is tested by itself as the sole criterion of a C<while> -test. Outside a C<while> test, this will not happen. - -=back - -(Mnemonic: underline is understood in certain operations.) - -=back - -=over 8 - -=item $<I<digits>> - -Contains the subpattern from the corresponding set of capturing -parentheses from the last pattern match, not counting patterns -matched in nested blocks that have been exited already. (Mnemonic: -like \digits.) These variables are all read-only and dynamically -scoped to the current BLOCK. - -=item $MATCH - -=item $& - -The string matched by the last successful pattern match (not counting -any matches hidden within a BLOCK or eval() enclosed by the current -BLOCK). (Mnemonic: like & in some editors.) This variable is read-only -and dynamically scoped to the current BLOCK. - -The use of this variable anywhere in a program imposes a considerable -performance penalty on all regular expression matches. See L<BUGS>. - -=item $PREMATCH - -=item $` - -The string preceding whatever was matched by the last successful -pattern match (not counting any matches hidden within a BLOCK or eval -enclosed by the current BLOCK). (Mnemonic: C<`> often precedes a quoted -string.) This variable is read-only. - -The use of this variable anywhere in a program imposes a considerable -performance penalty on all regular expression matches. See L<BUGS>. - -=item $POSTMATCH - -=item $' - -The string following whatever was matched by the last successful -pattern match (not counting any matches hidden within a BLOCK or eval() -enclosed by the current BLOCK). (Mnemonic: C<'> often follows a quoted -string.) Example: - - $_ = 'abcdefghi'; - /def/; - print "$`:$&:$'\n"; # prints abc:def:ghi - -This variable is read-only and dynamically scoped to the current BLOCK. - -The use of this variable anywhere in a program imposes a considerable -performance penalty on all regular expression matches. See L<BUGS>. - -=item $LAST_PAREN_MATCH - -=item $+ - -The last bracket matched by the last search pattern. This is useful if -you don't know which one of a set of alternative patterns matched. For -example: - - /Version: (.*)|Revision: (.*)/ && ($rev = $+); - -(Mnemonic: be positive and forward looking.) -This variable is read-only and dynamically scoped to the current BLOCK. - -=item @LAST_MATCH_END - -=item @+ - -This array holds the offsets of the ends of the last successful -submatches in the currently active dynamic scope. C<$+[0]> is -the offset into the string of the end of the entire match. This -is the same value as what the C<pos> function returns when called -on the variable that was matched against. The I<n>th element -of this array holds the offset of the I<n>th submatch, so -C<$+[1]> is the offset past where $1 ends, C<$+[2]> the offset -past where $2 ends, and so on. You can use C<$#+> to determine -how many subgroups were in the last successful match. See the -examples given for the C<@-> variable. - -=item $MULTILINE_MATCHING - -=item $* - -Set to a non-zero integer value to do multi-line matching within a -string, 0 (or undefined) to tell Perl that it can assume that strings -contain a single line, for the purpose of optimizing pattern matches. -Pattern matches on strings containing multiple newlines can produce -confusing results when C<$*> is 0 or undefined. Default is undefined. -(Mnemonic: * matches multiple things.) This variable influences the -interpretation of only C<^> and C<$>. A literal newline can be searched -for even when C<$* == 0>. - -Use of C<$*> is deprecated in modern Perl, supplanted by -the C</s> and C</m> modifiers on pattern matching. - -Assigning a non-numerical value to C<$*> triggers a warning (and makes -C<$*> act if C<$* == 0>), while assigning a numerical value to C<$*> -makes that an implicit C<int> is applied on the value. - -=item input_line_number HANDLE EXPR - -=item $INPUT_LINE_NUMBER - -=item $NR - -=item $. - -The current input record number for the last file handle from which -you just read() (or called a C<seek> or C<tell> on). The value -may be different from the actual physical line number in the file, -depending on what notion of "line" is in effect--see C<$/> on how -to change that. An explicit close on a filehandle resets the line -number. Because C<< <> >> never does an explicit close, line -numbers increase across ARGV files (but see examples in L<perlfunc/eof>). -Consider this variable read-only: setting it does not reposition -the seek pointer; you'll have to do that on your own. Localizing C<$.> -has the effect of also localizing Perl's notion of "the last read -filehandle". (Mnemonic: many programs use "." to mean the current line -number.) - -=item input_record_separator HANDLE EXPR - -=item $INPUT_RECORD_SEPARATOR - -=item $RS - -=item $/ - -The input record separator, newline by default. This -influences Perl's idea of what a "line" is. Works like B<awk>'s RS -variable, including treating empty lines as a terminator if set to -the null string. (An empty line cannot contain any spaces -or tabs.) You may set it to a multi-character string to match a -multi-character terminator, or to C<undef> to read through the end -of file. Setting it to C<"\n\n"> means something slightly -different than setting to C<"">, if the file contains consecutive -empty lines. Setting to C<""> will treat two or more consecutive -empty lines as a single empty line. Setting to C<"\n\n"> will -blindly assume that the next input character belongs to the next -paragraph, even if it's a newline. (Mnemonic: / delimits -line boundaries when quoting poetry.) - - undef $/; # enable "slurp" mode - $_ = <FH>; # whole file now here - s/\n[ \t]+/ /g; - -Remember: the value of C<$/> is a string, not a regex. B<awk> has to be -better for something. :-) - -Setting C<$/> to a reference to an integer, scalar containing an integer, or -scalar that's convertible to an integer will attempt to read records -instead of lines, with the maximum record size being the referenced -integer. So this: - - $/ = \32768; # or \"32768", or \$var_containing_32768 - open(FILE, $myfile); - $_ = <FILE>; - -will read a record of no more than 32768 bytes from FILE. If you're -not reading from a record-oriented file (or your OS doesn't have -record-oriented files), then you'll likely get a full chunk of data -with every read. If a record is larger than the record size you've -set, you'll get the record back in pieces. - -On VMS, record reads are done with the equivalent of C<sysread>, -so it's best not to mix record and non-record reads on the same -file. (This is unlikely to be a problem, because any file you'd -want to read in record mode is probably unusable in line mode.) -Non-VMS systems do normal I/O, so it's safe to mix record and -non-record reads of a file. - -See also L<perlport/"Newlines">. Also see C<$.>. - -=item autoflush HANDLE EXPR - -=item $OUTPUT_AUTOFLUSH - -=item $| - -If set to nonzero, forces a flush right away and after every write -or print on the currently selected output channel. Default is 0 -(regardless of whether the channel is really buffered by the -system or not; C<$|> tells you only whether you've asked Perl -explicitly to flush after each write). STDOUT will -typically be line buffered if output is to the terminal and block -buffered otherwise. Setting this variable is useful primarily when -you are outputting to a pipe or socket, such as when you are running -a Perl program under B<rsh> and want to see the output as it's -happening. This has no effect on input buffering. See L<perlfunc/getc> -for that. (Mnemonic: when you want your pipes to be piping hot.) - -=item output_field_separator HANDLE EXPR - -=item $OUTPUT_FIELD_SEPARATOR - -=item $OFS - -=item $, - -The output field separator for the print operator. Ordinarily the -print operator simply prints out its arguments without further -adornment. To get behavior more like B<awk>, set this variable as -you would set B<awk>'s OFS variable to specify what is printed -between fields. (Mnemonic: what is printed when there is a "," in -your print statement.) - -=item output_record_separator HANDLE EXPR - -=item $OUTPUT_RECORD_SEPARATOR - -=item $ORS - -=item $\ - -The output record separator for the print operator. Ordinarily the -print operator simply prints out its arguments as is, with no -trailing newline or other end-of-record string added. To get -behavior more like B<awk>, set this variable as you would set -B<awk>'s ORS variable to specify what is printed at the end of the -print. (Mnemonic: you set C<$\> instead of adding "\n" at the -end of the print. Also, it's just like C<$/>, but it's what you -get "back" from Perl.) - -=item $LIST_SEPARATOR - -=item $" - -This is like C<$,> except that it applies to array and slice values -interpolated into a double-quoted string (or similar interpreted -string). Default is a space. (Mnemonic: obvious, I think.) - -=item $SUBSCRIPT_SEPARATOR - -=item $SUBSEP - -=item $; - -The subscript separator for multidimensional array emulation. If you -refer to a hash element as - - $foo{$a,$b,$c} - -it really means - - $foo{join($;, $a, $b, $c)} - -But don't put - - @foo{$a,$b,$c} # a slice--note the @ - -which means - - ($foo{$a},$foo{$b},$foo{$c}) - -Default is "\034", the same as SUBSEP in B<awk>. If your -keys contain binary data there might not be any safe value for C<$;>. -(Mnemonic: comma (the syntactic subscript separator) is a -semi-semicolon. Yeah, I know, it's pretty lame, but C<$,> is already -taken for something more important.) - -Consider using "real" multidimensional arrays as described -in L<perllol>. - -=item $OFMT - -=item $# - -The output format for printed numbers. This variable is a half-hearted -attempt to emulate B<awk>'s OFMT variable. There are times, however, -when B<awk> and Perl have differing notions of what counts as -numeric. The initial value is "%.I<n>g", where I<n> is the value -of the macro DBL_DIG from your system's F<float.h>. This is different from -B<awk>'s default OFMT setting of "%.6g", so you need to set C<$#> -explicitly to get B<awk>'s value. (Mnemonic: # is the number sign.) - -Use of C<$#> is deprecated. - -=item format_page_number HANDLE EXPR - -=item $FORMAT_PAGE_NUMBER - -=item $% - -The current page number of the currently selected output channel. -Used with formats. -(Mnemonic: % is page number in B<nroff>.) - -=item format_lines_per_page HANDLE EXPR - -=item $FORMAT_LINES_PER_PAGE - -=item $= - -The current page length (printable lines) of the currently selected -output channel. Default is 60. -Used with formats. -(Mnemonic: = has horizontal lines.) - -=item format_lines_left HANDLE EXPR - -=item $FORMAT_LINES_LEFT - -=item $- - -The number of lines left on the page of the currently selected output -channel. -Used with formats. -(Mnemonic: lines_on_page - lines_printed.) - -=item @LAST_MATCH_START - -=item @- - -$-[0] is the offset of the start of the last successful match. -C<$-[>I<n>C<]> is the offset of the start of the substring matched by -I<n>-th subpattern, or undef if the subpattern did not match. - -Thus after a match against $_, $& coincides with C<substr $_, $-[0], -$+[0] - $-[0]>. Similarly, C<$>I<n> coincides with C<substr $_, $-[>I<n>C<], -$+[>I<n>C<] - $-[>I<n>C<]> if C<$-[>I<n>C<]> is defined, and $+ coincides with -C<substr $_, $-[$#-], $+[$#-]>. One can use C<$#-> to find the last -matched subgroup in the last successful match. Contrast with -C<$#+>, the number of subgroups in the regular expression. Compare -with C<@+>. - -This array holds the offsets of the beginnings of the last -successful submatches in the currently active dynamic scope. -C<$-[0]> is the offset into the string of the beginning of the -entire match. The I<n>th element of this array holds the offset -of the I<n>th submatch, so C<$+[1]> is the offset where $1 -begins, C<$+[2]> the offset where $2 begins, and so on. -You can use C<$#-> to determine how many subgroups were in the -last successful match. Compare with the C<@+> variable. - -After a match against some variable $var: - -=over 5 - -=item C<$`> is the same as C<substr($var, 0, $-[0])> - -=item C<$&> is the same as C<substr($var, $-[0], $+[0] - $-[0])> - -=item C<$'> is the same as C<substr($var, $+[0])> - -=item C<$1> is the same as C<substr($var, $-[1], $+[1] - $-[1])> - -=item C<$2> is the same as C<substr($var, $-[2], $+[2] - $-[2])> - -=item C<$3> is the same as C<substr $var, $-[3], $+[3] - $-[3])> - -=back - -=item format_name HANDLE EXPR - -=item $FORMAT_NAME - -=item $~ - -The name of the current report format for the currently selected output -channel. Default is the name of the filehandle. (Mnemonic: brother to -C<$^>.) - -=item format_top_name HANDLE EXPR - -=item $FORMAT_TOP_NAME - -=item $^ - -The name of the current top-of-page format for the currently selected -output channel. Default is the name of the filehandle with _TOP -appended. (Mnemonic: points to top of page.) - -=item format_line_break_characters HANDLE EXPR - -=item $FORMAT_LINE_BREAK_CHARACTERS - -=item $: - -The current set of characters after which a string may be broken to -fill continuation fields (starting with ^) in a format. Default is -S<" \n-">, to break on whitespace or hyphens. (Mnemonic: a "colon" in -poetry is a part of a line.) - -=item format_formfeed HANDLE EXPR - -=item $FORMAT_FORMFEED - -=item $^L - -What formats output as a form feed. Default is \f. - -=item $ACCUMULATOR - -=item $^A - -The current value of the write() accumulator for format() lines. A format -contains formline() calls that put their result into C<$^A>. After -calling its format, write() prints out the contents of C<$^A> and empties. -So you never really see the contents of C<$^A> unless you call -formline() yourself and then look at it. See L<perlform> and -L<perlfunc/formline()>. - -=item $CHILD_ERROR - -=item $? - -The status returned by the last pipe close, backtick (C<``>) command, -successful call to wait() or waitpid(), or from the system() -operator. This is just the 16-bit status word returned by the -wait() system call (or else is made up to look like it). Thus, the -exit value of the subprocess is really (C<<< $? >> 8 >>>), and -C<$? & 127> gives which signal, if any, the process died from, and -C<$? & 128> reports whether there was a core dump. (Mnemonic: -similar to B<sh> and B<ksh>.) - -Additionally, if the C<h_errno> variable is supported in C, its value -is returned via $? if any C<gethost*()> function fails. - -If you have installed a signal handler for C<SIGCHLD>, the -value of C<$?> will usually be wrong outside that handler. - -Inside an C<END> subroutine C<$?> contains the value that is going to be -given to C<exit()>. You can modify C<$?> in an C<END> subroutine to -change the exit status of your program. For example: - - END { - $? = 1 if $? == 255; # die would make it 255 - } - -Under VMS, the pragma C<use vmsish 'status'> makes C<$?> reflect the -actual VMS exit status, instead of the default emulation of POSIX -status. - -Also see L<Error Indicators>. - -=item $OS_ERROR - -=item $ERRNO - -=item $! - -If used numerically, yields the current value of the C C<errno> -variable, with all the usual caveats. (This means that you shouldn't -depend on the value of C<$!> to be anything in particular unless -you've gotten a specific error return indicating a system error.) -If used an a string, yields the corresponding system error string. -You can assign a number to C<$!> to set I<errno> if, for instance, -you want C<"$!"> to return the string for error I<n>, or you want -to set the exit value for the die() operator. (Mnemonic: What just -went bang?) - -Also see L<Error Indicators>. - -=item $EXTENDED_OS_ERROR - -=item $^E - -Error information specific to the current operating system. At -the moment, this differs from C<$!> under only VMS, OS/2, and Win32 -(and for MacPerl). On all other platforms, C<$^E> is always just -the same as C<$!>. - -Under VMS, C<$^E> provides the VMS status value from the last -system error. This is more specific information about the last -system error than that provided by C<$!>. This is particularly -important when C<$!> is set to B<EVMSERR>. - -Under OS/2, C<$^E> is set to the error code of the last call to -OS/2 API either via CRT, or directly from perl. - -Under Win32, C<$^E> always returns the last error information -reported by the Win32 call C<GetLastError()> which describes -the last error from within the Win32 API. Most Win32-specific -code will report errors via C<$^E>. ANSI C and Unix-like calls -set C<errno> and so most portable Perl code will report errors -via C<$!>. - -Caveats mentioned in the description of C<$!> generally apply to -C<$^E>, also. (Mnemonic: Extra error explanation.) - -Also see L<Error Indicators>. - -=item $EVAL_ERROR - -=item $@ - -The Perl syntax error message from the last eval() operator. If null, the -last eval() parsed and executed correctly (although the operations you -invoked may have failed in the normal fashion). (Mnemonic: Where was -the syntax error "at"?) - -Warning messages are not collected in this variable. You can, -however, set up a routine to process warnings by setting C<$SIG{__WARN__}> -as described below. - -Also see L<Error Indicators>. - -=item $PROCESS_ID - -=item $PID - -=item $$ - -The process number of the Perl running this script. You should -consider this variable read-only, although it will be altered -across fork() calls. (Mnemonic: same as shells.) - -=item $REAL_USER_ID - -=item $UID - -=item $< - -The real uid of this process. (Mnemonic: it's the uid you came I<from>, -if you're running setuid.) - -=item $EFFECTIVE_USER_ID - -=item $EUID - -=item $> - -The effective uid of this process. Example: - - $< = $>; # set real to effective uid - ($<,$>) = ($>,$<); # swap real and effective uid - -(Mnemonic: it's the uid you went I<to>, if you're running setuid.) -C<< $< >> and C<< $> >> can be swapped only on machines -supporting setreuid(). - -=item $REAL_GROUP_ID - -=item $GID - -=item $( - -The real gid of this process. If you are on a machine that supports -membership in multiple groups simultaneously, gives a space separated -list of groups you are in. The first number is the one returned by -getgid(), and the subsequent ones by getgroups(), one of which may be -the same as the first number. - -However, a value assigned to C<$(> must be a single number used to -set the real gid. So the value given by C<$(> should I<not> be assigned -back to C<$(> without being forced numeric, such as by adding zero. - -(Mnemonic: parentheses are used to I<group> things. The real gid is the -group you I<left>, if you're running setgid.) - -=item $EFFECTIVE_GROUP_ID - -=item $EGID - -=item $) - -The effective gid of this process. If you are on a machine that -supports membership in multiple groups simultaneously, gives a space -separated list of groups you are in. The first number is the one -returned by getegid(), and the subsequent ones by getgroups(), one of -which may be the same as the first number. - -Similarly, a value assigned to C<$)> must also be a space-separated -list of numbers. The first number sets the effective gid, and -the rest (if any) are passed to setgroups(). To get the effect of an -empty list for setgroups(), just repeat the new effective gid; that is, -to force an effective gid of 5 and an effectively empty setgroups() -list, say C< $) = "5 5" >. - -(Mnemonic: parentheses are used to I<group> things. The effective gid -is the group that's I<right> for you, if you're running setgid.) - -C<< $< >>, C<< $> >>, C<$(> and C<$)> can be set only on -machines that support the corresponding I<set[re][ug]id()> routine. C<$(> -and C<$)> can be swapped only on machines supporting setregid(). - -=item $PROGRAM_NAME - -=item $0 - -Contains the name of the program being executed. On some operating -systems assigning to C<$0> modifies the argument area that the B<ps> -program sees. This is more useful as a way of indicating the current -program state than it is for hiding the program you're running. -(Mnemonic: same as B<sh> and B<ksh>.) - -Note for BSD users: setting C<$0> does not completely remove "perl" -from the ps(1) output. For example, setting C<$0> to C<"foobar"> will -result in C<"perl: foobar (perl)">. This is an operating system -feature. - -=item $[ - -The index of the first element in an array, and of the first character -in a substring. Default is 0, but you could theoretically set it -to 1 to make Perl behave more like B<awk> (or Fortran) when -subscripting and when evaluating the index() and substr() functions. -(Mnemonic: [ begins subscripts.) - -As of release 5 of Perl, assignment to C<$[> is treated as a compiler -directive, and cannot influence the behavior of any other file. -Its use is highly discouraged. - -=item $] - -The version + patchlevel / 1000 of the Perl interpreter. This variable -can be used to determine whether the Perl interpreter executing a -script is in the right range of versions. (Mnemonic: Is this version -of perl in the right bracket?) Example: - - warn "No checksumming!\n" if $] < 3.019; - -See also the documentation of C<use VERSION> and C<require VERSION> -for a convenient way to fail if the running Perl interpreter is too old. - -The use of this variable is deprecated. The floating point representation -can sometimes lead to inaccurate numeric comparisons. See C<$^V> for a -more modern representation of the Perl version that allows accurate string -comparisons. - -=item $COMPILING - -=item $^C - -The current value of the flag associated with the B<-c> switch. -Mainly of use with B<-MO=...> to allow code to alter its behavior -when being compiled, such as for example to AUTOLOAD at compile -time rather than normal, deferred loading. See L<perlcc>. Setting -C<$^C = 1> is similar to calling C<B::minus_c>. - -=item $DEBUGGING - -=item $^D - -The current value of the debugging flags. (Mnemonic: value of B<-D> -switch.) - -=item $SYSTEM_FD_MAX - -=item $^F - -The maximum system file descriptor, ordinarily 2. System file -descriptors are passed to exec()ed processes, while higher file -descriptors are not. Also, during an open(), system file descriptors are -preserved even if the open() fails. (Ordinary file descriptors are -closed before the open() is attempted.) The close-on-exec -status of a file descriptor will be decided according to the value of -C<$^F> when the corresponding file, pipe, or socket was opened, not the -time of the exec(). - -=item $^H - -WARNING: This variable is strictly for internal use only. Its availability, -behavior, and contents are subject to change without notice. - -This variable contains compile-time hints for the Perl interpreter. At the -end of compilation of a BLOCK the value of this variable is restored to the -value when the interpreter started to compile the BLOCK. - -When perl begins to parse any block construct that provides a lexical scope -(e.g., eval body, required file, subroutine body, loop body, or conditional -block), the existing value of $^H is saved, but its value is left unchanged. -When the compilation of the block is completed, it regains the saved value. -Between the points where its value is saved and restored, code that -executes within BEGIN blocks is free to change the value of $^H. - -This behavior provides the semantic of lexical scoping, and is used in, -for instance, the C<use strict> pragma. - -The contents should be an integer; different bits of it are used for -different pragmatic flags. Here's an example: - - sub add_100 { $^H |= 0x100 } - - sub foo { - BEGIN { add_100() } - bar->baz($boon); - } - -Consider what happens during execution of the BEGIN block. At this point -the BEGIN block has already been compiled, but the body of foo() is still -being compiled. The new value of $^H will therefore be visible only while -the body of foo() is being compiled. - -Substitution of the above BEGIN block with: - - BEGIN { require strict; strict->import('vars') } - -demonstrates how C<use strict 'vars'> is implemented. Here's a conditional -version of the same lexical pragma: - - BEGIN { require strict; strict->import('vars') if $condition } - -=item %^H - -WARNING: This variable is strictly for internal use only. Its availability, -behavior, and contents are subject to change without notice. - -The %^H hash provides the same scoping semantic as $^H. This makes it -useful for implementation of lexically scoped pragmas. - -=item $INPLACE_EDIT - -=item $^I - -The current value of the inplace-edit extension. Use C<undef> to disable -inplace editing. (Mnemonic: value of B<-i> switch.) - -=item $^M - -By default, running out of memory is an untrappable, fatal error. -However, if suitably built, Perl can use the contents of C<$^M> -as an emergency memory pool after die()ing. Suppose that your Perl -were compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. -Then - - $^M = 'a' x (1 << 16); - -would allocate a 64K buffer for use in an emergency. See the -F<INSTALL> file in the Perl distribution for information on how to -enable this option. To discourage casual use of this advanced -feature, there is no L<English|English> long name for this variable. - -=item $OSNAME - -=item $^O - -The name of the operating system under which this copy of Perl was -built, as determined during the configuration process. The value -is identical to C<$Config{'osname'}>. See also L<Config> and the -B<-V> command-line switch documented in L<perlrun>. - -=item $PERLDB - -=item $^P - -The internal variable for debugging support. The meanings of the -various bits are subject to change, but currently indicate: - -=over 6 - -=item 0x01 - -Debug subroutine enter/exit. - -=item 0x02 - -Line-by-line debugging. - -=item 0x04 - -Switch off optimizations. - -=item 0x08 - -Preserve more data for future interactive inspections. - -=item 0x10 - -Keep info about source lines on which a subroutine is defined. - -=item 0x20 - -Start with single-step on. - -=item 0x40 - -Use subroutine address instead of name when reporting. - -=item 0x80 - -Report C<goto &subroutine> as well. - -=item 0x100 - -Provide informative "file" names for evals based on the place they were compiled. - -=item 0x200 - -Provide informative names to anonymous subroutines based on the place they -were compiled. - -=back - -Some bits may be relevant at compile-time only, some at -run-time only. This is a new mechanism and the details may change. - -=item $LAST_REGEXP_CODE_RESULT - -=item $^R - -The result of evaluation of the last successful C<(?{ code })> -regular expression assertion (see L<perlre>). May be written to. - -=item $EXCEPTIONS_BEING_CAUGHT - -=item $^S - -Current state of the interpreter. Undefined if parsing of the current -module/eval is not finished (may happen in $SIG{__DIE__} and -$SIG{__WARN__} handlers). True if inside an eval(), otherwise false. - -=item $BASETIME - -=item $^T - -The time at which the program began running, in seconds since the -epoch (beginning of 1970). The values returned by the B<-M>, B<-A>, -and B<-C> filetests are based on this value. - -=item $PERL_VERSION - -=item $^V - -The revision, version, and subversion of the Perl interpreter, represented -as a string composed of characters with those ordinals. Thus in Perl v5.6.0 -it equals C<chr(5) . chr(6) . chr(0)> and will return true for -C<$^V eq v5.6.0>. Note that the characters in this string value can -potentially be in Unicode range. - -This can be used to determine whether the Perl interpreter executing a -script is in the right range of versions. (Mnemonic: use ^V for Version -Control.) Example: - - warn "No \"our\" declarations!\n" if $^V and $^V lt v5.6.0; - -See the documentation of C<use VERSION> and C<require VERSION> -for a convenient way to fail if the running Perl interpreter is too old. - -See also C<$]> for an older representation of the Perl version. - -=item $WARNING - -=item $^W - -The current value of the warning switch, initially true if B<-w> -was used, false otherwise, but directly modifiable. (Mnemonic: -related to the B<-w> switch.) See also L<warnings>. - -=item ${^WARNING_BITS} - -The current set of warning checks enabled by the C<use warnings> pragma. -See the documentation of C<warnings> for more details. - -=item ${^WIDE_SYSTEM_CALLS} - -Global flag that enables system calls made by Perl to use wide character -APIs native to the system, if available. This is currently only implemented -on the Windows platform. - -This can also be enabled from the command line using the C<-C> switch. - -The initial value is typically C<0> for compatibility with Perl versions -earlier than 5.6, but may be automatically set to C<1> by Perl if the system -provides a user-settable default (e.g., C<$ENV{LC_CTYPE}>). - -The C<bytes> pragma always overrides the effect of this flag in the current -lexical scope. See L<bytes>. - -=item $EXECUTABLE_NAME - -=item $^X - -The name that the Perl binary itself was executed as, from C's C<argv[0]>. -This may not be a full pathname, nor even necessarily in your path. - -=item $ARGV - -contains the name of the current file when reading from <>. - -=item @ARGV - -The array @ARGV contains the command-line arguments intended for -the script. C<$#ARGV> is generally the number of arguments minus -one, because C<$ARGV[0]> is the first argument, I<not> the program's -command name itself. See C<$0> for the command name. - -=item @INC - -The array @INC contains the list of places that the C<do EXPR>, -C<require>, or C<use> constructs look for their library files. It -initially consists of the arguments to any B<-I> command-line -switches, followed by the default Perl library, probably -F</usr/local/lib/perl>, followed by ".", to represent the current -directory. If you need to modify this at runtime, you should use -the C<use lib> pragma to get the machine-dependent library properly -loaded also: - - use lib '/mypath/libdir/'; - use SomeMod; - -=item @_ - -Within a subroutine the array @_ contains the parameters passed to that -subroutine. See L<perlsub>. - -=item %INC - -The hash %INC contains entries for each filename included via the -C<do>, C<require>, or C<use> operators. The key is the filename -you specified (with module names converted to pathnames), and the -value is the location of the file found. The C<require> -operator uses this hash to determine whether a particular file has -already been included. - -=item %ENV - -=item $ENV{expr} - -The hash %ENV contains your current environment. Setting a -value in C<ENV> changes the environment for any child processes -you subsequently fork() off. - -=item %SIG - -=item $SIG{expr} - -The hash %SIG contains signal handlers for signals. For example: - - sub handler { # 1st argument is signal name - my($sig) = @_; - print "Caught a SIG$sig--shutting down\n"; - close(LOG); - exit(0); - } - - $SIG{'INT'} = \&handler; - $SIG{'QUIT'} = \&handler; - ... - $SIG{'INT'} = 'DEFAULT'; # restore default action - $SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT - -Using a value of C<'IGNORE'> usually has the effect of ignoring the -signal, except for the C<CHLD> signal. See L<perlipc> for more about -this special case. - -Here are some other examples: - - $SIG{"PIPE"} = "Plumber"; # assumes main::Plumber (not recommended) - $SIG{"PIPE"} = \&Plumber; # just fine; assume current Plumber - $SIG{"PIPE"} = *Plumber; # somewhat esoteric - $SIG{"PIPE"} = Plumber(); # oops, what did Plumber() return?? - -Be sure not to use a bareword as the name of a signal handler, -lest you inadvertently call it. - -If your system has the sigaction() function then signal handlers are -installed using it. This means you get reliable signal handling. If -your system has the SA_RESTART flag it is used when signals handlers are -installed. This means that system calls for which restarting is supported -continue rather than returning when a signal arrives. If you want your -system calls to be interrupted by signal delivery then do something like -this: - - use POSIX ':signal_h'; - - my $alarm = 0; - sigaction SIGALRM, new POSIX::SigAction sub { $alarm = 1 } - or die "Error setting SIGALRM handler: $!\n"; - -See L<POSIX>. - -Certain internal hooks can be also set using the %SIG hash. The -routine indicated by C<$SIG{__WARN__}> is called when a warning message is -about to be printed. The warning message is passed as the first -argument. The presence of a __WARN__ hook causes the ordinary printing -of warnings to STDERR to be suppressed. You can use this to save warnings -in a variable, or turn warnings into fatal errors, like this: - - local $SIG{__WARN__} = sub { die $_[0] }; - eval $proggie; - -The routine indicated by C<$SIG{__DIE__}> is called when a fatal exception -is about to be thrown. The error message is passed as the first -argument. When a __DIE__ hook routine returns, the exception -processing continues as it would have in the absence of the hook, -unless the hook routine itself exits via a C<goto>, a loop exit, or a die(). -The C<__DIE__> handler is explicitly disabled during the call, so that you -can die from a C<__DIE__> handler. Similarly for C<__WARN__>. - -Due to an implementation glitch, the C<$SIG{__DIE__}> hook is called -even inside an eval(). Do not use this to rewrite a pending exception -in C<$@>, or as a bizarre substitute for overriding CORE::GLOBAL::die(). -This strange action at a distance may be fixed in a future release -so that C<$SIG{__DIE__}> is only called if your program is about -to exit, as was the original intent. Any other use is deprecated. - -C<__DIE__>/C<__WARN__> handlers are very special in one respect: -they may be called to report (probable) errors found by the parser. -In such a case the parser may be in inconsistent state, so any -attempt to evaluate Perl code from such a handler will probably -result in a segfault. This means that warnings or errors that -result from parsing Perl should be used with extreme caution, like -this: - - require Carp if defined $^S; - Carp::confess("Something wrong") if defined &Carp::confess; - die "Something wrong, but could not load Carp to give backtrace... - To see backtrace try starting Perl with -MCarp switch"; - -Here the first line will load Carp I<unless> it is the parser who -called the handler. The second line will print backtrace and die if -Carp was available. The third line will be executed only if Carp was -not available. - -See L<perlfunc/die>, L<perlfunc/warn>, L<perlfunc/eval>, and -L<warnings> for additional information. - -=back - -=head2 Error Indicators - -The variables C<$@>, C<$!>, C<$^E>, and C<$?> contain information -about different types of error conditions that may appear during -execution of a Perl program. The variables are shown ordered by -the "distance" between the subsystem which reported the error and -the Perl process. They correspond to errors detected by the Perl -interpreter, C library, operating system, or an external program, -respectively. - -To illustrate the differences between these variables, consider the -following Perl expression, which uses a single-quoted string: - - eval q{ - open PIPE, "/cdrom/install |"; - @res = <PIPE>; - close PIPE or die "bad pipe: $?, $!"; - }; - -After execution of this statement all 4 variables may have been set. - -C<$@> is set if the string to be C<eval>-ed did not compile (this -may happen if C<open> or C<close> were imported with bad prototypes), -or if Perl code executed during evaluation die()d . In these cases -the value of $@ is the compile error, or the argument to C<die> -(which will interpolate C<$!> and C<$?>!). (See also L<Fatal>, -though.) - -When the eval() expression above is executed, open(), C<< <PIPE> >>, -and C<close> are translated to calls in the C run-time library and -thence to the operating system kernel. C<$!> is set to the C library's -C<errno> if one of these calls fails. - -Under a few operating systems, C<$^E> may contain a more verbose -error indicator, such as in this case, "CDROM tray not closed." -Systems that do not support extended error messages leave C<$^E> -the same as C<$!>. - -Finally, C<$?> may be set to non-0 value if the external program -F</cdrom/install> fails. The upper eight bits reflect specific -error conditions encountered by the program (the program's exit() -value). The lower eight bits reflect mode of failure, like signal -death and core dump information See wait(2) for details. In -contrast to C<$!> and C<$^E>, which are set only if error condition -is detected, the variable C<$?> is set on each C<wait> or pipe -C<close>, overwriting the old value. This is more like C<$@>, which -on every eval() is always set on failure and cleared on success. - -For more details, see the individual descriptions at C<$@>, C<$!>, C<$^E>, -and C<$?>. - -=head2 Technical Note on the Syntax of Variable Names - -Variable names in Perl can have several formats. Usually, they -must begin with a letter or underscore, in which case they can be -arbitrarily long (up to an internal limit of 251 characters) and -may contain letters, digits, underscores, or the special sequence -C<::> or C<'>. In this case, the part before the last C<::> or -C<'> is taken to be a I<package qualifier>; see L<perlmod>. - -Perl variable names may also be a sequence of digits or a single -punctuation or control character. These names are all reserved for -special uses by Perl; for example, the all-digits names are used -to hold data captured by backreferences after a regular expression -match. Perl has a special syntax for the single-control-character -names: It understands C<^X> (caret C<X>) to mean the control-C<X> -character. For example, the notation C<$^W> (dollar-sign caret -C<W>) is the scalar variable whose name is the single character -control-C<W>. This is better than typing a literal control-C<W> -into your program. - -Finally, new in Perl 5.6, Perl variable names may be alphanumeric -strings that begin with control characters (or better yet, a caret). -These variables must be written in the form C<${^Foo}>; the braces -are not optional. C<${^Foo}> denotes the scalar variable whose -name is a control-C<F> followed by two C<o>'s. These variables are -reserved for future special uses by Perl, except for the ones that -begin with C<^_> (control-underscore or caret-underscore). No -control-character name that begins with C<^_> will acquire a special -meaning in any future version of Perl; such names may therefore be -used safely in programs. C<$^_> itself, however, I<is> reserved. - -Perl identifiers that begin with digits, control characters, or -punctuation characters are exempt from the effects of the C<package> -declaration and are always forced to be in package C<main>. A few -other names are also exempt: - - ENV STDIN - INC STDOUT - ARGV STDERR - ARGVOUT - SIG - -In particular, the new special C<${^_XYZ}> variables are always taken -to be in package C<main>, regardless of any C<package> declarations -presently in scope. - -=head1 BUGS - -Due to an unfortunate accident of Perl's implementation, C<use -English> imposes a considerable performance penalty on all regular -expression matches in a program, regardless of whether they occur -in the scope of C<use English>. For that reason, saying C<use -English> in libraries is strongly discouraged. See the -Devel::SawAmpersand module documentation from CPAN -(http://www.perl.com/CPAN/modules/by-module/Devel/) -for more information. - -Having to even think about the C<$^S> variable in your exception -handlers is simply wrong. C<$SIG{__DIE__}> as currently implemented -invites grievous and difficult to track down errors. Avoid it -and use an C<END{}> or CORE::GLOBAL::die override instead. diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlvaro.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/perlvaro.txt deleted file mode 100644 index 0a679799623..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/perlvaro.txt +++ /dev/null @@ -1,406 +0,0 @@ -NAME -perlvar - Perl predefined variables -DESCRIPTION -Predefined Names -The following names have special meaning to Perl. Most punctuation names have reasonable mnemonics, or analogs in the shells. Nevertheless, if you wish to use long variable names, you need only say - use English; -at the top of your program. This will alias all the short names to the long names in the current package. Some even have medium names, generally borrowed from awk. -If you don't mind the performance hit, variables that depend on the currently selected filehandle may instead be set by calling an appropriate object method on the IO::Handle object. (Summary lines below for this contain the word HANDLE.) First you must say - use IO::Handle; -after which you may use either - method HANDLE EXPR -or more safely, - HANDLE->method(EXPR) -Each method returns the old value of the IO::Handle attribute. The methods each take an optional EXPR, which if supplied specifies the new value for the IO::Handle attribute in question. If not supplied, most methods do nothing to the current value--except for autoflush(), which will assume a 1 for you, just to be different. Because loading in the IO::Handle class is an expensive operation, you should learn how to use the regular built-in variables. -A few of these variables are considered "read-only". This means that if you try to assign to this variable, either directly or indirectly through a reference, you'll raise a run-time exception. -The following list is ordered by scalar variables first, then the arrays, then the hashes. -$ARG -$_ -The default input and pattern-searching space. The following pairs are equivalent: - while (<>) {...} # equivalent only in while! - while (defined($_ = <>)) {...} - /^Subject:/ - $_ =~ /^Subject:/ - tr/a-z/A-Z/ - $_ =~ tr/a-z/A-Z/ - chomp - chomp($_) -Here are the places where Perl will assume $_ even if you don't use it: - Various unary functions, including functions like ord() and int(), as well as the all file tests (-f, -d) except for -t, which defaults to STDIN. - Various list functions like print() and unlink(). - The pattern matching operations m//, s///, and tr/// when used without an =~ operator. - The default iterator variable in a foreach loop if no other variable is supplied. - The implicit iterator variable in the grep() and map() functions. - The default place to put an input record when a <FH> operation's result is tested by itself as the sole criterion of a while test. Outside a while test, this will not happen. -(Mnemonic: underline is understood in certain operations.) -$<digits> -Contains the subpattern from the corresponding set of capturing parentheses from the last pattern match, not counting patterns matched in nested blocks that have been exited already. (Mnemonic: like \digits.) These variables are all read-only and dynamically scoped to the current BLOCK. -$MATCH -$& -The string matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval() enclosed by the current BLOCK). (Mnemonic: like & in some editors.) This variable is read-only and dynamically scoped to the current BLOCK. -The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See BUGS. -$PREMATCH -$` -The string preceding whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: ` often precedes a quoted string.) This variable is read-only. -The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See BUGS. -$POSTMATCH -$' -The string following whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval() enclosed by the current BLOCK). (Mnemonic: ' often follows a quoted string.) Example: - $_ = 'abcdefghi'; - /def/; - print "$`:$&:$'\n"; # prints abc:def:ghi -This variable is read-only and dynamically scoped to the current BLOCK. -The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See BUGS. -$LAST_PAREN_MATCH -$+ -The last bracket matched by the last search pattern. This is useful if you don't know which one of a set of alternative patterns matched. For example: - /Version: (.*)|Revision: (.*)/ && ($rev = $+); -(Mnemonic: be positive and forward looking.) This variable is read-only and dynamically scoped to the current BLOCK. -@LAST_MATCH_END -@+ -This array holds the offsets of the ends of the last successful submatches in the currently active dynamic scope. $+[0] is the offset into the string of the end of the entire match. This is the same value as what the pos function returns when called on the variable that was matched against. The nth element of this array holds the offset of the nth submatch, so $+[1] is the offset past where $1 ends, $+[2] the offset past where $2 ends, and so on. You can use $#+ to determine how many subgroups were in the last successful match. See the examples given for the @- variable. -$MULTILINE_MATCHING -$* -Set to a non-zero integer value to do multi-line matching within a string, 0 (or undefined) to tell Perl that it can assume that strings contain a single line, for the purpose of optimizing pattern matches. Pattern matches on strings containing multiple newlines can produce confusing results when $* is 0 or undefined. Default is undefined. (Mnemonic: * matches multiple things.) This variable influences the interpretation of only ^ and $. A literal newline can be searched for even when $* == 0. -Use of $* is deprecated in modern Perl, supplanted by the /s and /m modifiers on pattern matching. -Assigning a non-numerical value to $* triggers a warning (and makes $* act if $* == 0), while assigning a numerical value to $* makes that an implicit int is applied on the value. -input_line_number HANDLE EXPR -$INPUT_LINE_NUMBER -$NR -$. -The current input record number for the last file handle from which you just read() (or called a seek or tell on). The value may be different from the actual physical line number in the file, depending on what notion of "line" is in effect--see $/ on how to change that. An explicit close on a filehandle resets the line number. Because <> never does an explicit close, line numbers increase across ARGV files (but see examples in "eof" in perlfunc). Consider this variable read-only: setting it does not reposition the seek pointer; you'll have to do that on your own. Localizing $. has the effect of also localizing Perl's notion of "the last read filehandle". (Mnemonic: many programs use "." to mean the current line number.) -input_record_separator HANDLE EXPR -$INPUT_RECORD_SEPARATOR -$RS -$/ -The input record separator, newline by default. This influences Perl's idea of what a "line" is. Works like awk's RS variable, including treating empty lines as a terminator if set to the null string. (An empty line cannot contain any spaces or tabs.) You may set it to a multi-character string to match a multi-character terminator, or to undef to read through the end of file. Setting it to "\n\n" means something slightly different than setting to "", if the file contains consecutive empty lines. Setting to "" will treat two or more consecutive empty lines as a single empty line. Setting to "\n\n" will blindly assume that the next input character belongs to the next paragraph, even if it's a newline. (Mnemonic: / delimits line boundaries when quoting poetry.) - undef $/; # enable "slurp" mode - $_ = <FH>; # whole file now here - s/\n[ \t]+/ /g; -Remember: the value of $/ is a string, not a regex. awk has to be better for something. :-) -Setting $/ to a reference to an integer, scalar containing an integer, or scalar that's convertible to an integer will attempt to read records instead of lines, with the maximum record size being the referenced integer. So this: - $/ = \32768; # or \"32768", or \$var_containing_32768 - open(FILE, $myfile); - $_ = <FILE>; -will read a record of no more than 32768 bytes from FILE. If you're not reading from a record-oriented file (or your OS doesn't have record-oriented files), then you'll likely get a full chunk of data with every read. If a record is larger than the record size you've set, you'll get the record back in pieces. -On VMS, record reads are done with the equivalent of sysread, so it's best not to mix record and non-record reads on the same file. (This is unlikely to be a problem, because any file you'd want to read in record mode is probably unusable in line mode.) Non-VMS systems do normal I/O, so it's safe to mix record and non-record reads of a file. -See also "Newlines" in perlport. Also see $.. -autoflush HANDLE EXPR -$OUTPUT_AUTOFLUSH -$| -If set to nonzero, forces a flush right away and after every write or print on the currently selected output channel. Default is 0 (regardless of whether the channel is really buffered by the system or not; $| tells you only whether you've asked Perl explicitly to flush after each write). STDOUT will typically be line buffered if output is to the terminal and block buffered otherwise. Setting this variable is useful primarily when you are outputting to a pipe or socket, such as when you are running a Perl program under rsh and want to see the output as it's happening. This has no effect on input buffering. See "getc" in perlfunc for that. (Mnemonic: when you want your pipes to be piping hot.) -output_field_separator HANDLE EXPR -$OUTPUT_FIELD_SEPARATOR -$OFS -$, -The output field separator for the print operator. Ordinarily the print operator simply prints out its arguments without further adornment. To get behavior more like awk, set this variable as you would set awk's OFS variable to specify what is printed between fields. (Mnemonic: what is printed when there is a "," in your print statement.) -output_record_separator HANDLE EXPR -$OUTPUT_RECORD_SEPARATOR -$ORS -$\ -The output record separator for the print operator. Ordinarily the print operator simply prints out its arguments as is, with no trailing newline or other end-of-record string added. To get behavior more like awk, set this variable as you would set awk's ORS variable to specify what is printed at the end of the print. (Mnemonic: you set $\ instead of adding "\n" at the end of the print. Also, it's just like $/, but it's what you get "back" from Perl.) -$LIST_SEPARATOR -$" -This is like $, except that it applies to array and slice values interpolated into a double-quoted string (or similar interpreted string). Default is a space. (Mnemonic: obvious, I think.) -$SUBSCRIPT_SEPARATOR -$SUBSEP -$; -The subscript separator for multidimensional array emulation. If you refer to a hash element as - $foo{$a,$b,$c} -it really means - $foo{join($;, $a, $b, $c)} -But don't put - @foo{$a,$b,$c} # a slice--note the @ -which means - ($foo{$a},$foo{$b},$foo{$c}) -Default is "\034", the same as SUBSEP in awk. If your keys contain binary data there might not be any safe value for $;. (Mnemonic: comma (the syntactic subscript separator) is a semi-semicolon. Yeah, I know, it's pretty lame, but $, is already taken for something more important.) -Consider using "real" multidimensional arrays as described in perllol. -$OFMT -$# -The output format for printed numbers. This variable is a half-hearted attempt to emulate awk's OFMT variable. There are times, however, when awk and Perl have differing notions of what counts as numeric. The initial value is "%.ng", where n is the value of the macro DBL_DIG from your system's float.h. This is different from awk's default OFMT setting of "%.6g", so you need to set $# explicitly to get awk's value. (Mnemonic: # is the number sign.) -Use of $# is deprecated. -format_page_number HANDLE EXPR -$FORMAT_PAGE_NUMBER -$% -The current page number of the currently selected output channel. Used with formats. (Mnemonic: % is page number in nroff.) -format_lines_per_page HANDLE EXPR -$FORMAT_LINES_PER_PAGE -$= -The current page length (printable lines) of the currently selected output channel. Default is 60. Used with formats. (Mnemonic: = has horizontal lines.) -format_lines_left HANDLE EXPR -$FORMAT_LINES_LEFT -$- -The number of lines left on the page of the currently selected output channel. Used with formats. (Mnemonic: lines_on_page - lines_printed.) -@LAST_MATCH_START -@- -$-[0] is the offset of the start of the last successful match. $-[n] is the offset of the start of the substring matched by n-th subpattern, or undef if the subpattern did not match. -Thus after a match against $_, $& coincides with substr $_, $-[0], $+[0] - $-[0]. Similarly, $n coincides with substr $_, $-[n], $+[n] - $-[n] if $-[n] is defined, and $+ coincides with substr $_, $-[$#-], $+[$#-]. One can use $#- to find the last matched subgroup in the last successful match. Contrast with $#+, the number of subgroups in the regular expression. Compare with @+. -This array holds the offsets of the beginnings of the last successful submatches in the currently active dynamic scope. $-[0] is the offset into the string of the beginning of the entire match. The nth element of this array holds the offset of the nth submatch, so $+[1] is the offset where $1 begins, $+[2] the offset where $2 begins, and so on. You can use $#- to determine how many subgroups were in the last successful match. Compare with the @+ variable. -After a match against some variable $var: -$` is the same as substr($var, 0, $-[0]) -$& is the same as substr($var, $-[0], $+[0] - $-[0]) -$' is the same as substr($var, $+[0]) -$1 is the same as substr($var, $-[1], $+[1] - $-[1]) -$2 is the same as substr($var, $-[2], $+[2] - $-[2]) -$3 is the same as substr $var, $-[3], $+[3] - $-[3]) -format_name HANDLE EXPR -$FORMAT_NAME -$~ -The name of the current report format for the currently selected output channel. Default is the name of the filehandle. (Mnemonic: brother to $^.) -format_top_name HANDLE EXPR -$FORMAT_TOP_NAME -$^ -The name of the current top-of-page format for the currently selected output channel. Default is the name of the filehandle with _TOP appended. (Mnemonic: points to top of page.) -format_line_break_characters HANDLE EXPR -$FORMAT_LINE_BREAK_CHARACTERS -$: -The current set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format. Default is " \n-", to break on whitespace or hyphens. (Mnemonic: a "colon" in poetry is a part of a line.) -format_formfeed HANDLE EXPR -$FORMAT_FORMFEED -$^L -What formats output as a form feed. Default is \f. -$ACCUMULATOR -$^A -The current value of the write() accumulator for format() lines. A format contains formline() calls that put their result into $^A. After calling its format, write() prints out the contents of $^A and empties. So you never really see the contents of $^A unless you call formline() yourself and then look at it. See perlform and "formline()" in perlfunc. -$CHILD_ERROR -$? -The status returned by the last pipe close, backtick (``) command, successful call to wait() or waitpid(), or from the system() operator. This is just the 16-bit status word returned by the wait() system call (or else is made up to look like it). Thus, the exit value of the subprocess is really ($? >> 8), and $? & 127 gives which signal, if any, the process died from, and $? & 128 reports whether there was a core dump. (Mnemonic: similar to sh and ksh.) -Additionally, if the h_errno variable is supported in C, its value is returned via $? if any gethost*() function fails. -If you have installed a signal handler for SIGCHLD, the value of $? will usually be wrong outside that handler. -Inside an END subroutine $? contains the value that is going to be given to exit(). You can modify $? in an END subroutine to change the exit status of your program. For example: - END { - $? = 1 if $? == 255; # die would make it 255 - } -Under VMS, the pragma use vmsish 'status' makes $? reflect the actual VMS exit status, instead of the default emulation of POSIX status. -Also see "Error Indicators". -$OS_ERROR -$ERRNO -$! -If used numerically, yields the current value of the C errno variable, with all the usual caveats. (This means that you shouldn't depend on the value of $! to be anything in particular unless you've gotten a specific error return indicating a system error.) If used an a string, yields the corresponding system error string. You can assign a number to $! to set errno if, for instance, you want "$!" to return the string for error n, or you want to set the exit value for the die() operator. (Mnemonic: What just went bang?) -Also see "Error Indicators". -$EXTENDED_OS_ERROR -$^E -Error information specific to the current operating system. At the moment, this differs from $! under only VMS, OS/2, and Win32 (and for MacPerl). On all other platforms, $^E is always just the same as $!. -Under VMS, $^E provides the VMS status value from the last system error. This is more specific information about the last system error than that provided by $!. This is particularly important when $! is set to EVMSERR. -Under OS/2, $^E is set to the error code of the last call to OS/2 API either via CRT, or directly from perl. -Under Win32, $^E always returns the last error information reported by the Win32 call GetLastError() which describes the last error from within the Win32 API. Most Win32-specific code will report errors via $^E. ANSI C and Unix-like calls set errno and so most portable Perl code will report errors via $!. -Caveats mentioned in the description of $! generally apply to $^E, also. (Mnemonic: Extra error explanation.) -Also see "Error Indicators". -$EVAL_ERROR -$@ -The Perl syntax error message from the last eval() operator. If null, the last eval() parsed and executed correctly (although the operations you invoked may have failed in the normal fashion). (Mnemonic: Where was the syntax error "at"?) -Warning messages are not collected in this variable. You can, however, set up a routine to process warnings by setting $SIG{__WARN__} as described below. -Also see "Error Indicators". -$PROCESS_ID -$PID -$$ -The process number of the Perl running this script. You should consider this variable read-only, although it will be altered across fork() calls. (Mnemonic: same as shells.) -$REAL_USER_ID -$UID -$< -The real uid of this process. (Mnemonic: it's the uid you came from, if you're running setuid.) -$EFFECTIVE_USER_ID -$EUID -$> -The effective uid of this process. Example: - $< = $>; # set real to effective uid - ($<,$>) = ($>,$<); # swap real and effective uid -(Mnemonic: it's the uid you went to, if you're running setuid.) $< and $> can be swapped only on machines supporting setreuid(). -$REAL_GROUP_ID -$GID -$( -The real gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getgid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. -However, a value assigned to $( must be a single number used to set the real gid. So the value given by $( should not be assigned back to $( without being forced numeric, such as by adding zero. -(Mnemonic: parentheses are used to group things. The real gid is the group you left, if you're running setgid.) -$EFFECTIVE_GROUP_ID -$EGID -$) -The effective gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getegid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. -Similarly, a value assigned to $) must also be a space-separated list of numbers. The first number sets the effective gid, and the rest (if any) are passed to setgroups(). To get the effect of an empty list for setgroups(), just repeat the new effective gid; that is, to force an effective gid of 5 and an effectively empty setgroups() list, say $) = "5 5" . -(Mnemonic: parentheses are used to group things. The effective gid is the group that's right for you, if you're running setgid.) -$<, $>, $( and $) can be set only on machines that support the corresponding set[re][ug]id() routine. $( and $) can be swapped only on machines supporting setregid(). -$PROGRAM_NAME -$0 -Contains the name of the program being executed. On some operating systems assigning to $0 modifies the argument area that the ps program sees. This is more useful as a way of indicating the current program state than it is for hiding the program you're running. (Mnemonic: same as sh and ksh.) -Note for BSD users: setting $0 does not completely remove "perl" from the ps(1) output. For example, setting $0 to "foobar" will result in "perl: foobar (perl)". This is an operating system feature. -$[ -The index of the first element in an array, and of the first character in a substring. Default is 0, but you could theoretically set it to 1 to make Perl behave more like awk (or Fortran) when subscripting and when evaluating the index() and substr() functions. (Mnemonic: [ begins subscripts.) -As of release 5 of Perl, assignment to $[ is treated as a compiler directive, and cannot influence the behavior of any other file. Its use is highly discouraged. -$] -The version + patchlevel / 1000 of the Perl interpreter. This variable can be used to determine whether the Perl interpreter executing a script is in the right range of versions. (Mnemonic: Is this version of perl in the right bracket?) Example: - warn "No checksumming!\n" if $] < 3.019; -See also the documentation of use VERSION and require VERSION for a convenient way to fail if the running Perl interpreter is too old. -The use of this variable is deprecated. The floating point representation can sometimes lead to inaccurate numeric comparisons. See $^V for a more modern representation of the Perl version that allows accurate string comparisons. -$COMPILING -$^C -The current value of the flag associated with the -c switch. Mainly of use with -MO=... to allow code to alter its behavior when being compiled, such as for example to AUTOLOAD at compile time rather than normal, deferred loading. See perlcc. Setting $^C = 1 is similar to calling B::minus_c. -$DEBUGGING -$^D -The current value of the debugging flags. (Mnemonic: value of -D switch.) -$SYSTEM_FD_MAX -$^F -The maximum system file descriptor, ordinarily 2. System file descriptors are passed to exec()ed processes, while higher file descriptors are not. Also, during an open(), system file descriptors are preserved even if the open() fails. (Ordinary file descriptors are closed before the open() is attempted.) The close-on-exec status of a file descriptor will be decided according to the value of $^F when the corresponding file, pipe, or socket was opened, not the time of the exec(). -$^H -WARNING: This variable is strictly for internal use only. Its availability, behavior, and contents are subject to change without notice. -This variable contains compile-time hints for the Perl interpreter. At the end of compilation of a BLOCK the value of this variable is restored to the value when the interpreter started to compile the BLOCK. -When perl begins to parse any block construct that provides a lexical scope (e.g., eval body, required file, subroutine body, loop body, or conditional block), the existing value of $^H is saved, but its value is left unchanged. When the compilation of the block is completed, it regains the saved value. Between the points where its value is saved and restored, code that executes within BEGIN blocks is free to change the value of $^H. -This behavior provides the semantic of lexical scoping, and is used in, for instance, the use strict pragma. -The contents should be an integer; different bits of it are used for different pragmatic flags. Here's an example: - sub add_100 { $^H |= 0x100 } - sub foo { - BEGIN { add_100() } - bar->baz($boon); - } -Consider what happens during execution of the BEGIN block. At this point the BEGIN block has already been compiled, but the body of foo() is still being compiled. The new value of $^H will therefore be visible only while the body of foo() is being compiled. -Substitution of the above BEGIN block with: - BEGIN { require strict; strict->import('vars') } -demonstrates how use strict 'vars' is implemented. Here's a conditional version of the same lexical pragma: - BEGIN { require strict; strict->import('vars') if $condition } -%^H -WARNING: This variable is strictly for internal use only. Its availability, behavior, and contents are subject to change without notice. -The %^H hash provides the same scoping semantic as $^H. This makes it useful for implementation of lexically scoped pragmas. -$INPLACE_EDIT -$^I -The current value of the inplace-edit extension. Use undef to disable inplace editing. (Mnemonic: value of -i switch.) -$^M -By default, running out of memory is an untrappable, fatal error. However, if suitably built, Perl can use the contents of $^M as an emergency memory pool after die()ing. Suppose that your Perl were compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then - $^M = 'a' x (1 << 16); -would allocate a 64K buffer for use in an emergency. See the INSTALL file in the Perl distribution for information on how to enable this option. To discourage casual use of this advanced feature, there is no English long name for this variable. -$OSNAME -$^O -The name of the operating system under which this copy of Perl was built, as determined during the configuration process. The value is identical to $Config{'osname'}. See also Config and the -V command-line switch documented in perlrun. -$PERLDB -$^P -The internal variable for debugging support. The meanings of the various bits are subject to change, but currently indicate: -0x01 -Debug subroutine enter/exit. -0x02 -Line-by-line debugging. -0x04 -Switch off optimizations. -0x08 -Preserve more data for future interactive inspections. -0x10 -Keep info about source lines on which a subroutine is defined. -0x20 -Start with single-step on. -0x40 -Use subroutine address instead of name when reporting. -0x80 -Report goto &subroutine as well. -0x100 -Provide informative "file" names for evals based on the place they were compiled. -0x200 -Provide informative names to anonymous subroutines based on the place they were compiled. -Some bits may be relevant at compile-time only, some at run-time only. This is a new mechanism and the details may change. -$LAST_REGEXP_CODE_RESULT -$^R -The result of evaluation of the last successful (?{ code }) regular expression assertion (see perlre). May be written to. -$EXCEPTIONS_BEING_CAUGHT -$^S -Current state of the interpreter. Undefined if parsing of the current module/eval is not finished (may happen in $SIG{__DIE__} and $SIG{__WARN__} handlers). True if inside an eval(), otherwise false. -$BASETIME -$^T -The time at which the program began running, in seconds since the epoch (beginning of 1970). The values returned by the -M, -A, and -C filetests are based on this value. -$PERL_VERSION -$^V -The revision, version, and subversion of the Perl interpreter, represented as a string composed of characters with those ordinals. Thus in Perl v5.6.0 it equals chr(5) . chr(6) . chr(0) and will return true for $^V eq v5.6.0. Note that the characters in this string value can potentially be in Unicode range. -This can be used to determine whether the Perl interpreter executing a script is in the right range of versions. (Mnemonic: use ^V for Version Control.) Example: - warn "No \"our\" declarations!\n" if $^V and $^V lt v5.6.0; -See the documentation of use VERSION and require VERSION for a convenient way to fail if the running Perl interpreter is too old. -See also $] for an older representation of the Perl version. -$WARNING -$^W -The current value of the warning switch, initially true if -w was used, false otherwise, but directly modifiable. (Mnemonic: related to the -w switch.) See also warnings. -${^WARNING_BITS} -The current set of warning checks enabled by the use warnings pragma. See the documentation of warnings for more details. -${^WIDE_SYSTEM_CALLS} -Global flag that enables system calls made by Perl to use wide character APIs native to the system, if available. This is currently only implemented on the Windows platform. -This can also be enabled from the command line using the -C switch. -The initial value is typically 0 for compatibility with Perl versions earlier than 5.6, but may be automatically set to 1 by Perl if the system provides a user-settable default (e.g., $ENV{LC_CTYPE}). -The bytes pragma always overrides the effect of this flag in the current lexical scope. See bytes. -$EXECUTABLE_NAME -$^X -The name that the Perl binary itself was executed as, from C's argv[0]. This may not be a full pathname, nor even necessarily in your path. -$ARGV -contains the name of the current file when reading from <>. -@ARGV -The array @ARGV contains the command-line arguments intended for the script. $#ARGV is generally the number of arguments minus one, because $ARGV[0] is the first argument, not the program's command name itself. See $0 for the command name. -@INC -The array @INC contains the list of places that the do EXPR, require, or use constructs look for their library files. It initially consists of the arguments to any -I command-line switches, followed by the default Perl library, probably /usr/local/lib/perl, followed by ".", to represent the current directory. If you need to modify this at runtime, you should use the use lib pragma to get the machine-dependent library properly loaded also: - use lib '/mypath/libdir/'; - use SomeMod; -@_ -Within a subroutine the array @_ contains the parameters passed to that subroutine. See perlsub. -%INC -The hash %INC contains entries for each filename included via the do, require, or use operators. The key is the filename you specified (with module names converted to pathnames), and the value is the location of the file found. The require operator uses this hash to determine whether a particular file has already been included. -%ENV -$ENV{expr} -The hash %ENV contains your current environment. Setting a value in ENV changes the environment for any child processes you subsequently fork() off. -%SIG -$SIG{expr} -The hash %SIG contains signal handlers for signals. For example: - sub handler { # 1st argument is signal name - my($sig) = @_; - print "Caught a SIG$sig--shutting down\n"; - close(LOG); - exit(0); - } - $SIG{'INT'} = \&handler; - $SIG{'QUIT'} = \&handler; - ... - $SIG{'INT'} = 'DEFAULT'; # restore default action - $SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT -Using a value of 'IGNORE' usually has the effect of ignoring the signal, except for the CHLD signal. See perlipc for more about this special case. -Here are some other examples: - $SIG{"PIPE"} = "Plumber"; # assumes main::Plumber (not recommended) - $SIG{"PIPE"} = \&Plumber; # just fine; assume current Plumber - $SIG{"PIPE"} = *Plumber; # somewhat esoteric - $SIG{"PIPE"} = Plumber(); # oops, what did Plumber() return?? -Be sure not to use a bareword as the name of a signal handler, lest you inadvertently call it. -If your system has the sigaction() function then signal handlers are installed using it. This means you get reliable signal handling. If your system has the SA_RESTART flag it is used when signals handlers are installed. This means that system calls for which restarting is supported continue rather than returning when a signal arrives. If you want your system calls to be interrupted by signal delivery then do something like this: - use POSIX ':signal_h'; - my $alarm = 0; - sigaction SIGALRM, new POSIX::SigAction sub { $alarm = 1 } - or die "Error setting SIGALRM handler: $!\n"; -See POSIX. -Certain internal hooks can be also set using the %SIG hash. The routine indicated by $SIG{__WARN__} is called when a warning message is about to be printed. The warning message is passed as the first argument. The presence of a __WARN__ hook causes the ordinary printing of warnings to STDERR to be suppressed. You can use this to save warnings in a variable, or turn warnings into fatal errors, like this: - local $SIG{__WARN__} = sub { die $_[0] }; - eval $proggie; -The routine indicated by $SIG{__DIE__} is called when a fatal exception is about to be thrown. The error message is passed as the first argument. When a __DIE__ hook routine returns, the exception processing continues as it would have in the absence of the hook, unless the hook routine itself exits via a goto, a loop exit, or a die(). The __DIE__ handler is explicitly disabled during the call, so that you can die from a __DIE__ handler. Similarly for __WARN__. -Due to an implementation glitch, the $SIG{__DIE__} hook is called even inside an eval(). Do not use this to rewrite a pending exception in $@, or as a bizarre substitute for overriding CORE::GLOBAL::die(). This strange action at a distance may be fixed in a future release so that $SIG{__DIE__} is only called if your program is about to exit, as was the original intent. Any other use is deprecated. -__DIE__/__WARN__ handlers are very special in one respect: they may be called to report (probable) errors found by the parser. In such a case the parser may be in inconsistent state, so any attempt to evaluate Perl code from such a handler will probably result in a segfault. This means that warnings or errors that result from parsing Perl should be used with extreme caution, like this: - require Carp if defined $^S; - Carp::confess("Something wrong") if defined &Carp::confess; - die "Something wrong, but could not load Carp to give backtrace... - To see backtrace try starting Perl with -MCarp switch"; -Here the first line will load Carp unless it is the parser who called the handler. The second line will print backtrace and die if Carp was available. The third line will be executed only if Carp was not available. -See "die" in perlfunc, "warn" in perlfunc, "eval" in perlfunc, and warnings for additional information. -Error Indicators -The variables $@, $!, $^E, and $? contain information about different types of error conditions that may appear during execution of a Perl program. The variables are shown ordered by the "distance" between the subsystem which reported the error and the Perl process. They correspond to errors detected by the Perl interpreter, C library, operating system, or an external program, respectively. -To illustrate the differences between these variables, consider the following Perl expression, which uses a single-quoted string: - eval q{ - open PIPE, "/cdrom/install |"; - @res = <PIPE>; - close PIPE or die "bad pipe: $?, $!"; - }; -After execution of this statement all 4 variables may have been set. -$@ is set if the string to be eval-ed did not compile (this may happen if open or close were imported with bad prototypes), or if Perl code executed during evaluation die()d . In these cases the value of $@ is the compile error, or the argument to die (which will interpolate $! and $?!). (See also Fatal, though.) -When the eval() expression above is executed, open(), <PIPE>, and close are translated to calls in the C run-time library and thence to the operating system kernel. $! is set to the C library's errno if one of these calls fails. -Under a few operating systems, $^E may contain a more verbose error indicator, such as in this case, "CDROM tray not closed." Systems that do not support extended error messages leave $^E the same as $!. -Finally, $? may be set to non-0 value if the external program /cdrom/install fails. The upper eight bits reflect specific error conditions encountered by the program (the program's exit() value). The lower eight bits reflect mode of failure, like signal death and core dump information See wait(2) for details. In contrast to $! and $^E, which are set only if error condition is detected, the variable $? is set on each wait or pipe close, overwriting the old value. This is more like $@, which on every eval() is always set on failure and cleared on success. -For more details, see the individual descriptions at $@, $!, $^E, and $?. -Technical Note on the Syntax of Variable Names -Variable names in Perl can have several formats. Usually, they must begin with a letter or underscore, in which case they can be arbitrarily long (up to an internal limit of 251 characters) and may contain letters, digits, underscores, or the special sequence :: or '. In this case, the part before the last :: or ' is taken to be a package qualifier; see perlmod. -Perl variable names may also be a sequence of digits or a single punctuation or control character. These names are all reserved for special uses by Perl; for example, the all-digits names are used to hold data captured by backreferences after a regular expression match. Perl has a special syntax for the single-control-character names: It understands ^X (caret X) to mean the control-X character. For example, the notation $^W (dollar-sign caret W) is the scalar variable whose name is the single character control-W. This is better than typing a literal control-W into your program. -Finally, new in Perl 5.6, Perl variable names may be alphanumeric strings that begin with control characters (or better yet, a caret). These variables must be written in the form ${^Foo}; the braces are not optional. ${^Foo} denotes the scalar variable whose name is a control-F followed by two o's. These variables are reserved for future special uses by Perl, except for the ones that begin with ^_ (control-underscore or caret-underscore). No control-character name that begins with ^_ will acquire a special meaning in any future version of Perl; such names may therefore be used safely in programs. $^_ itself, however, is reserved. -Perl identifiers that begin with digits, control characters, or punctuation characters are exempt from the effects of the package declaration and are always forced to be in package main. A few other names are also exempt: - ENV STDIN - INC STDOUT - ARGV STDERR - ARGVOUT - SIG -In particular, the new special ${^_XYZ} variables are always taken to be in package main, regardless of any package declarations presently in scope. -BUGS -Due to an unfortunate accident of Perl's implementation, use English imposes a considerable performance penalty on all regular expression matches in a program, regardless of whether they occur in the scope of use English. For that reason, saying use English in libraries is strongly discouraged. See the Devel::SawAmpersand module documentation from CPAN (http://www.perl.com/CPAN/modules/by-module/Devel/) for more information. -Having to even think about the $^S variable in your exception handlers is simply wrong. $SIG{__DIE__} as currently implemented invites grievous and difficult to track down errors. Avoid it and use an END{} or CORE::GLOBAL::die override instead. diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/puller.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/puller.t deleted file mode 100644 index df0e00ef697..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/puller.t +++ /dev/null @@ -1,358 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 136 }; - -#use Pod::Simple::Debug (5); - -#sub Pod::Simple::MANY_LINES () {1} -#sub Pod::Simple::PullParser::DEBUG () {1} - - -use Pod::Simple::PullParser; - -sub pump_it_up { - my $p = Pod::Simple::PullParser->new; - $p->set_source( \( $_[0] ) ); - my(@t, $t); - while($t = $p->get_token) { push @t, $t } - print "# Count of tokens: ", scalar(@t), "\n"; - print "# I.e., {", join("\n# + ", - map ref($_) . ": " . $_->dump, @t), "} \n"; - return @t; -} - -my @t; - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -@t = pump_it_up(qq{\n\nProk\n\n=head1 Things\n\n=cut\n\nBzorch\n\n}); - -if(not( - ok scalar( grep { ref $_ and $_->can('type') } @t), 5 -)) { - ok 0,1, "Wrong token count. Failing subsequent tests.\n"; - for ( 1 .. 12 ) {ok 0} -} else { - ok $t[0]->type, 'start'; - ok $t[1]->type, 'start'; - ok $t[2]->type, 'text'; - ok $t[3]->type, 'end'; - ok $t[4]->type, 'end'; - - ok $t[0]->tagname, 'Document'; - ok $t[1]->tagname, 'head1'; - ok $t[2]->text, 'Things'; - ok $t[3]->tagname, 'head1'; - ok $t[4]->tagname, 'Document'; - - ok $t[0]->attr('start_line'), '5'; - ok $t[1]->attr('start_line'), '5'; -} - - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -@t = pump_it_up( - qq{Woowoo\n\n=over\n\n=item *\n\nStuff L<HTML::TokeParser>\n\n} - . qq{=item *\n\nThings I<like that>\n\n=back\n\n=cut\n\n} -); - -if( - not( ok scalar( grep { ref $_ and $_->can('type') } @t) => 16 ) -) { - ok 0,1, "Wrong token count. Failing subsequent tests.\n"; - for ( 1 .. 32 ) {ok 0} -} else { - ok $t[ 0]->type, 'start'; - ok $t[ 1]->type, 'start'; - ok $t[ 2]->type, 'start'; - ok $t[ 3]->type, 'text'; - ok $t[ 4]->type, 'start'; - ok $t[ 5]->type, 'text'; - ok $t[ 6]->type, 'end'; - ok $t[ 7]->type, 'end'; - - ok $t[ 8]->type, 'start'; - ok $t[ 9]->type, 'text'; - ok $t[10]->type, 'start'; - ok $t[11]->type, 'text'; - ok $t[12]->type, 'end'; - ok $t[13]->type, 'end'; - ok $t[14]->type, 'end'; - ok $t[15]->type, 'end'; - - - - ok $t[ 0]->tagname, 'Document'; - ok $t[ 1]->tagname, 'over-bullet'; - ok $t[ 2]->tagname, 'item-bullet'; - ok $t[ 3]->text, 'Stuff '; - ok $t[ 4]->tagname, 'L'; - ok $t[ 5]->text, 'HTML::TokeParser'; - ok $t[ 6]->tagname, 'L'; - ok $t[ 7]->tagname, 'item-bullet'; - - ok $t[ 8]->tagname, 'item-bullet'; - ok $t[ 9]->text, 'Things '; - ok $t[10]->tagname, 'I'; - ok $t[11]->text, 'like that'; - ok $t[12]->tagname, 'I'; - ok $t[13]->tagname, 'item-bullet'; - ok $t[14]->tagname, 'over-bullet'; - ok $t[15]->tagname, 'Document'; - - ok $t[4]->attr("type"), "pod"; -} - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -{ -print "# Testing unget_token\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} ); - -ok 1; -my $t; -$t = $p->get_token; -ok $t && $t->type, 'start'; -ok $t && $t->tagname, 'Document'; -print "# ungetting ($t).\n"; -$p->unget_token($t); -ok 1; - -$t = $p->get_token; -ok $t && $t->type, 'start'; -ok $t && $t->tagname, 'Document'; -my @to_save = ($t); - -$t = $p->get_token; -ok $t && $t->type, 'start'; -ok $t && $t->tagname, 'Para'; -push @to_save, $t; - -print "# ungetting (@to_save).\n"; -$p->unget_token(@to_save); -splice @to_save; - - -$t = $p->get_token; -ok $t && $t->type, 'start'; -ok $t && $t->tagname, 'Document'; - -$t = $p->get_token; -ok $t && $t->type, 'start'; -ok $t && $t->tagname, 'Para'; - -ok 1; - -} - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -{ -print "# Testing pullparsing from an arrayref\n"; -my $p = Pod::Simple::PullParser->new; -ok 1; -$p->set_source( ['','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] ); -ok 1; -my( @t, $t ); -while($t = $p->get_token) { - print "# Got a token: ", $t->dump, "\n#\n"; - push @t, $t; -} -ok scalar(@t), 5; # count of tokens -ok $t[0]->type, 'start'; -ok $t[1]->type, 'start'; -ok $t[2]->type, 'text'; -ok $t[3]->type, 'end'; -ok $t[4]->type, 'end'; - -ok $t[0]->tagname, 'Document'; -ok $t[1]->tagname, 'Para'; -ok $t[2]->text, 'Lala zaza'; -ok $t[3]->tagname, 'Para'; -ok $t[4]->tagname, 'Document'; - -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -{ -print "# Testing pullparsing from an arrayref with terminal newlines\n"; -my $p = Pod::Simple::PullParser->new; -ok 1; -$p->set_source( [ map "$_\n", - '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] ); -ok 1; -my( @t, $t ); -while($t = $p->get_token) { - print "# Got a token: ", $t->dump, "\n#\n"; - push @t, $t; -} -ok scalar(@t), 5; # count of tokens -ok $t[0]->type, 'start'; -ok $t[1]->type, 'start'; -ok $t[2]->type, 'text'; -ok $t[3]->type, 'end'; -ok $t[4]->type, 'end'; - -ok $t[0]->tagname, 'Document'; -ok $t[1]->tagname, 'Para'; -ok $t[2]->text, 'Lala zaza'; -ok $t[3]->tagname, 'Para'; -ok $t[4]->tagname, 'Document'; - -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -END { unlink "temp.pod" } -{ -print "# Testing pullparsing from a file\n"; -my $p = Pod::Simple::PullParser->new; -ok 1; -open(OUT, ">temp.pod") || die "Can't write-open temp.pod: $!"; -print OUT - map "$_\n", - '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut' -; -close(OUT); -ok 1; -sleep 1; - -$p->set_source("temp.pod"); - -my( @t, $t ); -while($t = $p->get_token) { - print "# Got a token: ", $t->dump, "\n#\n"; - push @t, $t; - print "# That's token number ", scalar(@t), "\n"; -} -ok scalar(@t), 5; # count of tokens -ok $t[0]->type, 'start'; -ok $t[1]->type, 'start'; -ok $t[2]->type, 'text'; -ok $t[3]->type, 'end'; -ok $t[4]->type, 'end'; - -ok $t[0]->tagname, 'Document'; -ok $t[1]->tagname, 'Para'; -ok $t[2]->text, 'Lala zaza'; -ok $t[3]->tagname, 'Para'; -ok $t[4]->tagname, 'Document'; - -} - -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -{ -print "# Testing pullparsing from a glob\n"; -my $p = Pod::Simple::PullParser->new; -ok 1; -open(IN, "<temp.pod") || die "Can't read-open temp.pod: $!"; -$p->set_source(*IN); - -my( @t, $t ); -while($t = $p->get_token) { - print "# Got a token: ", $t->dump, "\n#\n"; - push @t, $t; - print "# That's token number ", scalar(@t), "\n"; -} -ok scalar(@t), 5; # count of tokens -ok $t[0]->type, 'start'; -ok $t[1]->type, 'start'; -ok $t[2]->type, 'text'; -ok $t[3]->type, 'end'; -ok $t[4]->type, 'end'; - -ok $t[0]->tagname, 'Document'; -ok $t[1]->tagname, 'Para'; -ok $t[2]->text, 'Lala zaza'; -ok $t[3]->tagname, 'Para'; -ok $t[4]->tagname, 'Document'; -close(IN); - -} - -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -{ -print "# Testing pullparsing from a globref\n"; -my $p = Pod::Simple::PullParser->new; -ok 1; -open(IN, "<temp.pod") || die "Can't read-open temp.pod: $!"; -$p->set_source(\*IN); - -my( @t, $t ); -while($t = $p->get_token) { - print "# Got a token: ", $t->dump, "\n#\n"; - push @t, $t; - print "# That's token number ", scalar(@t), "\n"; -} -ok scalar(@t), 5; # count of tokens -ok $t[0]->type, 'start'; -ok $t[1]->type, 'start'; -ok $t[2]->type, 'text'; -ok $t[3]->type, 'end'; -ok $t[4]->type, 'end'; - -ok $t[0]->tagname, 'Document'; -ok $t[1]->tagname, 'Para'; -ok $t[2]->text, 'Lala zaza'; -ok $t[3]->tagname, 'Para'; -ok $t[4]->tagname, 'Document'; -close(IN); - -} - -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -{ -print "# Testing pullparsing from a filehandle\n"; -my $p = Pod::Simple::PullParser->new; -ok 1; -open(IN, "<temp.pod") || die "Can't read-open temp.pod: $!"; -$p->set_source(*IN{IO}); - -my( @t, $t ); -while($t = $p->get_token) { - print "# Got a token: ", $t->dump, "\n#\n"; - push @t, $t; - print "# That's token number ", scalar(@t), "\n"; -} -ok scalar(@t), 5; # count of tokens -ok $t[0]->type, 'start'; -ok $t[1]->type, 'start'; -ok $t[2]->type, 'text'; -ok $t[3]->type, 'end'; -ok $t[4]->type, 'end'; - -ok $t[0]->tagname, 'Document'; -ok $t[1]->tagname, 'Para'; -ok $t[2]->text, 'Lala zaza'; -ok $t[3]->tagname, 'Para'; -ok $t[4]->tagname, 'Document'; -close(IN); - -} - - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/pulltitl.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/pulltitl.t deleted file mode 100644 index abaf83f7b79..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/pulltitl.t +++ /dev/null @@ -1,388 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 104 }; - -#use Pod::Simple::Debug (5); - -#sub Pod::Simple::MANY_LINES () {1} -#sub Pod::Simple::PullParser::DEBUG () {3} - - -use Pod::Simple::PullParser; - -ok 1; - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 NAME\n\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} ); - -ok $p->get_title(), 'Bzorch'; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'head1' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'text'); -ok( $t && $t->type eq 'text' && $t->text, 'NAME' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 NE<65>ME\n\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} ); - -ok $p->get_title(), 'Bzorch'; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'head1' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'text'); - -} - - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -{ -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 NAME\n\nBzorch - I<thing> lala\n\n=pod\n\nLala\n\n\=cut\n} ); -ok $p->get_title(), 'Bzorch - thing lala'; -} - - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 NAME\n\nBzorch - I<thing> lala\n\n=pod\n\nLala\n\n\=cut\n} ); -ok $p->get_title(), 'Bzorch - thing lala'; - -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'head1' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'text'); -ok( $t && $t->type eq 'text' && $t->text, 'NAME' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 Bzorch lala\n\n=pod\n\nLala\n\n\=cut\n} ); - -ok $p->get_title(), 'Bzorch lala'; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'head1' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'text'); -ok( $t && $t->type eq 'text' && $t->text, 'Bzorch lala' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 Bzorch - I<thing> lala\n\n=pod\n\nLala\n\n\=cut\n} ); - -ok $p->get_title(), 'Bzorch - thing lala'; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'head1' ); - -ok( $t = $p->get_token); -ok( $t && $t->type, 'text'); -ok( $t && $t->type eq 'text' && $t->text, 'Bzorch - ' ); - -} -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 Nombre (NAME)\n\nBzorch - I<thing> lala\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_version || '', ''; -ok $p->get_author || '', ''; - -ok $p->get_title(), 'Bzorch - thing lala'; - -my $t; -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 (NAME)\n\n -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_title(), q{ -- Fet's "When you were reading}; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 (NAME) \n\n -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_title(), q{ -- Fet's "When you were reading}; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 (DESCRIPTION) \n\n -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_title() || '', ''; -ok $p->get_description(), q{ -- Fet's "When you were reading}; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 (DESCRIPTION) \n\n -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_description(), q{ -- Fet's "When you were reading}; -ok $p->get_title() || '', ''; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 NAME\n\nThingy\n\n=head1 (DESCRIPTION) \n\n -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_description(), q{ -- Fet's "When you were reading}; -ok $p->get_title(), "Thingy"; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 NAME\n\nThingy\n\n=head1 (DESCRIPTION) \n\n -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_title(), "Thingy"; -ok $p->get_description(), q{ -- Fet's "When you were reading}; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \qq{\n=head1 (NAME) \n\nThingy\n\n=head1 (DESCRIPTION) \n\n -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); - -ok $p->get_title(), "Thingy"; -ok $p->get_description(), q{ -- Fet's "When you were reading}; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \q{ - -=head1 (NAME) - -Thingy - -=head1 (DESCRIPTION) - - -- Fet's I<"When you were> reading - -=pod - -Grunk - -=cut -} ); - -ok $p->get_title(), "Thingy"; -ok $p->get_version() || '', ''; -ok $p->get_description(), q{ -- Fet's "When you were reading}; -my $t; - -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### - -{ -print "# Testing another set, at line ", __LINE__, "\n"; - -my $p = Pod::Simple::PullParser->new; -$p->set_source( \q{ - -=head1 (NAME) - -Thingy - -=head1 (DESCRIPTION) - - -- Fet's I<"When you were> reading - -=head1 VERSION - - Stuff: Thing - Whatever: Um. - -=head1 AUTHOR - -Jojoj E<65>arzarz - -=pod - -Grunk - -=cut -} ); - -ok $p->get_title(), "Thingy"; -my $v = $p->get_version || ''; -$v =~ s/^ +//m; -$v =~ s/^\s+//s; -$v =~ s/\s+$//s; -ok $v, "Stuff: Thing\nWhatever: Um."; -ok $p->get_description(), q{ -- Fet's "When you were reading}; -ok $p->get_author() || '', 'Jojoj Aarzarz'; - - -my $t; -ok( $t = $p->get_token); -ok( $t && $t->type, 'start'); -ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); - -} - -########################################################################### -########################################################################### - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/reinit.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/reinit.t deleted file mode 100644 index c10c65eb179..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/reinit.t +++ /dev/null @@ -1,91 +0,0 @@ -BEGIN { - chdir 't' if -d 't'; - if($ENV{PERL_CORE}) { - @INC = '../lib'; - } -} - -use lib '../lib'; - -use strict; -use Test; -BEGIN { plan tests => 5 }; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catfile ($dir, $file); - } else { - return $file; - } -} - -use Pod::Simple::Text; -$Pod::Simple::Text::FREAKYMODE = 1; - -my $parser = Pod::Simple::Text->new(); - -foreach my $file ( - "junk1.pod", - "junk2.pod", - "perlcyg.pod", - "perlfaq.pod", - "perlvar.pod", -) { - - unless(-e source_path($file)) { - ok 0; - print "# But $file doesn't exist!!\n"; - next; - } - - my $precooked = source_path($file); - my $outstring; - my $compstring; - $precooked =~ s<\.pod><o.txt>s; - $parser->reinit; - $parser->output_string(\$outstring); - $parser->parse_file(source_path($file)); - - open(IN, $precooked) or die "Can't read-open $precooked: $!"; - { - local $/; - $compstring = <IN>; - } - close(IN); - - for ($outstring,$compstring) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } - - if($outstring eq $compstring) { - ok 1; - next; - } elsif( do{ - for ($outstring, $compstring) { tr/ //d; }; - $outstring eq $compstring; - }){ - print "# Differ only in whitespace.\n"; - ok 1; - next; - } else { - - my $x = $outstring ^ $compstring; - $x =~ m/^(\x00*)/s or die; - my $at = length($1); - print "# Difference at byte $at...\n"; - if($at > 10) { - $at -= 5; - } - { - print "# ", substr($outstring,$at,20), "\n"; - print "# ", substr($compstring,$at,20), "\n"; - print "# ^..."; - } - - ok 0; - printf "# Unequal lengths %s and %s\n", length($outstring), length($compstring); - next; - } - } diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/render.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/render.t deleted file mode 100644 index ae7b8f401d4..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/render.t +++ /dev/null @@ -1,164 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } else { - push @INC, '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 26 }; -use Pod::Simple::TextContent; -use Pod::Simple::Text; - -BEGIN { - *mytime = defined(&Win32::GetTickCount) - ? sub () {Win32::GetTickCount() / 1000} - : sub () {time()} -} - -$Pod::Simple::Text::FREAKYMODE = 1; -use Pod::Simple::TiedOutFH (); - -chdir 't' unless $ENV{PERL_CORE}; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catfile ($dir, $file); - } else { - return $file; - } -} - -my $outfile = '10000'; - -foreach my $file ( - "junk1.pod", - "junk2.pod", - "perlcyg.pod", - "perlfaq.pod", - "perlvar.pod", -) { - - unless(-e source_path($file)) { - ok 0; - print "# But $file doesn't exist!!\n"; - exit 1; - } - - my @out; - my $precooked = source_path($file); - $precooked =~ s<\.pod><o.txt>s; - unless(-e $precooked) { - ok 0; - print "# But $precooked doesn't exist!!\n"; - exit 1; - } - - print "#\n#\n#\n###################\n# $file\n"; - foreach my $class ('Pod::Simple::TextContent', 'Pod::Simple::Text') { - my $p = $class->new; - push @out, ''; - $p->output_string(\$out[-1]); - my $t = mytime(); - $p->parse_file(source_path($file)); - printf "# %s %s %sb, %.03fs\n", - ref($p), source_path($file), length($out[-1]), mytime() - $t ; - ok 1; - } - - print "# Reading $precooked...\n"; - open(IN, $precooked) or die "Can't read-open $precooked: $!"; - { - local $/; - push @out, <IN>; - } - close(IN); - print "# ", length($out[-1]), " bytes pulled in.\n"; - - - for (@out) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } - - my $faily = 0; - print "#\n#Now comparing 1 and 2...\n"; - $faily += compare2($out[0], $out[1]); - print "#\n#Now comparing 2 and 3...\n"; - $faily += compare2($out[1], $out[2]); - print "#\n#Now comparing 1 and 3...\n"; - $faily += compare2($out[0], $out[2]); - - if($faily) { - ++$outfile; - - my @outnames = map $outfile . $_ , qw(0 1); - open(OUT2, ">$outnames[0].~out.txt") || die "Can't write-open $outnames[0].txt: $!"; - - foreach my $out (@out) { push @outnames, $outnames[-1]; ++$outnames[-1] }; - pop @outnames; - printf "# Writing to %s.txt .. %s.txt\n", $outnames[0], $outnames[-1]; - shift @outnames; - - binmode(OUT2); - foreach my $out (@out) { - my $outname = shift @outnames; - open(OUT, ">$outname.txt") || die "Can't write-open $outname.txt: $!"; - binmode(OUT); - print OUT $out, "\n"; - print OUT2 $out, "\n"; - close(OUT); - } - close(OUT2); - } -} - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; -exit; - - -sub compare2 { - my @out = @_; - if($out[0] eq $out[1]) { - ok 1; - return 0; - } elsif( do{ - for ($out[0], $out[1]) { tr/ //d; }; - $out[0] eq $out[1]; - }){ - print "# Differ only in whitespace.\n"; - ok 1; - return 0; - } else { - #ok $out[0], $out[1]; - - my $x = $out[0] ^ $out[1]; - $x =~ m/^(\x00*)/s or die; - my $at = length($1); - print "# Difference at byte $at...\n"; - if($at > 10) { - $at -= 5; - } - { - print "# ", substr($out[0],$at,20), "\n"; - print "# ", substr($out[1],$at,20), "\n"; - print "# ^..."; - } - - - - ok 0; - printf "# Unequal lengths %s and %s\n", length($out[0]), length($out[1]); - return 1; - } -} - - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search05.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search05.t deleted file mode 100644 index a55ca72ce1a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search05.t +++ /dev/null @@ -1,40 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 15 } - -print "# Some basic sanity tests...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; -print "# New object: $x\n"; -print "# Version: ", $x->VERSION, "\n"; -ok defined $x->can('callback'); -ok defined $x->can('dir_prefix'); -ok defined $x->can('inc'); -ok defined $x->can('laborious'); -ok defined $x->can('limit_glob'); -ok defined $x->can('limit_re'); -ok defined $x->can('shadows'); -ok defined $x->can('verbose'); -ok defined $x->can('survey'); -ok defined $x->can('_state_as_string'); -ok defined $x->can('contains_pod'); -ok defined $x->can('find'); -ok defined $x->can('simplify_name'); - -print "# Testing state dumping...\n"; -print $x->_state_as_string; -$x->inc("I\nLike Pie!\t!!"); -print $x->_state_as_string; - -print "# bye\n"; -ok 1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search10.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search10.t deleted file mode 100644 index c69334b1f61..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search10.t +++ /dev/null @@ -1,86 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -# Time-stamp: "2004-05-23 22:38:58 ADT" - -use strict; - -#sub Pod::Simple::Search::DEBUG () {5}; - -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 7 } - -print "# ", __FILE__, - ": Testing the surveying of a single specified docroot...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -print "# Testing the surveying of the current directory...\n"; - -$x->inc(0); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my $here; -if( -e ($here = source_path('testlib1'))) { - # -} elsif(-e ($here = File::Spec->catdir($cwd, 't', 'testlib1'))) { - # -} else { - die "Can't find the test corpus"; -} -print "# OK, found the test corpus as $here\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my($name2where, $where2name) = $x->survey($here); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort values %$where2name; -ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; -} - -{ -my $names = join "|", sort keys %$name2where; -ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; -} - -ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); - -ok grep( m/squaa\.pm/, keys %$where2name ), 1; - -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search12.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search12.t deleted file mode 100644 index 4f620c0cf94..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search12.t +++ /dev/null @@ -1,79 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 7 } - -print "# ", __FILE__, - ": Testing the surveying of the current directory...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my $here; -if( -e ($here = source_path('testlib1'))) { - chdir $here; -} elsif(-e ($here = File::Spec->catdir($cwd, 't', 'testlib1'))) { - chdir $here; -} else { - die "Can't find the test corpus"; -} -print "# OK, found the test corpus as $here\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my($name2where, $where2name) = $x->survey('.'); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort values %$where2name; -ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; -} - -{ -my $names = join "|", sort keys %$name2where; -ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; -} - -ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); - -ok grep( m/squaa\.pm/, keys %$where2name ), 1; - -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search20.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search20.t deleted file mode 100644 index 3022b3653bb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search20.t +++ /dev/null @@ -1,91 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 7 } - -print "# ", __FILE__, - ": Testing the scanning of several (well, two) docroots...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); - -$x->callback(sub { - print "# ", join(" ", map "{$_}", @_), "\n"; - return; -}); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my($here1, $here2); -if( -e ($here1 = source_path('testlib1'))) { - die "But where's $here2?" - unless -e ($here2 = source_path('testlib2')); -} elsif( -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2')); -} else { - die "Can't find the test corpora"; -} -print "# OK, found the test corpora\n# as $here1\n# and $here2\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -print "# OK, starting run...\n# [[\n"; -my($name2where, $where2name) = $x->survey($here1, $here2); -print "# ]]\n#OK, run done.\n"; - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort values %$where2name; -skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0, - $names, - "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; -} - -{ -my $names = join "|", sort keys %$name2where; -skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0, - $names, - "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; -} - -ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); - -ok grep( m/squaa\.pm/, keys %$where2name ), 1; - -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search22.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search22.t deleted file mode 100644 index 6e6d662a1b1..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search22.t +++ /dev/null @@ -1,119 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 13 } - -print "# ", __FILE__, - ": Testing the scanning of several docroots...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); -$x->shadows(1); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my($here1, $here2, $here3); - -if( -e ($here1 = source_path('testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = source_path('testlib2')); - die "But where's $here3?" - unless -e ($here3 = source_path('testlib3')); - -} elsif( -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = File::Spec->catdir($cwd, 't', 'testlib3')); - -} else { - die "Can't find the test corpora"; -} -print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my($name2where, $where2name) = $x->survey($here1, $here2, $here3); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -print "# won't show any shadows, since we're just looking at the name2where keys\n"; -my $names = join "|", sort keys %$name2where; -skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0, - $names, - "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; -} - -{ -print "# but here we'll see shadowing:\n"; -my $names = join "|", sort values %$where2name; -skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0, - $names, - "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|hinkhonk::Vliff|hinkhonk::Vliff|perlflif|perlthng|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo|zikzik"; - -my %count; -for(values %$where2name) { ++$count{$_} }; -#print pretty(\%count), "\n\n"; -delete @count{ grep $count{$_} < 2, keys %count }; -my $shadowed = join "|", sort keys %count; -ok $shadowed, "hinkhonk::Glunk|hinkhonk::Vliff|perlthng|squaa::Vliff"; - -sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } - -ok $count{'perlthng'}, 2; -thar 'perlthng'; -ok $count{'squaa::Vliff'}, 3; -thar 'squaa::Vliff'; -} - - -ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); - -ok grep( m/squaa\.pm/, keys %$where2name ), 1; - -ok( ($name2where->{'perlthng'} || 'huh???'), '/[^\^]testlib1/' ); -ok( ($name2where->{'squaa::Vliff'} || 'huh???'), '/[^\^]testlib1/' ); - -# Some sanity: -ok( ($name2where->{'squaa::Wowo'} || 'huh???'), '/testlib2/' ); - - - - -print "# OK, bye from ", __FILE__, "\n"; -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search25.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search25.t deleted file mode 100644 index 77045033b9a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search25.t +++ /dev/null @@ -1,112 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; - -#sub Pod::Simple::Search::DEBUG () {5}; - -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 10 } - -print "# ", __FILE__, - ": Testing limit_glob ...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); -$x->shadows(1); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; -my $dir; -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - my $updir = File::Spec->updir; - $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my($here1, $here2, $here3); - -if( -e ($here1 = source_path( 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = source_path( 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = source_path( 'testlib3')); - -} elsif( -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = File::Spec->catdir($cwd, 't', 'testlib3')); - -} else { - die "Can't find the test corpora: $dir"; -} -print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my $glob = 'squaa::*'; -print "# Limiting to $glob\n"; -$x->limit_glob($glob); - -my($name2where, $where2name) = $x->survey($here1, $here2, $here3); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort keys %$name2where; -ok $names, "squaa::Glunk|squaa::Vliff|squaa::Wowo"; -} - -{ -my $names = join "|", sort values %$where2name; -ok $names, "squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo"; - -my %count; -for(values %$where2name) { ++$count{$_} }; -#print pretty(\%count), "\n\n"; -delete @count{ grep $count{$_} < 2, keys %count }; -my $shadowed = join "|", sort keys %count; -ok $shadowed, "squaa::Vliff"; - -sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } - -ok $count{'squaa::Vliff'}, 3; -thar 'squaa::Vliff'; -} - - -ok ! $name2where->{'squaa'}; # because squaa.pm isn't squaa::* - -ok( ($name2where->{'squaa::Vliff'} || 'huh???'), '/[^\^]testlib1/' ); - -ok( ($name2where->{'squaa::Wowo'} || 'huh???'), '/testlib2/' ); - - -print "# OK, bye from ", __FILE__, "\n"; -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search26.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search26.t deleted file mode 100644 index fb9d322c762..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search26.t +++ /dev/null @@ -1,95 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 5 } - - -# -# "kleene" rhymes with "zany". It's a fact! -# - - -print "# ", __FILE__, - ": Testing limit_glob ...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); -$x->shadows(1); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my($here1, $here2, $here3); - -if( -e ($here1 = source_path( 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = source_path ( 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = source_path( 'testlib3')); - -} elsif( -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = File::Spec->catdir($cwd, 't', 'testlib3')); - -} else { - die "Can't find the test corpora"; -} -print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my $glob = '*k'; -print "# Limiting to $glob\n"; -$x->limit_glob($glob); - -my($name2where, $where2name) = $x->survey($here1, $here2, $here3); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort keys %$name2where; -ok $names, "Zonk::Pronk|hinkhonk::Glunk|perlzuk|squaa::Glunk|zikzik"; -} - -{ -my $names = join "|", sort values %$where2name; -ok $names, "Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|perlzuk|squaa::Glunk|zikzik"; -} - -print "# OK, bye from ", __FILE__, "\n"; -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search27.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search27.t deleted file mode 100644 index 22cf32d1072..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search27.t +++ /dev/null @@ -1,109 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 10 } - -print "# ", __FILE__, - ": Testing limit_glob ...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); -$x->shadows(1); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my($here1, $here2, $here3); - -if( -e ($here1 = source_path( 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = source_path( 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = source_path( 'testlib3')); - -} elsif( -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = File::Spec->catdir($cwd, 't', 'testlib3')); - -} else { - die "Can't find the test corpora"; -} -print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my $glob = 'squaa*'; -print "# Limiting to $glob\n"; -$x->limit_glob($glob); - -my($name2where, $where2name) = $x->survey($here1, $here2, $here3); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort keys %$name2where; -ok $names, "squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo"; -} - -{ -my $names = join "|", sort values %$where2name; -ok $names, "squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo"; - -my %count; -for(values %$where2name) { ++$count{$_} }; -#print pretty(\%count), "\n\n"; -delete @count{ grep $count{$_} < 2, keys %count }; -my $shadowed = join "|", sort keys %count; -ok $shadowed, "squaa::Vliff"; - -sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } - -ok $count{'squaa::Vliff'}, 3; -thar 'squaa::Vliff'; -} - - -ok $name2where->{'squaa'}; # because squaa.pm IS squaa* - -ok( ($name2where->{'squaa::Vliff'} || 'huh???'), '/[^\^]testlib1/' ); - -ok( ($name2where->{'squaa::Wowo'} || 'huh???'), '/testlib2/' ); - - -print "# OK, bye from ", __FILE__, "\n"; -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search28.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search28.t deleted file mode 100644 index 93012323176..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search28.t +++ /dev/null @@ -1,85 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 4 } - -print "# ", __FILE__, - ": Testing limit_glob ...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); -$x->shadows(1); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my($here1, $here2, $here3); - -if( -e ($here1 = source_path( 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = source_path( 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = source_path( 'testlib3')); - -} elsif( -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = File::Spec->catdir($cwd, 't', 'testlib3')); - -} else { - die "Can't find the test corpora"; -} -print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my $glob = '*z*k*'; -print "# Limiting to $glob\n"; -$x->limit_glob($glob); - -my($name2where, $where2name) = $x->survey($here1, $here2, $here3); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort values %$where2name; -ok $names, "Zonk::Pronk|perlzuk|zikzik"; -} - - -print "# OK, bye from ", __FILE__, "\n"; -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search29.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search29.t deleted file mode 100644 index c62befbbf82..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search29.t +++ /dev/null @@ -1,85 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 4 } - -print "# ", __FILE__, - ": Testing limit_glob ...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; - -$x->inc(0); -$x->shadows(1); - -use File::Spec; -use Cwd; -my $cwd = cwd(); -print "# CWD: $cwd\n"; - -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir ($dir, $file); - } else { - return $file; - } -} - -my($here1, $here2, $here3); - -if( -e ($here1 = source_path( 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = source_path( 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = source_path( 'testlib3')); - -} elsif( -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1' ))) { - die "But where's $here2?" - unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2')); - die "But where's $here3?" - unless -e ($here3 = File::Spec->catdir($cwd, 't', 'testlib3')); - -} else { - die "Can't find the test corpora"; -} -print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; -ok 1; - -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my $glob = '*z?k*'; -print "# Limiting to $glob\n"; -$x->limit_glob($glob); - -my($name2where, $where2name) = $x->survey($here1, $here2, $here3); - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -{ -my $names = join "|", sort values %$where2name; -ok $names, "perlzuk|zikzik"; -} - - -print "# OK, bye from ", __FILE__, "\n"; -ok 1; - -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/search50.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/search50.t deleted file mode 100644 index d2072768578..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/search50.t +++ /dev/null @@ -1,67 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - use File::Spec; - @INC = (File::Spec->rel2abs('../lib') ); - } -} -use strict; - -#sub Pod::Simple::Search::DEBUG () {5}; - -use Pod::Simple::Search; -use Test; -BEGIN { plan tests => 7 } - -print "# Test the scanning of the whole of \@INC ...\n"; - -my $x = Pod::Simple::Search->new; -die "Couldn't make an object!?" unless ok defined $x; -ok $x->inc; # make sure inc=1 is the default -print $x->_state_as_string; -#$x->verbose(12); - -use Pod::Simple; -*pretty = \&Pod::Simple::BlackBox::pretty; - -my $found = 0; -$x->callback(sub { - print "# ", join(" ", map "{$_}", @_), "\n"; - ++$found; - return; -}); - -print "# \@INC == @INC\n"; - -my $t = time(); my($name2where, $where2name) = $x->survey(); -$t = time() - $t; -ok $found; - -print "# Found $found items in $t seconds!\n# See...\n"; - -my $p = pretty( $where2name, $name2where )."\n"; -$p =~ s/, +/,\n/g; -$p =~ s/^/# /mg; -print $p; - -print "# OK, making sure strict and strict.pm were in there...\n"; -ok( ($name2where->{'strict'} || 'huh???'), '/strict\.(pod|pm)$/'); - -ok grep( m/strict\.(pod|pm)/, keys %$where2name ); - -my $strictpath = $name2where->{'strict'}; -if( $strictpath ) { - my @x = ($x->find('strict')||'(nil)', $strictpath); - print "# Comparing \"$x[0]\" to \"$x[1]\"\n"; - for(@x) { s{[/\\]}{/}g; } - print "# => \"$x[0]\" to \"$x[1]\"\n"; - ok $x[0], $x[1], " find('strict') should match survey's name2where{strict}"; -} else { - ok 0; # no 'thatpath/strict.pm' means can't test find() -} - -ok 1; -print "# Byebye from ", __FILE__, "\n"; -print "# @INC\n"; -__END__ - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/stree.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/stree.t deleted file mode 100644 index efdf8097faf..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/stree.t +++ /dev/null @@ -1,151 +0,0 @@ - - -use strict; -use Test; -BEGIN { plan tests => 33 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::SimpleTree; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; - -my $hashes_dont_matter = 0; - - -my $x = 'Pod::Simple::SimpleTree'; -sub x { - my $p = $x->new; - $p->merge_text(1); - $p->parse_string_document( shift )->root; -} - -ok 1; - -print "# a bit of meta-testing...\n"; -&ok( deq( 1, 1 )); -&ok(!deq( 2, 1 )); - -&ok( deq( undef, undef )); -&ok(!deq( undef, 1 )); -&ok(!deq( 1, undef )); - -&ok( deq( [ ], [ ] )); -&ok(!deq( [ ], 1 )); -&ok(!deq( 1, [ ] )); - -&ok( deq( [1], [1] )); -&ok(!deq( [1], 1 )); -&ok(!deq( 1, [1] )); -&ok(!deq( [1], [ ] )); -&ok(!deq( [ ], [1] )); -&ok(!deq( [1], [2] )); -&ok(!deq( [2], [1] )); - -&ok( deq( [ ], [ ] )); -&ok(!deq( [ ], 1 )); -&ok(!deq( 1, [ ] )); - -&ok( deq( {}, {} )); -&ok(!deq( {}, 1 )); -&ok(!deq( 1, {} )); -&ok(!deq( {1,2}, {} )); -&ok(!deq( {}, {1,2} )); -&ok( deq( {1,2}, {1,2} )); -&ok(!deq( {2,1}, {1,2} )); - - - - -print '# ', Pod::Simple::pretty(x( "=pod\n\nI like pie.\n" )), "\n"; -print "# Making sure we get a tree at all...\n"; -ok x( "=pod\n\nI like pie.\n" ); - - -print "# Some real tests...\n"; -&ok( deq( x( "=pod\n\nI like pie.\n"), - [ "Document", {"start_line"=>1}, - [ "Para", {"start_line"=>3}, - "I like pie." - ] - ] -)); - -$hashes_dont_matter = 1; - -&ok( deq( x("=pod\n\nB<foo\t>\n"), - [ "Document", {}, - [ "Para", {}, - ["B", {}, - "foo " - ] - ] - ] -)); - - -&ok( deq( x("=pod\n\nB<pieF<zorch>X<foo>I<pling>>\n"), - [ "Document", {}, - [ "Para", {}, - ["B", {}, - "pie", - ['F',{}, 'zorch'], - ['X',{}, 'foo' ], - ['I',{}, 'pling'], - ] - ] - ] -)); - -&ok( deq( x("=over\n\n=item B<pieF<zorch>X<foo>I<pling>>!\n\n=back"), - [ "Document", {}, - [ "over-text", {}, - [ "item-text", {}, - ["B", {}, - "pie", - ['F',{}, 'zorch'], - ['X',{}, 'foo' ], - ['I',{}, 'pling'], - ], - '!' - ] - ] - ] -)); - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - -sub deq { # deep-equals - #print "# deq ", Pod::Simple::pretty($_[0], $_[1]), "\n"; - return 1 unless defined $_[0] or defined $_[1]; # two undefs = same - return '' if defined $_[0] xor defined $_[1]; - return '' if ref($_[0]) ne ref($_[1]); # unequal referentiality - return $_[0] eq $_[1] unless ref $_[0]; - # So it's a ref: - use UNIVERSAL; - if(UNIVERSAL::isa($_[0], 'ARRAY')) { - return '' unless @{$_[0]} == @{$_[1]}; - for(my $i = 0; $i < @{$_[0]}; $i++) { - print("# NEQ ", Pod::Simple::pretty($_[0]), - "\n# != ", Pod::Simple::pretty($_[1]), "\n"), - return '' unless deq($_[0][$i], $_[1][$i]); # recurse! - } - return 1; - } elsif(UNIVERSAL::isa($_[0], 'HASH')) { - return 1 if $hashes_dont_matter; - return '' unless keys %{$_[0]} == keys %{$_[1]}; - foreach my $k (keys %{$_[0]}) { - return '' unless exists $_[1]{$k}; - return '' unless deq($_[0]{$k}, $_[1]{$k}); - } - return 1; - } else { - print "# I don't know how to deque $_[0] & $_[1]\n"; - return 1; - } -} - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Blorm.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Blorm.pm deleted file mode 100644 index 13499fadc93..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Blorm.pm +++ /dev/null @@ -1,10 +0,0 @@ -=head1 NAME - -Blorm -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Fiddle.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Fiddle.txt deleted file mode 100644 index 656827cf743..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Fiddle.txt +++ /dev/null @@ -1,4 +0,0 @@ - -This is just a dummy file. It's podless and shouldn't even be scanned for pod. - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Pronk.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Pronk.pm deleted file mode 100644 index 559af82920d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Pronk.pm +++ /dev/null @@ -1,43 +0,0 @@ - -=head1 NAME - -Zonk::Pronk -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -This is a test Pod document in Latin-1. Its content is the last two -paragraphs of Baudelaire's I<Le Joujou du pauvre>. - -A travers ces barreaux symboliques sparant deux mondes, la grande route -et le chteau, l'enfant pauvre montrait l'enfant riche son propre -joujou, que celui-ci examinait avidement comme un objet rare et inconnu. -Or, ce joujou, que le petit souillon agaait, agitait et secouait dans -une bote grille, c'tait un rat vivantE<160>! Les parents, par conomie -sans doute, avaient tir le joujou de la vie elle-mme. - -Et les deux enfants se riaient l'un l'autre fraternellement, avec des -dents d'une I<gale> blancheur. - -=head2 As Verbatim - - A travers ces barreaux symboliques sparant deux mondes, la grande route - et le chteau, l'enfant pauvre montrait l'enfant riche son propre - joujou, que celui-ci examinait avidement comme un objet rare et inconnu. - Or, ce joujou, que le petit souillon agaait, agitait et secouait dans - une bote grille, c'tait un rat vivant! Les parents, par conomie - sans doute, avaient tir le joujou de la vie elle-mme. - - Et les deux enfants se riaient l'un l'autre fraternellement, avec des - dents d'une gale blancheur. - -[end] - -=cut - - - -print "HOOBOY!\n"; -1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Veng.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Veng.pm deleted file mode 100644 index 078119534dc..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/Zonk/Veng.pm +++ /dev/null @@ -1,4 +0,0 @@ - -# This is just a podless test file. -1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/Glunk.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/Glunk.pod deleted file mode 100644 index 98e7624a71d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/Glunk.pod +++ /dev/null @@ -1,11 +0,0 @@ - -=head1 NAME - -squaa::Glunk -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/Vliff.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/Vliff.pm deleted file mode 100644 index 93d1b411f29..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/Vliff.pm +++ /dev/null @@ -1,14 +0,0 @@ - -=head1 NAME - -squaa::Vliff -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - -print "HOOBOY!\n"; -1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/readme.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/readme.txt deleted file mode 100644 index 96ae070ee8b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/hinkhonk/readme.txt +++ /dev/null @@ -1 +0,0 @@ -This directory should never be scanned. diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/pod/perlflif.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/pod/perlflif.pod deleted file mode 100644 index 63ae3da3429..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/pod/perlflif.pod +++ /dev/null @@ -1,7 +0,0 @@ - -=head1 NAME - -perlthang - This is just some test file - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/pod/perlthng.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/pod/perlthng.pod deleted file mode 100644 index 63ae3da3429..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/pod/perlthng.pod +++ /dev/null @@ -1,7 +0,0 @@ - -=head1 NAME - -perlthang - This is just some test file - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa.pm deleted file mode 100644 index 43228fd174a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa.pm +++ /dev/null @@ -1,12 +0,0 @@ -package squaa; - -=head1 NAME - -squaa -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa/Glunk.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa/Glunk.pod deleted file mode 100644 index 98e7624a71d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa/Glunk.pod +++ /dev/null @@ -1,11 +0,0 @@ - -=head1 NAME - -squaa::Glunk -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa/Vliff.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa/Vliff.pm deleted file mode 100644 index 93d1b411f29..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/squaa/Vliff.pm +++ /dev/null @@ -1,14 +0,0 @@ - -=head1 NAME - -squaa::Vliff -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - -print "HOOBOY!\n"; -1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/zikzik.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/zikzik.pod deleted file mode 100644 index 50f86dec6aa..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib1/zikzik.pod +++ /dev/null @@ -1,10 +0,0 @@ -=head1 NAME - -zikzik -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/Suzzle.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/Suzzle.pm deleted file mode 100644 index b96722c13ba..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/Suzzle.pm +++ /dev/null @@ -1,10 +0,0 @@ - -1; -__END__ - -=head1 NAME - -Sizzlesuzzle -- hooboy, this is a test file too. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/Glunk.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/Glunk.pod deleted file mode 100644 index 98e7624a71d..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/Glunk.pod +++ /dev/null @@ -1,11 +0,0 @@ - -=head1 NAME - -squaa::Glunk -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/Vliff.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/Vliff.pm deleted file mode 100644 index 93d1b411f29..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/Vliff.pm +++ /dev/null @@ -1,14 +0,0 @@ - -=head1 NAME - -squaa::Vliff -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - -print "HOOBOY!\n"; -1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/readme.txt b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/readme.txt deleted file mode 100644 index 96ae070ee8b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/hinkhonk/readme.txt +++ /dev/null @@ -1 +0,0 @@ -This directory should never be scanned. diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/pod/perlthng.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/pod/perlthng.pod deleted file mode 100644 index 63ae3da3429..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/pod/perlthng.pod +++ /dev/null @@ -1,7 +0,0 @@ - -=head1 NAME - -perlthang - This is just some test file - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/pod/perlzuk.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/pod/perlzuk.pod deleted file mode 100644 index 63ae3da3429..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/pod/perlzuk.pod +++ /dev/null @@ -1,7 +0,0 @@ - -=head1 NAME - -perlthang - This is just some test file - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/squaa/Vliff.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/squaa/Vliff.pm deleted file mode 100644 index 93d1b411f29..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/squaa/Vliff.pm +++ /dev/null @@ -1,14 +0,0 @@ - -=head1 NAME - -squaa::Vliff -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - -print "HOOBOY!\n"; -1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/squaa/Wowo.pod b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/squaa/Wowo.pod deleted file mode 100644 index e2c9d5d90d2..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib2/squaa/Wowo.pod +++ /dev/null @@ -1,11 +0,0 @@ - -=head1 NAME - -squaa::Wowo -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib3/squaa/Vliff.pm b/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib3/squaa/Vliff.pm deleted file mode 100644 index 93d1b411f29..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/testlib3/squaa/Vliff.pm +++ /dev/null @@ -1,14 +0,0 @@ - -=head1 NAME - -squaa::Vliff -- blorpoesu - -=head1 DESCRIPTION - -This is just a test file. - -=cut - -print "HOOBOY!\n"; -1; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/tiedfh.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/tiedfh.t deleted file mode 100644 index 74da0c63735..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/tiedfh.t +++ /dev/null @@ -1,57 +0,0 @@ -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use Test; -BEGIN { plan tests => 8 }; - -use Pod::Simple::TiedOutFH; -ok 1; - -print "# Sanity test of Perl and Pod::Simple::TiedOutFH\n"; - -{ - my $x = 'abc'; - my $out = Pod::Simple::TiedOutFH->handle_on($x); - print $out "Puppies\n"; - print $out "rrrrr"; - print $out "uffuff!"; - ok $x, "abcPuppies\nrrrrruffuff!"; - undef $out; - ok $x, "abcPuppies\nrrrrruffuff!"; -} - -# Now test that we can have two different strings. -{ - my $x1 = 'abc'; - my $x2 = 'xyz'; - my $out1 = Pod::Simple::TiedOutFH->handle_on($x1); - my $out2 = Pod::Simple::TiedOutFH->handle_on($x2); - - print $out1 "Puppies\n"; - print $out2 "Kitties\n"; - print $out2 "mmmmm"; - print $out1 "rrrrr"; - print $out2 "iaooowwlllllllrrr!\n"; - print $out1 "uffuff!"; - - ok $x1, "abcPuppies\nrrrrruffuff!", "out1 test"; - ok $x2, "xyzKitties\nmmmmmiaooowwlllllllrrr!\n", "out2 test"; - - undef $out1; - undef $out2; - - ok $x1, "abcPuppies\nrrrrruffuff!", "out1 test"; - ok $x2, "xyzKitties\nmmmmmiaooowwlllllllrrr!\n", "out2 test"; -} - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/verb_fmt.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/verb_fmt.t deleted file mode 100644 index a3f422fde6b..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/verb_fmt.t +++ /dev/null @@ -1,308 +0,0 @@ - -use strict; -use Test; -BEGIN { plan tests => 62 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; - -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(\&without_vf, @_) } -sub ev ($$) { Pod::Simple::DumpAsXML->_duo(\&with_vf, @_) } - -sub with_vf { $_[0]-> accept_codes('VerbatimFormatted') } -sub without_vf { $_[0]->unaccept_codes('VerbatimFormatted') } - -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -print "# Testing VerbatimFormatted...\n"; - # 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] - # #:^^^^^^^^^^^^^^^^^ ///////////// - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ ///////////// - Hooboy. - -=cut - -}) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or whatever]</VerbatimI>\n Hooboy.</VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ ///////////// - Hooboy. - -=cut - -}) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or whatever]</VerbatimI>\n Hooboy.</VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ ///////////// - -=cut - -}) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or whatever]</VerbatimI></VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ /////////////} -) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or whatever]</VerbatimI></VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ //////////////////} -) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or whatever]</VerbatimI></VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ ///} -) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or</VerbatimI> whatever]</VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ /// -#:^^^^^^^^^^^^^^^^^ ///} -) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or</VerbatimI> whatever]\n#:^^^^^^^^^^^^^^^^^ ///</VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -# with a tab: -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ /// } -) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i like pie. <VerbatimI>[or</VerbatimI> whatever]</VerbatimFormatted></Document>} -); - - - -# Now testing the % too: -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - What do you want? i like pie. [or whatever] -#:^^^^^^^^^^^^^^^^^ %%%% //////////////////} -) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> <VerbatimB>What do you want?</VerbatimB> i <VerbatimBI>like</VerbatimBI> pie. <VerbatimI>[or whatever]</VerbatimI></VerbatimFormatted></Document>} -); - - -&ok( Pod::Simple::XMLOutStream->_out(\&with_vf, -q{=pod - - Hooboy! - What do you want? i like pie. [or whatever] -#: ^^^^^ %%%% //////////////////} -) => qq{<Document><VerbatimFormatted\nxml:space="preserve"> Hooboy!\n What do you <VerbatimB>want?</VerbatimB> i <VerbatimBI>like</VerbatimBI> pie. <VerbatimI>[or whatever]</VerbatimI></VerbatimFormatted></Document>} -); - - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - - - - -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -print "# Now running some tests adapted from verbatims.t...\n#\n#\n"; - -print "# Without VerbatimFormatted...\n"; -&ok( e "", "" ); -&ok( e "\n", "", ); -&ok( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz" ); -&ok( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz\n" ); -print "# With VerbatimFormatted...\n"; -&ok( ev "", "" ); -&ok( ev "\n", "", ); -&ok( ev "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz" ); -&ok( ev "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz\n" ); - - -print "# Now testing via XMLOutStream without VerbatimFormatted...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\n quux</Verbatim></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\nquux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\nquux</Verbatim></Document>} -); - -print "# Contiguous verbatims...\n"; -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\n\n quux</Verbatim></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\n\n\n quux</Verbatim></Document>} -); - -print "# Testing =cut...\n"; -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim></Document>} -); - - - - -print "#\n# Now retesting with VerbatimFormatted...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n"), - qq{<Document><VerbatimFormatted\nxml:space="preserve"> foo bar baz</VerbatimFormatted></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n quux\n"), - qq{<Document><VerbatimFormatted\nxml:space="preserve"> foo bar baz\n quux</VerbatimFormatted></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\nquux\n"), - qq{<Document><VerbatimFormatted\nxml:space="preserve"> foo bar baz\nquux</VerbatimFormatted></Document>} -); - -print "# Contiguous verbatims...\n"; -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n quux\n"), - qq{<Document><VerbatimFormatted\nxml:space="preserve"> foo bar baz\n\n quux</VerbatimFormatted></Document>} -); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n quux\n"), - qq{<Document><VerbatimFormatted\nxml:space="preserve"> foo bar baz\n\n\n quux</VerbatimFormatted></Document>} -); - -print "# Testing =cut...\n"; -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n quux\n"), - qq{<Document><VerbatimFormatted\nxml:space="preserve"> foo bar baz</VerbatimFormatted></Document>} -); - - - - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -{ -my $it = -qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim><head1>Foo</head1><Verbatim\nxml:space="preserve"> quux\nquum</Verbatim></Document>} -; - - -print "# Various \\n-(in)significance sanity checks...\n"; - -print "# verbatim/cut/head/verbatim sanity zero...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity one...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity two...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity three...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity four...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -} - - -# : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : - -print "#\n# Now retesting with VerbatimFormatted...\n"; - -{ -my $it = -qq{<Document><VerbatimFormatted\nxml:space="preserve"> foo bar baz</VerbatimFormatted><head1>Foo</head1><VerbatimFormatted\nxml:space="preserve"> quux\nquum</VerbatimFormatted></Document>} -; - - -print "# Various \\n-(in)significance sanity checks...\n"; - -print "# verbatim/cut/head/verbatim sanity zero...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity one...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity two...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity three...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity four...\n"; - -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -} - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/verbatim.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/verbatim.t deleted file mode 100644 index 35d419e372a..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/verbatim.t +++ /dev/null @@ -1,363 +0,0 @@ - -use strict; -use Test; -BEGIN { plan tests => 31 }; - -#use Pod::Simple::Debug (6); - -ok 1; - -use Pod::Simple::DumpAsXML; -use Pod::Simple::XMLOutStream; -print "# Pod::Simple version $Pod::Simple::VERSION\n"; -sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) } - -&ok( e "", "" ); -&ok( e "\n", "", ); - - - - -&ok( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz" ); -&ok( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz\n" ); - - -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim></Document>} -); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\n quux</Verbatim></Document>} -); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\nquux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\nquux</Verbatim></Document>} -); - -print "# Contiguous verbatims...\n"; -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\n\n quux</Verbatim></Document>} -); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz\n\n\n quux</Verbatim></Document>} -); - -print "# Testing =cut...\n"; -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n quux\n"), - qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim></Document>} -); - - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -{ -my $it = -qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim><head1>Foo</head1><Verbatim\nxml:space="preserve"> quux\nquum</Verbatim></Document>} -; - - -print "# Various \\n-(in)significance sanity checks...\n"; - -print "# verbatim/cut/head/verbatim sanity zero...\n"; - -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity one...\n"; - -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity two...\n"; - -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\n\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity three...\n"; - -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -print "# verbatim/cut/head/verbatim sanity four...\n"; - -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); -ok( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); - -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# Testing tab expansion...\n"; - -&ok( e -q{=pod - - here we go now -a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z -}, -q{=pod - - here we go now -a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z -}, -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -&ok( e -q{=pod - - here we go now -a -.b -. c -. d -. e -. f -. g -. h -. i -. j -. k -. l -. m -. n -. o -. p -. q -. r -. s -. t -. u -. v -. w -. x -. y -. z -}, -q{=pod - - here we go now -a -.b -. c -. d -. e -. f -. g -. h -. i -. j -. k -. l -. m -. n -. o -. p -. q -. r -. s -. t -. u -. v -. w -. x -. y -. z -}, -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -&ok( e -q{=pod - - here we go now -a -.b -..c -.. d -.. e -.. f -.. g -.. h -.. i -.. j -.. k -.. l -.. m -.. n -.. o -.. p -.. q -.. r -.. s -.. t -.. u -.. v -.. w -.. x -.. y -.. z -}, -q{=pod - - here we go now -a -.b -..c -.. d -.. e -.. f -.. g -.. h -.. i -.. j -.. k -.. l -.. m -.. n -.. o -.. p -.. q -.. r -.. s -.. t -.. u -.. v -.. w -.. x -.. y -.. z -}, -); - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -&ok( e -q{=pod - - here we go now -a -.b -..c -.. d -.. e -.. f -.. g -.. h -.. i -.. .j -.. . k -.. . l -.. . m -.. . n -.. . o -.. . p -.. . q -.. . r -.. . s -.. . t -.. . u -.. . v -.. . w -.. . x -.. . y -.. . z -}, -q{=pod - - here we go now -a -.b -..c -.. d -.. e -.. f -.. g -.. h -.. i -.. .j -.. . k -.. . l -.. . m -.. . n -.. . o -.. . p -.. . q -.. . r -.. . s -.. . t -.. . u -.. . v -.. . w -.. . x -.. . y -.. . z -}, -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -# TODO: long-line splitting? - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/x_nixer.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/x_nixer.t deleted file mode 100644 index 488b72cd626..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/x_nixer.t +++ /dev/null @@ -1,218 +0,0 @@ - - -use strict; -use Test; -BEGIN { plan tests => 11 }; - -my $d; -#use Pod::Simple::Debug (\$d, 0); - -ok 1; - -use Pod::Simple::XMLOutStream; -use Pod::Simple::DumpAsXML; - - -$Pod::Simple::XMLOutStream::ATTR_PAD = ' '; -$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output - - -print "# A simple sanity test...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>F<C<Z<>fE<111>o> I<bar>> B<stuff X<thingZ<>>baz>\n"), - '<Document><Para><F><C>foo</C> <I>bar</I></F> <B>stuff <X>thing</X>baz</B></Para></Document>' -); - -print "# With lots of nesting, and Z's...\n"; -ok( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>F<C<Z<>fE<111>o> I<bar>> B<stuff X<thingZ<>>baz>\n"), - '<Document><Para><F><C>foo</C> <I>bar</I></F> <B>stuff <X>thing</X>baz</B></Para></Document>' -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub mergy {$_[0]->merge_text(1)} -sub nixy {$_[0]->nix_X_codes(1)} -sub nixy_mergy {$_[0]->merge_text(1); $_[0]->nix_X_codes(1);} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# With no F/X\n"; - -ok( Pod::Simple::DumpAsXML->_out( "=pod\n\nZ<>F<C<Z<>fE<111>o> I<bar>> B<stuff X<thingZ<>>baz>\n"), - join "\n", - - '<Document>', - ' <Para>', - ' <F>', - ' <C>', - ' f', - ' o', - ' o', - ' </C>', - ' ', - ' <I>', - ' bar', - ' </I>', - ' </F>', - ' ', - ' <B>', - ' stuff ', - ' <X>', - ' thing', - ' </X>', - ' baz', - ' </B>', - ' </Para>', - '</Document>', - '', -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# with just X-nixing...\n"; - -ok( Pod::Simple::DumpAsXML->_out( \&nixy, "=pod\n\nZ<>F<C<Z<>fE<111>o> I<bar>> B<stuff X<thingZ<>>baz>\n"), - join "\n", - - '<Document>', - ' <Para>', - ' <F>', - ' <C>', - ' f', - ' o', - ' o', - ' </C>', - ' ', - ' <I>', - ' bar', - ' </I>', - ' </F>', - ' ', - ' <B>', - ' stuff ', - ' baz', - ' </B>', - ' </Para>', - '</Document>', - '', -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# With merging...\n"; - -ok( Pod::Simple::DumpAsXML->_out( \&mergy, "=pod\n\nZ<>F<C<Z<>fE<111>o> I<bar>> B<stuff X<thingZ<>>baz>\n"), - join "\n", - - '<Document>', - ' <Para>', - ' <F>', - ' <C>', - ' foo', - ' </C>', - ' ', - ' <I>', - ' bar', - ' </I>', - ' </F>', - ' ', - ' <B>', - ' stuff ', - ' <X>', - ' thing', - ' </X>', - ' baz', - ' </B>', - ' </Para>', - '</Document>', - '', -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -print "# With nixing and merging...\n"; -#$d = 10; -ok( Pod::Simple::DumpAsXML->_out( \&nixy_mergy, "=pod\n\nZ<>F<C<Z<>fE<111>o> I<bar>> B<stuff X<thingZ<>>baz>\n"), - join "\n", - - '<Document>', - ' <Para>', - ' <F>', - ' <C>', - ' foo', - ' </C>', - ' ', - ' <I>', - ' bar', - ' </I>', - ' </F>', - ' ', - ' <B>', - ' stuff baz', - ' </B>', - ' </Para>', - '</Document>', - '', -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -# Now the scary bits... with L's! -print "# A wee L<...> sanity test...\n"; -ok( Pod::Simple::XMLOutStream->_out(qq{=pod\n\nL<E<78>et::Ping/Ping-E<112>ong>\n}), - '<Document><Para><L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>' -); -print "# Now a wee L<...> with mergy...\n"; - -$d = 10; - -ok( Pod::Simple::DumpAsXML->_out(\&mergy, qq{=pod\n\nL<E<78>et::Ping/Ping-E<112>ong>\n}), - join "\n", - - '<Document>', - ' <Para>', - ' <L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">', - ' "Ping-pong" in Net::Ping', - ' </L>', - ' </Para>', - '</Document>', - '' -); - - -print "# Now a complex tree with L's, with nixy+mergy...\n"; - -ok( Pod::Simple::DumpAsXML->_out( \&nixy_mergy, "=pod\n\nZ<>F<C<Z<>fE<111>L<E<78>et::Ping/Ping-E<112>ong>o> I<bar>> B<stuff X<thingZ<>>baz>\n"), - join "\n", - - '<Document>', - ' <Para>', - ' <F>', - ' <C>', - ' fo', - ' <L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">', - ' "Ping-pong" in Net::Ping', - ' </L>', - ' o', - ' </C>', - ' ', - ' <I>', - ' bar', - ' </I>', - ' </F>', - ' ', - ' <B>', - ' stuff baz', - ' </B>', - ' </Para>', - '</Document>', - '', -); - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - - -print "# Wrapping up... one for the road...\n"; -ok 1; -print "# --- Done with ", __FILE__, " --- \n"; - diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/xhtml01.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/xhtml01.t deleted file mode 100755 index d75605a1ea2..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/xhtml01.t +++ /dev/null @@ -1,351 +0,0 @@ -#!/usr/bin/perl -w - -# t/xhtml01.t - check basic output from Pod::Simple::XHTML - -BEGIN { - chdir 't' if -d 't'; -} - -use strict; -use lib '../lib'; -use Test::More tests => 26; - -use_ok('Pod::Simple::XHTML') or exit; - -my $parser = Pod::Simple::XHTML->new (); -isa_ok ($parser, 'Pod::Simple::XHTML'); - -my $results; - -my $PERLDOC = "http://search.cpan.org/perldoc?"; - -initialize($parser, $results); -$parser->parse_string_document( "=head1 Poit!" ); -is($results, "<h1>Poit!</h1>\n\n", "head1 level output"); - -initialize($parser, $results); -$parser->parse_string_document( "=head2 I think so Brain." ); -is($results, "<h2>I think so Brain.</h2>\n\n", "head2 level output"); - -initialize($parser, $results); -$parser->parse_string_document( "=head3 I say, Brain..." ); -is($results, "<h3>I say, Brain...</h3>\n\n", "head3 level output"); - -initialize($parser, $results); -$parser->parse_string_document( "=head4 Zort!" ); -is($results, "<h4>Zort!</h4>\n\n", "head4 level output"); - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -Gee, Brain, what do you want to do tonight? -EOPOD - -is($results, <<'EOHTML', "simple paragraph"); -<p>Gee, Brain, what do you want to do tonight?</p> - -EOHTML - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -B: Now, Pinky, if by any chance you are captured during this mission, -remember you are Gunther Heindriksen from Appenzell. You moved to -Grindelwald to drive the cog train to Murren. Can you repeat that? - -P: Mmmm, no, Brain, don't think I can. -EOPOD - -is($results, <<'EOHTML', "multiple paragraphs"); -<p>B: Now, Pinky, if by any chance you are captured during this mission, remember you are Gunther Heindriksen from Appenzell. You moved to Grindelwald to drive the cog train to Murren. Can you repeat that?</p> - -<p>P: Mmmm, no, Brain, don't think I can.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=over - -=item * - -P: Gee, Brain, what do you want to do tonight? - -=item * - -B: The same thing we do every night, Pinky. Try to take over the world! - -=back - -EOPOD - -is($results, <<'EOHTML', "simple bulleted list"); -<ul> - -<li>P: Gee, Brain, what do you want to do tonight?</li> - -<li>B: The same thing we do every night, Pinky. Try to take over the world!</li> - -</ul> - -EOHTML - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=over - -=item 1 - -P: Gee, Brain, what do you want to do tonight? - -=item 2 - -B: The same thing we do every night, Pinky. Try to take over the world! - -=back - -EOPOD - -is($results, <<'EOHTML', "numbered list"); -<ol> - -<li>1. P: Gee, Brain, what do you want to do tonight?</li> - -<li>2. B: The same thing we do every night, Pinky. Try to take over the world!</li> - -</ol> - -EOHTML - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=over - -=item Pinky - -Gee, Brain, what do you want to do tonight? - -=item Brain - -The same thing we do every night, Pinky. Try to take over the world! - -=back - -EOPOD - -is($results, <<'EOHTML', "list with text headings"); -<ul> - -<li>Pinky - -<p>Gee, Brain, what do you want to do tonight?</p> - -<li>Brain - -<p>The same thing we do every night, Pinky. Try to take over the world!</p> - -</ul> - -EOHTML - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - - 1 + 1 = 2; - 2 + 2 = 4; - -EOPOD - -is($results, <<'EOHTML', "code block"); -<pre><code> 1 + 1 = 2; - 2 + 2 = 4;</code></pre> - -EOHTML - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with a C<functionname>. -EOPOD -is($results, <<"EOHTML", "code entity in a paragraph"); -<p>A plain paragraph with a <code>functionname</code>.</p> - -EOHTML - - -initialize($parser, $results); -$parser->html_header("<html>\n<body>"); -$parser->html_footer("</body>\n</html>"); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with body tags turned on. -EOPOD -is($results, <<"EOHTML", "adding html body tags"); -<html> -<body> - -<p>A plain paragraph with body tags turned on.</p> - -</body> -</html> - -EOHTML - - -initialize($parser, $results); -$parser->html_css('style.css'); -$parser->html_header(undef); -$parser->html_footer(undef); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with body tags and css tags turned on. -EOPOD -like($results, qr/<link rel='stylesheet' href='style.css' type='text\/css'>/, -"adding html body tags and css tags"); - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with S<non breaking text>. -EOPOD -is($results, <<"EOHTML", "Non breaking text in a paragraph"); -<p>A plain paragraph with <nobr>non breaking text</nobr>.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with a L<Newlines>. -EOPOD -is($results, <<"EOHTML", "Link entity in a paragraph"); -<p>A plain paragraph with a <a href="${PERLDOC}Newlines">Newlines</a>.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with a L<perlport/Newlines>. -EOPOD -is($results, <<"EOHTML", "Link entity in a paragraph"); -<p>A plain paragraph with a <a href="${PERLDOC}perlport/Newlines">"Newlines" in perlport</a>.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with a L<Boo|http://link.included.here>. -EOPOD -is($results, <<"EOHTML", "A link in a paragraph"); -<p>A plain paragraph with a <a href="http://link.included.here">Boo</a>.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with a L<http://link.included.here>. -EOPOD -is($results, <<"EOHTML", "A link in a paragraph"); -<p>A plain paragraph with a <a href="http://link.included.here">http://link.included.here</a>.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with B<bold text>. -EOPOD -is($results, <<"EOHTML", "Bold text in a paragraph"); -<p>A plain paragraph with <b>bold text</b>.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with I<italic text>. -EOPOD -is($results, <<"EOHTML", "Italic text in a paragraph"); -<p>A plain paragraph with <i>italic text</i>.</p> - -EOHTML - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - -A plain paragraph with a F<filename>. -EOPOD -is($results, <<"EOHTML", "File name in a paragraph"); -<p>A plain paragraph with a <i>filename</i>.</p> - -EOHTML - - -initialize($parser, $results); -$parser->parse_string_document(<<'EOPOD'); -=pod - - # this header is very important & don't you forget it - my $text = "File is: " . <FILE>; -EOPOD -is($results, <<"EOHTML", "Verbatim text with encodable entities"); -<pre><code> # this header is very important & don't you forget it - my \$text = "File is: " . <FILE>;</code></pre> - -EOHTML - -SKIP: for my $use_html_entities (0, 1) { - if ($use_html_entities and not $Pod::Simple::XHTML::HAS_HTML_ENTITIES) { - skip("HTML::Entities not installed", 1); - } - local $Pod::Simple::XHTML::HAS_HTML_ENTITIES = $use_html_entities; - initialize($parser, $results); - $parser->parse_string_document(<<'EOPOD'); -=pod - - # this header is very important & don't you forget it - B<my $file = <FILEE<gt> || 'Blank!';> - my $text = "File is: " . <FILE>; -EOPOD -is($results, <<"EOHTML", "Verbatim text with markup and embedded formatting"); -<pre><code> # this header is very important & don't you forget it - <b>my \$file = <FILE> || 'Blank!';</b> - my \$text = "File is: " . <FILE>;</code></pre> - -EOHTML -} - -###################################### - -sub initialize { - $_[0] = Pod::Simple::XHTML->new (); - $_[0]->html_header(""); - $_[0]->html_footer(""); - $_[0]->output_string( \$results ); # Send the resulting output to a string - $_[1] = ''; - return; -} diff --git a/gnu/usr.bin/perl/lib/Pod/Simple/t/xhtml05.t b/gnu/usr.bin/perl/lib/Pod/Simple/t/xhtml05.t deleted file mode 100755 index 4e2738ee7ff..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Simple/t/xhtml05.t +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/perl -w - -# t/xhtml05.t - check block output from Pod::Simple::XHTML - -BEGIN { - chdir 't' if -d 't'; -} - -use strict; -use lib '../lib'; -use Test::More tests => 6; - -use_ok('Pod::Simple::XHTML') or exit; - -my $parser = Pod::Simple::XHTML->new (); -isa_ok ($parser, 'Pod::Simple::XHTML'); - -my $results; -initialize($parser, $results); -$parser->accept_targets_as_text( 'comment' ); -$parser->parse_string_document(<<'EOPOD'); -=for comment -This is an ordinary for block. - -EOPOD - -is($results, <<'EOHTML', "a for block"); -<div class="comment"> - -<p>This is an ordinary for block.</p> - -</div> - -EOHTML - -foreach my $target qw(note tip warning) { - initialize($parser, $results); - $parser->accept_targets_as_text( $target ); - $parser->parse_string_document(<<"EOPOD"); -=begin $target - -This is a $target. - -=end $target -EOPOD - - is($results, <<"EOHTML", "allow $target blocks"); -<div class="$target"> - -<p>This is a $target.</p> - -</div> - -EOHTML - -} - -###################################### - -sub initialize { - $_[0] = Pod::Simple::XHTML->new (); - $_[0]->html_header(""); - $_[0]->html_footer(""); - $_[0]->output_string( \$results ); # Send the resulting output to a string - $_[1] = ''; - return; -} diff --git a/gnu/usr.bin/perl/lib/Pod/Text.pm b/gnu/usr.bin/perl/lib/Pod/Text.pm deleted file mode 100644 index cbab0f09d29..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Text.pm +++ /dev/null @@ -1,867 +0,0 @@ -# Pod::Text -- Convert POD data to formatted ASCII text. -# -# Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008 -# 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); - -$VERSION = '3.13'; - -############################################################################## -# 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); - - # Send errors to stderr if requested. - if ($$self{opt_stderr}) { - $self->no_errata_section (1); - $self->complain_stderr (1); - delete $$self{opt_stderr}; - } - - # 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. Replace non-breaking spaces with spaces -# and soft hyphens with nothing, and then try to fix the output encoding if -# necessary to match the input encoding unless UTF-8 output is forced. This -# preserves the traditional pass-through behavior of Pod::Text. -sub output { - my ($self, $text) = @_; - $text =~ tr/\240\255/ /d; - unless ($$self{opt_utf8} || $$self{CHECKED_ENCODING}) { - my $encoding = $$self{encoding} || ''; - if ($encoding) { - eval { binmode ($$self{output_fh}, ":encoding($encoding)") }; - } - $$self{CHECKED_ENCODING} = 1; - } - 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. - - # We have to redo encoding handling for each document. - delete $$self{CHECKED_ENCODING}; - - # If we were given the utf8 option, set an output encoding on our file - # handle. Wrap in an eval in case we're using a version of Perl too old - # to understand this. - # - # This is evil because it changes the global state of a file handle that - # we may not own. However, we can't just blindly encode all output, since - # there may be a pre-applied output encoding (such as from PERL_UNICODE) - # and then we would double-encode. This seems to be the least bad - # approach. - if ($$self{opt_utf8}) { - eval { binmode ($$self{output_fh}, ':encoding(UTF-8)') }; - } - - 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*)([ \t]*\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 { - $parser->output_fh (\*STDOUT); - 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 (@_); -} - -sub begin_pod { - my $self = shift; - $$self{EXCLUDE} = 0; - $$self{VERBATIM} = 0; -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Text - Convert POD data to formatted ASCII text - -=for stopwords -alt stderr Allbery Sean Burke's Christiansen UTF-8 pre-Unicode utf8 - -=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 stderr - -Send error messages about invalid POD to standard error instead of -appending a POD ERRORS section to the generated output. - -=item utf8 - -By default, Pod::Text uses the same output encoding as the input encoding -of the POD source (provided that Perl was built with PerlIO; otherwise, it -doesn't encode its output). If this option is given, the output encoding -is forced to UTF-8. - -Be aware that, when using this option, the input encoding of your POD -source must be properly declared unless it is US-ASCII or Latin-1. POD -input without an C<=encoding> command will be assumed to be in Latin-1, -and if it's actually in UTF-8, the output will be double-encoded. See -L<perlpod(1)> for more information on the C<=encoding> command. - -=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 BUGS - -Encoding handling assumes that PerlIO is available and does not work -properly if it isn't. The C<utf8> option is therefore not supported -unless Perl is built with PerlIO support. - -=head1 CAVEATS - -If Pod::Text is given the C<utf8> option, the encoding of its output file -handle will be forced to UTF-8 if possible, overriding any existing -encoding. This will be done even if the file handle is not created by -Pod::Text and was passed in from outside. This maintains consistency -regardless of PERL_UNICODE and other settings. - -If the C<utf8> option is not given, the encoding of its output file handle -will be forced to the detected encoding of the input POD, which preserves -whatever the input text is. This ensures backward compatibility with -earlier, pre-Unicode versions of this module, without large numbers of -Perl warnings. - -This is not ideal, but it seems to be the best compromise. If it doesn't -work for you, please let me know the details of how it broke. - -=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<perlpod(1)>, 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, 2008 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/gnu/usr.bin/perl/lib/Pod/Text/Color.pm b/gnu/usr.bin/perl/lib/Pod/Text/Color.pm deleted file mode 100644 index 517f5d04587..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Text/Color.pm +++ /dev/null @@ -1,146 +0,0 @@ -# Pod::Text::Color -- Convert POD data to formatted color ASCII text -# -# Copyright 1999, 2001, 2004, 2006, 2008 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); - -$VERSION = '2.05'; - -############################################################################## -# 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 - -=for stopwords -Allbery - -=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, 2008 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/gnu/usr.bin/perl/lib/Pod/Text/Overstrike.pm b/gnu/usr.bin/perl/lib/Pod/Text/Overstrike.pm deleted file mode 100644 index a76fc28f8e0..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Text/Overstrike.pm +++ /dev/null @@ -1,212 +0,0 @@ -# Pod::Text::Overstrike -- Convert POD data to formatted overstrike text -# -# Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000 -# (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>) -# Copyright 2000 Joe Smith <Joe.Smith@inwap.com>. -# Copyright 2001, 2004, 2008 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); - -$VERSION = '2.03'; - -############################################################################## -# 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 - -=for stopwords -overstrike - -Pod::Text::Overstrike - Convert POD data to formatted overstrike text - -=for stopwords -overstruck Overstruck Allbery terminal's - -=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 hard-copy terminals and/or line printers, yet is readable on soft-copy -(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/gnu/usr.bin/perl/lib/Pod/Text/Termcap.pm b/gnu/usr.bin/perl/lib/Pod/Text/Termcap.pm deleted file mode 100644 index 4a75b302516..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Text/Termcap.pm +++ /dev/null @@ -1,184 +0,0 @@ -# Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes. -# -# Copyright 1999, 2001, 2002, 2004, 2006, 2008 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); - -$VERSION = '2.05'; - -############################################################################## -# 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 - -=for stopwords -ECMA-48 VT100 Allbery - -=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, 2008 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/gnu/usr.bin/perl/lib/Pod/Usage.pm b/gnu/usr.bin/perl/lib/Pod/Usage.pm deleted file mode 100644 index cff00e608e3..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/Usage.pm +++ /dev/null @@ -1,730 +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 strict; - -use vars qw($VERSION @ISA @EXPORT); -$VERSION = '1.36'; ## 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">. - -Alternatively, an array reference of section specifications can be used: - - pod2usage(-verbose => 99, - -sections => [ qw(fred fred/subsection) ] ); - -=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>). - -If you are calling B<pod2usage()> from a module and want to display -that module's POD, you can use this: - - use Pod::Find qw(pod_where); - pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) ); - -=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>. - -Marek Rouchal E<lt>marekr@cpan.orgE<gt> - -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. - -=head1 SEE ALSO - -L<Pod::Parser>, L<Getopt::Long>, L<Pod::Find> - -=cut - -############################################################################# - -#use diagnostics; -use Carp; -use Config; -use Exporter; -use File::Spec; - -@EXPORT = qw(&pod2usage); -BEGIN { - if ( $] >= 5.005_58 ) { - require Pod::Text; - @ISA = qw( Pod::Text ); - } - else { - require Pod::PlainText; - @ISA = qw( Pod::PlainText ); - } -} - -require Pod::Select; - -##--------------------------------------------------------------------------- - -##--------------------------------- -## 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 ($key, $val) = ($_, $opts{$_}); - $key =~ s/^(?=\w)/-/; - $key =~ /^-msg/i and $key = '-message'; - $key =~ /^-exit/i and $key = '-exitval'; - lc($key) => $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 $basename = $opts{'-input'}; - my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';' - : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ':'); - my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB}; - - my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec); - for my $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|USAGE)\s*'); - } - elsif ($opts{'-verbose'} == 1) { - my $opt_re = '(?i)' . - '(?:OPTIONS|ARGUMENTS)' . - '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?'; - $parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" ); - } - elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) { - $parser->select('.*'); - } - elsif ($opts{'-verbose'} == 99) { - my $sections = $opts{'-sections'}; - $parser->select( (ref $sections) ? @$sections : $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'); - print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'}); - if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) { - # the perldocs back to 5.005 should all have -F - # without -F there are warnings in -T scripts - system($progpath, '-F', $1); - if($?) { - # RT16091: fall back to more if perldoc failed - system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1); - } - } else { - croak "Unspecified input file or insecure argument.\n"; - } - } - 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, @sections) = @_; - if ($ISA[0]->can('select')) { - $self->SUPER::select(@sections); - } else { - # we're using Pod::Simple - need to mimic the behavior of Pod::Select - my $add = ($sections[0] eq '+') ? shift(@sections) : ''; - ## Reset the set of sections to use - unless (@sections) { - delete $self->{USAGE_SELECT} unless ($add); - return; - } - $self->{USAGE_SELECT} = [] - unless ($add && $self->{USAGE_SELECT}); - my $sref = $self->{USAGE_SELECT}; - ## Compile each spec - for my $spec (@sections) { - my $cs = Pod::Select::_compile_section_spec($spec); - if ( defined $cs ) { - ## Store them in our sections array - push(@$sref, $cs); - } else { - carp qq{Ignoring section spec "$spec"!\n}; - } - } - } -} - -# 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_HEADINGS} = [ $$self{PENDING}[-1][1] ]; - if ($self->{USAGE_OPTIONS}->{-verbose} < 2) { - $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/; - } - } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0 - my $idx = $1 - 1; - $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS}); - $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1]; - } - if ($element =~ /^head\d+$/) { - $$self{USAGE_SKIPPING} = 1; - if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) { - $$self{USAGE_SKIPPING} = 0; - } else { - my @headings = @{$$self{USAGE_HEADINGS}}; - for my $section_spec ( @{$$self{USAGE_SELECT}} ) { - my $match = 1; - for (my $i = 0; $i < $Pod::Select::MAX_HEADING_LEVEL; ++$i) { - $headings[$i] = '' unless defined $headings[$i]; - my $regex = $section_spec->[$i]; - my $negated = ($regex =~ s/^\!//); - $match &= ($negated ? ($headings[$i] !~ /${regex}/) - : ($headings[$i] =~ /${regex}/)); - last unless ($match); - } # end heading levels - if ($match) { - $$self{USAGE_SKIPPING} = 0; - last; - } - } # end sections - } - - # 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} && $element !~ m/^over-/) { - pop @{ $$self{PENDING} }; - } else { - $self->SUPER::_handle_element_end($element); - } -} - -# required for Pod::Simple API -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"; -} - -# required for old Pod::Parser API -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 diff --git a/gnu/usr.bin/perl/lib/Pod/t/basic.cap b/gnu/usr.bin/perl/lib/Pod/t/basic.cap deleted file mode 100644 index 20fc1e561cc..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/basic.cap +++ /dev/null @@ -1,268 +0,0 @@ -[1mNAME[m - basic.pod - Test of various basic POD features in translators. - -[1mHEADINGS[m - Try a few different levels of headings, with embedded formatting codes and - other interesting bits. - -[1mThis "is" a "level 1" heading[m - [1m``Level'' "2 [4mheading[m[m - Level 3 [1mheading [4mwith "weird stuff "" (double quote)"[m[m - Level "4 "heading" - Now try again with [1mintermixed[m text. - -[1mThis "is" a "level 1" heading[m - Text. - - [1m``Level'' 2 [4mheading[m[m - Text. - - Level 3 [1mheading [4mwith "weird stuff"[m[m - Text. - - Level "4 "heading" - Text. - -[1mLINKS[m - These are all taken from the Pod::Parser tests. - - Try out [4mLOTS[m of different ways of specifying references: - - Reference the "section" in manpage - - Reference the "section" in "manpage" - - Reference the "section" in manpage - - Now try it using the new "|" stuff ... - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext| - - And then throw in a few new ones of my own. - - foo - - foo - - "bar" in foo - - "baz boo" in foo - - "bar" - - "baz boo" - - "baz boo" - - "baz boo" in foo bar - - "boo var baz" - - "bar baz" - - "boo", "bar", and "baz" - - foobar - - Testing [4mitalics[m - - "[4mItalic[m text" in foo - - "Section "with" [4m[1mother[m markup[m" in foo|bar - - Nested <http://www.perl.org/> - -[1mOVER AND ITEMS[m - Taken from Pod::Parser tests, this is a test to ensure that multiline - =item paragraphs get indented appropriately. - - This is a test. - - There should be whitespace now before this line. - - Taken from Pod::Parser tests, this is a test to ensure the nested =item - paragraphs get indented appropriately. - - 1 First section. - - a this is item a - - b this is item b - - 2 Second section. - - a this is item a - - b this is item b - - c - d This is item c & d. - - Now some additional weirdness of our own. Make sure that multiple tags for - one paragraph are properly compacted. - - "foo" - [1mbar[m - "baz" - There shouldn't be any spaces between any of these item tags; this - idiom is used in perlfunc. - - Some longer item text - Just to make sure that we test paragraphs where the item text doesn't - fit in the margin of the paragraph (and make sure that this paragraph - fills a few lines). - - Let's also make it multiple paragraphs to be sure that works. - - Test use of =over without =item as a block "quote" or block paragraph. - - This should be indented four spaces but otherwise formatted the same - as any other regular text paragraph. Make sure it's long enough to see - the results of the formatting..... - - Now try the same thing nested, and make sure that the indentation is reset - back properly. - - This paragraph should be doubly indented. - - This paragraph should only be singly indented. - - * This is an item in the middle of a block-quote, which should be - allowed. - - * We're also testing tagless item commands. - - Should be back to the single level of indentation. - - Should be back to regular indentation. - - Now also check the transformation of * into real bullets for man pages. - - * An item. We're also testing using =over without a number, and making - sure that item text wraps properly. - - * Another item. - - and now test the numbering of item blocks. - - 1. First item. - - 2. Second item. - -[1mFORMATTING CODES[m - Another test taken from Pod::Parser. - - This is a test to see if I can do not only $self and "method()", but also - "$self->method()" and "$self->{FIELDNAME}" and "$Foo <=> $Bar" without - resorting to escape sequences. If I want to refer to the right-shift - operator I can do something like "$x >> 3" or even "$y >> 5". - - Now for the grand finale of "$self->method()->{FIELDNAME} = {FOO=>BAR}". - And I also want to make sure that newlines work like this "$self->{FOOBAR} - >> 3 and [$b => $a]->[$a <=> $b]" - - Of course I should still be able to do all this [4mwith[m escape sequences too: - "$self->method()" and "$self->{FIELDNAME}" and "{FOO=>BAR}". - - Dont forget "$self->method()->{FIELDNAME} = {FOO=>BAR}". - - And make sure that 0 works too! - - Now, if I use << or >> as my delimiters, then I have to use whitespace. So - things like "<$self-"method()>> and "<$self-"{FIELDNAME}>> wont end up - doing what you might expect since the first > will still terminate the - first < seen. - - Lets make sure these work for empty ones too, like "" and ">>" (just to be - obnoxious) - - The statement: "This is dog kind's [4mfinest[m hour!" is a parody of a - quotation from Winston Churchill. - - The following tests are added to those: - - Make sure that a few other odd [4mthings[m still work. This should be a - vertical bar: |. Here's a test of a few more special escapes that have to - be supported: - - & An ampersand. - - ' An apostrophe. - - < A less-than sign. - - > A greater-than sign. - - " A double quotation mark. - - / A forward slash. - - Try to get this bit of text over towards the edge so - |that all of this text inside S<> won't| be wrapped. Also test the - |same thing with non-breaking spaces.| - - There is a soft hyphen in hyphen at hy-phen. - - This is a test of an index entry. - -[1mVERBATIM[m - Throw in a few verbatim paragraphs. - - use Term::ANSIColor; - print color 'bold blue'; - print "This text is bold blue.\n"; - print color 'reset'; - print "This text is normal.\n"; - print colored ("Yellow on magenta.\n", 'yellow on_magenta'); - print "This text is normal.\n"; - print colored ['yellow on_magenta'], "Yellow on magenta.\n"; - - use Term::ANSIColor qw(uncolor); - print uncolor '01;31', "\n"; - - But this isn't verbatim (make sure it wraps properly), and the next - paragraph is again: - - use Term::ANSIColor qw(:constants); - print BOLD, BLUE, "This text is in bold blue.\n", RESET; - - use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\n"; print "This text is normal.\n"; - - (Ugh, that's obnoxiously long.) Try different spacing: - - Starting with a tab. - Not - starting - with - a - tab. But this should still be verbatim. - As should this. - - This isn't. - - This is. And this: is an internal tab. It should be: - |--| <= lined up with that. - - (Tricky, but tabs should be expanded before the translator starts in on - the text since otherwise text with mixed tabs and spaces will get messed - up.) - - And now we test verbatim paragraphs right before a heading. Older - versions of Pod::Man generated two spaces between paragraphs like this - and the heading. (In order to properly test this, one may have to - visually inspect the nroff output when run on the generated *roff - text, unfortunately.) - -[1mCONCLUSION[m - That's all, folks! - diff --git a/gnu/usr.bin/perl/lib/Pod/t/basic.clr b/gnu/usr.bin/perl/lib/Pod/t/basic.clr deleted file mode 100644 index f98857187ab..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/basic.clr +++ /dev/null @@ -1,269 +0,0 @@ -[1mNAME[0m - basic.pod - Test of various basic POD features in translators. - -[1mHEADINGS[0m - Try a few different levels of headings, with embedded formatting codes - and other interesting bits. - -[1mThis "is" a "level 1" heading[0m - [1m``Level'' "2 [33mheading[0m[0m - Level 3 [1mheading [33mwith "weird [36mstuff "" (double quote)[0m"[0m[0m - Level "4 "heading" - Now try again with [1mintermixed[0m [36mtext[0m. - -[1mThis "is" a "level 1" heading[0m - Text. - - [1m``Level'' 2 [33mheading[0m[0m - Text. - - Level 3 [1mheading [33mwith "weird [36mstuff[0m"[0m[0m - Text. - - Level "4 "heading" - Text. - -[1mLINKS[0m - These are all taken from the Pod::Parser tests. - - Try out [33mLOTS[0m of different ways of specifying references: - - Reference the "section" in manpage - - Reference the "section" in "manpage" - - Reference the "section" in manpage - - Now try it using the new "|" stuff ... - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext| - - And then throw in a few new ones of my own. - - foo - - foo - - "bar" in foo - - "baz boo" in foo - - "bar" - - "baz boo" - - "baz boo" - - "baz boo" in foo bar - - "boo var baz" - - "bar baz" - - "boo", "bar", and "baz" - - foobar - - Testing [33mitalics[0m - - "[33mItalic[0m text" in foo - - "Section "with" [33m[1mother[0m markup[0m" in foo|bar - - Nested <http://www.perl.org/> - -[1mOVER AND ITEMS[0m - Taken from Pod::Parser tests, this is a test to ensure that multiline - =item paragraphs get indented appropriately. - - This is a test. - - There should be whitespace now before this line. - - Taken from Pod::Parser tests, this is a test to ensure the nested =item - paragraphs get indented appropriately. - - 1 First section. - - a this is item a - - b this is item b - - 2 Second section. - - a this is item a - - b this is item b - - c - d This is item c & d. - - Now some additional weirdness of our own. Make sure that multiple tags - for one paragraph are properly compacted. - - "foo" - [1mbar[0m - "baz" - There shouldn't be any spaces between any of these item tags; this - idiom is used in perlfunc. - - Some longer item text - Just to make sure that we test paragraphs where the item text - doesn't fit in the margin of the paragraph (and make sure that this - paragraph fills a few lines). - - Let's also make it multiple paragraphs to be sure that works. - - Test use of =over without =item as a block "quote" or block paragraph. - - This should be indented four spaces but otherwise formatted the same - as any other regular text paragraph. Make sure it's long enough to - see the results of the formatting..... - - Now try the same thing nested, and make sure that the indentation is - reset back properly. - - This paragraph should be doubly indented. - - This paragraph should only be singly indented. - - * This is an item in the middle of a block-quote, which should be - allowed. - - * We're also testing tagless item commands. - - Should be back to the single level of indentation. - - Should be back to regular indentation. - - Now also check the transformation of * into real bullets for man pages. - - * An item. We're also testing using =over without a number, and making - sure that item text wraps properly. - - * Another item. - - and now test the numbering of item blocks. - - 1. First item. - - 2. Second item. - -[1mFORMATTING CODES[0m - Another test taken from Pod::Parser. - - This is a test to see if I can do not only $self and "method()", but - also "$self->method()" and "$self->{FIELDNAME}" and "$Foo <=> $Bar" - without resorting to escape sequences. If I want to refer to the - right-shift operator I can do something like "$x >> 3" or even "$y >> - 5". - - Now for the grand finale of "$self->method()->{FIELDNAME} = {FOO=>BAR}". - And I also want to make sure that newlines work like this - "$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b]" - - Of course I should still be able to do all this [33mwith[0m escape sequences - too: "$self->method()" and "$self->{FIELDNAME}" and "{FOO=>BAR}". - - Dont forget "$self->method()->{FIELDNAME} = {FOO=>BAR}". - - And make sure that 0 works too! - - Now, if I use << or >> as my delimiters, then I have to use whitespace. - So things like "<$self-"method()>> and "<$self-"{FIELDNAME}>> wont end - up doing what you might expect since the first > will still terminate - the first < seen. - - Lets make sure these work for empty ones too, like "" and ">>" (just to - be obnoxious) - - The statement: "This is dog kind's [33mfinest[0m hour!" is a parody of a - quotation from Winston Churchill. - - The following tests are added to those: - - Make sure that a few other odd [33mthings[0m still work. This should be a - vertical bar: |. Here's a test of a few more special escapes that have - to be supported: - - & An ampersand. - - ' An apostrophe. - - < A less-than sign. - - > A greater-than sign. - - " A double quotation mark. - - / A forward slash. - - Try to get this bit of text over towards the edge so - |that all of this text inside S<> won't| be wrapped. Also test the - |same thing with non-breaking spaces.| - - There is a soft hyphen in hyphen at hy-phen. - - This is a test of an index entry. - -[1mVERBATIM[0m - Throw in a few verbatim paragraphs. - - use Term::ANSIColor; - print color 'bold blue'; - print "This text is bold blue.\n"; - print color 'reset'; - print "This text is normal.\n"; - print colored ("Yellow on magenta.\n", 'yellow on_magenta'); - print "This text is normal.\n"; - print colored ['yellow on_magenta'], "Yellow on magenta.\n"; - - use Term::ANSIColor qw(uncolor); - print uncolor '01;31', "\n"; - - But this isn't verbatim (make sure it wraps properly), and the next - paragraph is again: - - use Term::ANSIColor qw(:constants); - print BOLD, BLUE, "This text is in bold blue.\n", RESET; - - use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\n"; print "This text is normal.\n"; - - (Ugh, that's obnoxiously long.) Try different spacing: - - Starting with a tab. - Not - starting - with - a - tab. But this should still be verbatim. - As should this. - - This isn't. - - This is. And this: is an internal tab. It should be: - |--| <= lined up with that. - - (Tricky, but tabs should be expanded before the translator starts in on - the text since otherwise text with mixed tabs and spaces will get messed - up.) - - And now we test verbatim paragraphs right before a heading. Older - versions of Pod::Man generated two spaces between paragraphs like this - and the heading. (In order to properly test this, one may have to - visually inspect the nroff output when run on the generated *roff - text, unfortunately.) - -[1mCONCLUSION[0m - That's all, folks! - diff --git a/gnu/usr.bin/perl/lib/Pod/t/basic.man b/gnu/usr.bin/perl/lib/Pod/t/basic.man deleted file mode 100644 index 43874b6e877..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/basic.man +++ /dev/null @@ -1,321 +0,0 @@ -.SH "NAME" -basic.pod \- Test of various basic POD features in translators. -.SH "HEADINGS" -.IX Header "HEADINGS" -Try a few different levels of headings, with embedded formatting codes and -other interesting bits. -.ie n .SH "This ""is"" a ""level 1"" heading" -.el .SH "This \f(CWis\fP a ``level 1'' heading" -.IX Header "This is a level 1 heading" -.SS "``Level'' ""2 \fIheading\fP" -.IX Subsection "``Level'' ""2 heading" -\fILevel 3 \f(BIheading \f(BIwith \f(CB\*(C`weird \f(CBstuff "" (double quote)\f(CB\*(C'\f(BI\f(BI\fI\fR -.IX Subsection "Level 3 heading with weird stuff """" (double quote)" -.PP -Level "4 \f(CW\*(C`heading\*(C'\fR -.IX Subsection "Level ""4 heading" -.PP -Now try again with \fBintermixed\fR \fItext\fR. -.ie n .SH "This ""is"" a ""level 1"" heading" -.el .SH "This \f(CWis\fP a ``level 1'' heading" -.IX Header "This is a level 1 heading" -Text. -.SS "``Level'' 2 \fIheading\fP" -.IX Subsection "``Level'' 2 heading" -Text. -.PP -\fILevel 3 \f(BIheading \f(BIwith \f(CB\*(C`weird \f(CBstuff\f(CB\*(C'\f(BI\f(BI\fI\fR -.IX Subsection "Level 3 heading with weird stuff" -.PP -Text. -.PP -Level "4 \f(CW\*(C`heading\*(C'\fR -.IX Subsection "Level ""4 heading" -.PP -Text. -.SH "LINKS" -.IX Header "LINKS" -These are all taken from the Pod::Parser tests. -.PP -Try out \fI\s-1LOTS\s0\fR of different ways of specifying references: -.PP -Reference the \*(L"section\*(R" in manpage -.PP -Reference the \*(L"section\*(R" in \*(L"manpage\*(R" -.PP -Reference the \*(L"section\*(R" in manpage -.PP -Now try it using the new \*(L"|\*(R" stuff ... -.PP -Reference the thistext| -.PP -Reference the thistext | -.PP -Reference the thistext| -.PP -Reference the thistext | -.PP -Reference the thistext| -.PP -Reference the thistext| -.PP -And then throw in a few new ones of my own. -.PP -foo -.PP -foo -.PP -\&\*(L"bar\*(R" in foo -.PP -\&\*(L"baz boo\*(R" in foo -.PP -\&\*(L"bar\*(R" -.PP -\&\*(L"baz boo\*(R" -.PP -\&\*(L"baz boo\*(R" -.PP -\&\*(L"baz boo\*(R" in foo bar -.PP -\&\*(L"boo var baz\*(R" -.PP -\&\*(L"bar baz\*(R" -.PP -\&\*(L"boo\*(R", \*(L"bar\*(R", and \*(L"baz\*(R" -.PP -foobar -.PP -Testing \fIitalics\fR -.PP -"\fIItalic\fR text" in foo -.PP -"Section \f(CW\*(C`with\*(C'\fR \fI\f(BIother\fI markup\fR" in foo|bar -.PP -Nested <http://www.perl.org/> -.SH "OVER AND ITEMS" -.IX Header "OVER AND ITEMS" -Taken from Pod::Parser tests, this is a test to ensure that multiline -=item paragraphs get indented appropriately. -.IP "This is a test." 4 -.IX Item "This is a test." -.PP -There should be whitespace now before this line. -.PP -Taken from Pod::Parser tests, this is a test to ensure the nested =item -paragraphs get indented appropriately. -.IP "1." 2 -First section. -.RS 2 -.IP "a" 2 -.IX Item "a" -this is item a -.IP "b" 2 -.IX Item "b" -this is item b -.RE -.RS 2 -.RE -.IP "2." 2 -Second section. -.RS 2 -.IP "a" 2 -.IX Item "a" -this is item a -.IP "b" 2 -.IX Item "b" -this is item b -.IP "c" 2 -.IX Item "c" -.PD 0 -.IP "d" 2 -.IX Item "d" -.PD -This is item c & d. -.RE -.RS 2 -.RE -.PP -Now some additional weirdness of our own. Make sure that multiple tags -for one paragraph are properly compacted. -.ie n .IP """foo""" 4 -.el .IP "``foo''" 4 -.IX Item "foo" -.PD 0 -.IP "\fBbar\fR" 4 -.IX Item "bar" -.ie n .IP """baz""" 4 -.el .IP "\f(CWbaz\fR" 4 -.IX Item "baz" -.PD -There shouldn't be any spaces between any of these item tags; this idiom -is used in perlfunc. -.IP "Some longer item text" 4 -.IX Item "Some longer item text" -Just to make sure that we test paragraphs where the item text doesn't fit -in the margin of the paragraph (and make sure that this paragraph fills a -few lines). -.Sp -Let's also make it multiple paragraphs to be sure that works. -.PP -Test use of =over without =item as a block \*(L"quote\*(R" or block paragraph. -.Sp -.RS 4 -This should be indented four spaces but otherwise formatted the same as -any other regular text paragraph. Make sure it's long enough to see the -results of the formatting..... -.RE -.PP -Now try the same thing nested, and make sure that the indentation is reset -back properly. -.RS 4 -.Sp -.RS 4 -This paragraph should be doubly indented. -.RE -.RE -.RS 4 -.Sp -This paragraph should only be singly indented. -.IP "\(bu" 4 -This is an item in the middle of a block-quote, which should be allowed. -.IP "\(bu" 4 -We're also testing tagless item commands. -.RE -.RS 4 -.Sp -Should be back to the single level of indentation. -.RE -.PP -Should be back to regular indentation. -.PP -Now also check the transformation of * into real bullets for man pages. -.IP "\(bu" 4 -An item. We're also testing using =over without a number, and making sure -that item text wraps properly. -.IP "\(bu" 4 -Another item. -.PP -and now test the numbering of item blocks. -.IP "1." 4 -First item. -.IP "2." 4 -Second item. -.SH "FORMATTING CODES" -.IX Header "FORMATTING CODES" -Another test taken from Pod::Parser. -.PP -This is a test to see if I can do not only \f(CW$self\fR and \f(CW\*(C`method()\*(C'\fR, but -also \f(CW\*(C`$self\->method()\*(C'\fR and \f(CW\*(C`$self\->{FIELDNAME}\*(C'\fR and -\&\f(CW\*(C`$Foo <=> $Bar\*(C'\fR without resorting to escape sequences. If -I want to refer to the right-shift operator I can do something -like \f(CW\*(C`$x >> 3\*(C'\fR or even \f(CW\*(C`$y >> 5\*(C'\fR. -.PP -Now for the grand finale of \f(CW\*(C`$self\->method()\->{FIELDNAME} = {FOO=>BAR}\*(C'\fR. -And I also want to make sure that newlines work like this -\&\f(CW\*(C`$self\->{FOOBAR} >> 3 and [$b => $a]\->[$a <=> $b]\*(C'\fR -.PP -Of course I should still be able to do all this \fIwith\fR escape sequences -too: \f(CW\*(C`$self\->method()\*(C'\fR and \f(CW\*(C`$self\->{FIELDNAME}\*(C'\fR and -\&\f(CW\*(C`{FOO=>BAR}\*(C'\fR. -.PP -Dont forget \f(CW\*(C`$self\->method()\->{FIELDNAME} = {FOO=>BAR}\*(C'\fR. -.PP -And make sure that \f(CW0\fR works too! -.PP -Now, if I use << or >> as my delimiters, then I have to use whitespace. -So things like \f(CW\*(C`<$self\-\*(C'\fR\fImethod()\fR>> and \f(CW\*(C`<$self\-\*(C'\fR{\s-1FIELDNAME\s0}>> wont end -up doing what you might expect since the first > will still terminate -the first < seen. -.PP -Lets make sure these work for empty ones too, like \f(CW\*(C`\*(C'\fR and \f(CW\*(C`>>\*(C'\fR -(just to be obnoxious) -.PP -The statement: \f(CW\*(C`This is dog kind\*(Aqs \f(CIfinest\f(CW hour!\*(C'\fR is a parody of a -quotation from Winston Churchill. -.PP -The following tests are added to those: -.PP -Make sure that a few other odd \fIthings\fR still work. This should be -a vertical bar: |. Here's a test of a few more special escapes -that have to be supported: -.IP "&" 3 -An ampersand. -.IP "'" 3 -An apostrophe. -.IP "<" 3 -A less-than sign. -.IP ">" 3 -A greater-than sign. -.IP """" 3 -A double quotation mark. -.IP "/" 3 -A forward slash. -.PP -Try to get this bit of text over towards the edge so |that\ all\ of\ this\ text\ inside\ S<>\ won't| be wrapped. Also test the -|same\ thing\ with\ non-breaking\ spaces.| -.PP -There is a soft hy\%phen in hyphen at hy-phen. -.PP -This is a test of an index entry. -.IX Xref "index entry" -.SH "VERBATIM" -.IX Header "VERBATIM" -Throw in a few verbatim paragraphs. -.PP -.Vb 8 -\& use Term::ANSIColor; -\& print color \*(Aqbold blue\*(Aq; -\& print "This text is bold blue.\en"; -\& print color \*(Aqreset\*(Aq; -\& print "This text is normal.\en"; -\& print colored ("Yellow on magenta.\en", \*(Aqyellow on_magenta\*(Aq); -\& print "This text is normal.\en"; -\& print colored [\*(Aqyellow on_magenta\*(Aq], "Yellow on magenta.\en"; -\& -\& use Term::ANSIColor qw(uncolor); -\& print uncolor \*(Aq01;31\*(Aq, "\en"; -.Ve -.PP -But this isn't verbatim (make sure it wraps properly), and the next -paragraph is again: -.PP -.Vb 2 -\& use Term::ANSIColor qw(:constants); -\& print BOLD, BLUE, "This text is in bold blue.\en", RESET; -\& -\& use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\en"; print "This text is normal.\en"; -.Ve -.PP -(Ugh, that's obnoxiously long.) Try different spacing: -.PP -.Vb 7 -\& Starting with a tab. -\&Not -\&starting -\&with -\&a -\&tab. But this should still be verbatim. -\& As should this. -.Ve -.PP -This isn't. -.PP -.Vb 2 -\& This is. And this: is an internal tab. It should be: -\& |\-\-| <= lined up with that. -.Ve -.PP -(Tricky, but tabs should be expanded before the translator starts in on -the text since otherwise text with mixed tabs and spaces will get messed -up.) -.PP -.Vb 5 -\& And now we test verbatim paragraphs right before a heading. Older -\& versions of Pod::Man generated two spaces between paragraphs like this -\& and the heading. (In order to properly test this, one may have to -\& visually inspect the nroff output when run on the generated *roff -\& text, unfortunately.) -.Ve -.SH "CONCLUSION" -.IX Header "CONCLUSION" -That's all, folks! diff --git a/gnu/usr.bin/perl/lib/Pod/t/basic.ovr b/gnu/usr.bin/perl/lib/Pod/t/basic.ovr deleted file mode 100644 index bb124a0bd44..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/basic.ovr +++ /dev/null @@ -1,269 +0,0 @@ -NNAAMMEE - basic.pod - Test of various basic POD features in translators. - -HHEEAADDIINNGGSS - Try a few different levels of headings, with embedded formatting codes - and other interesting bits. - -TThhiiss ""iiss"" aa ""lleevveell 11"" hheeaaddiinngg - ````LLeevveell'''' ""22 hheeaaddiinngg - _L_e_v_e_l_ _3_ _h_e_a_d_i_n_g_ _w_i_t_h_ _"_w_e_i_r_d_ _s_t_u_f_f_ _"_"_ _(_d_o_u_b_l_e_ _q_u_o_t_e_)_" - _L_e_v_e_l_ _"_4_ _"_h_e_a_d_i_n_g_" - Now try again with iinntteerrmmiixxeedd _t_e_x_t. - -TThhiiss ""iiss"" aa ""lleevveell 11"" hheeaaddiinngg - Text. - - ````LLeevveell'''' 22 hheeaaddiinngg - Text. - - _L_e_v_e_l_ _3_ _h_e_a_d_i_n_g_ _w_i_t_h_ _"_w_e_i_r_d_ _s_t_u_f_f_" - Text. - - _L_e_v_e_l_ _"_4_ _"_h_e_a_d_i_n_g_" - Text. - -LLIINNKKSS - These are all taken from the Pod::Parser tests. - - Try out _L_O_T_S of different ways of specifying references: - - Reference the "section" in manpage - - Reference the "section" in "manpage" - - Reference the "section" in manpage - - Now try it using the new "|" stuff ... - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext| - - And then throw in a few new ones of my own. - - foo - - foo - - "bar" in foo - - "baz boo" in foo - - "bar" - - "baz boo" - - "baz boo" - - "baz boo" in foo bar - - "boo var baz" - - "bar baz" - - "boo", "bar", and "baz" - - foobar - - Testing _i_t_a_l_i_c_s - - "_I_t_a_l_i_c text" in foo - - "Section "with" _o_t_h_e_r_ _m_a_r_k_u_p" in foo|bar - - Nested <http://www.perl.org/> - -OOVVEERR AANNDD IITTEEMMSS - Taken from Pod::Parser tests, this is a test to ensure that multiline - =item paragraphs get indented appropriately. - - This is a test. - - There should be whitespace now before this line. - - Taken from Pod::Parser tests, this is a test to ensure the nested =item - paragraphs get indented appropriately. - - 1 First section. - - a this is item a - - b this is item b - - 2 Second section. - - a this is item a - - b this is item b - - c - d This is item c & d. - - Now some additional weirdness of our own. Make sure that multiple tags - for one paragraph are properly compacted. - - "foo" - bbaarr - "baz" - There shouldn't be any spaces between any of these item tags; this - idiom is used in perlfunc. - - Some longer item text - Just to make sure that we test paragraphs where the item text - doesn't fit in the margin of the paragraph (and make sure that this - paragraph fills a few lines). - - Let's also make it multiple paragraphs to be sure that works. - - Test use of =over without =item as a block "quote" or block paragraph. - - This should be indented four spaces but otherwise formatted the same - as any other regular text paragraph. Make sure it's long enough to - see the results of the formatting..... - - Now try the same thing nested, and make sure that the indentation is - reset back properly. - - This paragraph should be doubly indented. - - This paragraph should only be singly indented. - - * This is an item in the middle of a block-quote, which should be - allowed. - - * We're also testing tagless item commands. - - Should be back to the single level of indentation. - - Should be back to regular indentation. - - Now also check the transformation of * into real bullets for man pages. - - * An item. We're also testing using =over without a number, and making - sure that item text wraps properly. - - * Another item. - - and now test the numbering of item blocks. - - 1. First item. - - 2. Second item. - -FFOORRMMAATTTTIINNGG CCOODDEESS - Another test taken from Pod::Parser. - - This is a test to see if I can do not only $self and "method()", but - also "$self->method()" and "$self->{FIELDNAME}" and "$Foo <=> $Bar" - without resorting to escape sequences. If I want to refer to the - right-shift operator I can do something like "$x >> 3" or even "$y >> - 5". - - Now for the grand finale of "$self->method()->{FIELDNAME} = {FOO=>BAR}". - And I also want to make sure that newlines work like this - "$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b]" - - Of course I should still be able to do all this _w_i_t_h escape sequences - too: "$self->method()" and "$self->{FIELDNAME}" and "{FOO=>BAR}". - - Dont forget "$self->method()->{FIELDNAME} = {FOO=>BAR}". - - And make sure that 0 works too! - - Now, if I use << or >> as my delimiters, then I have to use whitespace. - So things like "<$self-"method()>> and "<$self-"{FIELDNAME}>> wont end - up doing what you might expect since the first > will still terminate - the first < seen. - - Lets make sure these work for empty ones too, like "" and ">>" (just to - be obnoxious) - - The statement: "This is dog kind's _f_i_n_e_s_t hour!" is a parody of a - quotation from Winston Churchill. - - The following tests are added to those: - - Make sure that a few other odd _t_h_i_n_g_s still work. This should be a - vertical bar: |. Here's a test of a few more special escapes that have - to be supported: - - & An ampersand. - - ' An apostrophe. - - < A less-than sign. - - > A greater-than sign. - - " A double quotation mark. - - / A forward slash. - - Try to get this bit of text over towards the edge so - |that all of this text inside S<> won't| be wrapped. Also test the - |same thing with non-breaking spaces.| - - There is a soft hyphen in hyphen at hy-phen. - - This is a test of an index entry. - -VVEERRBBAATTIIMM - Throw in a few verbatim paragraphs. - - use Term::ANSIColor; - print color 'bold blue'; - print "This text is bold blue.\n"; - print color 'reset'; - print "This text is normal.\n"; - print colored ("Yellow on magenta.\n", 'yellow on_magenta'); - print "This text is normal.\n"; - print colored ['yellow on_magenta'], "Yellow on magenta.\n"; - - use Term::ANSIColor qw(uncolor); - print uncolor '01;31', "\n"; - - But this isn't verbatim (make sure it wraps properly), and the next - paragraph is again: - - use Term::ANSIColor qw(:constants); - print BOLD, BLUE, "This text is in bold blue.\n", RESET; - - use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\n"; print "This text is normal.\n"; - - (Ugh, that's obnoxiously long.) Try different spacing: - - Starting with a tab. - Not - starting - with - a - tab. But this should still be verbatim. - As should this. - - This isn't. - - This is. And this: is an internal tab. It should be: - |--| <= lined up with that. - - (Tricky, but tabs should be expanded before the translator starts in on - the text since otherwise text with mixed tabs and spaces will get messed - up.) - - And now we test verbatim paragraphs right before a heading. Older - versions of Pod::Man generated two spaces between paragraphs like this - and the heading. (In order to properly test this, one may have to - visually inspect the nroff output when run on the generated *roff - text, unfortunately.) - -CCOONNCCLLUUSSIIOONN - That's all, folks! - diff --git a/gnu/usr.bin/perl/lib/Pod/t/basic.pod b/gnu/usr.bin/perl/lib/Pod/t/basic.pod deleted file mode 100644 index 949b3a88869..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/basic.pod +++ /dev/null @@ -1,383 +0,0 @@ -=head1 NAME - -basic.pod - Test of various basic POD features in translators. - -=head1 HEADINGS - -Try a few different levels of headings, with embedded formatting codes and -other interesting bits. - -=head1 This C<is> a "level 1" heading - -=head2 ``Level'' "2 I<heading> - -=head3 Level 3 B<heading I<with C<weird F<stuff "" (double quote)>>>> - -=head4 Level "4 C<heading> - -Now try again with B<intermixed> F<text>. - -=head1 This C<is> a "level 1" heading - -Text. - -=head2 ``Level'' 2 I<heading> - -Text. - -=head3 Level 3 B<heading I<with C<weird F<stuff>>>> - -Text. - -=head4 Level "4 C<heading> - -Text. - -=head1 LINKS - -These are all taken from the Pod::Parser tests. - -Try out I<LOTS> of different ways of specifying references: - -Reference the L<manpage/section> - -Reference the L<"manpage"/section> - -Reference the L<manpage/"section"> - -Now try it using the new "|" stuff ... - -Reference the L<thistext|manpage/section>| - -Reference the L<thistext | manpage / section>| - -Reference the L<thistext| manpage/ section>| - -Reference the L<thistext |manpage /section>| - -Reference the L<thistext|manpage/"section">| - -Reference the L<thistext| -manpage/ -section>| - -And then throw in a few new ones of my own. - -L<foo> - -L<foo|bar> - -L<foo/bar> - -L<foo/"baz boo"> - -L</bar> - -L</"baz boo"> - -L</baz boo> - -L<foo bar/baz boo> - -L<"boo var baz"> - -L<bar baz> - -L</boo>, L</bar>, and L</baz> - -L<fooZ<>bar> - -L<Testing I<italics>|foo/bar> - -L<foo/I<Italic> text> - -L<fooE<verbar>barZ<>/Section C<with> I<B<other> markup>> - -L<Nested L<http://www.perl.org/>|fooE<sol>bar> - -=head1 OVER AND ITEMS - -Taken from Pod::Parser tests, this is a test to ensure that multiline -=item paragraphs get indented appropriately. - -=over 4 - -=item This -is -a -test. - -=back - -There should be whitespace now before this line. - -Taken from Pod::Parser tests, this is a test to ensure the nested =item -paragraphs get indented appropriately. - -=over 2 - -=item 1 - -First section. - -=over 2 - -=item a - -this is item a - -=item b - -this is item b - -=back - -=item 2 - -Second section. - -=over 2 - -=item a - -this is item a - -=item b - -this is item b - -=item c - -=item d - -This is item c & d. - -=back - -=back - -Now some additional weirdness of our own. Make sure that multiple tags -for one paragraph are properly compacted. - -=over 4 - -=item "foo" - -=item B<bar> - -=item C<baz> - -There shouldn't be any spaces between any of these item tags; this idiom -is used in perlfunc. - -=item Some longer item text - -Just to make sure that we test paragraphs where the item text doesn't fit -in the margin of the paragraph (and make sure that this paragraph fills a -few lines). - -Let's also make it multiple paragraphs to be sure that works. - -=back - -Test use of =over without =item as a block "quote" or block paragraph. - -=over 4 - -This should be indented four spaces but otherwise formatted the same as -any other regular text paragraph. Make sure it's long enough to see the -results of the formatting..... - -=back - -Now try the same thing nested, and make sure that the indentation is reset -back properly. - -=over 4 - -=over 4 - -This paragraph should be doubly indented. - -=back - -This paragraph should only be singly indented. - -=over 4 - -=item - -This is an item in the middle of a block-quote, which should be allowed. - -=item - -We're also testing tagless item commands. - -=back - -Should be back to the single level of indentation. - -=back - -Should be back to regular indentation. - -Now also check the transformation of * into real bullets for man pages. - -=over - -=item * - -An item. We're also testing using =over without a number, and making sure -that item text wraps properly. - -=item * - -Another item. - -=back - -and now test the numbering of item blocks. - -=over 4 - -=item 1. - -First item. - -=item 2. - -Second item. - -=back - -=head1 FORMATTING CODES - -Another test taken from Pod::Parser. - -This is a test to see if I can do not only C<$self> and C<method()>, but -also C<< $self->method() >> and C<< $self->{FIELDNAME} >> and -C<< $Foo <=> $Bar >> without resorting to escape sequences. If -I want to refer to the right-shift operator I can do something -like C<<< $x >> 3 >>> or even C<<<< $y >> 5 >>>>. - -Now for the grand finale of C<< $self->method()->{FIELDNAME} = {FOO=>BAR} >>. -And I also want to make sure that newlines work like this -C<<< -$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b] ->>> - -Of course I should still be able to do all this I<with> escape sequences -too: C<$self-E<gt>method()> and C<$self-E<gt>{FIELDNAME}> and -C<{FOO=E<gt>BAR}>. - -Dont forget C<$self-E<gt>method()-E<gt>{FIELDNAME} = {FOO=E<gt>BAR}>. - -And make sure that C<0> works too! - -Now, if I use << or >> as my delimiters, then I have to use whitespace. -So things like C<<$self->method()>> and C<<$self->{FIELDNAME}>> wont end -up doing what you might expect since the first > will still terminate -the first < seen. - -Lets make sure these work for empty ones too, like C<< >> and C<< >> >> -(just to be obnoxious) - -The statement: C<This is dog kind's I<finest> hour!> is a parody of a -quotation from Winston Churchill. - -The following tests are added to those: - -Make sure that a few othZ<>er odd I<Z<>things> still work. This should be -a vertical bar: E<verbar>. Here's a test of a few more special escapes -that have to be supported: - -=over 3 - -=item E<amp> - -An ampersand. - -=item E<apos> - -An apostrophe. - -=item E<lt> - -A less-than sign. - -=item E<gt> - -A greater-than sign. - -=item E<quot> - -A double quotation mark. - -=item E<sol> - -A forward slash. - -=back - -Try to get this bit of text over towards the edge so S<|that all of this -text inside SE<lt>E<gt> won't|> be wrapped. Also test the -|sameE<nbsp>thingE<nbsp>withE<nbsp>non-breakingS< spaces>.| - -There is a soft hyE<shy>phen in hyphen at hy-phen. - -This is a test of an X<index entry>index entry. - -=head1 VERBATIM - -Throw in a few verbatim paragraphs. - - use Term::ANSIColor; - print color 'bold blue'; - print "This text is bold blue.\n"; - print color 'reset'; - print "This text is normal.\n"; - print colored ("Yellow on magenta.\n", 'yellow on_magenta'); - print "This text is normal.\n"; - print colored ['yellow on_magenta'], "Yellow on magenta.\n"; - - use Term::ANSIColor qw(uncolor); - print uncolor '01;31', "\n"; - -But this isn't verbatim (make sure it wraps properly), and the next -paragraph is again: - - use Term::ANSIColor qw(:constants); - print BOLD, BLUE, "This text is in bold blue.\n", RESET; - - use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\n"; print "This text is normal.\n"; - -(Ugh, that's obnoxiously long.) Try different spacing: - - Starting with a tab. -Not -starting -with -a -tab. But this should still be verbatim. - As should this. - -This isn't. - - This is. And this: is an internal tab. It should be: - |--| <= lined up with that. - -(Tricky, but tabs should be expanded before the translator starts in on -the text since otherwise text with mixed tabs and spaces will get messed -up.) - - And now we test verbatim paragraphs right before a heading. Older - versions of Pod::Man generated two spaces between paragraphs like this - and the heading. (In order to properly test this, one may have to - visually inspect the nroff output when run on the generated *roff - text, unfortunately.) - -=head1 CONCLUSION - -That's all, folks! - -=cut diff --git a/gnu/usr.bin/perl/lib/Pod/t/basic.t b/gnu/usr.bin/perl/lib/Pod/t/basic.t deleted file mode 100644 index 603d1085745..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/basic.t +++ /dev/null @@ -1,127 +0,0 @@ -#!/usr/bin/perl -w -# -# basic.t -- Basic tests for podlators. -# -# Copyright 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..11\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Man; -use Pod::Text; -use Pod::Text::Overstrike; -use Pod::Text::Termcap; - -# Find the path to the test source files. This requires some fiddling when -# these tests are run as part of Perl core. -sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 't'); - return File::Spec->catfile ($dir, $file); - } else { - return $file; - } -} - -$loaded = 1; -print "ok 1\n"; - -# Hard-code a few values to try to get reproducible results. -$ENV{COLUMNS} = 80; -$ENV{TERM} = 'xterm'; -$ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m'; - -# Map of translators to file extensions to find the formatted output to -# compare against. -my %translators = ('Pod::Man' => 'man', - 'Pod::Text' => 'txt', - 'Pod::Text::Color' => 'clr', - 'Pod::Text::Overstrike' => 'ovr', - 'Pod::Text::Termcap' => 'cap'); - -# Set default options to match those of pod2man and pod2text. -%options = (sentence => 0); - -my $n = 2; -for (sort keys %translators) { - if ($_ eq 'Pod::Text::Color') { - eval { require Term::ANSIColor }; - if ($@) { - print "ok $n # skip\n"; - $n++; - print "ok $n # skip\n"; - $n++; - next; - } - require Pod::Text::Color; - } - my $parser = $_->new (%options); - print (($parser && ref ($parser) eq $_) ? "ok $n\n" : "not ok $n\n"); - $n++; - - # For Pod::Man, strip out the autogenerated header up to the .TH title - # line. That means that we don't check those things; oh well. The header - # changes with each version change or touch of the input file. - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $parser->parse_from_file (source_path ('basic.pod'), \*OUT); - close OUT; - if ($_ eq 'Pod::Man') { - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - open (OUTPUT, "> out.$translators{$_}") - or die "Cannot create out.$translators{$_}: $!\n"; - local $_; - while (<TMP>) { last if /^\.nh/ } - print OUTPUT while <TMP>; - close OUTPUT; - close TMP; - unlink 'out.tmp'; - } else { - rename ('out.tmp', "out.$translators{$_}") - or die "Cannot rename out.tmp: $!\n"; - } - { - local $/; - open (MASTER, source_path ("basic.$translators{$_}")) - or die "Cannot open basic.$translators{$_}: $!\n"; - open (OUTPUT, "out.$translators{$_}") - or die "Cannot open out.$translators{$_}: $!\n"; - my $master = <MASTER>; - my $output = <OUTPUT>; - close MASTER; - close OUTPUT; - - # OS/390 is EBCDIC, which uses a different character for ESC - # apparently. Try to convert so that the test still works. - if ($^O eq 'os390' && $_ eq 'Pod::Text::Termcap') { - $output =~ tr/\033/\047/; - } - - if ($master eq $output) { - print "ok $n\n"; - unlink "out.$translators{$_}"; - } else { - print "not ok $n\n"; - print "# Non-matching output left in out.$translators{$_}\n"; - } - } - $n++; -} diff --git a/gnu/usr.bin/perl/lib/Pod/t/basic.txt b/gnu/usr.bin/perl/lib/Pod/t/basic.txt deleted file mode 100644 index 986e98a1cd2..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/basic.txt +++ /dev/null @@ -1,269 +0,0 @@ -NAME - basic.pod - Test of various basic POD features in translators. - -HEADINGS - Try a few different levels of headings, with embedded formatting codes - and other interesting bits. - -This "is" a "level 1" heading - ``Level'' "2 *heading* - Level 3 heading *with "weird stuff "" (double quote)"* - Level "4 "heading" - Now try again with intermixed text. - -This "is" a "level 1" heading - Text. - - ``Level'' 2 *heading* - Text. - - Level 3 heading *with "weird stuff"* - Text. - - Level "4 "heading" - Text. - -LINKS - These are all taken from the Pod::Parser tests. - - Try out *LOTS* of different ways of specifying references: - - Reference the "section" in manpage - - Reference the "section" in "manpage" - - Reference the "section" in manpage - - Now try it using the new "|" stuff ... - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext | - - Reference the thistext| - - Reference the thistext| - - And then throw in a few new ones of my own. - - foo - - foo - - "bar" in foo - - "baz boo" in foo - - "bar" - - "baz boo" - - "baz boo" - - "baz boo" in foo bar - - "boo var baz" - - "bar baz" - - "boo", "bar", and "baz" - - foobar - - Testing *italics* - - "*Italic* text" in foo - - "Section "with" *other markup*" in foo|bar - - Nested <http://www.perl.org/> - -OVER AND ITEMS - Taken from Pod::Parser tests, this is a test to ensure that multiline - =item paragraphs get indented appropriately. - - This is a test. - - There should be whitespace now before this line. - - Taken from Pod::Parser tests, this is a test to ensure the nested =item - paragraphs get indented appropriately. - - 1 First section. - - a this is item a - - b this is item b - - 2 Second section. - - a this is item a - - b this is item b - - c - d This is item c & d. - - Now some additional weirdness of our own. Make sure that multiple tags - for one paragraph are properly compacted. - - "foo" - bar - "baz" - There shouldn't be any spaces between any of these item tags; this - idiom is used in perlfunc. - - Some longer item text - Just to make sure that we test paragraphs where the item text - doesn't fit in the margin of the paragraph (and make sure that this - paragraph fills a few lines). - - Let's also make it multiple paragraphs to be sure that works. - - Test use of =over without =item as a block "quote" or block paragraph. - - This should be indented four spaces but otherwise formatted the same - as any other regular text paragraph. Make sure it's long enough to - see the results of the formatting..... - - Now try the same thing nested, and make sure that the indentation is - reset back properly. - - This paragraph should be doubly indented. - - This paragraph should only be singly indented. - - * This is an item in the middle of a block-quote, which should be - allowed. - - * We're also testing tagless item commands. - - Should be back to the single level of indentation. - - Should be back to regular indentation. - - Now also check the transformation of * into real bullets for man pages. - - * An item. We're also testing using =over without a number, and making - sure that item text wraps properly. - - * Another item. - - and now test the numbering of item blocks. - - 1. First item. - - 2. Second item. - -FORMATTING CODES - Another test taken from Pod::Parser. - - This is a test to see if I can do not only $self and "method()", but - also "$self->method()" and "$self->{FIELDNAME}" and "$Foo <=> $Bar" - without resorting to escape sequences. If I want to refer to the - right-shift operator I can do something like "$x >> 3" or even "$y >> - 5". - - Now for the grand finale of "$self->method()->{FIELDNAME} = {FOO=>BAR}". - And I also want to make sure that newlines work like this - "$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b]" - - Of course I should still be able to do all this *with* escape sequences - too: "$self->method()" and "$self->{FIELDNAME}" and "{FOO=>BAR}". - - Dont forget "$self->method()->{FIELDNAME} = {FOO=>BAR}". - - And make sure that 0 works too! - - Now, if I use << or >> as my delimiters, then I have to use whitespace. - So things like "<$self-"method()>> and "<$self-"{FIELDNAME}>> wont end - up doing what you might expect since the first > will still terminate - the first < seen. - - Lets make sure these work for empty ones too, like "" and ">>" (just to - be obnoxious) - - The statement: "This is dog kind's *finest* hour!" is a parody of a - quotation from Winston Churchill. - - The following tests are added to those: - - Make sure that a few other odd *things* still work. This should be a - vertical bar: |. Here's a test of a few more special escapes that have - to be supported: - - & An ampersand. - - ' An apostrophe. - - < A less-than sign. - - > A greater-than sign. - - " A double quotation mark. - - / A forward slash. - - Try to get this bit of text over towards the edge so - |that all of this text inside S<> won't| be wrapped. Also test the - |same thing with non-breaking spaces.| - - There is a soft hyphen in hyphen at hy-phen. - - This is a test of an index entry. - -VERBATIM - Throw in a few verbatim paragraphs. - - use Term::ANSIColor; - print color 'bold blue'; - print "This text is bold blue.\n"; - print color 'reset'; - print "This text is normal.\n"; - print colored ("Yellow on magenta.\n", 'yellow on_magenta'); - print "This text is normal.\n"; - print colored ['yellow on_magenta'], "Yellow on magenta.\n"; - - use Term::ANSIColor qw(uncolor); - print uncolor '01;31', "\n"; - - But this isn't verbatim (make sure it wraps properly), and the next - paragraph is again: - - use Term::ANSIColor qw(:constants); - print BOLD, BLUE, "This text is in bold blue.\n", RESET; - - use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\n"; print "This text is normal.\n"; - - (Ugh, that's obnoxiously long.) Try different spacing: - - Starting with a tab. - Not - starting - with - a - tab. But this should still be verbatim. - As should this. - - This isn't. - - This is. And this: is an internal tab. It should be: - |--| <= lined up with that. - - (Tricky, but tabs should be expanded before the translator starts in on - the text since otherwise text with mixed tabs and spaces will get messed - up.) - - And now we test verbatim paragraphs right before a heading. Older - versions of Pod::Man generated two spaces between paragraphs like this - and the heading. (In order to properly test this, one may have to - visually inspect the nroff output when run on the generated *roff - text, unfortunately.) - -CONCLUSION - That's all, folks! - diff --git a/gnu/usr.bin/perl/lib/Pod/t/color.t b/gnu/usr.bin/perl/lib/Pod/t/color.t deleted file mode 100755 index 2f1668f88ee..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/color.t +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl -w -# -# color.t -- Additional specialized tests for Pod::Text::Color. -# -# Copyright 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..2\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -eval { require Term::ANSIColor }; -if ($@) { - for (1..2) { - print "ok $_ # skip\n"; - } - $loaded = 1; - exit; -} -require Pod::Text::Color; - -$loaded = 1; -print "ok 1\n"; - -my $parser = Pod::Text::Color->new or die "Cannot create parser\n"; -my $n = 2; -while (<DATA>) { - next until $_ eq "###\n"; - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $parser->parse_from_file ('tmp.pod', \*OUT); - close OUT; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected output. This is -# used to test specific features or problems with Pod::Text::Termcap. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -=head1 WRAPPING - -B<I<Do>> I<B<not>> B<I<include>> B<I<formatting codes when>> B<I<wrapping>>. -### -[1mWRAPPING[0m - [1m[33mDo[0m[0m [33m[1mnot[0m[0m [1m[33minclude[0m[0m [1m[33mformatting codes when[0m[0m [1m[33mwrapping[0m[0m. - -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/contains_pod.t b/gnu/usr.bin/perl/lib/Pod/t/contains_pod.t deleted file mode 100755 index bdabdf056a5..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/contains_pod.t +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/env perl - -# Copyright (C) 2005 Joshua Hoblitt -# -# $Id: contains_pod.t,v 1.4 2009/10/12 18:24:42 millert Exp $ - -use strict; -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } else { - use lib qw( ./lib ); - } -} - -use Test::More tests => 2; - -use Pod::Find qw( contains_pod ); - -{ - ok(contains_pod('lib/contains_pod.xr'), "contains pod"); -} - -{ - ok(contains_pod('lib/contains_bad_pod.xr'), "contains bad pod"); -} diff --git a/gnu/usr.bin/perl/lib/Pod/t/filehandle.t b/gnu/usr.bin/perl/lib/Pod/t/filehandle.t deleted file mode 100644 index a53884d50d3..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/filehandle.t +++ /dev/null @@ -1,121 +0,0 @@ -#!/usr/bin/perl -w -# -# filehandle.t -- Test the parse_from_filehandle interface. -# -# Copyright 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..3\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Man; -use Pod::Text; - -$loaded = 1; -print "ok 1\n"; - -my $man = Pod::Man->new or die "Cannot create parser\n"; -my $text = Pod::Text->new or die "Cannot create parser\n"; -my $n = 2; -while (<DATA>) { - next until $_ eq "###\n"; - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - open (IN, '< tmp.pod') or die "Cannot open tmp.pod: $!\n"; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $man->parse_from_filehandle (\*IN, \*OUT); - close IN; - close OUT; - open (OUT, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - while (<OUT>) { last if /^\.nh/ } - my $output; - { - local $/; - $output = <OUT>; - } - close OUT; - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; - open (IN, '< tmp.pod') or die "Cannot open tmp.pod: $!\n"; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $text->parse_from_filehandle (\*IN, \*OUT); - close IN; - close OUT; - open (OUT, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - { - local $/; - $output = <OUT>; - } - close OUT; - unlink ('tmp.pod', 'out.tmp'); - $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD, corresponding expected nroff output, and -# corresponding expected text output. The input and output are separated by -# lines containing only ###. - -__DATA__ - -### -=head1 NAME - -gcc - GNU project C and C++ compiler - -=head1 C++ NOTES - -Other mentions of C++. -### -.SH "NAME" -gcc \- GNU project C and C++ compiler -.SH "\*(C+ NOTES" -.IX Header " NOTES" -Other mentions of \*(C+. -### -NAME - gcc - GNU project C and C++ compiler - -C++ NOTES - Other mentions of C++. - -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/man-options.t b/gnu/usr.bin/perl/lib/Pod/t/man-options.t deleted file mode 100755 index 04895d539cb..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/man-options.t +++ /dev/null @@ -1,175 +0,0 @@ -#!/usr/bin/perl -w -# -# man-options.t -- Additional tests for Pod::Man options. -# -# Copyright 2002, 2004, 2006, 2008 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..7\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Man; - -# Redirect stderr to a file. -sub stderr_save { - open (OLDERR, '>&STDERR') or die "Can't dup STDERR: $!\n"; - open (STDERR, '> out.err') or die "Can't redirect STDERR: $!\n"; -} - -# Restore stderr. -sub stderr_restore { - close STDERR; - open (STDERR, '>&OLDERR') or die "Can't dup STDERR: $!\n"; - close OLDERR; -} - -$loaded = 1; -print "ok 1\n"; - -my $n = 2; -while (<DATA>) { - my %options; - next until $_ eq "###\n"; - while (<DATA>) { - last if $_ eq "###\n"; - my ($option, $value) = split; - $options{$option} = $value; - } - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - my $parser = Pod::Man->new (%options) or die "Cannot create parser\n"; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - stderr_save; - $parser->parse_from_file ('tmp.pod', \*OUT); - stderr_restore; - close OUT; - my $accents = 0; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - while (<TMP>) { - last if /^\.nh/; - } - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; - open (ERR, 'out.err') or die "Cannot open out.err: $!\n"; - my $errors; - { - local $/; - $errors = <ERR>; - } - close ERR; - unlink ('out.err'); - $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($errors eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected errors:\n ${expected}Errors:\n $errors"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected text output. -# This is used to test specific features or problems with Pod::Man. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -fixed CR -fixedbold CY -fixeditalic CW -fixedbolditalic CX -### -=head1 FIXED FONTS - -C<foo B<bar I<baz>> I<bay>> -### -.SH "FIXED FONTS" -.IX Header "FIXED FONTS" -\&\f(CR\*(C`foo \f(CYbar \f(CXbaz\f(CY\f(CR \f(CWbay\f(CR\*(C'\fR -### -### - -### -### -=over 4 - -=item Foo - -Bar. - -=head1 NEXT -### -.IP "Foo" 4 -.IX Item "Foo" -Bar. -.SH "NEXT" -.IX Header "NEXT" -.SH "POD ERRORS" -.IX Header "POD ERRORS" -Hey! \fBThe above document had some coding errors, which are explained below:\fR -.IP "Around line 7:" 4 -.IX Item "Around line 7:" -You forgot a '=back' before '=head1' -### -### - -### -stderr 1 -### -=over 4 - -=item Foo - -Bar. - -=head1 NEXT -### -.IP "Foo" 4 -.IX Item "Foo" -Bar. -.SH "NEXT" -.IX Header "NEXT" -### -tmp.pod around line 7: You forgot a '=back' before '=head1' -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/man-utf8.t b/gnu/usr.bin/perl/lib/Pod/t/man-utf8.t deleted file mode 100755 index 8b44d6b2905..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/man-utf8.t +++ /dev/null @@ -1,141 +0,0 @@ -#!/usr/bin/perl -w -# -# man-options.t -- Additional tests for Pod::Man options. -# -# Copyright 2002, 2004, 2006, 2008 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..5\n"; - - # UTF-8 support requires Perl 5.8 or later. - if ($] < 5.008) { - my $n; - for $n (1..5) { - print "ok $n # skip -- Perl 5.8 required for UTF-8 support\n"; - } - exit; - } -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Man; - -$loaded = 1; -print "ok 1\n"; - -my $n = 2; -eval { binmode (\*DATA, ':encoding(utf-8)') }; -eval { binmode (\*STDOUT, ':encoding(utf-8)') }; -while (<DATA>) { - my %options; - next until $_ eq "###\n"; - while (<DATA>) { - last if $_ eq "###\n"; - my ($option, $value) = split; - $options{$option} = $value; - } - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - eval { binmode (\*TMP, ':encoding(utf-8)') }; - print TMP "=encoding utf-8\n\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - my $parser = Pod::Man->new (%options) or die "Cannot create parser\n"; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $parser->parse_from_file ('tmp.pod', \*OUT); - close OUT; - my $accents = 0; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - eval { binmode (\*TMP, ':encoding(utf-8)') }; - while (<TMP>) { - $accents = 1 if /Accent mark definitions/; - last if /^\.nh/; - } - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - unlink ('tmp.pod', 'out.tmp'); - if (($options{utf8} && !$accents) || (!$options{utf8} && $accents)) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print ($accents ? "Saw accents\n" : "Saw no accents\n"); - print ($options{utf8} ? "Wanted no accents\n" : "Wanted accents\n"); - } - $n++; - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected text output. -# This is used to test specific features or problems with Pod::Man. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -utf8 1 -### -=head1 BEYONCÉ - -Beyoncé! Beyoncé! Beyoncé!! - - Beyoncé! Beyoncé! - Beyoncé! Beyoncé! - Beyoncé! Beyoncé! - -Older versions did not convert Beyoncé in verbatim. -### -.SH "BEYONCÉ" -.IX Header "BEYONCÉ" -Beyoncé! Beyoncé! Beyoncé!! -.PP -.Vb 3 -\& Beyoncé! Beyoncé! -\& Beyoncé! Beyoncé! -\& Beyoncé! Beyoncé! -.Ve -.PP -Older versions did not convert Beyoncé in verbatim. -### - -### -utf8 1 -### -=head1 SE<lt>E<gt> output with UTF-8 - -This is S<non-breaking output>. -### -.SH "S<> output with UTF\-8" -.IX Header "S<> output with UTF-8" -This is non-breaking output. -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/man.t b/gnu/usr.bin/perl/lib/Pod/t/man.t deleted file mode 100644 index 419cce3ee60..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/man.t +++ /dev/null @@ -1,484 +0,0 @@ -#!/usr/bin/perl -w -# -# man.t -- Additional specialized tests for Pod::Man. -# -# Copyright 2002, 2003, 2004, 2006, 2007, 2008 -# 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..25\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Man; - -$loaded = 1; -print "ok 1\n"; - -# Test whether we can use binmode to set encoding. -my $have_encoding = (eval { require PerlIO::encoding; 1 } and not $@); - -my $parser = Pod::Man->new or die "Cannot create parser\n"; -my $n = 2; -while (<DATA>) { - next until $_ eq "###\n"; - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - - # We have a test in ISO 8859-1 encoding. Make sure that nothing strange - # happens if Perl thinks the world is Unicode. Wrap this in eval so that - # older versions of Perl don't croak. - eval { binmode (\*TMP, ':encoding(iso-8859-1)') if $have_encoding }; - - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $parser->parse_from_file ('tmp.pod', \*OUT); - close OUT; - open (OUT, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - while (<OUT>) { last if /^\.nh/ } - my $output; - { - local $/; - $output = <OUT>; - } - close OUT; - unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected nroff output. -# This is used to test specific features or problems with Pod::Man. The input -# and output are separated by lines containing only ###. - -__DATA__ - -### -=head1 NAME - -gcc - GNU project C and C++ compiler - -=head1 C++ NOTES - -Other mentions of C++. -### -.SH "NAME" -gcc \- GNU project C and C++ compiler -.SH "\*(C+ NOTES" -.IX Header " NOTES" -Other mentions of \*(C+. -### - -### -=head1 PERIODS - -This C<.> should be quoted. -### -.SH "PERIODS" -.IX Header "PERIODS" -This \f(CW\*(C`.\*(C'\fR should be quoted. -### - -### -=over 4 - -=item * - -A bullet. - -=item * - -Another bullet. - -=item * Also a bullet. - -=back -### -.IP "\(bu" 4 -A bullet. -.IP "\(bu" 4 -Another bullet. -.IP "\(bu" 4 -Also a bullet. -### - -### -=over 4 - -=item foo - -Not a bullet. - -=item * - -Also not a bullet. - -=back -### -.IP "foo" 4 -.IX Item "foo" -Not a bullet. -.IP "*" 4 -Also not a bullet. -### - -### -=encoding iso-8859-1 - -=head1 ACCENTS - -Beyonc! Beyonc! Beyonc!! - - Beyonc! Beyonc! - Beyonc! Beyonc! - Beyonc! Beyonc! - -Older versions didn't convert Beyonc in verbatim. -### -.SH "ACCENTS" -.IX Header "ACCENTS" -Beyonce\*'! Beyonce\*'! Beyonce\*'!! -.PP -.Vb 3 -\& Beyonce\*'! Beyonce\*'! -\& Beyonce\*'! Beyonce\*'! -\& Beyonce\*'! Beyonce\*'! -.Ve -.PP -Older versions didn't convert Beyonce\*' in verbatim. -### - -### -=over 4 - -=item 1. Not a number - -=item 2. Spaced right - -=back - -=over 2 - -=item 1 Not a number - -=item 2 Spaced right - -=back -### -.IP "1. Not a number" 4 -.IX Item "1. Not a number" -.PD 0 -.IP "2. Spaced right" 4 -.IX Item "2. Spaced right" -.IP "1 Not a number" 2 -.IX Item "1 Not a number" -.IP "2 Spaced right" 2 -.IX Item "2 Spaced right" -### - -### -=over 4 - -=item Z<>* - -Not bullet. - -=back -### -.IP "*" 4 -Not bullet. -### - -### -=head1 SEQS - -"=over ... Z<>=back" - -"SE<lt>...E<gt>" - -The quotes should be converted in the above to paired quotes. -### -.SH "SEQS" -.IX Header "SEQS" -\&\*(L"=over ... =back\*(R" -.PP -\&\*(L"S<...>\*(R" -.PP -The quotes should be converted in the above to paired quotes. -### - -### -=head1 YEN - -It cost me E<165>12345! That should be an X. -### -.SH "YEN" -.IX Header "YEN" -It cost me X12345! That should be an X. -### - -### -=head1 agrave - -Open E<agrave> la shell. Previous versions mapped it wrong. -### -.SH "agrave" -.IX Header "agrave" -Open a\*` la shell. Previous versions mapped it wrong. -### - -### -=over - -=item First level - -Blah blah blah.... - -=over - -=item * - -Should be a bullet. - -=back - -=back -### -.IP "First level" 4 -.IX Item "First level" -Blah blah blah.... -.RS 4 -.IP "\(bu" 4 -Should be a bullet. -.RE -.RS 4 -.RE -### - -### -=over 4 - -=item 1. Check fonts in @CARP_NOT test. - -=back -### -.ie n .IP "1. Check fonts in @CARP_NOT test." 4 -.el .IP "1. Check fonts in \f(CW@CARP_NOT\fR test." 4 -.IX Item "1. Check fonts in @CARP_NOT test." -### - -### -=head1 LINK QUOTING - -There should not be double quotes: L<C<< (?>pattern) >>>. -### -.SH "LINK QUOTING" -.IX Header "LINK QUOTING" -There should not be double quotes: \f(CW\*(C`(?>pattern)\*(C'\fR. -### - -### -=head1 SE<lt>E<gt> MAGIC - -Magic should be applied S<RISC OS> to that. -### -.SH "S<> MAGIC" -.IX Header "S<> MAGIC" -Magic should be applied \s-1RISC\s0\ \s-1OS\s0 to that. -### - -### -=head1 MAGIC MONEY - -These should be identical. - -Bippity boppity boo "The -price is $Z<>100." - -Bippity boppity boo "The -price is $100." -### -.SH "MAGIC MONEY" -.IX Header "MAGIC MONEY" -These should be identical. -.PP -Bippity boppity boo \*(L"The -price is \f(CW$100\fR.\*(R" -.PP -Bippity boppity boo \*(L"The -price is \f(CW$100\fR.\*(R" -### - -### -=head1 NAME - -"Stuff" (no guesswork) - -=head2 THINGS - -Oboy, is this C++ "fun" yet! (guesswork) -### -.SH "NAME" -"Stuff" (no guesswork) -.SS "\s-1THINGS\s0" -.IX Subsection "THINGS" -Oboy, is this \*(C+ \*(L"fun\*(R" yet! (guesswork) -### - -### -=head1 Newline C Quote Weirdness - -Blorp C<' -''>. Yes. -### -.SH "Newline C Quote Weirdness" -.IX Header "Newline C Quote Weirdness" -Blorp \f(CW\*(Aq -\&\*(Aq\*(Aq\fR. Yes. -### - -### -=head1 Soft Hypen Testing - -sigE<shy>action -manuE<shy>script -JarkE<shy>ko HieE<shy>taE<shy>nieE<shy>mi - -And again: - -sigE<173>action -manuE<173>script -JarkE<173>ko HieE<173>taE<173>nieE<173>mi - -And one more time: - -sigE<0x00AD>action -manuE<0x00AD>script -JarkE<0x00AD>ko HieE<0x00AD>taE<0x00AD>nieE<0x00AD>mi -### -.SH "Soft Hypen Testing" -.IX Header "Soft Hypen Testing" -sig\%action -manu\%script -Jark\%ko Hie\%ta\%nie\%mi -.PP -And again: -.PP -sig\%action -manu\%script -Jark\%ko Hie\%ta\%nie\%mi -.PP -And one more time: -.PP -sig\%action -manu\%script -Jark\%ko Hie\%ta\%nie\%mi -### - -### -=head1 XE<lt>E<gt> Whitespace - -Blorpy L<B<prok>|blap> X<bivav> wugga chachacha. -### -.SH "X<> Whitespace" -.IX Header "X<> Whitespace" -Blorpy \fBprok\fR wugga chachacha. -.IX Xref "bivav" -### - -### -=head1 Hyphen in SE<lt>E<gt> - -Don't S<transform even-this hyphen>. This "one's-fine!", as well. However, -$-0.13 should have a real hyphen. -### -.SH "Hyphen in S<>" -.IX Header "Hyphen in S<>" -Don't transform\ even-this\ hyphen. This \*(L"one's-fine!\*(R", as well. However, -$\-0.13 should have a real hyphen. -### - -### -=head1 Quote escaping - -Don't escape `this' but do escape C<`this'> (and don't surround it in quotes). -### -.SH "Quote escaping" -.IX Header "Quote escaping" -Don't escape `this' but do escape \f(CW\`this\*(Aq\fR (and don't surround it in quotes). -### - -### -=pod - -E<eth> -### -.PP -\&\*(d- -### - -### -=head1 C<one> and C<two> -### -.ie n .SH """one"" and ""two""" -.el .SH "\f(CWone\fP and \f(CWtwo\fP" -.IX Header "one and two" -### - -### -=pod - -Some text. - -=for man -Some raw nroff. - -=for roff \fBBold text.\fP - -=for html -Stuff that's hidden. - -=for MAN \fIItalic text.\fP - -=for ROFF -.PP -\&A paragraph. - -More text. -### -Some text. -Some raw nroff. -\fBBold text.\fP -\fIItalic text.\fP -.PP -\&A paragraph. -.PP -More text. -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/parselink.t b/gnu/usr.bin/perl/lib/Pod/t/parselink.t deleted file mode 100644 index c5c2bb660bd..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/parselink.t +++ /dev/null @@ -1,132 +0,0 @@ -#!/usr/bin/perl -w -# -# parselink.t -- Tests for Pod::ParseLink. -# -# 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. - -# The format of each entry in this array is the L<> text followed by the -# five-element parse returned by parselink. When adding a new test, also -# increment the test count in the BEGIN block below. We don't use any of the -# fancy test modules intentionally for backward compatibility to older -# versions of Perl. -@TESTS = ( - [ 'foo', - undef, 'foo', 'foo', undef, 'pod' ], - - [ 'foo|bar', - 'foo', 'foo', 'bar', undef, 'pod' ], - - [ 'foo/bar', - undef, '"bar" in foo', 'foo', 'bar', 'pod' ], - - [ 'foo/"baz boo"', - undef, '"baz boo" in foo', 'foo', 'baz boo', 'pod' ], - - [ '/bar', - undef, '"bar"', undef, 'bar', 'pod' ], - - [ '/"baz boo"', - undef, '"baz boo"', undef, 'baz boo', 'pod' ], - - [ '/baz boo', - undef, '"baz boo"', undef, 'baz boo', 'pod' ], - - [ 'foo bar/baz boo', - undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ], - - [ 'foo bar / baz boo', - undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ], - - [ "foo\nbar\nbaz\n/\nboo", - undef, '"boo" in foo bar baz', 'foo bar baz', 'boo', 'pod' ], - - [ 'anchor|name/section', - 'anchor', 'anchor', 'name', 'section', 'pod' ], - - [ '"boo var baz"', - undef, '"boo var baz"', undef, 'boo var baz', 'pod' ], - - [ 'bar baz', - undef, '"bar baz"', undef, 'bar baz', 'pod' ], - - [ '"boo bar baz / baz boo"', - undef, '"boo bar baz / baz boo"', undef, 'boo bar baz / baz boo', - 'pod' ], - - [ 'fooZ<>bar', - undef, 'fooZ<>bar', 'fooZ<>bar', undef, 'pod' ], - - [ 'Testing I<italics>|foo/bar', - 'Testing I<italics>', 'Testing I<italics>', 'foo', 'bar', 'pod' ], - - [ 'foo/I<Italic> text', - undef, '"I<Italic> text" in foo', 'foo', 'I<Italic> text', 'pod' ], - - [ 'fooE<verbar>barZ<>/Section C<with> I<B<other> markup', - undef, '"Section C<with> I<B<other> markup" in fooE<verbar>barZ<>', - 'fooE<verbar>barZ<>', 'Section C<with> I<B<other> markup', 'pod' ], - - [ 'Nested L<http://www.perl.org/>|fooE<sol>bar', - 'Nested L<http://www.perl.org/>', 'Nested L<http://www.perl.org/>', - 'fooE<sol>bar', undef, 'pod' ], - - [ 'ls(1)', - undef, 'ls(1)', 'ls(1)', undef, 'man' ], - - [ ' perlfunc(1)/open ', - undef, '"open" in perlfunc(1)', 'perlfunc(1)', 'open', 'man' ], - - [ 'some manual page|perl(1)', - 'some manual page', 'some manual page', 'perl(1)', undef, 'man' ], - - [ 'http://www.perl.org/', - undef, 'http://www.perl.org/', 'http://www.perl.org/', undef, 'url' ], - - [ 'news:yld72axzc8.fsf@windlord.stanford.edu', - undef, 'news:yld72axzc8.fsf@windlord.stanford.edu', - 'news:yld72axzc8.fsf@windlord.stanford.edu', undef, 'url' ] -); - -BEGIN { - chdir 't' if -d 't'; - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..25\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::ParseLink; -$loaded = 1; -print "ok 1\n"; - -# Used for reporting test failures. -my @names = qw(text inferred name section type); - -my $n = 2; -for (@TESTS) { - my @expected = @$_; - my $link = shift @expected; - my @results = parselink ($link); - my $okay = 1; - for (0..4) { - # Make sure to check undef explicitly; we don't want undef to match - # the empty string because they're semantically different. - unless ((!defined ($results[$_]) && !defined ($expected[$_])) - || (defined ($results[$_]) && defined ($expected[$_]) - && $results[$_] eq $expected[$_])) { - print "not ok $n\n" if $okay; - print "# Incorrect $names[$_]:\n"; - print "# expected: $expected[$_]\n"; - print "# seen: $results[$_]\n"; - $okay = 0; - } - } - print "ok $n\n" if $okay; - $n++; -} diff --git a/gnu/usr.bin/perl/lib/Pod/t/pod-parser.t b/gnu/usr.bin/perl/lib/Pod/t/pod-parser.t deleted file mode 100644 index 318a76bc151..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/pod-parser.t +++ /dev/null @@ -1,102 +0,0 @@ -#!/usr/bin/perl -w -# -# pod-parser.t -- Tests for backward compatibility with Pod::Parser. -# -# Copyright 2006, 2008 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..4\n"; -} - -my $loaded; - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Man; -use Pod::Text; -use strict; - -$loaded = 1; -print "ok 1\n"; - -my $parser = Pod::Man->new or die "Cannot create parser\n"; -open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; -print TMP "Some random B<text>.\n"; -close TMP; -open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; -$parser->parse_from_file ({ -cutting => 0 }, 'tmp.pod', \*OUT); -close OUT; -open (OUT, 'out.tmp') or die "Cannot open out.tmp: $!\n"; -while (<OUT>) { last if /^\.nh/ } -my $output; -{ - local $/; - $output = <OUT>; -} -close OUT; -if ($output eq "Some random \\fBtext\\fR.\n") { - print "ok 2\n"; -} else { - print "not ok 2\n"; - print "Expected\n========\nSome random \\fBtext\\fR.\n\n"; - print "Output\n======\n$output\n"; -} - -$parser = Pod::Text->new or die "Cannot create parser\n"; -open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; -$parser->parse_from_file ({ -cutting => 0 }, 'tmp.pod', \*OUT); -close OUT; -open (OUT, 'out.tmp') or die "Cannot open out.tmp: $!\n"; -{ - local $/; - $output = <OUT>; -} -close OUT; -if ($output eq " Some random text.\n\n") { - print "ok 3\n"; -} else { - print "not ok 3\n"; - print "Expected\n========\n Some random text.\n\n\n"; - print "Output\n======\n$output\n"; -} - -# Test the pod2text function, particularly with only one argument. -open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; -print TMP "=pod\n\nSome random B<text>.\n"; -close TMP; -open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; -open (SAVE, '>&STDOUT') or die "Cannot dup stdout: $!\n"; -open (STDOUT, '>&OUT') or die "Cannot replace stdout: $!\n"; -pod2text ('tmp.pod'); -close OUT; -open (STDOUT, '>&SAVE') or die "Cannot fix stdout: $!\n"; -close SAVE; -open (OUT, 'out.tmp') or die "Cannot open out.tmp: $!\n"; -{ - local $/; - $output = <OUT>; -} -close OUT; -if ($output eq " Some random text.\n\n") { - print "ok 4\n"; -} else { - print "not ok 4\n"; - print "Expected\n========\n Some random text.\n\n\n"; - print "Output\n======\n$output\n"; -} - -unlink ('tmp.pod', 'out.tmp'); -exit 0; diff --git a/gnu/usr.bin/perl/lib/Pod/t/pod-spelling.t b/gnu/usr.bin/perl/lib/Pod/t/pod-spelling.t deleted file mode 100755 index 41c902782e9..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/pod-spelling.t +++ /dev/null @@ -1,76 +0,0 @@ -#!/usr/bin/perl -# -# t/pod-spelling.t -- Test POD spelling. -# -# Copyright 2008 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. - -# Called to skip all tests with a reason. -sub skip_all { - print "1..0 # Skipped: @_\n"; - exit; -} - -# Skip all spelling tests unless flagged to run maintainer tests. -skip_all "Spelling tests only run for maintainer" - unless $ENV{RRA_MAINTAINER_TESTS}; - -# Make sure we have prerequisites. hunspell is currently not supported due to -# lack of support for contractions. -eval 'use Test::Pod 1.00'; -skip_all "Test::Pod 1.00 required for testing POD" if $@; -eval 'use Pod::Spell'; -skip_all "Pod::Spell required to test POD spelling" if $@; -my @spell; -my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ], - ispell => [ qw(-d american -l -p /dev/null) ]); -SEARCH: for my $program (qw/aspell ispell/) { - for my $dir (split ':', $ENV{PATH}) { - if (-x "$dir/$program") { - @spell = ("$dir/$program", @{ $options{$program} }); - } - last SEARCH if @spell; - } -} -skip_all "aspell or ispell required to test POD spelling" unless @spell; - -# Run the test, one for each POD file. -$| = 1; -my @pod = all_pod_files (); -my $count = scalar @pod; -print "1..$count\n"; -my $n = 1; -for my $pod (@pod) { - my $child = open (CHILD, '-|'); - if (not defined $child) { - die "Cannot fork: $!\n"; - } elsif ($child == 0) { - my $pid = open (SPELL, '|-', @spell) - or die "Cannot run @spell: $!\n"; - open (POD, '<', $pod) or die "Cannot open $pod: $!\n"; - my $parser = Pod::Spell->new; - $parser->parse_from_filehandle (\*POD, \*SPELL); - close POD; - close SPELL; - exit ($? >> 8); - } else { - my @words = <CHILD>; - close CHILD; - if ($? != 0) { - print "ok $n # skip - @spell failed: $?\n"; - } elsif (@words) { - for (@words) { - s/^\s+//; - s/\s+$//; - } - print "not ok $n\n"; - print " - Misspelled words found in $pod\n"; - print " @words\n"; - } else { - print "ok $n\n"; - } - $n++; - } -} diff --git a/gnu/usr.bin/perl/lib/Pod/t/pod.t b/gnu/usr.bin/perl/lib/Pod/t/pod.t deleted file mode 100755 index ecb37a642c7..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/pod.t +++ /dev/null @@ -1,11 +0,0 @@ -#!/usr/bin/perl -# -# t/pod.t -- Test POD formatting. - -eval 'use Test::Pod 1.00'; -if ($@) { - print "1..1\n"; - print "ok 1 # skip - Test::Pod 1.00 required for testing POD\n"; - exit; -} -all_pod_files_ok (); diff --git a/gnu/usr.bin/perl/lib/Pod/t/pod2latex.t b/gnu/usr.bin/perl/lib/Pod/t/pod2latex.t deleted file mode 100644 index 965c9ccaff3..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/pod2latex.t +++ /dev/null @@ -1,401 +0,0 @@ -#!perl -# Test that Pod::LaTeX works -# This test relies on the DATA filehandle -# DATA contains the latex that is used for comparison -# and the pod that was used to generate it. The two -# are separated by '=pod' -# Note that if the translator is adjusted the output tex -# will probably not match what is currently there. You -# will need to adjust it to match (assuming it is correct). - -use Test; -use strict; - -BEGIN { plan tests => 177 } - -use Pod::LaTeX; - -# The link parsing changed between v0.22 and v0.30 of Pod::ParseUtils -use Pod::ParseUtils; -my $linkver = $Pod::ParseUtils::VERSION; - -# Set up an END block to remove the test output file -END { - unlink "test.tex"; -}; - -ok(1); - -# First thing to do is to read the expected output from -# the DATA filehandle and store it in a scalar. -# Do this until we read an =pod -my @reference; -while (my $line = <DATA>) { - last if $line =~ /^=pod/; - push(@reference,$line); -} - -# Create a new parser -my $parser = Pod::LaTeX->new; -ok($parser); -$parser->Head1Level(1); -# Add the preamble but remember not to compare the timestamps -$parser->AddPreamble(1); -$parser->AddPostamble(1); - -# For a laugh add a table of contents -$parser->TableOfContents(1); - -# Create an output file -open(OUTFH, "> test.tex" ) or die "Unable to open test tex file: $!\n"; - -# Read from the DATA filehandle and write to a new output file -# Really want to write this to a scalar -$parser->parse_from_filehandle(\*DATA,\*OUTFH); - -close(OUTFH) or die "Error closing OUTFH test.tex: $!\n"; - -# Now read in OUTFH and compare -open(INFH, "< test.tex") or die "Unable to read test tex file: $!\n"; -my @output = <INFH>; - -ok(@output, @reference); -for my $i (0..$#reference) { - next if $reference[$i] =~ /^%%/; # skip timestamp comments - - # if we are running a new version of Pod::ParseUtils we need - # to change the link text. This is a kluge until we drop support - # for older versions of Pod::ParseUtils - if ($linkver < 0.29 && $output[$i] =~ /manpage/) { - # convert our expectations from new to old new format - $reference[$i] =~ s/Standard link: \\emph\{Pod::LaTeX\}/Standard link: the \\emph\{Pod::LaTeX\} manpage/; - $reference[$i] =~ s/\\textsf\{sec\} in \\emph\{Pod::LaTeX\}/the section on \\textsf\{sec\} in the \\emph\{Pod::LaTeX\} manpage/; - } - ok($output[$i], $reference[$i]); -} - -close(INFH) or die "Error closing INFH test.tex: $!\n"; - - -__DATA__ -\documentclass{article} -\usepackage[T1]{fontenc} -\usepackage{textcomp} - -%% Latex generated from POD in document (unknown) -%% Using the perl module Pod::LaTeX -%% Converted on Sat Apr 5 21:16:02 2003 - - -\usepackage{makeidx} -\makeindex - - -\begin{document} - -\tableofcontents - -\section{Introduction\label{Introduction}\index{Introduction}} -\begin{itemize} - -\item - -Always check the return codes of system calls. Good error messages should -go to STDERR, include which program caused the problem, what the failed -system call and arguments were, and (\textbf{very important}) should contain -the standard system error message for what went wrong. Here's a simple -but sufficient example: - -\begin{verbatim} - opendir(D, $dir) or die "can't opendir $dir: $!"; -\end{verbatim} - -\item - -Line up your transliterations when it makes sense: - -\begin{verbatim} - tr [abc] - [xyz]; -\end{verbatim} - - -The above should be aligned since it includes an embedded tab. - - -\item - -Think about reusability. Why waste brainpower on a one-shot when you -might want to do something like it again? Consider generalizing your -code. Consider writing a module or object class. Consider making your -code run cleanly with \texttt{use strict} and \texttt{-w} (or \texttt{use warnings} in -Perl 5.6) in effect. Consider giving away your code. Consider changing -your whole world view. Consider... oh, never mind. - - -\item - -Be consistent. - - -\item - -Be nice. - -\end{itemize} -\section{Links\label{Links}\index{Links}} - - -This link should just include one word: \textsf{Pod::LaTeX} - - - -This link should include the text \texttt{test} even though -it refers to \texttt{Pod::LaTeX}: \textsf{test}. - - - -Standard link: \emph{Pod::LaTeX}. - - - -Now refer to an external section: \textsf{sec} in \emph{Pod::LaTeX} - -\section{Lists\label{Lists}\index{Lists}} - - -Test description list with long lines - -\begin{description} - -\item[{Some short text}] \mbox{} - -Some additional para. - -\begin{itemize} - -\item - -Nested itemized list - - -\item - -Second item - -\end{itemize} - -\item[{some longer text than that}] \mbox{} - -and again. - - -\item[{this text is even longer and greater than}] \textbf{40 characters} - -Some more content for the item. - - -\item[{this is some text with \textit{something across}}] \textbf{the 40 char boundary} - -This is item content. - - -\item[{square [ bracket in item}] \mbox{} - -Square bracket content - -\end{description} - - -And this should be an enumerated list without any cruft after the numbers or additional numbers at all. - -\begin{enumerate} - -\item - -item 1 - - -\item - -item 2 - -\end{enumerate} -\section{Escapes\label{Escapes}\index{Escapes}} - - -Test some normal escapes such as $<$ (lt) and $>$ (gt) and $|$ (verbar) and -\texttt{\~{}} (tilde) and \& (amp) as well as $<$ (Esc lt) and $|$ (Esc -verbar) and \textfractionsolidus{} (Esc sol) and $>$ (Esc gt) and \& (Esc amp) -and " (Esc quot) and even $\alpha$ (Esc alpha). - -\section{For blocks\label{For_blocks}\index{For blocks}} - Some latex code \textbf{here}. - - - -Some text that should appear. - - - -Some more text that should appear - -Some latex in a \textsf{begin block} - -and some more - -\begin{equation} -a = \frac{3}{2} -\end{equation} - - - -Back to pod. - -\printindex - -\end{document} -=pod - -=head1 Introduction - -=over 4 - -=item * - -Always check the return codes of system calls. Good error messages should -go to STDERR, include which program caused the problem, what the failed -system call and arguments were, and (B<very important>) should contain -the standard system error message for what went wrong. Here's a simple -but sufficient example: - - opendir(D, $dir) or die "can't opendir $dir: $!"; - -=item * - -Line up your transliterations when it makes sense: - - tr [abc] - [xyz]; - -The above should be aligned since it includes an embedded tab. - -=item * - -Think about reusability. Why waste brainpower on a one-shot when you -might want to do something like it again? Consider generalizing your -code. Consider writing a module or object class. Consider making your -code run cleanly with C<use strict> and C<-w> (or C<use warnings> in -Perl 5.6) in effect. Consider giving away your code. Consider changing -your whole world view. Consider... oh, never mind. - -=item * - -Be consistent. - -=item * - -Be nice. - -=back - -=head1 Links - -This link should just include one word: L<Pod::LaTeX|Pod::LaTeX> - -This link should include the text C<test> even though -it refers to C<Pod::LaTeX>: L<test|Pod::LaTeX>. - -Standard link: L<Pod::LaTeX>. - -Now refer to an external section: L<Pod::LaTeX/"sec"> - - -=head1 Lists - -Test description list with long lines - -=over 4 - -=item Some short text - -Some additional para. - -=over 4 - -=item * - -Nested itemized list - -=item * - -Second item - -=back - -=item some longer text than that - -and again. - -=item this text is even longer and greater than 40 characters - -Some more content for the item. - -=item this is some text with I<something across> the 40 char boundary - -This is item content. - -=item square [ bracket in item - -Square bracket content - -=back - -And this should be an enumerated list without any cruft after the numbers or additional numbers at all. - -=over 4 - -=item 1) - -item 1 - -=item 2. - -item 2 - -=back - -=head1 Escapes - -Test some normal escapes such as < (lt) and > (gt) and | (verbar) and -~ (tilde) and & (amp) as well as E<lt> (Esc lt) and E<verbar> (Esc -verbar) and E<sol> (Esc sol) and E<gt> (Esc gt) and E<amp> (Esc amp) -and E<quot> (Esc quot) and even E<alpha> (Esc alpha). - -=head1 For blocks - -=for latex - Some latex code \textbf{here}. - -Some text that should appear. - -=for comment - Should not print anything - -Some more text that should appear - -=begin latex - -Some latex in a \textsf{begin block} - -and some more - -\begin{equation} -a = \frac{3}{2} -\end{equation} - -=end latex - -Back to pod. - -=cut diff --git a/gnu/usr.bin/perl/lib/Pod/t/termcap.t b/gnu/usr.bin/perl/lib/Pod/t/termcap.t deleted file mode 100755 index 5ec98288f65..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/termcap.t +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/bin/perl -w -# -# termcap.t -- Additional specialized tests for Pod::Text::Termcap. -# -# Copyright 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..2\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -# Hard-code a few values to try to get reproducible results. -$ENV{COLUMNS} = 80; -$ENV{TERM} = 'xterm'; -$ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m'; - -use Pod::Text::Termcap; - -$loaded = 1; -print "ok 1\n"; - -my $parser = Pod::Text::Termcap->new or die "Cannot create parser\n"; -my $n = 2; -while (<DATA>) { - next until $_ eq "###\n"; - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $parser->parse_from_file ('tmp.pod', \*OUT); - close OUT; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected output. This is -# used to test specific features or problems with Pod::Text::Termcap. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -=head1 WRAPPING - -B<I<Do>> I<B<not>> B<I<include>> B<I<formatting codes when>> B<I<wrapping>>. -### -[1mWRAPPING[m - [1m[4mDo[m[m [4m[1mnot[m[m [1m[4minclude[m[m [1m[4mformatting codes when[m[m [1m[4mwrapping[m[m. - -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/text-encoding.t b/gnu/usr.bin/perl/lib/Pod/t/text-encoding.t deleted file mode 100755 index c803cff1f97..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/text-encoding.t +++ /dev/null @@ -1,142 +0,0 @@ -#!/usr/bin/perl -w -# -# text-encoding.t -- Test Pod::Text with various weird encoding combinations. -# -# Copyright 2002, 2004, 2006, 2007, 2008 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..4\n"; - - # PerlIO encoding support requires Perl 5.8 or later. - if ($] < 5.008) { - my $n; - for $n (1..4) { - print "ok $n # skip -- Perl 5.8 required for UTF-8 support\n"; - } - exit; - } -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Text; - -$loaded = 1; -print "ok 1\n"; - -my $n = 2; -eval { binmode (\*DATA, ':raw') }; -eval { binmode (\*STDOUT, ':raw') }; -while (<DATA>) { - my %opts; - $opts{utf8} = 1 if $n == 4; - my $parser = Pod::Text->new (%opts) or die "Cannot create parser\n"; - next until $_ eq "###\n"; - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - eval { binmode (\*TMP, ':raw') }; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - eval { binmode (\*OUT, ':raw') }; - $parser->parse_from_file ('tmp.pod', \*OUT); - close OUT; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - eval { binmode (\*TMP, ':raw') }; - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected text output. -# This is used to test specific features or problems with Pod::Text. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -=head1 Test of SE<lt>E<gt> - -This is S<some whitespace>. -### -Test of S<> - This is some whitespace. - -### - -### -=encoding utf-8 - -=head1 I can eat glass - -=over 4 - -=item Esperanto - -Mi povas manÄi vitron, Äi ne damaÄas min. - -=item Braille - -â â â â â â â â â â â â â â â â â â â â â â â â â â â â â â â â ¥â â â â â - -=item Hindi - -मà¥à¤ à¤à¤¾à¤à¤ à¤à¤¾ सà¤à¤¤à¤¾ हà¥à¤ à¤à¤° मà¥à¤à¥ à¤à¤¸à¤¸à¥ à¤à¥à¤ à¤à¥à¤ नहà¥à¤ पहà¥à¤à¤à¤¤à¥. - -=back - -See L<http://www.columbia.edu/kermit/utf8.html> -### -I can eat glass - Esperanto - Mi povas manÄi vitron, Äi ne damaÄas min. - - Braille - â â â â â â â â â â â â â â â â â â â â â â â - â â â â â â â â â ¥â â â â â - - Hindi - मà¥à¤ à¤à¤¾à¤à¤ à¤à¤¾ सà¤à¤¤à¤¾ हà¥à¤ à¤à¤° - मà¥à¤à¥ à¤à¤¸à¤¸à¥ à¤à¥à¤ à¤à¥à¤ नहà¥à¤ - पहà¥à¤à¤à¤¤à¥. - - See <http://www.columbia.edu/kermit/utf8.html> - -### - -### -=head1 Beyoncé -### -Beyoncé -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/text-options.t b/gnu/usr.bin/perl/lib/Pod/t/text-options.t deleted file mode 100644 index 8a115d83a5c..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/text-options.t +++ /dev/null @@ -1,271 +0,0 @@ -#!/usr/bin/perl -w -# -# text-options.t -- Additional tests for Pod::Text options. -# -# Copyright 2002, 2004, 2006, 2008 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..13\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Text; - -# Redirect stderr to a file. -sub stderr_save { - open (OLDERR, '>&STDERR') or die "Can't dup STDERR: $!\n"; - open (STDERR, '> out.err') or die "Can't redirect STDERR: $!\n"; -} - -# Restore stderr. -sub stderr_restore { - close STDERR; - open (STDERR, '>&OLDERR') or die "Can't dup STDERR: $!\n"; - close OLDERR; -} - -$loaded = 1; -print "ok 1\n"; - -my $n = 2; -while (<DATA>) { - my %options; - next until $_ eq "###\n"; - while (<DATA>) { - last if $_ eq "###\n"; - my ($option, $value) = split; - $options{$option} = $value; - } - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - my $parser = Pod::Text->new (%options) or die "Cannot create parser\n"; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - stderr_save; - $parser->parse_from_file ('tmp.pod', \*OUT); - stderr_restore; - close OUT; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - 1 while unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; - open (ERR, 'out.err') or die "Cannot open out.err: $!\n"; - my $errors; - { - local $/; - $errors = <ERR>; - } - close ERR; - unlink ('out.err'); - $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($errors eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected errors:\n ${expected}Errors:\n $errors"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected text output. -# This is used to test specific features or problems with Pod::Text. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -alt 1 -### -=head1 SAMPLE - -=over 4 - -=item F - -Paragraph. - -=item Bar - -=item B - -Paragraph. - -=item Longer - -Paragraph. - -=back - -### - -==== SAMPLE ==== - -: F Paragraph. - -: Bar -: B Paragraph. - -: Longer - Paragraph. - -### -### - -### -margin 4 -### -=head1 SAMPLE - -This is some body text that is long enough to be a paragraph that wraps, -thereby testing margins with wrapped paragraphs. - - This is some verbatim text. - -=over 6 - -=item Test - -This is a test of an indented paragraph. - -This is another indented paragraph. - -=back -### - SAMPLE - This is some body text that is long enough to be a paragraph that - wraps, thereby testing margins with wrapped paragraphs. - - This is some verbatim text. - - Test This is a test of an indented paragraph. - - This is another indented paragraph. - -### -### - -### -code 1 -### -This is some random text. -This is more random text. - -This is some random text. -This is more random text. - -=head1 SAMPLE - -This is POD. - -=cut - -This is more random text. -### -This is some random text. -This is more random text. - -This is some random text. -This is more random text. - -SAMPLE - This is POD. - - -This is more random text. -### -### - -### -sentence 1 -### -=head1 EXAMPLE - -Whitespace around C<< this. >> must be ignored per perlpodspec. >> -needs to eat all of the space in front of it. - -=cut -### -EXAMPLE - Whitespace around "this." must be ignored per perlpodspec. >> needs to - eat all of the space in front of it. - -### -### - -### -### -=over 4 - -=item Foo - -Bar. - -=head1 NEXT -### - Foo Bar. - -NEXT -POD ERRORS - Hey! The above document had some coding errors, which are explained - below: - - Around line 7: - You forgot a '=back' before '=head1' - -### -### - -### -stderr 1 -### -=over 4 - -=item Foo - -Bar. - -=head1 NEXT -### - Foo Bar. - -NEXT -### -tmp.pod around line 7: You forgot a '=back' before '=head1' -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/text-utf8.t b/gnu/usr.bin/perl/lib/Pod/t/text-utf8.t deleted file mode 100755 index 806947827ed..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/text-utf8.t +++ /dev/null @@ -1,129 +0,0 @@ -#!/usr/bin/perl -w -# -# text-utf8.t -- Test Pod::Text with UTF-8 input. -# -# Copyright 2002, 2004, 2006, 2007, 2008 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..3\n"; - - # UTF-8 support requires Perl 5.8 or later. - if ($] < 5.008) { - my $n; - for $n (1..3) { - print "ok $n # skip -- Perl 5.8 required for UTF-8 support\n"; - } - exit; - } -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Text; - -$loaded = 1; -print "ok 1\n"; - -my $parser = Pod::Text->new or die "Cannot create parser\n"; -my $n = 2; -eval { binmode (\*DATA, ':encoding(utf-8)') }; -eval { binmode (\*STDOUT, ':encoding(utf-8)') }; -while (<DATA>) { - next until $_ eq "###\n"; - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - eval { binmode (\*TMP, ':encoding(utf-8)') }; - print TMP "=encoding UTF-8\n\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $parser->parse_from_file ('tmp.pod', \*OUT); - close OUT; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - eval { binmode (\*TMP, ':encoding(utf-8)') }; - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected text output. -# This is used to test specific features or problems with Pod::Text. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -=head1 Test of SE<lt>E<gt> - -This is S<some whitespace>. -### -Test of S<> - This is some whitespace. - -### - -### -=head1 I can eat glass - -=over 4 - -=item Esperanto - -Mi povas manĝi vitron, ĝi ne damaĝas min. - -=item Braille - -⠊⠀⠉⠁⠝⠀⠑⠁⠞⠀⠛⠇⠁⠎⠎⠀⠁⠝⠙⠀⠊⠞⠀⠙⠕⠑⠎⠝⠞⠀⠓⠥⠗⠞⠀⠍⠑ - -=item Hindi - -मैं काँच खा सकता हूँ और मुझे उससे कोई चोट नहीं पहुंचती. - -=back - -See L<http://www.columbia.edu/kermit/utf8.html> -### -I can eat glass - Esperanto - Mi povas manĝi vitron, ĝi ne damaĝas min. - - Braille - ⠊⠀⠉⠁⠝⠀⠑⠁⠞⠀⠛⠇⠁⠎⠎⠀⠁⠝⠙⠀⠊⠞⠀⠙⠕⠑⠎⠝⠞⠀⠓⠥⠗⠞⠀⠍⠑ - - Hindi - मैं काँच खा सकता हूँ और मुझे उससे कोई चोट नहीं पहुंचती. - - See <http://www.columbia.edu/kermit/utf8.html> - -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/text.t b/gnu/usr.bin/perl/lib/Pod/t/text.t deleted file mode 100644 index c96acba63d3..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/text.t +++ /dev/null @@ -1,147 +0,0 @@ -#!/usr/bin/perl -w -# -# text.t -- Additional specialized tests for Pod::Text. -# -# Copyright 2002, 2004, 2006, 2007, 2008, 2009 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. - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift (@INC, '../blib/lib'); - } - unshift (@INC, '../blib/lib'); - $| = 1; - print "1..6\n"; -} - -END { - print "not ok 1\n" unless $loaded; -} - -use Pod::Text; -use Pod::Simple; - -$loaded = 1; -print "ok 1\n"; - -my $parser = Pod::Text->new or die "Cannot create parser\n"; -my $n = 2; -while (<DATA>) { - next until $_ eq "###\n"; - open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; - while (<DATA>) { - last if $_ eq "###\n"; - print TMP $_; - } - close TMP; - open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; - $parser->parse_from_file ('tmp.pod', \*OUT); - close OUT; - open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; - my $output; - { - local $/; - $output = <TMP>; - } - close TMP; - unlink ('tmp.pod', 'out.tmp'); - my $expected = ''; - while (<DATA>) { - last if $_ eq "###\n"; - $expected .= $_; - } - if ($output eq $expected) { - print "ok $n\n"; - } elsif ($n == 4 && $Pod::Simple::VERSION < 3.06) { - print "ok $n # skip Pod::Simple S<> parsing bug\n"; - } else { - print "not ok $n\n"; - print "Expected\n========\n$expected\nOutput\n======\n$output\n"; - } - $n++; -} - -# Below the marker are bits of POD and corresponding expected text output. -# This is used to test specific features or problems with Pod::Text. The -# input and output are separated by lines containing only ###. - -__DATA__ - -### -=head1 PERIODS - -This C<.> should be quoted. -### -PERIODS - This "." should be quoted. - -### - -### -=head1 CE<lt>E<gt> WITH SPACES - -What does C<< this. >> end up looking like? -### -C<> WITH SPACES - What does "this." end up looking like? - -### - -### -=head1 Test of SE<lt>E<gt> - -This is some S< > whitespace. -### -Test of S<> - This is some whitespace. - -### - -### -=head1 Test of =for - -=for comment -This won't be seen. - -Yes. - -=for text -This should be seen. - -=for TEXT As should this. - -=for man -But this shouldn't. - -Some more text. -### -Test of =for - Yes. - -This should be seen. -As should this. - Some more text. - -### - -### -=pod - -text - - line1 - - line3 -### - text - - line1 - - line3 - -### diff --git a/gnu/usr.bin/perl/lib/Pod/t/user.t b/gnu/usr.bin/perl/lib/Pod/t/user.t deleted file mode 100644 index 04776de5ace..00000000000 --- a/gnu/usr.bin/perl/lib/Pod/t/user.t +++ /dev/null @@ -1,104 +0,0 @@ -#!perl - -# Purpose: test UserPreamble and UserPostamble -# It's a minor variation of 'pod2latex.t', -# subject to the same limitations. -# Variant provided by -# Adriano Rodrigues Ferreira <ferreira@triang.com.br> - -use Test; -use strict; - -BEGIN { plan tests => 17 } - -use Pod::LaTeX; - -# The link parsing changed between v0.22 and v0.30 of Pod::ParseUtils -use Pod::ParseUtils; -my $linkver = $Pod::ParseUtils::VERSION; - -# Set up an END block to remove the test output file -END { - unlink "test.tex"; -}; - -ok(1); - -# First thing to do is to read the expected output from -# the DATA filehandle and store it in a scalar. -# Do this until we read an =pod -my @reference; -while (my $line = <DATA>) { - last if $line =~ /^=pod/; - push(@reference,$line); -} - -my $user_preamble = <<PRE; - -\\documentclass{article} - -\\begin{document} -PRE - -my $user_postamble = <<POST; -\\end{document} - -POST - -# Create a new parser -my %params = ( - UserPreamble => $user_preamble, - UserPostamble => $user_postamble -); - -my $parser = Pod::LaTeX->new(%params); -ok($parser); - -# Create an output file -open(OUTFH, "> test.tex" ) or die "Unable to open test tex file: $!\n"; - -# Read from the DATA filehandle and write to a new output file -# Really want to write this to a scalar -$parser->parse_from_filehandle(\*DATA,\*OUTFH); - -close(OUTFH) or die "Error closing OUTFH test.tex: $!\n"; - -# Now read in OUTFH and compare -open(INFH, "< test.tex") or die "Unable to read test tex file: $!\n"; -my @output = <INFH>; - -ok(@output, @reference); - -for my $i (0..$#reference) { - next if $reference[$i] =~ /^%%/; # skip timestamp comments - ok($output[$i], $reference[$i]); -} - -close(INFH) or die "Error closing INFH test.tex: $!\n"; - - -__DATA__ - -\documentclass{article} - -\begin{document} - -%% Latex generated from POD in document (unknown) -%% Using the perl module Pod::LaTeX -%% Converted on Wed Jan 14 19:04:22 2004 - -%% Preamble supplied by user. - -\section{POD\label{POD}\index{POD}} - - -This is a POD file, very simple. \textit{Bye}. - -\end{document} - -=pod - -=head1 POD - -This is a POD file, very simple. I<Bye>. - |