dslinux/user/perl/lib/Pod Checker.pm Find.pm Functions.pm Html.pm InputObjects.pm LaTeX.pm Man.pm ParseLink.pm ParseUtils.pm Parser.pm Perldoc.pm PlainText.pm Plainer.pm Select.pm Text.pm Usage.pm
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:58 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/Pod
In directory antilope:/tmp/cvs-serv17422/lib/Pod
Added Files:
Checker.pm Find.pm Functions.pm Html.pm InputObjects.pm
LaTeX.pm Man.pm ParseLink.pm ParseUtils.pm Parser.pm
Perldoc.pm PlainText.pm Plainer.pm Select.pm Text.pm Usage.pm
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: Select.pm ---
#############################################################################
# Pod/Select.pm -- function to select portions of POD docs
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::Select;
use vars qw($VERSION);
$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
=head1 NAME
Pod::Select, podselect() - extract selected sections of POD from input
=head1 SYNOPSIS
use Pod::Select;
## Select all the POD sections for each file in @filelist
## and print the result on standard output.
podselect(@filelist);
## Same as above, but write to tmp.out
podselect({-output => "tmp.out"}, @filelist):
## Select from the given filelist, only those POD sections that are
## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):
## Select the "DESCRIPTION" section of the PODs from STDIN and write
## the result to STDERR.
podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
or
use Pod::Select;
## Create a parser object for selecting POD sections from the input
$parser = new Pod::Select();
## Select all the POD sections for each file in @filelist
## and print the result to tmp.out.
$parser->parse_from_file("<&STDIN", "tmp.out");
## Select from the given filelist, only those POD sections that are
## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
$parser->select("NAME|SYNOPSIS", "OPTIONS");
for (@filelist) { $parser->parse_from_file($_); }
## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
## STDIN and write the result to STDERR.
$parser->select("DESCRIPTION");
$parser->add_selection("SEE ALSO");
$parser->parse_from_filehandle(\*STDIN, \*STDERR);
=head1 REQUIRES
perl5.005, Pod::Parser, Exporter, Carp
=head1 EXPORTS
podselect()
=head1 DESCRIPTION
B<podselect()> is a function which will extract specified sections of
pod documentation from an input stream. This ability is provided by the
B<Pod::Select> module which is a subclass of B<Pod::Parser>.
B<Pod::Select> provides a method named B<select()> to specify the set of
POD sections to select for processing/printing. B<podselect()> merely
creates a B<Pod::Select> object and then invokes the B<podselect()>
followed by B<parse_from_file()>.
=head1 SECTION SPECIFICATIONS
B<podselect()> and B<Pod::Select::select()> may be given one or more
"section specifications" to restrict the text processed to only the
desired set of sections and their corresponding subsections. A section
specification is a string containing one or more Perl-style regular
expressions separated by forward slashes ("/"). If you need to use a
forward slash literally within a section title you can escape it with a
backslash ("\/").
The formal syntax of a section specification is:
=over 4
=item *
I<head1-title-regex>/I<head2-title-regex>/...
=back
Any omitted or empty regular expressions will default to ".*".
Please note that each regular expression given is implicitly
anchored by adding "^" and "$" to the beginning and end. Also, if a
given regular expression starts with a "!" character, then the
expression is I<negated> (so C<!foo> would match anything I<except>
C<foo>).
Some example section specifications follow.
=over 4
=item *
Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
C<NAME|SYNOPSIS>
=item *
Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
section:
C<DESCRIPTION/Question|Answer>
=item *
Match the C<Comments> subsection of I<all> sections:
C</Comments>
=item *
Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
C<DESCRIPTION/!Comments>
=item *
Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
C<DESCRIPTION/!.+>
=item *
Match all top level sections but none of their subsections:
C</!.+>
=back
=begin _NOT_IMPLEMENTED_
=head1 RANGE SPECIFICATIONS
B<podselect()> and B<Pod::Select::select()> may be given one or more
"range specifications" to restrict the text processed to only the
desired ranges of paragraphs in the desired set of sections. A range
specification is a string containing a single Perl-style regular
expression (a regex), or else two Perl-style regular expressions
(regexs) separated by a ".." (Perl's "range" operator is "..").
The regexs in a range specification are delimited by forward slashes
("/"). If you need to use a forward slash literally within a regex you
can escape it with a backslash ("\/").
The formal syntax of a range specification is:
=over 4
=item *
/I<start-range-regex>/[../I<end-range-regex>/]
=back
Where each the item inside square brackets (the ".." followed by the
end-range-regex) is optional. Each "range-regex" is of the form:
=cmd-expr text-expr
Where I<cmd-expr> is intended to match the name of one or more POD
commands, and I<text-expr> is intended to match the paragraph text for
the command. If a range-regex is supposed to match a POD command, then
the first character of the regex (the one after the initial '/')
absolutely I<must> be a single '=' character; it may not be anything
else (not even a regex meta-character) if it is supposed to match
against the name of a POD command.
If no I<=cmd-expr> is given then the text-expr will be matched against
plain textblocks unless it is preceded by a space, in which case it is
matched against verbatim text-blocks. If no I<text-expr> is given then
only the command-portion of the paragraph is matched against.
Note that these two expressions are each implicitly anchored. This
means that when matching against the command-name, there will be an
implicit '^' and '$' around the given I<=cmd-expr>; and when matching
against the paragraph text there will be an implicit '\A' and '\Z'
around the given I<text-expr>.
Unlike with section-specs, the '!' character does I<not> have any special
meaning (negation or otherwise) at the beginning of a range-spec!
Some example range specifications follow.
=over 4
=item
Match all C<=for html> paragraphs:
C</=for html/>
=item
Match all paragraphs between C<=begin html> and C<=end html>
(note that this will I<not> work correctly if such sections
are nested):
C</=begin html/../=end html/>
=item
Match all paragraphs between the given C<=item> name until the end of the
current section:
C</=item mine/../=head\d/>
=item
Match all paragraphs between the given C<=item> until the next item, or
until the end of the itemized list (note that this will I<not> work as
desired if the item contains an itemized list nested within it):
C</=item mine/../=(item|back)/>
=back
=end _NOT_IMPLEMENTED_
=cut
#############################################################################
use strict;
#use diagnostics;
use Carp;
use Pod::Parser 1.04;
use vars qw(@ISA @EXPORT $MAX_HEADING_LEVEL);
@ISA = qw(Pod::Parser);
@EXPORT = qw(&podselect);
## Maximum number of heading levels supported for '=headN' directives
*MAX_HEADING_LEVEL = \3;
#############################################################################
=head1 OBJECT METHODS
The following methods are provided in this module. Each one takes a
reference to the object itself as an implicit first parameter.
=cut
##---------------------------------------------------------------------------
## =begin _PRIVATE_
##
## =head1 B<_init_headings()>
##
## Initialize the current set of active section headings.
##
## =cut
##
## =end _PRIVATE_
use vars qw(%myData @section_headings);
sub _init_headings {
my $self = shift;
local *myData = $self;
## Initialize current section heading titles if necessary
unless (defined $myData{_SECTION_HEADINGS}) {
local *section_headings = $myData{_SECTION_HEADINGS} = [];
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
$section_headings[$i] = '';
}
}
}
##---------------------------------------------------------------------------
=head1 B<curr_headings()>
($head1, $head2, $head3, ...) = $parser->curr_headings();
$head1 = $parser->curr_headings(1);
This method returns a list of the currently active section headings and
subheadings in the document being parsed. The list of headings returned
corresponds to the most recently parsed paragraph of the input.
If an argument is given, it must correspond to the desired section
heading number, in which case only the specified section heading is
returned. If there is no current section heading at the specified
level, then C<undef> is returned.
=cut
sub curr_headings {
my $self = shift;
$self->_init_headings() unless (defined $self->{_SECTION_HEADINGS});
my @headings = @{ $self->{_SECTION_HEADINGS} };
return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
}
##---------------------------------------------------------------------------
=head1 B<select()>
$parser->select($section_spec1,$section_spec2,...);
This method is used to select the particular sections and subsections of
POD documentation that are to be printed and/or processed. The existing
set of selected sections is I<replaced> with the given set of sections.
See B<add_selection()> for adding to the current set of selected
sections.
Each of the C<$section_spec> arguments should be a section specification
as described in L<"SECTION SPECIFICATIONS">. The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.
If no C<$section_spec> arguments are given, then the existing set of
selected sections is cleared out (which means C<all> sections will be
processed).
This method should I<not> normally be overridden by subclasses.
=cut
use vars qw(@selected_sections);
sub select {
my $self = shift;
my @sections = @_;
local *myData = $self;
local $_;
### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)
##---------------------------------------------------------------------
## The following is a blatant hack for backward compatibility, and for
## implementing add_selection(). If the *first* *argument* is the
## string "+", then the remaining section specifications are *added*
## to the current set of selections; otherwise the given section
## specifications will *replace* the current set of selections.
##
## This should probably be fixed someday, but for the present time,
## it seems incredibly unlikely that "+" would ever correspond to
## a legitimate section heading
##---------------------------------------------------------------------
my $add = ($sections[0] eq "+") ? shift(@sections) : "";
## Reset the set of sections to use
unless (@sections > 0) {
delete $myData{_SELECTED_SECTIONS} unless ($add);
return;
}
$myData{_SELECTED_SECTIONS} = []
unless ($add && exists $myData{_SELECTED_SECTIONS});
local *selected_sections = $myData{_SELECTED_SECTIONS};
## Compile each spec
my $spec;
for $spec (@sections) {
if ( defined($_ = &_compile_section_spec($spec)) ) {
## Store them in our sections array
push(@selected_sections, $_);
}
else {
carp "Ignoring section spec \"$spec\"!\n";
}
}
}
##---------------------------------------------------------------------------
=head1 B<add_selection()>
$parser->add_selection($section_spec1,$section_spec2,...);
This method is used to add to the currently selected sections and
subsections of POD documentation that are to be printed and/or
processed. See <select()> for replacing the currently selected sections.
Each of the C<$section_spec> arguments should be a section specification
as described in L<"SECTION SPECIFICATIONS">. The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.
This method should I<not> normally be overridden by subclasses.
=cut
sub add_selection {
my $self = shift;
$self->select("+", @_);
}
##---------------------------------------------------------------------------
=head1 B<clear_selections()>
$parser->clear_selections();
This method takes no arguments, it has the exact same effect as invoking
<select()> with no arguments.
=cut
sub clear_selections {
my $self = shift;
$self->select();
}
##---------------------------------------------------------------------------
=head1 B<match_section()>
$boolean = $parser->match_section($heading1,$heading2,...);
Returns a value of true if the given section and subsection heading
titles match any of the currently selected section specifications in
effect from prior calls to B<select()> and B<add_selection()> (or if
there are no explictly selected/deselected sections).
The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
the corresponding sections, subsections, etc. to try and match. If
C<$headingN> is omitted then it defaults to the current corresponding
section heading title in the input.
This method should I<not> normally be overridden by subclasses.
=cut
sub match_section {
my $self = shift;
my (@headings) = @_;
local *myData = $self;
## Return true if no restrictions were explicitly specified
my $selections = (exists $myData{_SELECTED_SECTIONS})
? $myData{_SELECTED_SECTIONS} : undef;
return 1 unless ((defined $selections) && (@{$selections} > 0));
## Default any unspecified sections to the current one
my @current_headings = $self->curr_headings();
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
(defined $headings[$i]) or $headings[$i] = $current_headings[$i];
}
## Look for a match against the specified section expressions
my ($section_spec, $regex, $negated, $match);
for $section_spec ( @{$selections} ) {
##------------------------------------------------------
## Each portion of this spec must match in order for
## the spec to be matched. So we will start with a
## match-value of 'true' and logically 'and' it with
## the results of matching a given element of the spec.
##------------------------------------------------------
$match = 1;
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
$regex = $section_spec->[$i];
$negated = ($regex =~ s/^\!//);
$match &= ($negated ? ($headings[$i] !~ /${regex}/)
: ($headings[$i] =~ /${regex}/));
last unless ($match);
}
return 1 if ($match);
}
return 0; ## no match
}
##---------------------------------------------------------------------------
=head1 B<is_selected()>
$boolean = $parser->is_selected($paragraph);
This method is used to determine if the block of text given in
C<$paragraph> falls within the currently selected set of POD sections
and subsections to be printed or processed. This method is also
responsible for keeping track of the current input section and
subsections. It is assumed that C<$paragraph> is the most recently read
(but not yet processed) input paragraph.
The value returned will be true if the C<$paragraph> and the rest of the
text in the same section as C<$paragraph> should be selected (included)
for processing; otherwise a false value is returned.
=cut
sub is_selected {
my ($self, $paragraph) = @_;
local $_;
local *myData = $self;
$self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});
## Keep track of current sections levels and headings
$_ = $paragraph;
if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/)
{
## This is a section heading command
my ($level, $heading) = ($2, $3);
$level = 1 + (length($1) / 3) if ((! length $level) || (length $1));
## Reset the current section heading at this level
$myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
## Reset subsection headings of this one to empty
for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
$myData{_SECTION_HEADINGS}->[$i] = '';
}
}
return $self->match_section();
}
#############################################################################
=head1 EXPORTED FUNCTIONS
The following functions are exported by this module. Please note that
these are functions (not methods) and therefore C<do not> take an
implicit first argument.
=cut
##---------------------------------------------------------------------------
=head1 B<podselect()>
podselect(\%options, at 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 interpeted to mean standard input (which is the default if no
filenames are given).
=cut
sub podselect {
my(@argv) = @_;
my %defaults = ();
my $pod_parser = new Pod::Select(%defaults);
my $num_inputs = 0;
my $output = ">&STDOUT";
my %opts;
local $_;
for (@argv) {
if (ref($_)) {
next unless (ref($_) eq 'HASH');
%opts = (%defaults, %{$_});
##-------------------------------------------------------------
## Need this for backward compatibility since we formerly used
## options that were all uppercase words rather than ones that
## looked like Unix command-line options.
## to be uppercase keywords)
##-------------------------------------------------------------
%opts = map {
my ($key, $val) = (lc $_, $opts{$_});
$key =~ s/^(?=\w)/-/;
$key =~ /^-se[cl]/ and $key = '-sections';
#! $key eq '-range' and $key .= 's';
($key => $val);
} (keys %opts);
## Process the options
(exists $opts{'-output'}) and $output = $opts{'-output'};
## Select the desired sections
$pod_parser->select(@{ $opts{'-sections'} })
if ( (defined $opts{'-sections'})
&& ((ref $opts{'-sections'}) eq 'ARRAY') );
#! ## Select the desired paragraph ranges
#! $pod_parser->select(@{ $opts{'-ranges'} })
#! if ( (defined $opts{'-ranges'})
#! && ((ref $opts{'-ranges'}) eq 'ARRAY') );
}
else {
$pod_parser->parse_from_file($_, $output);
++$num_inputs;
}
}
$pod_parser->parse_from_file("-") unless ($num_inputs > 0);
}
#############################################################################
=head1 PRIVATE METHODS AND DATA
B<Pod::Select> makes uses a number of internal methods and data fields
which clients should not need to see or use. For the sake of avoiding
name collisions with client data and methods, these methods and fields
are briefly discussed here. Determined hackers may obtain further
information about them by reading the B<Pod::Select> source code.
Private data fields are stored in the hash-object whose reference is
returned by the B<new()> constructor for this class. The names of all
private methods and data-fields used by B<Pod::Select> begin with a
prefix of "_" and match the regular expression C</^_\w+$/>.
=cut
##---------------------------------------------------------------------------
=begin _PRIVATE_
=head1 B<_compile_section_spec()>
$listref = $parser->_compile_section_spec($section_spec);
This function (note it is a function and I<not> a method) takes a
section specification (as described in L<"SECTION SPECIFICATIONS">)
given in C<$section_sepc>, and compiles it into a list of regular
expressions. If C<$section_spec> has no syntax errors, then a reference
to the list (array) of corresponding regular expressions is returned;
otherwise C<undef> is returned and an error message is printed (using
B<carp>) for each invalid regex.
=end _PRIVATE_
=cut
sub _compile_section_spec {
my ($section_spec) = @_;
my (@regexs, $negated);
## Compile the spec into a list of regexs
local $_ = $section_spec;
s|\\\\|\001|g; ## handle escaped backward slashes
s|\\/|\002|g; ## handle escaped forward slashes
## Parse the regexs for the heading titles
@regexs = split('/', $_, $MAX_HEADING_LEVEL);
## Set default regex for ommitted levels
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
$regexs[$i] = '.*' unless ((defined $regexs[$i])
&& (length $regexs[$i]));
}
## Modify the regexs as needed and validate their syntax
my $bad_regexs = 0;
for (@regexs) {
$_ .= '.+' if ($_ eq '!');
s|\001|\\\\|g; ## restore escaped backward slashes
s|\002|\\/|g; ## restore escaped forward slashes
$negated = s/^\!//; ## check for negation
eval "/$_/"; ## check regex syntax
if ($@) {
++$bad_regexs;
carp "Bad regular expression /$_/ in \"$section_spec\": $@\n";
}
else {
## Add the forward and rear anchors (and put the negator back)
$_ = '^' . $_ unless (/^\^/);
$_ = $_ . '$' unless (/\$$/);
$_ = '!' . $_ if ($negated);
}
}
return (! $bad_regexs) ? [ @regexs ] : undef;
}
##---------------------------------------------------------------------------
=begin _PRIVATE_
=head2 $self->{_SECTION_HEADINGS}
A reference to an array of the current section heading titles for each
heading level (note that the first heading level title is at index 0).
=end _PRIVATE_
=cut
##---------------------------------------------------------------------------
=begin _PRIVATE_
=head2 $self->{_SELECTED_SECTIONS}
A reference to an array of references to arrays. Each subarray is a list
of anchored regular expressions (preceded by a "!" if the expression is to
be negated). The index of the expression in the subarray should correspond
to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
that it is to be matched against.
=end _PRIVATE_
=cut
#############################################################################
=head1 SEE ALSO
L<Pod::Parser>
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp at enteract.comE<gt>
Based on code for B<pod2text> written by
Tom Christiansen E<lt>tchrist at mox.perl.comE<gt>
=cut
1;
# vim: ts=4 sw=4 et
--- NEW FILE: PlainText.pm ---
# Pod::PlainText -- Convert POD data to formatted ASCII text.
# $Id: PlainText.pm,v 1.1 2006-12-04 17:00:55 dslinux_cayenne Exp $
#
# Copyright 1999-2000 by Russ Allbery <rra at stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This module is intended to be a replacement for Pod::Text, and attempts to
# match its output except for some specific circumstances where other
# decisions seemed to produce better output. It uses Pod::Parser and is
# designed to be very easy to subclass.
############################################################################
# Modules and declarations
############################################################################
package Pod::PlainText;
require 5.005;
use Carp qw(carp croak);
use Pod::Select ();
use strict;
use vars qw(@ISA %ESCAPES $VERSION);
# We inherit from Pod::Select instead of Pod::Parser so that we can be used
# by Pod::Usage.
@ISA = qw(Pod::Select);
$VERSION = '2.02';
############################################################################
# Table of supported E<> escapes
############################################################################
# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
# which got it near verbatim from the original Pod::Text. It is therefore
# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)
%ESCAPES = (
'amp' => '&', # ampersand
'lt' => '<', # left chevron, less-than
'gt' => '>', # right chevron, greater-than
'quot' => '"', # double quote
"Aacute" => "\xC1", # capital A, acute accent
"aacute" => "\xE1", # small a, acute accent
"Acirc" => "\xC2", # capital A, circumflex accent
"acirc" => "\xE2", # small a, circumflex accent
"AElig" => "\xC6", # capital AE diphthong (ligature)
"aelig" => "\xE6", # small ae diphthong (ligature)
"Agrave" => "\xC0", # capital A, grave accent
"agrave" => "\xE0", # small a, grave accent
"Aring" => "\xC5", # capital A, ring
"aring" => "\xE5", # small a, ring
"Atilde" => "\xC3", # capital A, tilde
"atilde" => "\xE3", # small a, tilde
"Auml" => "\xC4", # capital A, dieresis or umlaut mark
"auml" => "\xE4", # small a, dieresis or umlaut mark
"Ccedil" => "\xC7", # capital C, cedilla
"ccedil" => "\xE7", # small c, cedilla
"Eacute" => "\xC9", # capital E, acute accent
"eacute" => "\xE9", # small e, acute accent
"Ecirc" => "\xCA", # capital E, circumflex accent
"ecirc" => "\xEA", # small e, circumflex accent
"Egrave" => "\xC8", # capital E, grave accent
"egrave" => "\xE8", # small e, grave accent
"ETH" => "\xD0", # capital Eth, Icelandic
"eth" => "\xF0", # small eth, Icelandic
"Euml" => "\xCB", # capital E, dieresis or umlaut mark
"euml" => "\xEB", # small e, dieresis or umlaut mark
"Iacute" => "\xCD", # capital I, acute accent
"iacute" => "\xED", # small i, acute accent
"Icirc" => "\xCE", # capital I, circumflex accent
"icirc" => "\xEE", # small i, circumflex accent
"Igrave" => "\xCD", # capital I, grave accent
"igrave" => "\xED", # small i, grave accent
"Iuml" => "\xCF", # capital I, dieresis or umlaut mark
"iuml" => "\xEF", # small i, dieresis or umlaut mark
"Ntilde" => "\xD1", # capital N, tilde
"ntilde" => "\xF1", # small n, tilde
"Oacute" => "\xD3", # capital O, acute accent
"oacute" => "\xF3", # small o, acute accent
"Ocirc" => "\xD4", # capital O, circumflex accent
"ocirc" => "\xF4", # small o, circumflex accent
"Ograve" => "\xD2", # capital O, grave accent
"ograve" => "\xF2", # small o, grave accent
"Oslash" => "\xD8", # capital O, slash
"oslash" => "\xF8", # small o, slash
"Otilde" => "\xD5", # capital O, tilde
"otilde" => "\xF5", # small o, tilde
"Ouml" => "\xD6", # capital O, dieresis or umlaut mark
"ouml" => "\xF6", # small o, dieresis or umlaut mark
"szlig" => "\xDF", # small sharp s, German (sz ligature)
"THORN" => "\xDE", # capital THORN, Icelandic
"thorn" => "\xFE", # small thorn, Icelandic
"Uacute" => "\xDA", # capital U, acute accent
"uacute" => "\xFA", # small u, acute accent
"Ucirc" => "\xDB", # capital U, circumflex accent
"ucirc" => "\xFB", # small u, circumflex accent
"Ugrave" => "\xD9", # capital U, grave accent
"ugrave" => "\xF9", # small u, grave accent
"Uuml" => "\xDC", # capital U, dieresis or umlaut mark
"uuml" => "\xFC", # small u, dieresis or umlaut mark
"Yacute" => "\xDD", # capital Y, acute accent
"yacute" => "\xFD", # small y, acute accent
"yuml" => "\xFF", # small y, dieresis or umlaut mark
"lchevron" => "\xAB", # left chevron (double less than)
"rchevron" => "\xBB", # right chevron (double greater than)
);
############################################################################
# Initialization
############################################################################
# Initialize the object. Must be sure to call our parent initializer.
sub initialize {
my $self = shift;
$$self{alt} = 0 unless defined $$self{alt};
$$self{indent} = 4 unless defined $$self{indent};
$$self{loose} = 0 unless defined $$self{loose};
$$self{sentence} = 0 unless defined $$self{sentence};
$$self{width} = 76 unless defined $$self{width};
$$self{INDENTS} = []; # Stack of indentations.
$$self{MARGIN} = $$self{indent}; # Current left margin in spaces.
$self->SUPER::initialize;
}
############################################################################
# Core overrides
############################################################################
# Called for each command paragraph. Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
# the command to a method named the same as the command. =cut is handled
# internally by Pod::Parser.
sub command {
my $self = shift;
my $command = shift;
return if $command eq 'pod';
return if ($$self{EXCLUDE} && $command ne 'end');
$self->item ("\n") if defined $$self{ITEM};
$command = 'cmd_' . $command;
$self->$command (@_);
}
# Called for a verbatim paragraph. Gets the paragraph, the line number, and
# a Pod::Paragraph object. Just output it verbatim, but with tabs converted
# to spaces.
sub verbatim {
my $self = shift;
return if $$self{EXCLUDE};
$self->item if defined $$self{ITEM};
local $_ = shift;
return if /^\s*$/;
s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
$self->output ($_);
}
# Called for a regular text block. Gets the paragraph, the line number, and
# a Pod::Paragraph object. Perform interpolation and output the results.
sub textblock {
my $self = shift;
return if $$self{EXCLUDE};
$self->output ($_[0]), return if $$self{VERBATIM};
local $_ = shift;
my $line = shift;
# Perform a little magic to collapse multiple L<> references. This is
# here mostly for backwards-compatibility. We'll just rewrite the whole
# thing into actual text at this part, bypassing the whole internal
# sequence parsing thing.
s{
(
L< # A link of the form L</something>.
/
(
[:\w]+ # The item has to be a simple word...
(\(\))? # ...or simple function.
)
>
(
,?\s+(and\s+)? # Allow lots of them, conjuncted.
L<
/
(
[:\w]+
(\(\))?
)
>
)+
)
} {
local $_ = $1;
s%L</([^>]+)>%$1%g;
my @items = split /(?:,?\s+(?:and\s+)?)/;
my $string = "the ";
my $i;
for ($i = 0; $i < @items; $i++) {
$string .= $items[$i];
$string .= ", " if @items > 2 && $i != $#items;
$string .= " and " if ($i == $#items - 1);
}
$string .= " entries elsewhere in this document";
$string;
}gex;
# Now actually interpolate and output the paragraph.
$_ = $self->interpolate ($_, $line);
s/\s+$/\n/;
if (defined $$self{ITEM}) {
$self->item ($_ . "\n");
} else {
$self->output ($self->reformat ($_ . "\n"));
}
}
# Called for an interior sequence. Gets the command, argument, and a
# Pod::InteriorSequence object and is expected to return the resulting text.
# Calls code, bold, italic, file, and link to handle those types of
# sequences, and handles S<>, E<>, X<>, and Z<> directly.
sub interior_sequence {
my $self = shift;
my $command = shift;
local $_ = shift;
return '' if ($command eq 'X' || $command eq 'Z');
# Expand escapes into the actual character now, carping if invalid.
if ($command eq 'E') {
return $ESCAPES{$_} if defined $ESCAPES{$_};
carp "Unknown escape: E<$_>";
return "E<$_>";
}
# For all the other sequences, empty content produces no output.
return if $_ eq '';
# For S<>, compress all internal whitespace and then map spaces to \01.
# When we output the text, we'll map this back.
if ($command eq 'S') {
s/\s{2,}/ /g;
tr/ /\01/;
return $_;
}
# Anything else needs to get dispatched to another method.
if ($command eq 'B') { return $self->seq_b ($_) }
elsif ($command eq 'C') { return $self->seq_c ($_) }
elsif ($command eq 'F') { return $self->seq_f ($_) }
elsif ($command eq 'I') { return $self->seq_i ($_) }
elsif ($command eq 'L') { return $self->seq_l ($_) }
else { carp "Unknown sequence $command<$_>" }
}
# Called for each paragraph that's actually part of the POD. We take
# advantage of this opportunity to untabify the input.
sub preprocess_paragraph {
my $self = shift;
local $_ = shift;
1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
$_;
}
############################################################################
# Command paragraphs
############################################################################
# All command paragraphs take the paragraph and the line number.
# First level heading.
sub cmd_head1 {
my $self = shift;
local $_ = shift;
s/\s+$//;
$_ = $self->interpolate ($_, shift);
if ($$self{alt}) {
$self->output ("\n==== $_ ====\n\n");
} else {
$_ .= "\n" if $$self{loose};
$self->output ($_ . "\n");
}
}
# Second level heading.
sub cmd_head2 {
my $self = shift;
local $_ = shift;
s/\s+$//;
$_ = $self->interpolate ($_, shift);
if ($$self{alt}) {
$self->output ("\n== $_ ==\n\n");
} else {
$self->output (' ' x ($$self{indent} / 2) . $_ . "\n\n");
}
}
# Start a list.
sub cmd_over {
my $self = shift;
local $_ = shift;
unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
push (@{ $$self{INDENTS} }, $$self{MARGIN});
$$self{MARGIN} += ($_ + 0);
}
# End a list.
sub cmd_back {
my $self = shift;
$$self{MARGIN} = pop @{ $$self{INDENTS} };
unless (defined $$self{MARGIN}) {
carp "Unmatched =back";
$$self{MARGIN} = $$self{indent};
}
}
# An individual list item.
sub cmd_item {
my $self = shift;
if (defined $$self{ITEM}) { $self->item }
local $_ = shift;
s/\s+$//;
$$self{ITEM} = $self->interpolate ($_);
}
# Begin a block for a particular translator. Setting VERBATIM triggers
# special handling in textblock().
sub cmd_begin {
my $self = shift;
local $_ = shift;
my ($kind) = /^(\S+)/ or return;
if ($kind eq 'text') {
$$self{VERBATIM} = 1;
} else {
$$self{EXCLUDE} = 1;
}
}
# End a block for a particular translator. We assume that all =begin/=end
# pairs are properly closed.
sub cmd_end {
my $self = shift;
$$self{EXCLUDE} = 0;
$$self{VERBATIM} = 0;
}
# One paragraph for a particular translator. Ignore it unless it's intended
# for text, in which case we treat it as a verbatim text block.
sub cmd_for {
my $self = shift;
local $_ = shift;
my $line = shift;
return unless s/^text\b[ \t]*\n?//;
$self->verbatim ($_, $line);
}
############################################################################
# Interior sequences
############################################################################
# The simple formatting ones. These are here mostly so that subclasses can
# override them and do more complicated things.
sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" }
sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
sub seq_i { return '*' . $_[1] . '*' }
# The complicated one. Handle links. Since this is plain text, we can't
# actually make any real links, so this is all to figure out what text we
# print out.
sub seq_l {
my $self = shift;
local $_ = shift;
# Smash whitespace in case we were split across multiple lines.
s/\s+/ /g;
# If we were given any explicit text, just output it.
if (/^([^|]+)\|/) { return $1 }
# Okay, leading and trailing whitespace isn't important; get rid of it.
s/^\s+//;
s/\s+$//;
# Default to using the whole content of the link entry as a section
# name. Note that L<manpage/> forces a manpage interpretation, as does
# something looking like L<manpage(section)>. The latter is an
# enhancement over the original Pod::Text.
my ($manpage, $section) = ('', $_);
if (/^(?:https?|ftp|news):/) {
# a URL
return $_;
} elsif (/^"\s*(.*?)\s*"$/) {
$section = '"' . $1 . '"';
} elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
($manpage, $section) = ($_, '');
} elsif (m%/%) {
($manpage, $section) = split (/\s*\/\s*/, $_, 2);
}
my $text = '';
# Now build the actual output text.
if (!length $section) {
$text = "the $manpage manpage" if length $manpage;
} elsif ($section =~ /^[:\w]+(?:\(\))?/) {
$text .= 'the ' . $section . ' entry';
$text .= (length $manpage) ? " in the $manpage manpage"
: " elsewhere in this document";
} else {
$section =~ s/^\"\s*//;
$section =~ s/\s*\"$//;
$text .= 'the section on "' . $section . '"';
$text .= " in the $manpage manpage" if length $manpage;
}
$text;
}
############################################################################
# List handling
############################################################################
# This method is called whenever an =item command is complete (in other
# words, we've seen its associated paragraph or know for certain that it
# doesn't have one). It gets the paragraph associated with the item as an
# argument. If that argument is empty, just output the item tag; if it
# contains a newline, output the item tag followed by the newline.
# Otherwise, see if there's enough room for us to output the item tag in the
# margin of the text or if we have to put it on a separate line.
sub item {
my $self = shift;
local $_ = shift;
my $tag = $$self{ITEM};
unless (defined $tag) {
carp "item called without tag";
return;
}
undef $$self{ITEM};
my $indent = $$self{INDENTS}[-1];
unless (defined $indent) { $indent = $$self{indent} }
my $space = ' ' x $indent;
$space =~ s/^ /:/ if $$self{alt};
if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
my $margin = $$self{MARGIN};
$$self{MARGIN} = $indent;
my $output = $self->reformat ($tag);
$output =~ s/\n*$/\n/;
$self->output ($output);
$$self{MARGIN} = $margin;
$self->output ($self->reformat ($_)) if /\S/;
} else {
$_ = $self->reformat ($_);
s/^ /:/ if ($$self{alt} && $indent > 0);
my $tagspace = ' ' x length $tag;
s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";
$self->output ($_);
}
}
############################################################################
# Output formatting
############################################################################
# Wrap a line, indenting by the current left margin. We can't use
# Text::Wrap because it plays games with tabs. We can't use formline, even
# though we'd really like to, because it screws up non-printing characters.
# So we have to do the wrapping ourselves.
sub wrap {
my $self = shift;
local $_ = shift;
my $output = '';
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{width} - $$self{MARGIN};
while (length > $width) {
if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) {
$output .= $spaces . $1 . "\n";
} else {
last;
}
}
$output .= $spaces . $_;
$output =~ s/\s+$/\n\n/;
$output;
}
# Reformat a paragraph of text for the current margin. Takes the text to
# reformat and returns the formatted text.
sub reformat {
my $self = shift;
local $_ = shift;
# If we're trying to preserve two spaces after sentences, do some
# munging to support that. Otherwise, smash all repeated whitespace.
if ($$self{sentence}) {
s/ +$//mg;
s/\.\n/. \n/g;
s/\n/ /g;
s/ +/ /g;
} else {
s/\s+/ /g;
}
$self->wrap ($_);
}
# Output text to the output device.
sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
############################################################################
# Backwards compatibility
############################################################################
# The old Pod::Text module did everything in a pod2text() function. This
# tries to provide the same interface for legacy applications.
sub pod2text {
my @args;
# This is really ugly; I hate doing option parsing in the middle of a
# module. But the old Pod::Text module supported passing flags to its
# entry function, so handle -a and -<number>.
while ($_[0] =~ /^-/) {
my $flag = shift;
if ($flag eq '-a') { push (@args, alt => 1) }
elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
else {
unshift (@_, $flag);
last;
}
}
# Now that we know what arguments we're using, create the parser.
my $parser = Pod::PlainText->new (@args);
# If two arguments were given, the second argument is going to be a file
# handle. That means we want to call parse_from_filehandle(), which
# means we need to turn the first argument into a file handle. Magic
# open will handle the <&STDIN case automagically.
if (defined $_[1]) {
local *IN;
unless (open (IN, $_[0])) {
croak ("Can't open $_[0] for reading: $!\n");
return;
}
$_[0] = \*IN;
return $parser->parse_from_filehandle (@_);
} else {
return $parser->parse_from_file (@_);
}
}
############################################################################
# Module return value and documentation
############################################################################
1;
__END__
=head1 NAME
Pod::PlainText - Convert POD data to formatted ASCII text
=head1 SYNOPSIS
use Pod::PlainText;
my $parser = Pod::PlainText->new (sentence => 0, width => 78);
# Read POD from STDIN and write to STDOUT.
$parser->parse_from_filehandle;
# Read POD from file.pod and write to file.txt.
$parser->parse_from_file ('file.pod', 'file.txt');
=head1 DESCRIPTION
Pod::PlainText is a module that can convert documentation in the POD format (the
preferred language for documenting Perl) into formatted ASCII. It uses no
special formatting controls or codes whatsoever, and its output is therefore
suitable for nearly any device.
As a derived class from Pod::Parser, Pod::PlainText supports the same methods and
interfaces. See L<Pod::Parser> for all the details; briefly, one creates a
new parser with C<Pod::PlainText-E<gt>new()> and then calls either
parse_from_filehandle() or parse_from_file().
new() can take options, in the form of key/value pairs, that control the
behavior of the parser. The currently recognized options are:
=over 4
=item alt
If set to a true value, selects an alternate output format that, among other
things, uses a different heading style and marks C<=item> entries with a
colon in the left margin. Defaults to false.
=item indent
The number of spaces to indent regular text, and the default indentation for
C<=over> blocks. Defaults to 4.
=item loose
If set to a true value, a blank line is printed after a C<=head1> heading.
If set to false (the default), no blank line is printed after C<=head1>,
although one is still printed after C<=head2>. This is the default because
it's the expected formatting for manual pages; if you're formatting
arbitrary text documents, setting this to true may result in more pleasing
output.
=item sentence
If set to a true value, Pod::PlainText will assume that each sentence ends in two
spaces, and will try to preserve that spacing. If set to false, all
consecutive whitespace in non-verbatim paragraphs is compressed into a
single space. Defaults to true.
=item width
The column at which to wrap text on the right-hand side. Defaults to 76.
=back
The standard Pod::Parser method parse_from_filehandle() takes up to two
arguments, the first being the file handle to read POD from and the second
being the file handle to write the formatted output to. The first defaults
to STDIN if not given, and the second defaults to STDOUT. The method
parse_from_file() is almost identical, except that its two arguments are the
input and output disk files instead. See L<Pod::Parser> for the specific
details.
=head1 DIAGNOSTICS
=over 4
=item Bizarre space in item
(W) Something has gone wrong in internal C<=item> processing. This message
indicates a bug in Pod::PlainText; you should never see it.
=item Can't open %s for reading: %s
(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface
and the input file it was given could not be opened.
=item Unknown escape: %s
(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::PlainText didn't
know about.
=item Unknown sequence: %s
(W) The POD source contained a non-standard internal sequence (something of
the form C<XE<lt>E<gt>>) that Pod::PlainText didn't know about.
=item Unmatched =back
(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an
C<=over> command.
=back
=head1 RESTRICTIONS
Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on
output, due to an internal implementation detail.
=head1 NOTES
This is a replacement for an earlier Pod::Text module written by Tom
Christiansen. It has a revamped interface, since it now uses Pod::Parser,
but an interface roughly compatible with the old Pod::Text::pod2text()
function is still available. Please change to the new calling convention,
though.
The original Pod::Text contained code to do formatting via termcap
sequences, although it wasn't turned on by default and it was problematic to
get it to work at all. This rewrite doesn't even try to do that, but a
subclass of it does. Look for L<Pod::Text::Termcap|Pod::Text::Termcap>.
=head1 SEE ALSO
L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>,
pod2text(1)
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Russ Allbery E<lt>rra at stanford.eduE<gt>, based I<very> heavily on the
original Pod::Text by Tom Christiansen E<lt>tchrist at mox.perl.comE<gt> and
its conversion to Pod::Parser by Brad Appleton
E<lt>bradapp at enteract.comE<gt>.
=cut
--- NEW FILE: Parser.pm ---
#############################################################################
# Pod/Parser.pm -- package which defines a base class for parsing POD docs.
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::Parser;
use vars qw($VERSION);
$VERSION = 1.32; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
=head1 NAME
[...1760 lines suppressed...]
=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 at enteract.comE<gt>
Based on code for B<Pod::Text> written by
Tom Christiansen E<lt>tchrist at mox.perl.comE<gt>
=cut
1;
# vim: ts=4 sw=4 et
--- NEW FILE: LaTeX.pm ---
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
[...1837 lines suppressed...]
=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.2 2006-12-04 17:00:52 dslinux_cayenne Exp $
=end __PRIVATE__
=cut
1;
--- NEW FILE: Perldoc.pm ---
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';
#..........................................................................
BEGIN { # Make a DEBUG constant very first thing...
unless(defined &DEBUG) {
[...1722 lines suppressed...]
# it'll run faster.
#
# Version 1.01: Tue May 30 14:47:34 EDT 1995
# Andy Dougherty <doughera at 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?
--- NEW FILE: Functions.pm ---
package Pod::Functions;
use strict;
=head1 NAME
Pod::Functions - Group Perl's functions a la perlfunc.pod
=head1 SYNOPSIS
use Pod::Functions;
my @misc_ops = @{ $Kinds{ 'Misc' } };
my $misc_dsc = $Type_Description{ 'Misc' };
or
perl /path/to/lib/Pod/Functions.pm
This will print a grouped list of Perl's functions, like the
L<perlfunc/"Perl Functions by Category"> section.
=head1 DESCRIPTION
It exports the following variables:
=over 4
=item %Kinds
This holds a hash-of-lists. Each list contains the functions in the category
the key denotes.
=item %Type
In this hash each key represents a function and the value is the category.
The category can be a comma separated list.
=item %Flavor
In this hash each key represents a function and the value is a short
description of that function.
=item %Type_Description
In this hash each key represents a category of functions and the value is
a short description of that category.
=item @Type_Order
This list of categories is used to produce the same order as the
L<perlfunc/"Perl Functions by Category"> section.
=back
=head1 CHANGES
1.02 20020813 <abe at ztreet.demon.nl>
de-typo in the SYNOPSIS section (thanks Mike Castle for noticing)
1.01 20011229 <abe at ztreet.demon.nl>
fixed some bugs that slipped in after 5.6.1
added the pod
finished making it strict safe
1.00 ??
first numbered version
=cut
our $VERSION = '1.03';
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(%Kinds %Type %Flavor %Type_Description @Type_Order);
our(%Kinds, %Type, %Flavor);
our %Type_Description = (
'ARRAY' => 'Functions for real @ARRAYs',
'Binary' => 'Functions for fixed length data or records',
'File' => 'Functions for filehandles, files, or directories',
'Flow' => 'Keywords related to control flow of your perl program',
'HASH' => 'Functions for real %HASHes',
'I/O' => 'Input and output functions',
'LIST' => 'Functions for list data',
'Math' => 'Numeric functions',
'Misc' => 'Miscellaneous functions',
'Modules' => 'Keywords related to perl modules',
'Network' => 'Fetching network info',
'Objects' => 'Keywords related to classes and object-orientedness',
'Process' => 'Functions for processes and process groups',
'Regexp' => 'Regular expressions and pattern matching',
'Socket' => 'Low-level socket functions',
'String' => 'Functions for SCALARs or strings',
'SysV' => 'System V interprocess communication functions',
'Time' => 'Time-related functions',
'User' => 'Fetching user and group info',
'Namespace' => 'Keywords altering or affecting scoping of identifiers',
);
our @Type_Order = qw{
String
Regexp
Math
ARRAY
LIST
HASH
I/O
Binary
File
Flow
Namespace
Misc
Process
Modules
Objects
Socket
SysV
User
Network
Time
};
while (<DATA>) {
chomp;
s/#.*//;
next unless $_;
my($name, $type, $text) = split " ", $_, 3;
$Type{$name} = $type;
$Flavor{$name} = $text;
for my $t ( split /[,\s]+/, $type ) {
push @{$Kinds{$t}}, $name;
}
}
close DATA;
my( $typedesc, $list );
unless (caller) {
foreach my $type ( @Type_Order ) {
$list = join(", ", sort @{$Kinds{$type}});
$typedesc = $Type_Description{$type} . ":";
write;
}
}
format =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$typedesc
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$typedesc
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$list
.
1;
__DATA__
-X File a file test (-r, -x, etc)
abs Math absolute value function
accept Socket accept an incoming socket connect
alarm Process schedule a SIGALRM
atan2 Math arctangent of Y/X in the range -PI to PI
bind Socket binds an address to a socket
binmode I/O prepare binary files for I/O
bless Objects create an object
caller Flow,Namespace get context of the current subroutine call
chdir File change your current working directory
chmod File changes the permissions on a list of files
chomp String remove a trailing record separator from a string
chop String remove the last character from a string
chown File change the owership on a list of files
chr String get character this number represents
chroot File make directory new root for path lookups
close I/O close file (or pipe or socket) handle
closedir I/O close directory handle
connect Socket connect to a remote socket
continue Flow optional trailing block in a while or foreach
cos Math cosine function
crypt String one-way passwd-style encryption
dbmclose Objects,I/O breaks binding on a tied dbm file
dbmopen Objects,I/O create binding on a tied dbm file
defined Misc test whether a value, variable, or function is defined
delete HASH deletes a value from a hash
die I/O,Flow raise an exception or bail out
do Flow,Modules turn a BLOCK into a TERM
dump Misc,Flow create an immediate core dump
each HASH retrieve the next key/value pair from a hash
endgrent User be done using group file
endhostent User be done using hosts file
endnetent User be done using networks file
endprotoent Network be done using protocols file
endpwent User be done using passwd file
endservent Network be done using services file
eof I/O test a filehandle for its end
eval Flow,Misc catch exceptions or compile and run code
exec Process abandon this program to run another
exists HASH test whether a hash key is present
exit Flow terminate this program
exp Math raise I<e> to a power
fcntl File file control system call
fileno I/O return file descriptor from filehandle
flock I/O lock an entire file with an advisory lock
fork Process create a new process just like this one
format I/O declare a picture format with use by the write() function
formline Misc internal function used for formats
getc I/O get the next character from the filehandle
getgrent User get next group record
getgrgid User get group record given group user ID
getgrnam User get group record given group name
gethostbyaddr Network get host record given its address
gethostbyname Network get host record given name
gethostent Network get next hosts record
getlogin User return who logged in at this tty
getnetbyaddr Network get network record given its address
getnetbyname Network get networks record given name
getnetent Network get next networks record
getpeername Socket find the other end of a socket connection
getpgrp Process get process group
getppid Process get parent process ID
getpriority Process get current nice value
getprotobyname Network get protocol record given name
getprotobynumber Network get protocol record numeric protocol
getprotoent Network get next protocols record
getpwent User get next passwd record
getpwnam User get passwd record given user login name
getpwuid User get passwd record given user ID
getservbyname Network get services record given its name
getservbyport Network get services record given numeric port
getservent Network get next services record
getsockname Socket retrieve the sockaddr for a given socket
getsockopt Socket get socket options on a given socket
glob File expand filenames using wildcards
gmtime Time convert UNIX time into record or string using Greenwich time
goto Flow create spaghetti code
grep LIST locate elements in a list test true against a given criterion
hex Math,String convert a string to a hexadecimal number
import Modules,Namespace patch a module's namespace into your own
index String find a substring within a string
int Math get the integer portion of a number
ioctl File system-dependent device control system call
join LIST join a list into a string using a separator
keys HASH retrieve list of indices from a hash
kill Process send a signal to a process or process group
last Flow exit a block prematurely
lc String return lower-case version of a string
lcfirst String return a string with just the next letter in lower case
length String return the number of bytes in a string
link File create a hard link in the filesytem
listen Socket register your socket as a server
local Misc,Namespace create a temporary value for a global variable (dynamic scoping)
localtime Time convert UNIX time into record or string using local time
lock Threads get a thread lock on a variable, subroutine, or method
log Math retrieve the natural logarithm for a number
lstat File stat a symbolic link
m// Regexp match a string with a regular expression pattern
map LIST apply a change to a list to get back a new list with the changes
mkdir File create a directory
msgctl SysV SysV IPC message control operations
msgget SysV get SysV IPC message queue
msgrcv SysV receive a SysV IPC message from a message queue
msgsnd SysV send a SysV IPC message to a message queue
my Misc,Namespace declare and assign a local variable (lexical scoping)
next Flow iterate a block prematurely
no Modules unimport some module symbols or semantics at compile time
package Modules,Objects,Namespace declare a separate global namespace
prototype Flow,Misc get the prototype (if any) of a subroutine
oct String,Math convert a string to an octal number
open File open a file, pipe, or descriptor
opendir File open a directory
ord String find a character's numeric representation
our Misc,Namespace declare and assign a package variable (lexical scoping)
pack Binary,String convert a list into a binary representation
pipe Process open a pair of connected filehandles
pop ARRAY remove the last element from an array and return it
pos Regexp find or set the offset for the last/next m//g search
print I/O output a list to a filehandle
printf I/O output a formatted list to a filehandle
push ARRAY append one or more elements to an array
q/STRING/ String singly quote a string
qq/STRING/ String doubly quote a string
quotemeta Regexp quote regular expression magic characters
qw/STRING/ LIST quote a list of words
qx/STRING/ Process backquote quote a string
qr/STRING/ Regexp Compile pattern
rand Math retrieve the next pseudorandom number
read I/O,Binary fixed-length buffered input from a filehandle
readdir I/O get a directory from a directory handle
readline I/O fetch a record from a file
readlink File determine where a symbolic link is pointing
readpipe Process execute a system command and collect standard output
recv Socket receive a message over a Socket
redo Flow start this loop iteration over again
ref Objects find out the type of thing being referenced
rename File change a filename
require Modules load in external functions from a library at runtime
reset Misc clear all variables of a given name
return Flow get out of a function early
reverse String,LIST flip a string or a list
rewinddir I/O reset directory handle
rindex String right-to-left substring search
rmdir File remove a directory
s/// Regexp replace a pattern with a string
scalar Misc force a scalar context
seek I/O reposition file pointer for random-access I/O
seekdir I/O reposition directory pointer
select I/O reset default output or do I/O multiplexing
semctl SysV SysV semaphore control operations
semget SysV get set of SysV semaphores
semop SysV SysV semaphore operations
send Socket send a message over a socket
setgrent User prepare group file for use
sethostent Network prepare hosts file for use
setnetent Network prepare networks file for use
setpgrp Process set the process group of a process
setpriority Process set a process's nice value
setprotoent Network prepare protocols file for use
setpwent User prepare passwd file for use
setservent Network prepare services file for use
setsockopt Socket set some socket options
shift ARRAY remove the first element of an array, and return it
shmctl SysV SysV shared memory operations
shmget SysV get SysV shared memory segment identifier
shmread SysV read SysV shared memory
shmwrite SysV write SysV shared memory
shutdown Socket close down just half of a socket connection
sin Math return the sine of a number
sleep Process block for some number of seconds
socket Socket create a socket
socketpair Socket create a pair of sockets
sort LIST sort a list of values
splice ARRAY add or remove elements anywhere in an array
split Regexp split up a string using a regexp delimiter
sprintf String formatted print into a string
sqrt Math square root function
srand Math seed the random number generator
stat File get a file's status information
study Regexp optimize input data for repeated searches
sub Flow declare a subroutine, possibly anonymously
substr String get or alter a portion of a stirng
symlink File create a symbolic link to a file
syscall I/O,Binary execute an arbitrary system call
sysopen File open a file, pipe, or descriptor
sysread I/O,Binary fixed-length unbuffered input from a filehandle
sysseek I/O,Binary position I/O pointer on handle used with sysread and syswrite
system Process run a separate program
syswrite I/O,Binary fixed-length unbuffered output to a filehandle
tell I/O get current seekpointer on a filehandle
telldir I/O get current seekpointer on a directory handle
tie Objects bind a variable to an object class
tied Objects get a reference to the object underlying a tied variable
time Time return number of seconds since 1970
times Process,Time return elapsed time for self and child processes
tr/// String transliterate a string
truncate I/O shorten a file
uc String return upper-case version of a string
ucfirst String return a string with just the next letter in upper case
umask File set file creation mode mask
undef Misc remove a variable or function definition
unlink File remove one link to a file
unpack Binary,LIST convert binary structure into normal perl variables
unshift ARRAY prepend more elements to the beginning of a list
untie Objects break a tie binding to a variable
use Modules,Namespace load a module and import its namespace
use Objects load in a module at compile time
utime File set a file's last access and modify times
values HASH return a list of the values in a hash
vec Binary test or set particular bits in a string
wait Process wait for any child process to die
waitpid Process wait for a particular child process to die
wantarray Misc,Flow get void vs scalar vs list context of current subroutine call
warn I/O print debugging info
write I/O print a picture record
y/// String transliterate a string
--- NEW FILE: Text.pm ---
# Pod::Text -- Convert POD data to formatted ASCII text.
# $Id: Text.pm,v 1.2 2006-12-04 17:00:55 dslinux_cayenne Exp $
#
# Copyright 1999, 2000, 2001, 2002 by Russ Allbery <rra at 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 Carp qw(carp croak);
use Exporter ();
use Pod::ParseLink qw(parselink);
use Pod::Select ();
use strict;
use vars qw(@ISA @EXPORT %ESCAPES $VERSION);
# We inherit from Pod::Select instead of Pod::Parser so that we can be used by
# Pod::Usage.
@ISA = qw(Pod::Select Exporter);
# We have to export pod2text for backward compatibility.
@EXPORT = qw(pod2text);
# Don't use the CVS revision as the version, since this module is also in Perl
# core and too many things could munge CVS magic revision strings. This
# number should ideally be the same as the CVS revision in podlators, however.
$VERSION = 2.21;
##############################################################################
# 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. :) "iexcl" to
# "divide" added by Tim Jenness.
%ESCAPES = (
'amp' => '&', # ampersand
'apos' => "'", # apostrophe
'lt' => '<', # left chevron, less-than
'gt' => '>', # right chevron, greater-than
'quot' => '"', # double quote
'sol' => '/', # solidus (forward slash)
'verbar' => '|', # vertical bar
"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" => "\xCC", # capital I, grave accent
"igrave" => "\xEC", # 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
"laquo" => "\xAB", # left pointing double angle quotation mark
"lchevron" => "\xAB", # synonym (backwards compatibility)
"raquo" => "\xBB", # right pointing double angle quotation mark
"rchevron" => "\xBB", # synonym (backwards compatibility)
"iexcl" => "\xA1", # inverted exclamation mark
"cent" => "\xA2", # cent sign
"pound" => "\xA3", # (UK) pound sign
"curren" => "\xA4", # currency sign
"yen" => "\xA5", # yen sign
"brvbar" => "\xA6", # broken vertical bar
"sect" => "\xA7", # section sign
"uml" => "\xA8", # diaresis
"copy" => "\xA9", # Copyright symbol
"ordf" => "\xAA", # feminine ordinal indicator
"not" => "\xAC", # not sign
"shy" => '', # soft (discretionary) hyphen
"reg" => "\xAE", # registered trademark
"macr" => "\xAF", # macron, overline
"deg" => "\xB0", # degree sign
"plusmn" => "\xB1", # plus-minus sign
"sup2" => "\xB2", # superscript 2
"sup3" => "\xB3", # superscript 3
"acute" => "\xB4", # acute accent
"micro" => "\xB5", # micro sign
"para" => "\xB6", # pilcrow sign = paragraph sign
"middot" => "\xB7", # middle dot = Georgian comma
"cedil" => "\xB8", # cedilla
"sup1" => "\xB9", # superscript 1
"ordm" => "\xBA", # masculine ordinal indicator
"frac14" => "\xBC", # vulgar fraction one quarter
"frac12" => "\xBD", # vulgar fraction one half
"frac34" => "\xBE", # vulgar fraction three quarters
"iquest" => "\xBF", # inverted question mark
"times" => "\xD7", # multiplication sign
"divide" => "\xF7", # division sign
"nbsp" => "\x01", # non-breaking space
);
##############################################################################
# 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{margin} = 0 unless defined $$self{margin};
$$self{loose} = 0 unless defined $$self{loose};
$$self{sentence} = 0 unless defined $$self{sentence};
$$self{width} = 76 unless defined $$self{width};
# Figure out what quotes we'll be using for C<> text.
$$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}");
}
# Stack of indentations.
$$self{INDENTS} = [];
# Current left margin.
$$self{MARGIN} = $$self{indent} + $$self{margin};
$self->SUPER::initialize;
# Tell Pod::Parser that we want the non-POD stuff too if code was set.
$self->parseopts ('-want_nonPODs' => 1) if $$self{code};
}
##############################################################################
# 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 ($self->can ('cmd_' . $command)) {
$command = 'cmd_' . $command;
$self->$command (@_);
} else {
my ($text, $line, $paragraph) = @_;
my $file;
($file, $line) = $paragraph->file_line;
$text =~ s/\n+\z//;
$text = " $text" if ($text =~ /^\S/);
warn qq($file:$line: Unknown command paragraph: =$command$text\n);
return;
}
}
# Called for a verbatim paragraph. Gets the paragraph, the line number, and a
# Pod::Paragraph object. Just output it verbatim, but with tabs converted to
# spaces.
sub verbatim {
my $self = shift;
return if $$self{EXCLUDE};
$self->item if defined $$self{ITEM};
local $_ = shift;
return if /^\s*$/;
s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
$self->output ($_);
}
# Called for a regular text block. Gets the paragraph, the line number, and a
# Pod::Paragraph object. Perform interpolation and output the results.
sub textblock {
my $self = shift;
return if $$self{EXCLUDE};
$self->output ($_[0]), return if $$self{VERBATIM};
local $_ = shift;
my $line = shift;
# Interpolate and output the paragraph.
$_ = $self->interpolate ($_, $line);
s/\s+$/\n/;
if (defined $$self{ITEM}) {
$self->item ($_ . "\n");
} else {
$self->output ($self->reformat ($_ . "\n"));
}
}
# Called for a formatting code. Gets the command, argument, and a
# Pod::InteriorSequence object and is expected to return the resulting text.
# Calls methods for code, bold, italic, file, and link to handle those types
# of codes, and handles S<>, E<>, X<>, and Z<> directly.
sub interior_sequence {
local $_;
my ($self, $command, $seq);
($self, $command, $_, $seq) = @_;
# We have to defer processing of the inside of an L<> formatting code. If
# this code is nested inside an L<> code, return the literal raw text of
# it.
my $parent = $seq->nested;
while (defined $parent) {
return $seq->raw_text if ($parent->cmd_name eq 'L');
$parent = $parent->nested;
}
# Index entries are ignored in plain text.
return '' if ($command eq 'X' || $command eq 'Z');
# Expand escapes into the actual character now, warning if invalid.
if ($command eq 'E') {
if (/^\d+$/) {
return chr;
} else {
return $ESCAPES{$_} if defined $ESCAPES{$_};
my ($file, $line) = $seq->file_line;
warn "$file:$line: Unknown escape: E<$_>\n";
return "E<$_>";
}
}
# For all the other formatting codes, 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+/ /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 ($_, $seq) }
else {
my ($file, $line) = $seq->file_line;
warn "$file:$line: Unknown formatting code: $command<$_>\n";
}
}
# Called for each paragraph that's actually part of the POD. We take
# advantage of this opportunity to untabify the input. Also, if given the
# code option, we may see paragraphs that aren't part of the POD and need to
# output them directly.
sub preprocess_paragraph {
my $self = shift;
local $_ = shift;
1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
$self->output_code ($_) if $self->cutting;
$_;
}
##############################################################################
# Command paragraphs
##############################################################################
# All command paragraphs take the paragraph and the line number.
# First level heading.
sub cmd_head1 {
my ($self, $text, $line) = @_;
$self->heading ($text, $line, 0, '====');
}
# Second level heading.
sub cmd_head2 {
my ($self, $text, $line) = @_;
$self->heading ($text, $line, $$self{indent} / 2, '== ');
}
# Third level heading.
sub cmd_head3 {
my ($self, $text, $line) = @_;
$self->heading ($text, $line, $$self{indent} * 2 / 3 + 0.5, '= ');
}
# Third level heading.
sub cmd_head4 {
my ($self, $text, $line) = @_;
$self->heading ($text, $line, $$self{indent} * 3 / 4 + 0.5, '- ');
}
# Start a list.
sub cmd_over {
my $self = shift;
local $_ = shift;
$self->item ("\n\n") if defined $$self{ITEM};
unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
push (@{ $$self{INDENTS} }, $$self{MARGIN});
$$self{MARGIN} += ($_ + 0);
}
# End a list.
sub cmd_back {
my ($self, $text, $line, $paragraph) = @_;
$self->item ("\n\n") if defined $$self{ITEM};
$$self{MARGIN} = pop @{ $$self{INDENTS} };
unless (defined $$self{MARGIN}) {
my $file;
($file, $line) = $paragraph->file_line;
warn "$file:$line: Unmatched =back\n";
$$self{MARGIN} = $$self{indent};
}
}
# An individual list item.
sub cmd_item {
my $self = shift;
if (defined $$self{ITEM}) { $self->item }
local $_ = shift;
s/\s+$//;
$$self{ITEM} = $_ ? $self->interpolate ($_) : '*';
}
# Begin a block for a particular translator. Setting VERBATIM triggers
# special handling in textblock().
sub cmd_begin {
my $self = shift;
local $_ = shift;
my ($kind) = /^(\S+)/ or return;
if ($kind eq 'text') {
$$self{VERBATIM} = 1;
} else {
$$self{EXCLUDE} = 1;
}
}
# End a block for a particular translator. We assume that all =begin/=end
# pairs are properly closed.
sub cmd_end {
my $self = shift;
$$self{EXCLUDE} = 0;
$$self{VERBATIM} = 0;
}
# One paragraph for a particular translator. Ignore it unless it's intended
# for text, in which case we treat it as a verbatim text block.
sub cmd_for {
my $self = shift;
local $_ = shift;
my $line = shift;
return unless s/^text\b[ \t]*\n?//;
$self->verbatim ($_, $line);
}
##############################################################################
# Formatting codes
##############################################################################
# The simple 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_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
sub seq_i { return '*' . $_[1] . '*' }
# 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 seq_c {
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
| \` .* \' # `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 $_;
# If we didn't return, go ahead and quote the text.
return $$self{alt} ? "``$_''" : "$$self{LQUOTE}$_$$self{RQUOTE}";
}
# 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. Most of the
# work is done by Pod::ParseLink.
sub seq_l {
my ($self, $link, $seq) = @_;
my ($text, $type) = (parselink ($link))[1,4];
my ($file, $line) = $seq->file_line;
$text = $self->interpolate ($text, $line);
$text = '<' . $text . '>' if $type eq 'url';
return $text || '';
}
##############################################################################
# Header handling
##############################################################################
# The common code for handling all headers. Takes the interpolated header
# text, the line number, the indentation, and the surrounding marker for the
# alt formatting method.
sub heading {
my ($self, $text, $line, $indent, $marker) = @_;
$self->item ("\n\n") if defined $$self{ITEM};
$text =~ s/\s+$//;
$text = $self->interpolate ($text, $line);
if ($$self{alt}) {
my $closemark = reverse (split (//, $marker));
my $margin = ' ' x $$self{margin};
$self->output ("\n" . "$margin$marker $text $closemark" . "\n\n");
} else {
$text .= "\n" if $$self{loose};
my $margin = ' ' x ($$self{margin} + $indent);
$self->output ($margin . $text . "\n");
}
}
##############################################################################
# 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 $margin = ' ' x $$self{margin};
if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
my $realindent = $$self{MARGIN};
$$self{MARGIN} = $indent;
my $output = $self->reformat ($tag);
$output =~ s/^$margin /$margin:/ if ($$self{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 $_ && $_ =~ /^\s*$/;
$self->output ($output);
$$self{MARGIN} = $realindent;
$self->output ($self->reformat ($_)) if $_ && /\S/;
} else {
my $space = ' ' x $indent;
$space =~ s/^$margin /$margin:/ if $$self{alt};
$_ = $self->reformat ($_);
s/^$margin /$margin:/ if ($$self{alt} && $indent > 0);
my $tagspace = ' ' x length $tag;
s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";
$self->output ($_);
}
}
##############################################################################
# Output formatting
##############################################################################
# Wrap a line, indenting by the current left margin. We can't use Text::Wrap
# because it plays games with tabs. We can't use formline, even though we'd
# really like to, because it screws up non-printing characters. So we have to
# do the wrapping ourselves.
sub wrap {
my $self = shift;
local $_ = shift;
my $output = '';
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{width} - $$self{MARGIN};
while (length > $width) {
if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) {
$output .= $spaces . $1 . "\n";
} else {
last;
}
}
$output .= $spaces . $_;
$output =~ s/\s+$/\n\n/;
$output;
}
# Reformat a paragraph of text for the current margin. Takes the text to
# reformat and returns the formatted text.
sub reformat {
my $self = shift;
local $_ = shift;
# If we're trying to preserve two spaces after sentences, do some munging
# to support that. Otherwise, smash all repeated whitespace.
if ($$self{sentence}) {
s/ +$//mg;
s/\.\n/. \n/g;
s/\n/ /g;
s/ +/ /g;
} else {
s/\s+/ /g;
}
$self->wrap ($_);
}
# Output text to the output device.
sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
# 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]) }
##############################################################################
# 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;
return $parser->parse_from_filehandle (@fhs);
} else {
return $parser->parse_from_file (@_);
}
}
##############################################################################
# Module return value and documentation
##############################################################################
1;
__END__
=head1 NAME
Pod::Text - Convert POD data to formatted ASCII text
=head1 SYNOPSIS
use Pod::Text;
my $parser = Pod::Text->new (sentence => 0, width => 78);
# Read POD from STDIN and write to STDOUT.
$parser->parse_from_filehandle;
# Read POD from file.pod and write to file.txt.
$parser->parse_from_file ('file.pod', 'file.txt');
=head1 DESCRIPTION
Pod::Text is a module that can convert documentation in the POD format (the
preferred language for documenting Perl) into formatted ASCII. It uses no
special formatting controls or codes whatsoever, and its output is therefore
suitable for nearly any device.
As a derived class from Pod::Parser, Pod::Text supports the same methods and
interfaces. See L<Pod::Parser> for all the details; briefly, one creates a
new parser with C<< Pod::Text->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 code
If set to a true value, the non-POD parts of the input file will be included
in the output. Useful for viewing code documented with POD blocks with the
POD rendered and the code left intact.
=item indent
The number of spaces to indent regular text, and the default indentation for
C<=over> blocks. Defaults to 4.
=item loose
If set to a true value, a blank line is printed after a C<=head1> heading.
If set to false (the default), no blank line is printed after C<=head1>,
although one is still printed after C<=head2>. This is the default because
it's the expected formatting for manual pages; if you're formatting
arbitrary text documents, setting this to true may result in more pleasing
output.
=item margin
The width of the left margin in spaces. Defaults to 0. This is the margin
for all text, including headings, not the amount by which regular text is
indented; for the latter, see the I<indent> option. To set the right
margin, see the I<width> option.
=item quotes
Sets the quote marks used to surround CE<lt>> text. If the value is a
single character, it is used as both the left and right quote; if it is two
characters, the first character is used as the left quote and the second as
the right quoted; and if it is four characters, the first two are used as
the left quote and the second two as the right quote.
This may also be set to the special value C<none>, in which case no quote
marks are added around CE<lt>> text.
=item sentence
If set to a true value, Pod::Text will assume that each sentence ends in two
spaces, and will try to preserve that spacing. If set to false, all
consecutive whitespace in non-verbatim paragraphs is compressed into a
single space. Defaults to true.
=item width
The column at which to wrap text on the right-hand side. Defaults to 76.
=back
The standard Pod::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
=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.
=item %s:%d: Unknown command paragraph: %s
(W) The POD source contained a non-standard command paragraph (something of
the form C<=command args>) that Pod::Man didn't know about. It was ignored.
=item %s:%d: Unknown escape: %s
(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::Text didn't
know about.
=item %s:%d: Unknown formatting code: %s
(W) The POD source contained a non-standard formatting code (something of
the form C<XE<lt>E<gt>>) that Pod::Text didn't know about.
=item %s:%d: Unmatched =back
(W) Pod::Text 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>.
=head1 SEE ALSO
L<Pod::Parser>, L<Pod::Text::Termcap>, L<pod2text(1)>
The current version of this module is always available from its web site at
L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the
Perl core distribution as of 5.6.0.
=head1 AUTHOR
Russ Allbery <rra at stanford.edu>, based I<very> heavily on the original
Pod::Text by Tom Christiansen <tchrist at mox.perl.com> and its conversion to
Pod::Parser by Brad Appleton <bradapp at enteract.com>.
=head1 COPYRIGHT AND LICENSE
Copyright 1999, 2000, 2001, 2002 by Russ Allbery <rra at stanford.edu>.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut
--- NEW FILE: InputObjects.pm ---
#############################################################################
# Pod/InputObjects.pm -- package which defines objects for input streams
# and paragraphs and commands when parsing POD docs.
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::InputObjects;
use vars qw($VERSION);
$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
=head1 NAME
Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
=head1 SYNOPSIS
use Pod::InputObjects;
=head1 REQUIRES
perl5.004, Carp
=head1 EXPORTS
Nothing.
=head1 DESCRIPTION
This module defines some basic input objects used by B<Pod::Parser> when
reading and parsing POD text from an input source. The following objects
are defined:
=over 4
=begin __PRIVATE__
=item package B<Pod::InputSource>
An object corresponding to a source of POD input text. It is mostly a
wrapper around a filehandle or C<IO::Handle>-type object (or anything
that implements the C<getline()> method) which keeps track of some
additional information relevant to the parsing of PODs.
=end __PRIVATE__
=item package B<Pod::Paragraph>
An object corresponding to a paragraph of POD input text. It may be a
plain paragraph, a verbatim paragraph, or a command paragraph (see
L<perlpod>).
=item package B<Pod::InteriorSequence>
An object corresponding to an interior sequence command from the POD
input text (see L<perlpod>).
=item package B<Pod::ParseTree>
An object corresponding to a tree of parsed POD text. Each "node" in
a parse-tree (or I<ptree>) is either a text-string or a reference to
a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
in the order in which they were parsed from left-to-right.
=back
Each of these input objects are described in further detail in the
sections which follow.
=cut
#############################################################################
use strict;
#use diagnostics;
#use Carp;
#############################################################################
package Pod::InputSource;
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head1 B<Pod::InputSource>
This object corresponds to an input source or stream of POD
documentation. When parsing PODs, it is necessary to associate and store
certain context information with each input source. All of this
information is kept together with the stream itself in one of these
C<Pod::InputSource> objects. Each such object is merely a wrapper around
an C<IO::Handle> object of some kind (or at least something that
implements the C<getline()> method). They have the following
methods/attributes:
=end __PRIVATE__
=cut
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<new()>
my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
my $pod_input2 = new Pod::InputSource(-handle => $filehandle,
-name => $name);
my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);
my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,
-name => "(STDIN)");
This is a class method that constructs a C<Pod::InputSource> object and
returns a reference to the new input source object. It takes one or more
keyword arguments in the form of a hash. The keyword C<-handle> is
required and designates the corresponding input handle. The keyword
C<-name> is optional and specifies the name associated with the input
handle (typically a file name).
=end __PRIVATE__
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
## Any remaining arguments are treated as initial values for the
## hash that is used to represent this object. Note that we default
## certain values by specifying them *before* the arguments passed.
## If they are in the argument list, they will override the defaults.
my $self = { -name => '(unknown)',
-handle => undef,
-was_cutting => 0,
@_ };
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<name()>
my $filename = $pod_input->name();
$pod_input->name($new_filename_to_use);
This method gets/sets the name of the input source (usually a filename).
If no argument is given, it returns a string containing the name of
the input source; otherwise it sets the name of the input source to the
contents of the given argument.
=end __PRIVATE__
=cut
sub name {
(@_ > 1) and $_[0]->{'-name'} = $_[1];
return $_[0]->{'-name'};
}
## allow 'filename' as an alias for 'name'
*filename = \&name;
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<handle()>
my $handle = $pod_input->handle();
Returns a reference to the handle object from which input is read (the
one used to contructed this input source object).
=end __PRIVATE__
=cut
sub handle {
return $_[0]->{'-handle'};
}
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<was_cutting()>
print "Yes.\n" if ($pod_input->was_cutting());
The value of the C<cutting> state (that the B<cutting()> method would
have returned) immediately before any input was read from this input
stream. After all input from this stream has been read, the C<cutting>
state is restored to this value.
=end __PRIVATE__
=cut
sub was_cutting {
(@_ > 1) and $_[0]->{-was_cutting} = $_[1];
return $_[0]->{-was_cutting};
}
##---------------------------------------------------------------------------
#############################################################################
package Pod::Paragraph;
##---------------------------------------------------------------------------
=head1 B<Pod::Paragraph>
An object representing a paragraph of POD input text.
It has the following methods/attributes:
=cut
##---------------------------------------------------------------------------
=head2 Pod::Paragraph-E<gt>B<new()>
my $pod_para1 = Pod::Paragraph->new(-text => $text);
my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
-text => $text);
my $pod_para3 = new Pod::Paragraph(-text => $text);
my $pod_para4 = new Pod::Paragraph(-name => $cmd,
-text => $text);
my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
-text => $text,
-file => $filename,
-line => $line_number);
This is a class method that constructs a C<Pod::Paragraph> object and
returns a reference to the new paragraph object. It may be given one or
two keyword arguments. The C<-text> keyword indicates the corresponding
text of the POD paragraph. The C<-name> keyword indicates the name of
the corresponding POD command, such as C<head1> or C<item> (it should
I<not> contain the C<=> prefix); this is needed only if the POD
paragraph corresponds to a command paragraph. The C<-file> and C<-line>
keywords indicate the filename and line number corresponding to the
beginning of the paragraph
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
## Any remaining arguments are treated as initial values for the
## hash that is used to represent this object. Note that we default
## certain values by specifying them *before* the arguments passed.
## If they are in the argument list, they will override the defaults.
my $self = {
-name => undef,
-text => (@_ == 1) ? shift : undef,
-file => '<unknown-file>',
-line => 0,
-prefix => '=',
-separator => ' ',
-ptree => [],
@_
};
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<cmd_name()>
my $para_cmd = $pod_para->cmd_name();
If this paragraph is a command paragraph, then this method will return
the name of the command (I<without> any leading C<=> prefix).
=cut
sub cmd_name {
(@_ > 1) and $_[0]->{'-name'} = $_[1];
return $_[0]->{'-name'};
}
## let name() be an alias for cmd_name()
*name = \&cmd_name;
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<text()>
my $para_text = $pod_para->text();
This method will return the corresponding text of the paragraph.
=cut
sub text {
(@_ > 1) and $_[0]->{'-text'} = $_[1];
return $_[0]->{'-text'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<raw_text()>
my $raw_pod_para = $pod_para->raw_text();
This method will return the I<raw> text of the POD paragraph, exactly
as it appeared in the input.
=cut
sub raw_text {
return $_[0]->{'-text'} unless (defined $_[0]->{'-name'});
return $_[0]->{'-prefix'} . $_[0]->{'-name'} .
$_[0]->{'-separator'} . $_[0]->{'-text'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<cmd_prefix()>
my $prefix = $pod_para->cmd_prefix();
If this paragraph is a command paragraph, then this method will return
the prefix used to denote the command (which should be the string "="
or "==").
=cut
sub cmd_prefix {
return $_[0]->{'-prefix'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<cmd_separator()>
my $separator = $pod_para->cmd_separator();
If this paragraph is a command paragraph, then this method will return
the text used to separate the command name from the rest of the
paragraph (if any).
=cut
sub cmd_separator {
return $_[0]->{'-separator'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<parse_tree()>
my $ptree = $pod_parser->parse_text( $pod_para->text() );
$pod_para->parse_tree( $ptree );
$ptree = $pod_para->parse_tree();
This method will get/set the corresponding parse-tree of the paragraph's text.
=cut
sub parse_tree {
(@_ > 1) and $_[0]->{'-ptree'} = $_[1];
return $_[0]->{'-ptree'};
}
## let ptree() be an alias for parse_tree()
*ptree = \&parse_tree;
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<file_line()>
my ($filename, $line_number) = $pod_para->file_line();
my $position = $pod_para->file_line();
Returns the current filename and line number for the paragraph
object. If called in a list context, it returns a list of two
elements: first the filename, then the line number. If called in
a scalar context, it returns a string containing the filename, followed
by a colon (':'), followed by the line number.
=cut
sub file_line {
my @loc = ($_[0]->{'-file'} || '<unknown-file>',
$_[0]->{'-line'} || 0);
return (wantarray) ? @loc : join(':', @loc);
}
##---------------------------------------------------------------------------
#############################################################################
package Pod::InteriorSequence;
##---------------------------------------------------------------------------
=head1 B<Pod::InteriorSequence>
An object representing a POD interior sequence command.
It has the following methods/attributes:
=cut
##---------------------------------------------------------------------------
=head2 Pod::InteriorSequence-E<gt>B<new()>
my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
-ldelim => $delimiter);
my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,
-ldelim => $delimiter);
my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,
-ldelim => $delimiter,
-file => $filename,
-line => $line_number);
my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
This is a class method that constructs a C<Pod::InteriorSequence> object
and returns a reference to the new interior sequence object. It should
be given two keyword arguments. The C<-ldelim> keyword indicates the
corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
The C<-name> keyword indicates the name of the corresponding interior
sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
C<-line> keywords indicate the filename and line number corresponding
to the beginning of the interior sequence. If the C<$ptree> argument is
given, it must be the last argument, and it must be either string, or
else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
it may be a reference to a Pod::ParseTree object).
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
## See if first argument has no keyword
if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {
## Yup - need an implicit '-name' before first parameter
unshift @_, '-name';
}
## See if odd number of args
if ((@_ % 2) != 0) {
## Yup - need an implicit '-ptree' before the last parameter
splice @_, $#_, 0, '-ptree';
}
## Any remaining arguments are treated as initial values for the
## hash that is used to represent this object. Note that we default
## certain values by specifying them *before* the arguments passed.
## If they are in the argument list, they will override the defaults.
my $self = {
-name => (@_ == 1) ? $_[0] : undef,
-file => '<unknown-file>',
-line => 0,
-ldelim => '<',
-rdelim => '>',
@_
};
## Initialize contents if they havent been already
my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
if ( ref $ptree =~ /^(ARRAY)?$/ ) {
## We have an array-ref, or a normal scalar. Pass it as an
## an argument to the ptree-constructor
$ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
}
$self->{'-ptree'} = $ptree;
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<cmd_name()>
my $seq_cmd = $pod_seq->cmd_name();
The name of the interior sequence command.
=cut
sub cmd_name {
(@_ > 1) and $_[0]->{'-name'} = $_[1];
return $_[0]->{'-name'};
}
## let name() be an alias for cmd_name()
*name = \&cmd_name;
##---------------------------------------------------------------------------
## Private subroutine to set the parent pointer of all the given
## children that are interior-sequences to be $self
sub _set_child2parent_links {
my ($self, @children) = @_;
## Make sure any sequences know who their parent is
for (@children) {
next unless (length and ref and ref ne 'SCALAR');
if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
UNIVERSAL::can($_, 'nested'))
{
$_->nested($self);
}
}
}
## Private subroutine to unset child->parent links
sub _unset_child2parent_links {
my $self = shift;
$self->{'-parent_sequence'} = undef;
my $ptree = $self->{'-ptree'};
for (@$ptree) {
next unless (length and ref and ref ne 'SCALAR');
$_->_unset_child2parent_links()
if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
}
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<prepend()>
$pod_seq->prepend($text);
$pod_seq1->prepend($pod_seq2);
Prepends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.
=cut
sub prepend {
my $self = shift;
$self->{'-ptree'}->prepend(@_);
_set_child2parent_links($self, @_);
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<append()>
$pod_seq->append($text);
$pod_seq1->append($pod_seq2);
Appends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.
=cut
sub append {
my $self = shift;
$self->{'-ptree'}->append(@_);
_set_child2parent_links($self, @_);
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<nested()>
$outer_seq = $pod_seq->nested || print "not nested";
If this interior sequence is nested inside of another interior
sequence, then the outer/parent sequence that contains it is
returned. Otherwise C<undef> is returned.
=cut
sub nested {
my $self = shift;
(@_ == 1) and $self->{'-parent_sequence'} = shift;
return $self->{'-parent_sequence'} || undef;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<raw_text()>
my $seq_raw_text = $pod_seq->raw_text();
This method will return the I<raw> text of the POD interior sequence,
exactly as it appeared in the input.
=cut
sub raw_text {
my $self = shift;
my $text = $self->{'-name'} . $self->{'-ldelim'};
for ( $self->{'-ptree'}->children ) {
$text .= (ref $_) ? $_->raw_text : $_;
}
$text .= $self->{'-rdelim'};
return $text;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<left_delimiter()>
my $ldelim = $pod_seq->left_delimiter();
The leftmost delimiter beginning the argument text to the interior
sequence (should be "<").
=cut
sub left_delimiter {
(@_ > 1) and $_[0]->{'-ldelim'} = $_[1];
return $_[0]->{'-ldelim'};
}
## let ldelim() be an alias for left_delimiter()
*ldelim = \&left_delimiter;
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<right_delimiter()>
The rightmost delimiter beginning the argument text to the interior
sequence (should be ">").
=cut
sub right_delimiter {
(@_ > 1) and $_[0]->{'-rdelim'} = $_[1];
return $_[0]->{'-rdelim'};
}
## let rdelim() be an alias for right_delimiter()
*rdelim = \&right_delimiter;
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<parse_tree()>
my $ptree = $pod_parser->parse_text($paragraph_text);
$pod_seq->parse_tree( $ptree );
$ptree = $pod_seq->parse_tree();
This method will get/set the corresponding parse-tree of the interior
sequence's text.
=cut
sub parse_tree {
(@_ > 1) and $_[0]->{'-ptree'} = $_[1];
return $_[0]->{'-ptree'};
}
## let ptree() be an alias for parse_tree()
*ptree = \&parse_tree;
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<file_line()>
my ($filename, $line_number) = $pod_seq->file_line();
my $position = $pod_seq->file_line();
Returns the current filename and line number for the interior sequence
object. If called in a list context, it returns a list of two
elements: first the filename, then the line number. If called in
a scalar context, it returns a string containing the filename, followed
by a colon (':'), followed by the line number.
=cut
sub file_line {
my @loc = ($_[0]->{'-file'} || '<unknown-file>',
$_[0]->{'-line'} || 0);
return (wantarray) ? @loc : join(':', @loc);
}
##---------------------------------------------------------------------------
=head2 Pod::InteriorSequence::B<DESTROY()>
This method performs any necessary cleanup for the interior-sequence.
If you override this method then it is B<imperative> that you invoke
the parent method from within your own method, otherwise
I<interior-sequence storage will not be reclaimed upon destruction!>
=cut
sub DESTROY {
## We need to get rid of all child->parent pointers throughout the
## tree so their reference counts will go to zero and they can be
## garbage-collected
_unset_child2parent_links(@_);
}
##---------------------------------------------------------------------------
#############################################################################
package Pod::ParseTree;
##---------------------------------------------------------------------------
=head1 B<Pod::ParseTree>
This object corresponds to a tree of parsed POD text. As POD text is
scanned from left to right, it is parsed into an ordered list of
text-strings and B<Pod::InteriorSequence> objects (in order of
appearance). A B<Pod::ParseTree> object corresponds to this list of
strings and sequences. Each interior sequence in the parse-tree may
itself contain a parse-tree (since interior sequences may be nested).
=cut
##---------------------------------------------------------------------------
=head2 Pod::ParseTree-E<gt>B<new()>
my $ptree1 = Pod::ParseTree->new;
my $ptree2 = new Pod::ParseTree;
my $ptree4 = Pod::ParseTree->new($array_ref);
my $ptree3 = new Pod::ParseTree($array_ref);
This is a class method that constructs a C<Pod::Parse_tree> object and
returns a reference to the new parse-tree. If a single-argument is given,
it must be a reference to an array, and is used to initialize the root
(top) of the parse tree.
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
my $self = (@_ == 1 and ref $_[0]) ? $_[0] : [];
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<top()>
my $top_node = $ptree->top();
$ptree->top( $top_node );
$ptree->top( @children );
This method gets/sets the top node of the parse-tree. If no arguments are
given, it returns the topmost node in the tree (the root), which is also
a B<Pod::ParseTree>. If it is given a single argument that is a reference,
then the reference is assumed to a parse-tree and becomes the new top node.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.
=cut
sub top {
my $self = shift;
if (@_ > 0) {
@{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
}
return $self;
}
## let parse_tree() & ptree() be aliases for the 'top' method
*parse_tree = *ptree = \⊤
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<children()>
This method gets/sets the children of the top node in the parse-tree.
If no arguments are given, it returns the list (array) of children
(each of which should be either a string or a B<Pod::InteriorSequence>.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.
=cut
sub children {
my $self = shift;
if (@_ > 0) {
@{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
}
return @{ $self };
}
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<prepend()>
This method prepends the given text or parse-tree to the current parse-tree.
If the first item on the parse-tree is text and the argument is also text,
then the text is prepended to the first item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<before>
the current one.
=cut
use vars qw(@ptree); ## an alias used for performance reasons
sub prepend {
my $self = shift;
local *ptree = $self;
for (@_) {
next unless length;
if (@ptree and !(ref $ptree[0]) and !(ref $_)) {
$ptree[0] = $_ . $ptree[0];
}
else {
unshift @ptree, $_;
}
}
}
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<append()>
This method appends the given text or parse-tree to the current parse-tree.
If the last item on the parse-tree is text and the argument is also text,
then the text is appended to the last item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<after>
the current one.
=cut
sub append {
my $self = shift;
local *ptree = $self;
my $can_append = @ptree && !(ref $ptree[-1]);
for (@_) {
if (ref) {
push @ptree, $_;
}
elsif(!length) {
next;
}
elsif ($can_append) {
$ptree[-1] .= $_;
}
else {
push @ptree, $_;
}
}
}
=head2 $ptree-E<gt>B<raw_text()>
my $ptree_raw_text = $ptree->raw_text();
This method will return the I<raw> text of the POD parse-tree
exactly as it appeared in the input.
=cut
sub raw_text {
my $self = shift;
my $text = "";
for ( @$self ) {
$text .= (ref $_) ? $_->raw_text : $_;
}
return $text;
}
##---------------------------------------------------------------------------
## Private routines to set/unset child->parent links
sub _unset_child2parent_links {
my $self = shift;
local *ptree = $self;
for (@ptree) {
next unless (defined and length and ref and ref ne 'SCALAR');
$_->_unset_child2parent_links()
if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
}
}
sub _set_child2parent_links {
## nothing to do, Pod::ParseTrees cant have parent pointers
}
=head2 Pod::ParseTree::B<DESTROY()>
This method performs any necessary cleanup for the parse-tree.
If you override this method then it is B<imperative>
that you invoke the parent method from within your own method,
otherwise I<parse-tree storage will not be reclaimed upon destruction!>
=cut
sub DESTROY {
## We need to get rid of all child->parent pointers throughout the
## tree so their reference counts will go to zero and they can be
## garbage-collected
_unset_child2parent_links(@_);
}
#############################################################################
=head1 SEE ALSO
See L<Pod::Parser>, L<Pod::Select>
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp at enteract.comE<gt>
=cut
1;
--- NEW FILE: Checker.pm ---
#############################################################################
# Pod/Checker.pm -- check pod documents for syntax errors
#
# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::Checker;
use vars qw($VERSION);
$VERSION = 1.43; ## Current version of this package
require 5.005; ## requires this Perl version or later
use Pod::ParseUtils; ## for hyperlinks and lists
=head1 NAME
[...1231 lines suppressed...]
}
}
}
1;
__END__
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp at enteract.comE<gt> (initial version),
Marek Rouchal E<lt>marekr at cpan.orgE<gt>
Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist at mox.perl.comE<gt>
=cut
--- NEW FILE: Man.pm ---
# Pod::Man -- Convert POD data to formatted *roff input.
# $Id: Man.pm,v 1.2 2006-12-04 17:00:52 dslinux_cayenne Exp $
#
# Copyright 1999, 2000, 2001, 2002, 2003 by Russ Allbery <rra at stanford.edu>
#
# 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.
[...1371 lines suppressed...]
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.
=head1 AUTHOR
Russ Allbery <rra at stanford.edu>, based I<very> heavily on the original
B<pod2man> by Tom Christiansen <tchrist at mox.perl.com>.
=head1 COPYRIGHT AND LICENSE
Copyright 1999, 2000, 2001, 2002, 2003 by Russ Allbery <rra at stanford.edu>.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut
--- NEW FILE: Plainer.pm ---
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 at cise.npl.co.uk
=head1 SEE ALSO
See L<Pod::Parser>.
=cut
--- NEW FILE: Usage.pm ---
#############################################################################
# Pod/Usage.pm -- print usage messages for the running script.
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::Usage;
use vars qw($VERSION);
$VERSION = 1.33; ## 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 -section
parameter; then these sections are extracted (see L<Pod::Select>)
and printed.
=item C<-section>
A string representing a selection list for sections to be printed
when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
=item C<-output>
A reference to a filehandle, or the pathname of a file to which the
usage message should be written. The default is C<\*STDERR> unless the
exit value is less than 2 (in which case the default is C<\*STDOUT>).
=item C<-input>
A reference to a filehandle, or the pathname of a file from which the
invoking script's pod documentation should be read. It defaults to the
file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
=item C<-pathlist>
A list of directory paths. If the input file does not exist, then it
will be searched for in the given directory list (in the order the
directories appear in the list). It defaults to the list of directories
implied by C<$ENV{PATH}>. The list may be specified either by a reference
to an array, or by a string of directory paths which use the same path
separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
MSWin32 and DOS).
=item C<-noperldoc>
By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
specified. This does not work well e.g. if the script was packed
with L<PAR>. The -noperldoc option suppresses the external call to
L<perldoc> and uses the simple text formatter (L<Pod::Text>) to
output the POD.
=back
=head1 DESCRIPTION
B<pod2usage> will print a usage message for the invoking script (using
its embedded pod documentation) and then exit the script with the
desired exit status. The usage message printed may have any one of three
levels of "verboseness": If the verbose level is 0, then only a synopsis
is printed. If the verbose level is 1, then the synopsis is printed
along with a description (if present) of the command line options and
arguments. If the verbose level is 2, then the entire manual page is
printed.
Unless they are explicitly specified, the default values for the exit
status, verbose level, and output stream to use are determined as
follows:
=over 4
=item *
If neither the exit status nor the verbose level is specified, then the
default is to use an exit status of 2 with a verbose level of 0.
=item *
If an exit status I<is> specified but the verbose level is I<not>, then the
verbose level will default to 1 if the exit status is less than 2 and
will default to 0 otherwise.
=item *
If an exit status is I<not> specified but verbose level I<is> given, then
the exit status will default to 2 if the verbose level is 0 and will
default to 1 otherwise.
=item *
If the exit status used is less than 2, then output is printed on
C<STDOUT>. Otherwise output is printed on C<STDERR>.
=back
Although the above may seem a bit confusing at first, it generally does
"the right thing" in most situations. This determination of the default
values to use is based upon the following typical Unix conventions:
=over 4
=item *
An exit status of 0 implies "success". For example, B<diff(1)> exits
with a status of 0 if the two files have the same contents.
=item *
An exit status of 1 implies possibly abnormal, but non-defective, program
termination. For example, B<grep(1)> exits with a status of 1 if
it did I<not> find a matching line for the given regular expression.
=item *
An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
exits with a status of 2 if you specify an illegal (unknown) option on
the command line.
=item *
Usage messages issued as a result of bad command-line syntax should go
to C<STDERR>. However, usage messages issued due to an explicit request
to print usage (like specifying B<-help> on the command line) should go
to C<STDOUT>, just in case the user wants to pipe the output to a pager
(such as B<more(1)>).
=item *
If program usage has been explicitly requested by the user, it is often
desireable to exit with a status of 1 (as opposed to 0) after issuing
the user-requested usage message. It is also desireable to give a
more verbose description of program usage in this case.
=back
B<pod2usage> doesn't force the above conventions upon you, but it will
use them by default if you don't expressly tell it to do otherwise. The
ability of B<pod2usage()> to accept a single number or a string makes it
convenient to use as an innocent looking error message handling function:
use Pod::Usage;
use Getopt::Long;
## Parse options
GetOptions("help", "man", "flag1") || pod2usage(2);
pod2usage(1) if ($opt_help);
pod2usage(-verbose => 2) if ($opt_man);
## Check for too many filenames
pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
Some user's however may feel that the above "economy of expression" is
not particularly readable nor consistent and may instead choose to do
something more like the following:
use Pod::Usage;
use Getopt::Long;
## Parse options
GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0);
pod2usage(-verbose => 1) if ($opt_help);
pod2usage(-verbose => 2) if ($opt_man);
## Check for too many filenames
pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
if (@ARGV > 1);
As with all things in Perl, I<there's more than one way to do it>, and
B<pod2usage()> adheres to this philosophy. If you are interested in
seeing a number of different ways to invoke B<pod2usage> (although by no
means exhaustive), please refer to L<"EXAMPLES">.
=head1 EXAMPLES
Each of the following invocations of C<pod2usage()> will print just the
"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
pod2usage();
pod2usage(2);
pod2usage(-verbose => 0);
pod2usage(-exitval => 2);
pod2usage({-exitval => 2, -output => \*STDERR});
pod2usage({-verbose => 0, -output => \*STDERR});
pod2usage(-exitval => 2, -verbose => 0);
pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
Each of the following invocations of C<pod2usage()> will print a message
of "Syntax error." (followed by a newline) to C<STDERR>, immediately
followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
will exit with a status of 2:
pod2usage("Syntax error.");
pod2usage(-message => "Syntax error.", -verbose => 0);
pod2usage(-msg => "Syntax error.", -exitval => 2);
pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
pod2usage(-message => "Syntax error.",
-exitval => 2,
-verbose => 0,
-output => \*STDERR);
Each of the following invocations of C<pod2usage()> will print the
"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
C<STDOUT> and will exit with a status of 1:
pod2usage(1);
pod2usage(-verbose => 1);
pod2usage(-exitval => 1);
pod2usage({-exitval => 1, -output => \*STDOUT});
pod2usage({-verbose => 1, -output => \*STDOUT});
pod2usage(-exitval => 1, -verbose => 1);
pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
Each of the following invocations of C<pod2usage()> will print the
entire manual page to C<STDOUT> and will exit with a status of 1:
pod2usage(-verbose => 2);
pod2usage({-verbose => 2, -output => \*STDOUT});
pod2usage(-exitval => 1, -verbose => 2);
pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
=head2 Recommended Use
Most scripts should print some type of usage message to C<STDERR> when a
command line syntax error is detected. They should also provide an
option (usually C<-H> or C<-help>) to print a (possibly more verbose)
usage message to C<STDOUT>. Some scripts may even wish to go so far as to
provide a means of printing their complete documentation to C<STDOUT>
(perhaps by allowing a C<-man> option). The following complete example
uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
things:
use Getopt::Long;
use Pod::Usage;
my $man = 0;
my $help = 0;
## Parse options and print usage if there is a syntax error,
## or if usage was explicitly requested.
GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-verbose => 2) if $man;
## If no arguments were given, then allow STDIN to be used only
## if it's not connected to a terminal (otherwise print usage)
pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
__END__
=head1 NAME
sample - Using GetOpt::Long and Pod::Usage
=head1 SYNOPSIS
sample [options] [file ...]
Options:
-help brief help message
-man full documentation
=head1 OPTIONS
=over 8
=item B<-help>
Print a brief help message and exits.
=item B<-man>
Prints the manual page and exits.
=back
=head1 DESCRIPTION
B<This program> will read the given input file(s) and do something
useful with the contents thereof.
=cut
=head1 CAVEATS
By default, B<pod2usage()> will use C<$0> as the path to the pod input
file. Unfortunately, not all systems on which Perl runs will set C<$0>
properly (although if C<$0> isn't found, B<pod2usage()> will search
C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
If this is the case for your system, you may need to explicitly specify
the path to the pod docs for the invoking script using something
similar to the following:
pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
In the pathological case that a script is called via a relative path
I<and> the script itself changes the current working directory
(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
fail even on robust platforms. Don't do that.
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp at enteract.comE<gt>
Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist at mox.perl.comE<gt>
=head1 ACKNOWLEDGEMENTS
Steven McDougall E<lt>swmcd at world.std.comE<gt> for his help and patience
with re-writing this manpage.
=cut
#############################################################################
use strict;
#use diagnostics;
use Carp;
use Config;
use Exporter;
use File::Spec;
use vars qw(@ISA @EXPORT);
@EXPORT = qw(&pod2usage);
BEGIN {
if ( $] >= 5.005_58 ) {
require Pod::Text;
@ISA = qw( Pod::Text );
}
else {
require Pod::PlainText;
@ISA = qw( Pod::PlainText );
}
}
##---------------------------------------------------------------------------
##---------------------------------
## Function definitions begin here
##---------------------------------
sub pod2usage {
local($_) = shift;
my %opts;
## Collect arguments
if (@_ > 0) {
## Too many arguments - assume that this is a hash and
## the user forgot to pass a reference to it.
%opts = ($_, @_);
}
elsif (!defined $_) {
$_ = "";
}
elsif (ref $_) {
## User passed a ref to a hash
%opts = %{$_} if (ref($_) eq 'HASH');
}
elsif (/^[-+]?\d+$/) {
## User passed in the exit value to use
$opts{"-exitval"} = $_;
}
else {
## User passed in a message to print before issuing usage.
$_ and $opts{"-message"} = $_;
}
## Need this for backward compatibility since we formerly used
## options that were all uppercase words rather than ones that
## looked like Unix command-line options.
## to be uppercase keywords)
%opts = map {
my $val = $opts{$_};
s/^(?=\w)/-/;
/^-msg/i and $_ = '-message';
/^-exit/i and $_ = '-exitval';
lc($_) => $val;
} (keys %opts);
## Now determine default -exitval and -verbose values to use
if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
$opts{"-exitval"} = 2;
$opts{"-verbose"} = 0;
}
elsif (! defined $opts{"-exitval"}) {
$opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
}
elsif (! defined $opts{"-verbose"}) {
$opts{"-verbose"} = (lc($opts{"-exitval"}) eq "noexit" ||
$opts{"-exitval"} < 2);
}
## Default the output file
$opts{"-output"} = (lc($opts{"-exitval"}) eq "noexit" ||
$opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR
unless (defined $opts{"-output"});
## Default the input file
$opts{"-input"} = $0 unless (defined $opts{"-input"});
## Look up input file in path if it doesnt exist.
unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
my ($dirname, $basename) = ('', $opts{"-input"});
my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
: (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ":");
my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
for $dirname (@paths) {
$_ = File::Spec->catfile($dirname, $basename) if length;
last if (-e $_) && ($opts{"-input"} = $_);
}
}
## Now create a pod reader and constrain it to the desired sections.
my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
if ($opts{"-verbose"} == 0) {
$parser->select('SYNOPSIS\s*');
}
elsif ($opts{"-verbose"} == 1) {
my $opt_re = '(?i)' .
'(?:OPTIONS|ARGUMENTS)' .
'(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
$parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
}
elsif ($opts{"-verbose"} == 99) {
$parser->select( $opts{"-sections"} );
$opts{"-verbose"} = 1;
}
## Now translate the pod document and then exit with the desired status
if ( !$opts{"-noperldoc"}
and $opts{"-verbose"} >= 2
and !ref($opts{"-input"})
and $opts{"-output"} == \*STDOUT )
{
## spit out the entire PODs. Might as well invoke perldoc
my $progpath = File::Spec->catfile($Config{scriptdir}, "perldoc");
system($progpath, $opts{"-input"});
}
else {
$parser->parse_from_file($opts{"-input"}, $opts{"-output"});
}
exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit');
}
##---------------------------------------------------------------------------
##-------------------------------
## Method definitions begin here
##-------------------------------
sub new {
my $this = shift;
my $class = ref($this) || $this;
my %params = @_;
my $self = {%params};
bless $self, $class;
if ($self->can('initialize')) {
$self->initialize();
} else {
$self = $self->SUPER::new();
%$self = (%$self, %params);
}
return $self;
}
sub select {
my ($self, @res) = @_;
if ($ISA[0]->can('select')) {
$self->SUPER::select(@_);
} else {
$self->{USAGE_SELECT} = \@res;
}
}
# Override Pod::Text->seq_i to return just "arg", not "*arg*".
sub seq_i { return $_[1] }
# This overrides the Pod::Text method to do something very akin to what
# Pod::Select did as well as the work done below by preprocess_paragraph.
# Note that the below is very, very specific to Pod::Text.
sub _handle_element_end {
my ($self, $element) = @_;
if ($element eq 'head1') {
$$self{USAGE_HEAD1} = $$self{PENDING}[-1][1];
$$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
} elsif ($element eq 'head2') {
$$self{USAGE_HEAD2} = $$self{PENDING}[-1][1];
}
if ($element eq 'head1' || $element eq 'head2') {
$$self{USAGE_SKIPPING} = 1;
my $heading = $$self{USAGE_HEAD1};
$heading .= '/' . $$self{USAGE_HEAD2} if defined $$self{USAGE_HEAD2};
for (@{ $$self{USAGE_SELECT} }) {
if ($heading =~ /^$_\s*$/) {
$$self{USAGE_SKIPPING} = 0;
last;
}
}
# Try to do some lowercasing instead of all-caps in headings, and use
# a colon to end all headings.
local $_ = $$self{PENDING}[-1][1];
s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
s/\s*$/:/ unless (/:\s*$/);
$_ .= "\n";
$$self{PENDING}[-1][1] = $_;
}
if ($$self{USAGE_SKIPPING}) {
pop @{ $$self{PENDING} };
} else {
$self->SUPER::_handle_element_end($element);
}
}
sub start_document {
my $self = shift;
$self->SUPER::start_document();
my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
my $out_fh = $self->output_fh();
print $out_fh "$msg\n";
}
sub begin_pod {
my $self = shift;
$self->SUPER::begin_pod(); ## Have to call superclass
my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
my $out_fh = $self->output_handle();
print $out_fh "$msg\n";
}
sub preprocess_paragraph {
my $self = shift;
local $_ = shift;
my $line = shift;
## See if this is a heading and we arent printing the entire manpage.
if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
## Change the title of the SYNOPSIS section to USAGE
s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
## Try to do some lowercasing instead of all-caps in headings
s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
## Use a colon to end all headings
s/\s*$/:/ unless (/:\s*$/);
$_ .= "\n";
}
return $self->SUPER::preprocess_paragraph($_);
}
1; # keep require happy
--- NEW FILE: ParseUtils.pm ---
#############################################################################
# Pod/ParseUtils.pm -- helpers for POD parsing and conversion
#
# Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::ParseUtils;
use vars qw($VERSION);
$VERSION = 1.33; ## Current version of this package
require 5.005; ## requires this Perl version or later
=head1 NAME
Pod::ParseUtils - helpers for POD parsing and conversion
=head1 SYNOPSIS
use Pod::ParseUtils;
my $list = new Pod::List;
my $link = Pod::Hyperlink->new('Pod::Parser');
=head1 DESCRIPTION
B<Pod::ParseUtils> contains a few object-oriented helper packages for
POD parsing and processing (i.e. in POD formatters and translators).
=cut
#-----------------------------------------------------------------------------
# Pod::List
#
# class to hold POD list info (=over, =item, =back)
#-----------------------------------------------------------------------------
package Pod::List;
use Carp;
=head2 Pod::List
B<Pod::List> can be used to hold information about POD lists
(written as =over ... =item ... =back) for further processing.
The following methods are available:
=over 4
=item Pod::List-E<gt>new()
Create a new list object. Properties may be specified through a hash
reference like this:
my $list = Pod::List->new({ -start => $., -indent => 4 });
See the individual methods/properties for details.
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my %params = @_;
my $self = {%params};
bless $self, $class;
$self->initialize();
return $self;
}
sub initialize {
my $self = shift;
$self->{-file} ||= 'unknown';
$self->{-start} ||= 'unknown';
$self->{-indent} ||= 4; # perlpod: "should be the default"
$self->{_items} = [];
$self->{-type} ||= '';
}
=item $list-E<gt>file()
Without argument, retrieves the file name the list is in. This must
have been set before by either specifying B<-file> in the B<new()>
method or by calling the B<file()> method with a scalar argument.
=cut
# The POD file name the list appears in
sub file {
return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}
=item $list-E<gt>start()
Without argument, retrieves the line number where the list started.
This must have been set before by either specifying B<-start> in the
B<new()> method or by calling the B<start()> method with a scalar
argument.
=cut
# The line in the file the node appears
sub start {
return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
}
=item $list-E<gt>indent()
Without argument, retrieves the indent level of the list as specified
in C<=over n>. This must have been set before by either specifying
B<-indent> in the B<new()> method or by calling the B<indent()> method
with a scalar argument.
=cut
# indent level
sub indent {
return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
}
=item $list-E<gt>type()
Without argument, retrieves the list type, which can be an arbitrary value,
e.g. C<OL>, C<UL>, ... when thinking the HTML way.
This must have been set before by either specifying
B<-type> in the B<new()> method or by calling the B<type()> method
with a scalar argument.
=cut
# The type of the list (UL, OL, ...)
sub type {
return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
}
=item $list-E<gt>rx()
Without argument, retrieves a regular expression for simplifying the
individual item strings once the list type has been determined. Usage:
E.g. when converting to HTML, one might strip the leading number in
an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.
This must have been set before by either specifying
B<-rx> in the B<new()> method or by calling the B<rx()> method
with a scalar argument.
=cut
# The regular expression to simplify the items
sub rx {
return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
}
=item $list-E<gt>item()
Without argument, retrieves the array of the items in this list.
The items may be represented by any scalar.
If an argument has been given, it is pushed on the list of items.
=cut
# The individual =items of this list
sub item {
my ($self,$item) = @_;
if(defined $item) {
push(@{$self->{_items}}, $item);
return $item;
}
else {
return @{$self->{_items}};
}
}
=item $list-E<gt>parent()
Without argument, retrieves information about the parent holding this
list, which is represented as an arbitrary scalar.
This must have been set before by either specifying
B<-parent> in the B<new()> method or by calling the B<parent()> method
with a scalar argument.
=cut
# possibility for parsers/translators to store information about the
# lists's parent object
sub parent {
return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
}
=item $list-E<gt>tag()
Without argument, retrieves information about the list tag, which can be
any scalar.
This must have been set before by either specifying
B<-tag> in the B<new()> method or by calling the B<tag()> method
with a scalar argument.
=back
=cut
# possibility for parsers/translators to store information about the
# list's object
sub tag {
return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
}
#-----------------------------------------------------------------------------
# Pod::Hyperlink
#
# class to manipulate POD hyperlinks (L<>)
#-----------------------------------------------------------------------------
package Pod::Hyperlink;
=head2 Pod::Hyperlink
B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:
my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
different parts of a POD hyperlink for further processing. It can also be
used to construct hyperlinks.
=over 4
=item Pod::Hyperlink-E<gt>new()
The B<new()> method can either be passed a set of key/value pairs or a single
scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
failure, the error message is stored in C<$@>.
=cut
use Carp;
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = +{};
bless $self, $class;
$self->initialize();
if(defined $_[0]) {
if(ref($_[0])) {
# called with a list of parameters
%$self = %{$_[0]};
$self->_construct_text();
}
else {
# called with L<> contents
return undef unless($self->parse($_[0]));
}
}
return $self;
}
sub initialize {
my $self = shift;
$self->{-line} ||= 'undef';
$self->{-file} ||= 'undef';
$self->{-page} ||= '';
$self->{-node} ||= '';
$self->{-alttext} ||= '';
$self->{-type} ||= 'undef';
$self->{_warnings} = [];
}
=item $link-E<gt>parse($string)
This method can be used to (re)parse a (new) hyperlink, i.e. the contents
of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
Warnings are stored in the B<warnings> property.
E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point
to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage
section can simply be dropped.
=cut
sub parse {
my $self = shift;
local($_) = $_[0];
# syntax check the link and extract destination
my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);
$self->{_warnings} = [];
# collapse newlines with whitespace
s/\s*\n+\s*/ /g;
# strip leading/trailing whitespace
if(s/^[\s\n]+//) {
$self->warning("ignoring leading whitespace in link");
}
if(s/[\s\n]+$//) {
$self->warning("ignoring trailing whitespace in link");
}
unless(length($_)) {
_invalid_link("empty link");
return undef;
}
## Check for different possibilities. This is tedious and error-prone
# we match all possibilities (alttext, page, section/item)
#warn "DEBUG: link=$_\n";
# only page
# problem: a lot of people use (), or (1) or the like to indicate
# man page sections. But this collides with L<func()> that is supposed
# to point to an internal funtion...
my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';
# page name only
if(m!^($page_rx)$!o) {
$page = $1;
$type = 'page';
}
# alttext, page and "section"
elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$!o) {
($alttext, $page, $node) = ($1, $2, $3);
$type = 'section';
$quoted = 1; #... therefore | and / are allowed
}
# alttext and page
elsif(m!^(.*?)\s*[|]\s*($page_rx)$!o) {
($alttext, $page) = ($1, $2);
$type = 'page';
}
# alttext and "section"
elsif(m!^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
($alttext, $node) = ($1,$2);
$type = 'section';
$quoted = 1;
}
# page and "section"
elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) {
($page, $node) = ($1, $2);
$type = 'section';
$quoted = 1;
}
# page and item
elsif(m!^($page_rx)\s*/\s*(.+)$!o) {
($page, $node) = ($1, $2);
$type = 'item';
}
# only "section"
elsif(m!^/?"(.+)"$!) {
$node = $1;
$type = 'section';
$quoted = 1;
}
# only item
elsif(m!^\s*/(.+)$!) {
$node = $1;
$type = 'item';
}
# non-standard: Hyperlink
elsif(m!^(\w+:[^:\s]\S*)$!i) {
$node = $1;
$type = 'hyperlink';
}
# alttext, page and item
elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$!o) {
($alttext, $page, $node) = ($1, $2, $3);
$type = 'item';
}
# alttext and item
elsif(m!^(.*?)\s*[|]\s*/(.+)$!) {
($alttext, $node) = ($1,$2);
}
# nonstandard: alttext and hyperlink
elsif(m!^(.*?)\s*[|]\s*(\w+:[^:\s]\S*)$!) {
($alttext, $node) = ($1,$2);
$type = 'hyperlink';
}
# must be an item or a "malformed" section (without "")
else {
$node = $_;
$type = 'item';
}
# collapse whitespace in nodes
$node =~ s/\s+/ /gs;
# empty alternative text expands to node name
if(defined $alttext) {
if(!length($alttext)) {
$alttext = $node | $page;
}
}
else {
$alttext = '';
}
if($page =~ /[(]\w*[)]$/) {
$self->warning("(section) in '$page' deprecated");
}
if(!$quoted && $node =~ m:[|/]: && $type ne 'hyperlink') {
$self->warning("node '$node' contains non-escaped | or /");
}
if($alttext =~ m:[|/]:) {
$self->warning("alternative text '$node' contains non-escaped | or /");
}
$self->{-page} = $page;
$self->{-node} = $node;
$self->{-alttext} = $alttext;
#warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
$self->{-type} = $type;
$self->_construct_text();
1;
}
sub _construct_text {
my $self = shift;
my $alttext = $self->alttext();
my $type = $self->type();
my $section = $self->node();
my $page = $self->page();
my $page_ext = '';
$page =~ s/([(]\w*[)])$// && ($page_ext = $1);
if($alttext) {
$self->{_text} = $alttext;
}
elsif($type eq 'hyperlink') {
$self->{_text} = $section;
}
else {
$self->{_text} = ($section || '') .
(($page && $section) ? ' in ' : '') .
"$page$page_ext";
}
# for being marked up later
# use the non-standard markers P<> and Q<>, so that the resulting
# text can be parsed by the translators. It's their job to put
# the correct hypertext around the linktext
if($alttext) {
$self->{_markup} = "Q<$alttext>";
}
elsif($type eq 'hyperlink') {
$self->{_markup} = "Q<$section>";
}
else {
$self->{_markup} = (!$section ? '' : "Q<$section>") .
($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');
}
}
=item $link-E<gt>markup($string)
Set/retrieve the textual value of the link. This string contains special
markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the
translator's interior sequence expansion engine to the
formatter-specific code to highlight/activate the hyperlink. The details
have to be implemented in the translator.
=cut
#' retrieve/set markuped text
sub markup {
return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
}
=item $link-E<gt>text()
This method returns the textual representation of the hyperlink as above,
but without markers (read only). Depending on the link type this is one of
the following alternatives (the + and * denote the portions of the text
that are marked up):
+perl+ L<perl>
*$|* in +perlvar+ L<perlvar/$|>
*OPTIONS* in +perldoc+ L<perldoc/"OPTIONS">
*DESCRIPTION* L<"DESCRIPTION">
=cut
# The complete link's text
sub text {
$_[0]->{_text};
}
=item $link-E<gt>warning()
After parsing, this method returns any warnings encountered during the
parsing process.
=cut
# Set/retrieve warnings
sub warning {
my $self = shift;
if(@_) {
push(@{$self->{_warnings}}, @_);
return @_;
}
return @{$self->{_warnings}};
}
=item $link-E<gt>file()
=item $link-E<gt>line()
Just simple slots for storing information about the line and the file
the link was encountered in. Has to be filled in manually.
=cut
# The line in the file the link appears
sub line {
return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
}
# The POD file name the link appears in
sub file {
return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}
=item $link-E<gt>page()
This method sets or returns the POD page this link points to.
=cut
# The POD page the link appears on
sub page {
if (@_ > 1) {
$_[0]->{-page} = $_[1];
$_[0]->_construct_text();
}
$_[0]->{-page};
}
=item $link-E<gt>node()
As above, but the destination node text of the link.
=cut
# The link destination
sub node {
if (@_ > 1) {
$_[0]->{-node} = $_[1];
$_[0]->_construct_text();
}
$_[0]->{-node};
}
=item $link-E<gt>alttext()
Sets or returns an alternative text specified in the link.
=cut
# Potential alternative text
sub alttext {
if (@_ > 1) {
$_[0]->{-alttext} = $_[1];
$_[0]->_construct_text();
}
$_[0]->{-alttext};
}
=item $link-E<gt>type()
The node type, either C<section> or C<item>. As an unofficial type,
there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>
=cut
# The type: item or headn
sub type {
return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
}
=item $link-E<gt>link()
Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.
=back
=cut
# The link itself
sub link {
my $self = shift;
my $link = $self->page() || '';
if($self->node()) {
my $node = $self->node();
$text =~ s/\|/E<verbar>/g;
$text =~ s:/:E<sol>:g;
if($self->type() eq 'section') {
$link .= ($link ? '/' : '') . '"' . $node . '"';
}
elsif($self->type() eq 'hyperlink') {
$link = $self->node();
}
else { # item
$link .= '/' . $node;
}
}
if($self->alttext()) {
my $text = $self->alttext();
$text =~ s/\|/E<verbar>/g;
$text =~ s:/:E<sol>:g;
$link = "$text|$link";
}
$link;
}
sub _invalid_link {
my ($msg) = @_;
# this sets @_
#eval { die "$msg\n" };
#chomp $@;
$@ = $msg; # this seems to work, too!
undef;
}
#-----------------------------------------------------------------------------
# Pod::Cache
#
# class to hold POD page details
#-----------------------------------------------------------------------------
package Pod::Cache;
=head2 Pod::Cache
B<Pod::Cache> holds information about a set of POD documents,
especially the nodes for hyperlinks.
The following methods are available:
=over 4
=item Pod::Cache-E<gt>new()
Create a new cache object. This object can hold an arbitrary number of
POD documents of class Pod::Cache::Item.
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = [];
bless $self, $class;
return $self;
}
=item $cache-E<gt>item()
Add a new item to the cache. Without arguments, this method returns a
list of all cache elements.
=cut
sub item {
my ($self,%param) = @_;
if(%param) {
my $item = Pod::Cache::Item->new(%param);
push(@$self, $item);
return $item;
}
else {
return @{$self};
}
}
=item $cache-E<gt>find_page($name)
Look for a POD document named C<$name> in the cache. Returns the
reference to the corresponding Pod::Cache::Item object or undef if
not found.
=back
=cut
sub find_page {
my ($self,$page) = @_;
foreach(@$self) {
if($_->page() eq $page) {
return $_;
}
}
undef;
}
package Pod::Cache::Item;
=head2 Pod::Cache::Item
B<Pod::Cache::Item> holds information about individual POD documents,
that can be grouped in a Pod::Cache object.
It is intended to hold information about the hyperlink nodes of POD
documents.
The following methods are available:
=over 4
=item Pod::Cache::Item-E<gt>new()
Create a new object.
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my %params = @_;
my $self = {%params};
bless $self, $class;
$self->initialize();
return $self;
}
sub initialize {
my $self = shift;
$self->{-nodes} = [] unless(defined $self->{-nodes});
}
=item $cacheitem-E<gt>page()
Set/retrieve the POD document name (e.g. "Pod::Parser").
=cut
# The POD page
sub page {
return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
}
=item $cacheitem-E<gt>description()
Set/retrieve the POD short description as found in the C<=head1 NAME>
section.
=cut
# The POD description, taken out of NAME if present
sub description {
return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
}
=item $cacheitem-E<gt>path()
Set/retrieve the POD file storage path.
=cut
# The file path
sub path {
return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
}
=item $cacheitem-E<gt>file()
Set/retrieve the POD file name.
=cut
# The POD file name
sub file {
return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}
=item $cacheitem-E<gt>nodes()
Add a node (or a list of nodes) to the document's node list. Note that
the order is kept, i.e. start with the first node and end with the last.
If no argument is given, the current list of nodes is returned in the
same order the nodes have been added.
A node can be any scalar, but usually is a pair of node string and
unique id for the C<find_node> method to work correctly.
=cut
# The POD nodes
sub nodes {
my ($self, at 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 arry) or undef if not found.
=cut
sub find_node {
my ($self,$node) = @_;
my @search;
push(@search, @{$self->{-nodes}}) if($self->{-nodes});
push(@search, @{$self->{-idx}}) if($self->{-idx});
foreach(@search) {
if($_->[0] eq $node) {
return $_->[1]; # id
}
}
undef;
}
=item $cacheitem-E<gt>idx()
Add an index entry (or a list of them) to the document's index list. Note that
the order is kept, i.e. start with the first node and end with the last.
If no argument is given, the current list of index entries is returned in the
same order the entries have been added.
An index entry can be any scalar, but usually is a pair of string and
unique id.
=back
=cut
# The POD index entries
sub idx {
my ($self, at 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 at 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;
--- NEW FILE: Html.pm ---
package Pod::Html;
use strict;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
$VERSION = 1.0504;
@ISA = qw(Exporter);
@EXPORT = qw(pod2html htmlify);
@EXPORT_OK = qw(anchorify);
use Carp;
use Config;
use Cwd;
use File::Spec;
use File::Spec::Unix;
use Getopt::Long;
use locale; # make \w work right in non-ASCII lands
[...2073 lines suppressed...]
$text = substr( $text, 0, 50 );
} else {
return undef();
}
}
#
# make_URL_href - generate HTML href from URL
# Special treatment for CGI queries.
#
sub make_URL_href($){
my( $url ) = @_;
if( $url !~
s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ){
$url = "<a href=\"$url\">$url</a>";
}
return $url;
}
1;
--- NEW FILE: ParseLink.pm ---
# Pod::ParseLink -- Parse an L<> formatting code in POD text.
# $Id: ParseLink.pm,v 1.1 2006-12-04 17:00:55 dslinux_cayenne Exp $
#
# Copyright 2001 by Russ Allbery <rra at stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This module implements parsing of the text of an L<> formatting code as
# defined in perlpodspec. It should be suitable for any POD formatter. It
# exports only one function, parselink(), which returns the five-item parse
# defined in perlpodspec.
#
# Perl core hackers, please note that this module is also separately
# maintained outside of the Perl core as part of the podlators. Please send
# me any patches at the address above in addition to sending them to the
# standard Perl mailing lists.
##############################################################################
# Modules and declarations
##############################################################################
package Pod::ParseLink;
require 5.004;
use strict;
use vars qw(@EXPORT @ISA $VERSION);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(parselink);
# Don't use the CVS revision as the version, since this module is also in Perl
# core and too many things could munge CVS magic revision strings. This
# number should ideally be the same as the CVS revision in podlators, however.
$VERSION = 1.06;
##############################################################################
# Implementation
##############################################################################
# Parse the name and section portion of a link into a name and section.
sub _parse_section {
my ($link) = @_;
$link =~ s/^\s+//;
$link =~ s/\s+$//;
# If the whole link is enclosed in quotes, interpret it all as a section
# even if it contains a slash.
return (undef, $1) if ($link =~ /^"\s*(.*?)\s*"$/);
# Split into page and section on slash, and then clean up quoting in the
# section. If there is no section and the name contains spaces, also
# guess that it's an old section link.
my ($page, $section) = split (/\s*\/\s*/, $link, 2);
$section =~ s/^"\s*(.*?)\s*"$/$1/ if $section;
if ($page && $page =~ / / && !defined ($section)) {
$section = $page;
$page = undef;
} else {
$page = undef unless $page;
$section = undef unless $section;
}
return ($page, $section);
}
# Infer link text from the page and section.
sub _infer_text {
my ($page, $section) = @_;
my $inferred;
if ($page && !$section) {
$inferred = $page;
} elsif (!$page && $section) {
$inferred = '"' . $section . '"';
} elsif ($page && $section) {
$inferred = '"' . $section . '" in ' . $page;
}
return $inferred;
}
# Given the contents of an L<> formatting code, parse it into the link text,
# the possibly inferred link text, the name or URL, the section, and the type
# of link (pod, man, or url).
sub parselink {
my ($link) = @_;
$link =~ s/\s+/ /g;
if ($link =~ /\A\w+:[^:\s]\S*\Z/) {
return (undef, $link, $link, undef, 'url');
} else {
my $text;
if ($link =~ /\|/) {
($text, $link) = split (/\|/, $link, 2);
}
my ($name, $section) = _parse_section ($link);
my $inferred = $text || _infer_text ($name, $section);
my $type = ($name && $name =~ /\(\S*\)/) ? 'man' : 'pod';
return ($text, $inferred, $name, $section, $type);
}
}
##############################################################################
# Module return value and documentation
##############################################################################
# Ensure we evaluate to true.
1;
__END__
=head1 NAME
Pod::ParseLink - Parse an LE<lt>E<gt> formatting code in POD text
=head1 SYNOPSIS
use Pod::ParseLink;
my ($text, $inferred, $name, $section, $type) = parselink ($link);
=head1 DESCRIPTION
This module only provides a single function, parselink(), which takes the
text of an LE<lt>E<gt> formatting code and parses it. It returns the anchor
text for the link (if any was given), the anchor text possibly inferred from
the name and section, the name or URL, the section if any, and the type of
link. The type will be one of 'url', 'pod', or 'man', indicating a URL, a
link to a POD page, or a link to a Unix manual page.
Parsing is implemented per L<perlpodspec>. For backward compatibility,
links where there is no section and name contains spaces, or links where the
entirety of the link (except for the anchor text if given) is enclosed in
double-quotes are interpreted as links to a section (LE<lt>/sectionE<gt>).
The inferred anchor text is implemented per L<perlpodspec>:
L<name> => L<name|name>
L</section> => L<"section"|/section>
L<name/section> => L<"section" in name|name/section>
The name may contain embedded EE<lt>E<gt> and ZE<lt>E<gt> formatting codes,
and the section, anchor text, and inferred anchor text may contain any
formatting codes. Any double quotes around the section are removed as part
of the parsing, as is any leading or trailing whitespace.
If the text of the LE<lt>E<gt> escape is entirely enclosed in double quotes,
it's interpreted as a link to a section for backwards compatibility.
No attempt is made to resolve formatting codes. This must be done after
calling parselink (since EE<lt>E<gt> formatting codes can be used to escape
characters that would otherwise be significant to the parser and resolving
them before parsing would result in an incorrect parse of a formatting code
like:
L<verticalE<verbar>barE<sol>slash>
which should be interpreted as a link to the C<vertical|bar/slash> POD page
and not as a link to the C<slash> section of the C<bar> POD page with an
anchor text of C<vertical>. Note that not only the anchor text will need to
have formatting codes expanded, but so will the target of the link (to deal
with EE<lt>E<gt> and ZE<lt>E<gt> formatting codes), and special handling of
the section may be necessary depending on whether the translator wants to
consider markup in sections to be significant when resolving links. See
L<perlpodspec> for more information.
=head1 SEE ALSO
L<Pod::Parser>
The current version of this module is always available from its web site at
L<http://www.eyrie.org/~eagle/software/podlators/>.
=head1 AUTHOR
Russ Allbery <rra at stanford.edu>.
=head1 COPYRIGHT AND LICENSE
Copyright 2001 by Russ Allbery <rra at stanford.edu>.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut
--- NEW FILE: Find.pm ---
#############################################################################
# Pod/Find.pm -- finds files containing POD documentation
#
# Author: Marek Rouchal <marekr at cpan.org>
#
# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code
# from Nick Ing-Simmon's PodToHtml). All rights reserved.
# This file is part of "PodParser". Pod::Find is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::Find;
use vars qw($VERSION);
$VERSION = 1.34; ## Current version of this package
require 5.005; ## requires this Perl version or later
use Carp;
#############################################################################
=head1 NAME
Pod::Find - find POD documents in directory trees
=head1 SYNOPSIS
use Pod::Find qw(pod_find simplify_name);
my %pods = pod_find({ -verbose => 1, -inc => 1 });
foreach(keys %pods) {
print "found library POD `$pods{$_}' in $_\n";
}
print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";
$location = pod_where( { -inc => 1 }, "Pod::Find" );
=head1 DESCRIPTION
B<Pod::Find> provides a set of functions to locate POD files. Note that
no function is exported by default to avoid pollution of your namespace,
so be sure to specify them in the B<use> statement if you need them:
use Pod::Find qw(pod_find);
>From this version on the typical SCM (software configuration management)
files/directories like RCS, CVS, SCCS, .svn are ignored.
=cut
use strict;
#use diagnostics;
use Exporter;
use File::Spec;
use File::Find;
use Cwd;
use vars qw(@ISA @EXPORT_OK $VERSION);
@ISA = qw(Exporter);
@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);
# package global variables
my $SIMPLIFY_RX;
=head2 C<pod_find( { %opts } , @directories )>
The function B<pod_find> searches for POD documents in a given set of
files and/or directories. It returns a hash with the file names as keys
and the POD name as value. The POD name is derived from the file name
and its position in the directory tree.
E.g. when searching in F<$HOME/perl5lib>, the file
F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
I<Myclass::Subclass>. The name information can be used for POD
translators.
Only text files containing at least one valid POD command are found.
A warning is printed if more than one POD file with the same POD name
is found, e.g. F<CPAN.pm> in different directories. This usually
indicates duplicate occurrences of modules in the I<@INC> search path.
B<OPTIONS> The first argument for B<pod_find> may be a hash reference
with options. The rest are either directories that are searched
recursively or files. The POD names of files are the plain basenames
with any Perl-like extension (.pm, .pl, .pod) stripped.
=over 4
=item C<-verbose =E<gt> 1>
Print progress information while scanning.
=item C<-perl =E<gt> 1>
Apply Perl-specific heuristics to find the correct PODs. This includes
stripping Perl-like extensions, omitting subdirectories that are numeric
but do I<not> match the current Perl interpreter's version id, suppressing
F<site_perl> as a module hierarchy name etc.
=item C<-script =E<gt> 1>
Search for PODs in the current Perl interpreter's installation
B<scriptdir>. This is taken from the local L<Config|Config> module.
=item C<-inc =E<gt> 1>
Search for PODs in the current Perl interpreter's I<@INC> paths. This
automatically considers paths specified in the C<PERL5LIB> environment
as this is prepended to I<@INC> by the Perl interpreter itself.
=back
=cut
# return a hash of the POD files found
# first argument may be a hashref (options),
# rest is a list of directories to search recursively
sub pod_find
{
my %opts;
if(ref $_[0]) {
%opts = %{shift()};
}
$opts{-verbose} ||= 0;
$opts{-perl} ||= 0;
my (@search) = @_;
if($opts{-script}) {
require Config;
push(@search, $Config::Config{scriptdir})
if -d $Config::Config{scriptdir};
$opts{-perl} = 1;
}
if($opts{-inc}) {
if ($^O eq 'MacOS') {
# tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
my @new_INC = @INC;
for (@new_INC) {
if ( $_ eq '.' ) {
$_ = ':';
} elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
$_ = ':'. $_;
} else {
$_ =~ s|^\./|:|;
}
}
push(@search, grep($_ ne File::Spec->curdir, @new_INC));
} else {
push(@search, grep($_ ne File::Spec->curdir, @INC));
}
$opts{-perl} = 1;
}
if($opts{-perl}) {
require Config;
# this code simplifies the POD name for Perl modules:
# * remove "site_perl"
# * remove e.g. "i586-linux" (from 'archname')
# * remove e.g. 5.00503
# * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
# Mac OS:
# * remove ":?site_perl:"
# * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)
if ($^O eq 'MacOS') {
$SIMPLIFY_RX =
qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
} else {
$SIMPLIFY_RX =
qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
}
}
my %dirs_visited;
my %pods;
my %names;
my $pwd = cwd();
foreach my $try (@search) {
unless(File::Spec->file_name_is_absolute($try)) {
# make path absolute
$try = File::Spec->catfile($pwd,$try);
}
# simplify path
# on VMS canonpath will vmsify:[the.path], but File::Find::find
# wants /unixy/paths
$try = File::Spec->canonpath($try) if ($^O ne 'VMS');
$try = VMS::Filespec::unixify($try) if ($^O eq 'VMS');
my $name;
if(-f $try) {
if($name = _check_and_extract_name($try, $opts{-verbose})) {
_check_for_duplicates($try, $name, \%names, \%pods);
}
next;
}
my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
File::Find::find( sub {
my $item = $File::Find::name;
if(-d) {
if($item =~ m{/(?:RCS|CVS|SCCS|\.svn)$}) {
$File::Find::prune = 1;
return;
}
elsif($dirs_visited{$item}) {
warn "Directory '$item' already seen, skipping.\n"
if($opts{-verbose});
$File::Find::prune = 1;
return;
}
else {
$dirs_visited{$item} = 1;
}
if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
$File::Find::prune = 1;
warn "Perl $] version mismatch on $_, skipping.\n"
if($opts{-verbose});
}
return;
}
if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
_check_for_duplicates($item, $name, \%names, \%pods);
}
}, $try); # end of File::Find::find
}
chdir $pwd;
%pods;
}
sub _check_for_duplicates {
my ($file, $name, $names_ref, $pods_ref) = @_;
if($$names_ref{$name}) {
warn "Duplicate POD found (shadowing?): $name ($file)\n";
warn " Already seen in ",
join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
}
else {
$$names_ref{$name} = 1;
}
$$pods_ref{$file} = $name;
}
sub _check_and_extract_name {
my ($file, $verbose, $root_rx) = @_;
# check extension or executable flag
# this involves testing the .bat extension on Win32!
unless(-f $file && -T $file && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) {
return undef;
}
return undef unless contains_pod($file,$verbose);
# strip non-significant path components
# TODO what happens on e.g. Win32?
my $name = $file;
if(defined $root_rx) {
$name =~ s!$root_rx!!s;
$name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
}
else {
if ($^O eq 'MacOS') {
$name =~ s/^.*://s;
} else {
$name =~ s:^.*/::s;
}
}
_simplify($name);
$name =~ s!/+!::!g; #/
if ($^O eq 'MacOS') {
$name =~ s!:+!::!g; # : -> ::
} else {
$name =~ s!/+!::!g; # / -> ::
}
$name;
}
=head2 C<simplify_name( $str )>
The function B<simplify_name> is equivalent to B<basename>, but also
strips Perl-like extensions (.pm, .pl, .pod) and extensions like
F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
=cut
# basic simplification of the POD name:
# basename & strip extension
sub simplify_name {
my ($str) = @_;
# remove all path components
if ($^O eq 'MacOS') {
$str =~ s/^.*://s;
} else {
$str =~ s:^.*/::s;
}
_simplify($str);
$str;
}
# internal sub only
sub _simplify {
# strip Perl's own extensions
$_[0] =~ s/\.(pod|pm|plx?)\z//i;
# strip meaningless extensions on Win32 and OS/2
$_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
# strip meaningless extensions on VMS
$_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
}
# contribution from Tim Jenness <t.jenness at jach.hawaii.edu>
=head2 C<pod_where( { %opts }, $pod )>
Returns the location of a pod document given a search directory
and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
Options:
=over 4
=item C<-inc =E<gt> 1>
Search @INC for the pod and also the C<scriptdir> defined in the
L<Config|Config> module.
=item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
Reference to an array of search directories. These are searched in order
before looking in C<@INC> (if B<-inc>). Current directory is used if
none are specified.
=item C<-verbose =E<gt> 1>
List directories as they are searched
=back
Returns the full path of the first occurrence to the file.
Package names (eg 'A::B') are automatically converted to directory
names in the selected directory. (eg on unix 'A::B' is converted to
'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
search automatically if required.
A subdirectory F<pod/> is also checked if it exists in any of the given
search directories. This ensures that e.g. L<perlfunc|perlfunc> is
found.
It is assumed that if a module name is supplied, that that name
matches the file name. Pods are not opened to check for the 'NAME'
entry.
A check is made to make sure that the file that is found does
contain some pod documentation.
=cut
sub pod_where {
# default options
my %options = (
'-inc' => 0,
'-verbose' => 0,
'-dirs' => [ File::Spec->curdir ],
);
# Check for an options hash as first argument
if (defined $_[0] && ref($_[0]) eq 'HASH') {
my $opt = shift;
# Merge default options with supplied options
%options = (%options, %$opt);
}
# Check usage
carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
# Read argument
my $pod = shift;
# Split on :: and then join the name together using File::Spec
my @parts = split (/::/, $pod);
# Get full directory list
my @search_dirs = @{ $options{'-dirs'} };
if ($options{'-inc'}) {
require Config;
# Add @INC
if ($^O eq 'MacOS' && $options{'-inc'}) {
# tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
my @new_INC = @INC;
for (@new_INC) {
if ( $_ eq '.' ) {
$_ = ':';
} elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
$_ = ':'. $_;
} else {
$_ =~ s|^\./|:|;
}
}
push (@search_dirs, @new_INC);
} elsif ($options{'-inc'}) {
push (@search_dirs, @INC);
}
# Add location of pod documentation for perl man pages (eg perlfunc)
# This is a pod directory in the private install tree
#my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
# 'pod');
#push (@search_dirs, $perlpoddir)
# if -d $perlpoddir;
# Add location of binaries such as pod2text
push (@search_dirs, $Config::Config{'scriptdir'})
if -d $Config::Config{'scriptdir'};
}
warn "Search path is: ".join(' ', @search_dirs)."\n"
if $options{'-verbose'};
# Loop over directories
Dir: foreach my $dir ( @search_dirs ) {
# Don't bother if can't find the directory
if (-d $dir) {
warn "Looking in directory $dir\n"
if $options{'-verbose'};
# Now concatenate this directory with the pod we are searching for
my $fullname = File::Spec->catfile($dir, @parts);
warn "Filename is now $fullname\n"
if $options{'-verbose'};
# Loop over possible extensions
foreach my $ext ('', '.pod', '.pm', '.pl') {
my $fullext = $fullname . $ext;
if (-f $fullext &&
contains_pod($fullext, $options{'-verbose'}) ) {
warn "FOUND: $fullext\n" if $options{'-verbose'};
return $fullext;
}
}
} else {
warn "Directory $dir does not exist\n"
if $options{'-verbose'};
next Dir;
}
# for some strange reason the path on MacOS/darwin/cygwin is
# 'pods' not 'pod'
# this could be the case also for other systems that
# have a case-tolerant file system, but File::Spec
# does not recognize 'darwin' yet. And cygwin also has "pods",
# but is not case tolerant. Oh well...
if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
&& -d File::Spec->catdir($dir,'pods')) {
$dir = File::Spec->catdir($dir,'pods');
redo Dir;
}
if(-d File::Spec->catdir($dir,'pod')) {
$dir = File::Spec->catdir($dir,'pod');
redo Dir;
}
}
# No match;
return undef;
}
=head2 C<contains_pod( $file , $verbose )>
Returns true if the supplied filename (not POD module) contains some pod
information.
=cut
sub contains_pod {
my $file = shift;
my $verbose = 0;
$verbose = shift if @_;
# check for one line of POD
unless(open(POD,"<$file")) {
warn "Error: $file is unreadable: $!\n";
return undef;
}
local $/ = undef;
my $pod = <POD>;
close(POD) || die "Error closing $file: $!\n";
unless($pod =~ /^=(head\d|pod|over|item)\b/m) {
warn "No POD in $file, skipping.\n"
if($verbose);
return 0;
}
return 1;
}
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Marek Rouchal E<lt>marekr at cpan.orgE<gt>,
heavily borrowing code from Nick Ing-Simmons' PodToHtml.
Tim Jenness E<lt>t.jenness at 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;
More information about the dslinux-commit
mailing list