The POD file has some C<=item> and/or C<=head> commands that have
the same text. Potential hyperlinks to such a text cannot be unique then.
+This warning is printed only with warning level greater than one.
=item * line containing nothing but whitespace in paragraph
# check the internal nodes for uniqueness. This pertains to
# =headX, =item and X<...>
- foreach(grep($self->{_unique_nodes}->{$_} > 1,
- keys %{$self->{_unique_nodes}})) {
- $self->poderror({ -line => '-', -file => $infile,
+ if($self->{-warnings} && $self->{-warnings}>1) {
+ foreach(grep($self->{_unique_nodes}->{$_} > 1,
+ keys %{$self->{_unique_nodes}})) {
+ $self->poderror({ -line => '-', -file => $infile,
-severity => 'WARNING',
-msg => "multiple occurrence of link target '$_'"});
+ }
}
# no POD found here
package Pod::Find;
use vars qw($VERSION);
-$VERSION = 0.24_01; ## Current version of this package
+$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
use Carp;
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;
package Pod::InputObjects;
use vars qw($VERSION);
-$VERSION = 1.14; ## Current version of this package
+$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
package Pod::ParseUtils;
use vars qw($VERSION);
-$VERSION = 1.20; ## Current version of this package
+$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
=head1 NAME
package Pod::Parser;
use vars qw($VERSION);
-$VERSION = 1.14; ## Current version of this package
+$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
STDERR filehandle is used for output (and no open or close is
performed). If no output filehandle is currently in use and no output
filename is specified, then "-" is implied.
+Alternatively, an L<IO::String> object is also accepted as an output
+file handle.
This method does I<not> usually need to be overridden by subclasses.
my ($in_fh, $out_fh) = (gensym, gensym) if ($] < 5.6);
my ($close_input, $close_output) = (0, 0);
local *myData = $self;
- local $_;
+ local *_;
## Is $infile a filename or a (possibly implied) filehandle
- $infile = '-' unless ((defined $infile) && (length $infile));
+ $infile = '-' unless ((defined $infile) && (length $infile));
if (($infile eq '-') || ($infile =~ /^<&(STDIN|0)$/i)) {
## Not a filename, just a string implying STDIN
+ $infile ||= '-';
$myData{_INFILE} = "<standard input>";
$in_fh = \*STDIN;
}
elsif (ref $infile) {
+ if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
+ croak "Input from $1 reference not supported!\n";
+ }
## Must be a filehandle-ref (or else assume its a ref to an object
## that supports the common IO read operations).
$myData{_INFILE} = ${$infile};
## the entire document (but *not* if this is an included file). We
## determine this by seeing if the input stream stack has been set-up
## already
- ##
- unless ((defined $outfile) && (length $outfile)) {
- (defined $myData{_TOP_STREAM}) && ($out_fh = $myData{_OUTPUT})
- || ($outfile = '-');
- }
- ## Is $outfile a filename or a (possibly implied) filehandle
- if ((defined $outfile) && (length $outfile)) {
- if (($outfile eq '-') || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) {
+
+ ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?
+ if (!defined($outfile) || !length($outfile) || ($outfile eq '-')
+ || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
+ {
+ if (defined $myData{_TOP_STREAM}) {
+ $out_fh = $myData{_OUTPUT};
+ }
+ else {
## Not a filename, just a string implying STDOUT
+ $outfile ||= '-';
$myData{_OUTFILE} = "<standard output>";
$out_fh = \*STDOUT;
}
- elsif ($outfile =~ /^>&(STDERR|2)$/i) {
- ## Not a filename, just a string implying STDERR
- $myData{_OUTFILE} = "<standard error>";
- $out_fh = \*STDERR;
+ }
+ elsif (ref $outfile) {
+ ## we need to check for ref() first, as other checks involve reading
+ if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {
+ croak "Output to $1 reference not supported!\n";
+ }
+ elsif (ref($outfile) eq 'SCALAR') {
+# # NOTE: IO::String isn't a part of the perl distribution,
+# # so probably we shouldn't support this case...
+# require IO::String;
+# $myData{_OUTFILE} = "$outfile";
+# $out_fh = IO::String->new($outfile);
+ croak "Output to SCALAR reference not supported!\n";
}
- elsif (ref $outfile) {
+ else {
## Must be a filehandle-ref (or else assume its a ref to an
## object that supports the common IO write operations).
$myData{_OUTFILE} = ${$outfile};
$out_fh = $outfile;
}
- else {
- ## We have a filename, open it for writing
- $myData{_OUTFILE} = $outfile;
- (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
- open($out_fh, "> $outfile") or
- croak "Can't open $outfile for writing: $!\n";
- $close_output = 1;
- }
+ }
+ elsif ($outfile =~ /^>&(STDERR|2)$/i) {
+ ## Not a filename, just a string implying STDERR
+ $myData{_OUTFILE} = "<standard error>";
+ $out_fh = \*STDERR;
+ }
+ else {
+ ## We have a filename, open it for writing
+ $myData{_OUTFILE} = $outfile;
+ (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
+ open($out_fh, "> $outfile") or
+ croak "Can't open $outfile for writing: $!\n";
+ $close_output = 1;
}
## Whew! That was a lot of work to set up reasonably/robust behavior
=cut
1;
+# vim: ts=4 sw=4 et
package Pod::Select;
use vars qw($VERSION);
-$VERSION = 1.13; ## Current version of this package
+$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
## Keep track of current sections levels and headings
$_ = $paragraph;
- if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) {
+ 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));
sub podselect {
my(@argv) = @_;
- my %defaults = ();
+ my %defaults = ();
my $pod_parser = new Pod::Select(%defaults);
my $num_inputs = 0;
my $output = ">&STDOUT";
- my %opts = ();
+ my %opts;
local $_;
for (@argv) {
if (ref($_)) {
- next unless (ref($_) eq 'HASH');
+ next unless (ref($_) eq 'HASH');
%opts = (%defaults, %{$_});
##-------------------------------------------------------------
=cut
1;
-
+# vim: ts=4 sw=4 et
package Pod::Usage;
use vars qw($VERSION);
-$VERSION = 1.16_01; ## Current version of this package
+$VERSION = 1.30; ## Current version of this package
require 5.005; ## requires this Perl version or later
=head1 NAME
"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 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
'(?:\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{"-verbose"} >= 2
my %params = @_;
my $self = {%params};
bless $self, $class;
- $self->initialize();
+ 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;
+ }
+}
+
+# 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
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
-$file = basename($0, '.PL');
-$file .= '.com' if $^O eq 'VMS';
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
-$file = basename($0, '.PL');
-$file .= '.com' if $^O eq 'VMS';
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
*** ERROR: unresolved internal link 'OoPs' at line 110 in file t/pod/poderrs.t
*** ERROR: unresolved internal link 'abc def' at line 114 in file t/pod/poderrs.t
*** ERROR: unresolved internal link 'I/O Operators' at line 202 in file t/pod/poderrs.t
-*** WARNING: multiple occurrence of link target 'Misc' at line - in file t/pod/poderrs.t
projects / platform / upstream / perl.git / commitdiff