use feature 'unicode_strings';
use Carp;
+use Config;
use Digest;
use File::Find;
use File::Spec;
=head1 SYNOPSIS
cd t
- ./perl -I../lib porting/podcheck.t [--show_all] [--cpan] [--counts]
- [ FILE ...]
+ ./perl -I../lib porting/podcheck.t [--show_all] [--cpan] [--deltas]
+ [--counts] [ FILE ...]
+ ./perl -I../lib porting/podcheck.t --add_link MODULE ...
+
./perl -I../lib porting/podcheck.t --regen
=head1 DESCRIPTION
podcheck.t is an extension of Pod::Checker. It looks for pod errors and
potential errors in the files given as arguments, or if none specified, in all
-pods in the distribution workspace, except those in the cpan directory (unless
-C<--cpan> is specified). It does additional checking beyond that done by
+pods in the distribution workspace, except certain known special ones
+(specified below). It does additional checking beyond that done by
Pod::Checker, and keeps a database of known potential problems, and will
fail a pod only if the number of such problems differs from that given in the
database. It also suppresses the C<(section) deprecated> message from
Pod::Checker verifies that links to an internal target in a pod are not
broken. podcheck.t extends that (when called without FILE arguments) to
external links. It does this by gathering up all the possible targets in the
-workspace, and cross-checking them. The database has a list of known targets
-outside the workspace, so podcheck.t will not raise a warning for
-using those. It also checks that a non-broken link points to just one target.
-(The destination pod could have two targets with the same name.)
+workspace, and cross-checking them. It also checks that a non-broken link
+points to just one target. (The destination pod could have two targets with
+the same name.)
+
+The way that the C<LE<lt>E<gt>> pod command works (for links outside the pod)
+is to actually create a link to C<search.cpan.org> with an embedded query for
+the desired pod or man page. That means that links outside the distribution
+are valid. podcheck.t doesn't verify the validity of such links, but instead
+keeps a data base of those known to be valid. This means that if a link to a
+target not on the list is created, the target needs to be added to the data
+base. This is accomplished via the L<--add_link|/--add_link MODULE ...>
+option to podcheck.t, described below.
=item An internal link that isn't so specified
name, it is likely that the internal target was meant, and the C<"/"> is
missing from the C<LE<lt>E<gt>> pod command.
-=item Verbatim paragraphs that wrap in an 80 column window
+=item Verbatim paragraphs that wrap in an 80 (including 1 spare) column window
It's annoying to have lines wrap when displaying pod documentation in a
-terminal window. This checks that all such lines fit, and for those that
-don't, it tells you how much needs to be cut in order to fit. However,
-if you're fixing these, keep in mind that some terminal/pager combinations
-require really a maximum of 79 or 78 columns to display properly.
+terminal window. This checks that all verbatim lines fit in a standard 80
+column window, even when using a pager that reserves a column for its own use.
+(Thus the check is for a net of 79 columns.)
+For those lines that don't fit, it tells you how much needs to be cut in
+order to fit.
Often, the easiest thing to do to gain space for these is to lower the indent
to just one space.
=back
A number of issues raised by podcheck.t and by the base Pod::Checker are not
-really problems, but merely potential problems. After inspecting them and
+really problems, but merely potential problems, that is, false positives.
+After inspecting them and
deciding that they aren't real problems, it is possible to shut up this program
about them, unlike base Pod::Checker. To do this, call podcheck.t with the
C<--regen> option to regenerate the database. This tells it that all existing
the database must be regenerated so that it knows the new number. The program
gives instructions when this happens.
+Some pods will have varying numbers of problems of a given type. This can
+be handled by manually editing the database file (see L</FILES>), and setting
+the number of those problems for that pod to a negative number. This will
+cause the corresponding error to always be suppressed no matter how many there
+actually are.
+
There is currently no check that modules listed as valid in the data base
actually are. Thus any errors introduced there will remain there.
+=head2 Specially handled pods
+
+=over
+
+=item perltoc
+
+This pod is generated by pasting bits from other pods. Errors in those bits
+will show up as errors here, as well as for those other pods. Therefore
+errors here are suppressed, and the pod is checked only to verify that nodes
+within it that are externally linked to actually exist.
+
+=item perldelta
+
+The current perldelta pod is initialized from a template that contains
+placeholder text. Some of this text is in the form of links that don't really
+exist. Any such links that are listed in C<@perldelta_ignore_links> will not
+generate messages. It is presumed that these links will be cleaned up when
+the perldelta is cleaned up for release since they should be marked with
+C<XXX>.
+
+=item Porting/perldelta_template.pod
+
+This is not a pod, but a template for C<perldelta>. Any errors introduced
+here will show up when C<perldelta> is created from it.
+
+=item cpan-upstream pods
+
+See the L</--cpan> option documentation
+
+=item old perldeltas
+
+See the L</--deltas> option documentation
+
+=back
+
=head1 OPTIONS
=over
+=item --add_link MODULE ...
+
+Use this option to teach podcheck.t that the C<MODULE>s or man pages actually
+exist, and to silence any messages that links to them are broken.
+
+podcheck.t checks that links within the Perl core distribution are valid, but
+it doesn't check links to man pages or external modules. When it finds
+a broken link, it checks its data base of external modules and man pages,
+and only if not found there does it raise a message. This option just adds
+the list of modules and man page references that follow it on the command line
+to that data base.
+
+For example,
+
+ cd t
+ ./perl -I../lib porting/podcheck.t --add_link Unicode::Casing
+
+causes the external module "Unicode::Casing" to be added to the data base, so
+C<LE<lt>Unicode::Casing<gt>> will be considered valid.
+
=item --regen
Regenerate the data base used by podcheck.t to include all the existing
Normally, all pods in the cpan directory are skipped, except to make sure that
any blead-upstream links to such pods are valid.
-This option will cause cpan upstream pods to be checked.
+This option will cause cpan upstream pods to be fully checked.
+
+=item --deltas
+
+Normally, all old perldelta pods are skipped, except to make sure that
+any links to such pods are valid. This is because they are considered
+stable, and perhaps trying to fix them will cause changes that will
+misrepresent Perl's history. But, this option will cause them to be fully
+checked.
=item --show_all
# has many false positives; higher numbers give more messages.
my $Warnings_Level = 200;
+# perldelta during construction may have place holder links.
+our @perldelta_ignore_links = ( "XXX", "perl5YYYdelta", "perldiag/message" );
+
# To see if two pods with the same NAME are actually copies of the same pod,
# which is not an error, it uses a checksum to save work.
my $digest_type = "SHA-1";
my $known_issues = File::Spec->catfile($data_dir, 'known_pod_issues.dat');
my $copy_fh;
-my $MAX_LINE_LENGTH = 80; # 80 columns
-my $INDENT = 8; # default nroff indent
+my $MAX_LINE_LENGTH = 79; # 79 columns
+my $INDENT = 7; # default nroff indent
# Our warning messages. Better not have [('"] in them, as those are used as
# delimiters for variable parts of the messages by poderror.
my $missing_name_description = "The NAME should have a dash and short description after it";
# objects, tests, etc can't be pods, so don't look for them. Also skip
-# files output by the patch program.
-my $non_pods = qr/\.(?:[achot]|zip|gz|bz2|jar|tar|tgz|PL|so|orig|rej)$/;
+# files output by the patch program. Could also ignore most of .gitignore
+# files, but not all, so don't.
+
+my $obj_ext = $Config{'obj_ext'}; $obj_ext =~ tr/.//d; # dot will be added back
+my $lib_ext = $Config{'lib_ext'}; $lib_ext =~ tr/.//d;
+my $lib_so = $Config{'so'}; $lib_so =~ tr/.//d;
+my $dl_ext = $Config{'dlext'}; $dl_ext =~ tr/.//d;
+
+# This list should not include anything for which case sensitivity is
+# important, as it won't work on VMS, and won't show up until tested on VMS.
+# Instead is_pod_file() can be used to exclude these at a finer grained
+# level.
+my $non_pods = qr/ (?: \.
+ (?: [achot] | zip | gz | bz2 | jar | tar | tgz
+ | orig | rej | patch # Patch program output
+ | sw[op] | \#.* # Editor droppings
+ | old # buildtoc output
+ | xs # pod should be in the .pm file
+ | al # autosplit files
+ | bs # bootstrap files
+ | (?i:sh) # shell scripts, hints, templates
+ | lst # assorted listing files
+ | bat # Windows,Netware,OS2 batch files
+ | cmd # Windows,Netware,OS2 command files
+ | lis # VMS compiler listings
+ | map # VMS linker maps
+ | opt # VMS linker options files
+ | mms # MM(K|S) description files
+ | ts # timestamp files generated during build
+ | $obj_ext # object files
+ | exe # $Config{'exe_ext'} might be empty string
+ | $lib_ext # object libraries
+ | $lib_so # shared libraries
+ | $dl_ext # dynamic libraries
+ )
+ $
+ ) | ~$ | \ \(Autosaved\)\.txt$ # Other editor droppings
+ | ^cxx\$demangler_db\.$ # VMS name mangler database
+ | ^typemap\.?$ # typemap files
+ | ^(?i:Makefile\.PL)$
+ /x;
# Pod::Checker messages to suppress
"multiple occurrence of link target", # We catch independently the ones
# that are real problems.
"unescaped <>",
+ "Entity number out of range", # Checker outputs this for anything above
+ # 255, and all Unicode is valid
);
sub suppressed {
# Assumes $volume is constant for everything in this directory structure
$directories = "" if ! $directories;
$file = "" if ! $file;
+ $file =~ s/\.$// if $^O eq 'VMS';
my $output = lc join '/', File::Spec->splitdir($directories), $file;
$output =~ s! / /+ !/!gx; # Multiple slashes => single slash
return $output;
my $show_counts = 0;
my $regen = 0;
+my $add_link = 0;
my $show_all = 0;
-# Assume that are to skip anything in /cpan
-my $do_upstream_cpan = 0;
+my $do_upstream_cpan = 0; # Assume that are to skip anything in /cpan
+my $do_deltas = 0; # And stable perldeltas
while (@ARGV && substr($ARGV[0], 0, 1) eq '-') {
my $arg = shift @ARGV;
if ($arg eq '-regen') {
$regen = 1;
}
+ elsif ($arg eq '-add_link') {
+ $add_link = 1;
+ }
elsif ($arg eq '-cpan') {
$do_upstream_cpan = 1;
}
+ elsif ($arg eq '-deltas') {
+ $do_deltas = 1;
+ }
elsif ($arg eq '-show_all') {
$show_all = 1;
}
die <<EOF;
Unknown option '$arg'
-Usage: $0 [ --regen | --cpan | --show_all ] [ FILE ... ]\n"
- --cpan -> Include files in the cpan subdirectory.
+Usage: $0 [ --regen | --cpan | --show_all | FILE ... | --add_link MODULE ... ]\n"
+ --add_link -> Add the MODULE and man page references to the data base
--regen -> Regenerate the data file for $0
+ --cpan -> Include files in the cpan subdirectory.
+ --deltas -> Include stable perldeltas
--show_all -> Show all known potential problems
--counts -> Don't test, but give summary counts of the currently
existing database
my @files = @ARGV;
-if (($regen + $show_all + $show_counts + $do_upstream_cpan) > 1) {
- croak "--regen, --show_all, --cpan, and --counts are mutually exclusive";
+my $cpan_or_deltas = $do_upstream_cpan || $do_deltas;
+if (($regen + $show_all + $show_counts + $add_link + $cpan_or_deltas ) > 1) {
+ croak "--regen, --show_all, --counts, and --add_link are mutually exclusive\n and none can be run with --cpan nor --deltas";
}
my $has_input_files = @files;
-if ($has_input_files && ($regen || $show_counts || $do_upstream_cpan)) {
- croak "--regen, --counts and --cpan can't be used since using specific files";
+if ($has_input_files
+ && ($regen || $show_counts || $do_upstream_cpan || $do_deltas))
+{
+ croak "--regen, --counts, --deltas, and --cpan can't be used since using specific files";
+}
+
+if ($add_link && ! $has_input_files) {
+ croak "--add_link requires at least one module or man page reference";
}
our %problems; # potential problems found in this run
$self->SUPER::verbatim($paragraph, $line_num, $pod_para);
+ my $addr = Scalar::Util::refaddr $self;
+
# Pick up the name, since the parent class doesn't in verbatim
# NAMEs; so treat as non-verbatim. The parent class only allows one
# paragraph in a NAME section, so if there is an extra blank line, it
# will trigger a message, but such a blank line is harmless, so skip
# in that case.
- if ($in_NAME{Scalar::Util::refaddr $self} && $paragraph =~ /\S/) {
+ if ($in_NAME{$addr} && $paragraph =~ /\S/) {
$self->textblock($paragraph, $line_num, $pod_para);
}
my @lines = split /^/, $paragraph;
for my $i (0 .. @lines - 1) {
+ if ( my $encoding = $seen_encoding_cmd{$addr} ) {
+ require Encode;
+ $lines[$i] = Encode::decode($encoding, $lines[$i]);
+ }
$lines[$i] =~ s/\s+$//;
my $indent = $self->get_current_indent;
my $exceeds = length(Text::Tabs::expand($lines[$i]))
# Matches something that looks like a file name, but is enclosed in
# C<...>
my $C_path_re = qr{ \b ( C<
- # exclude regexes and 'OS/2'
- (?! (?: (?: s | qr | m) / ) | OS/2 > )
- \w+ (?: / \w+ )+ > (?: \. \w+ )? )
+ # exclude various things that have slashes
+ # in them but aren't paths
+ (?!
+ (?: (?: s | qr | m) / ) # regexes
+ | \d+/\d+> # probable fractions
+ | OS/2>
+ | Perl/Tk>
+ | origin/blead>
+ | origin/maint
+ | - # File names don't begin with "-"
+ )
+ [-\w]+ (?: / [-\w]+ )+ (?: \. \w+ )? > )
}x;
# If looks like a reference to other documentation by containing the
# word 'See' and then a likely pod directive, warn.
-
- while ($paragraph =~ m{ \b See \s+ ( ( [^L] ) <
- ( [^<]*? ) # The not-< excludes nested C<L<...
- > ) }ixg) {
- my $construct = $1;
- my $type = $2;
- my $interior = $3;
- if ($interior !~ /$non_pods/
- && $construct !~ /$C_path_re/g) {
- $self->poderror({ -line => $line, -file => $file,
- -msg => $see_not_linked,
- parameter => $construct
- });
+ while ($paragraph =~ m{
+ ( (?: \w+ \s+ )* ) # The phrase before, if any
+ \b [Ss]ee \s+
+ ( ( [^L] )
+ <
+ ( [^<]*? ) # The not < excludes nested C<L<...
+ >
+ )
+ ( \s+ (?: under | in ) \s+ L< )?
+ }xg) {
+ my $prefix = $1 // "";
+ my $construct = $2; # The whole thing, like C<...>
+ my $type = $3;
+ my $interior = $4;
+ my $trailing = $5; # After the whole thing ending in "L<"
+
+ # If the full phrase is something like, "you might see C<", or
+ # similar, it really isn't a reference to a link. The ones I saw
+ # all had the word "you" in them; and the "you" wasn't the
+ # beginning of a sentence.
+ if ($prefix !~ / \b you \b /x) {
+
+ # Now, find what the module or man page name within the
+ # construct would be if it actually has L<> syntax. If it
+ # doesn't have that syntax, will set the module to the entire
+ # interior.
+ $interior =~ m/ ^
+ (?: [^|]+ \| )? # Optional arbitrary text ending
+ # in "|"
+ ( .+? ) # module, etc. name
+ (?: \/ .+ )? # target within module
+ $
+ /xs;
+ my $module = $1;
+ if (! defined $trailing # not referring to something in another
+ # section
+ && $interior !~ /$non_pods/
+
+ # C<> that look like files have their own message below, so
+ # exclude them
+ && $construct !~ /$C_path_re/g
+
+ # There can't be spaces (I think) in module names or man
+ # pages
+ && $module !~ / \s /x
+
+ # F<> that end in eg \.pl are almost certainly ok, as are
+ # those that look like a path with multiple "/" chars
+ && ($type ne "F"
+ || (! -e $interior
+ && $interior !~ /\.\w+$/
+ && $interior !~ /\/.+\//)
+ )
+ ) {
+ $self->poderror({ -line => $line, -file => $file,
+ -msg => $see_not_linked,
+ parameter => $construct
+ });
+ }
}
}
while ($paragraph =~ m/$C_path_re/g) {
}
elsif ($cmd eq "encoding") {
my ($file, $line) = $pod_para->file_line;
- $seen_encoding_cmd{$addr} = 1;
+ $seen_encoding_cmd{$addr} = $paragraph; # for later decoding
if ($command_count{$addr} != 1 && $seen_pod_cmd{$addr}) {
$self->poderror({ -line => $line, -file => $file,
-msg => $encoding_first
sub hyperlink {
my $self = shift;
- # If the hyperlink is to an interior node of another page, save it
- # so that we can see if we need to parse normally skipped files.
- $has_referred_to_node{$_[0][1]{'-page'}} = 1
- if $_[0] && $_[0][1]{'-page'} && $_[0][1]{'-node'};
+ my $page;
+ if ($_[0] && ($page = $_[0][1]{'-page'})) {
+ my $node = $_[0][1]{'-node'};
+
+ # If the hyperlink is to an interior node of another page, save it
+ # so that we can see if we need to parse normally skipped files.
+ $has_referred_to_node{$page} = 1 if $node;
+
+ # Ignore certain placeholder links in perldelta. Check if the
+ # link is page-level, and also check if to a node within the page
+ if ($self->name && $self->name eq "perldelta"
+ && ((grep { $page eq $_ } @perldelta_ignore_links)
+ || ($node
+ && (grep { "$page/$node" eq $_ } @perldelta_ignore_links)
+ ))) {
+ return;
+ }
+ }
return $self->SUPER::hyperlink($_[0]);
}
my %files_with_fixes;
my $data_fh;
-open($data_fh, $known_issues) || die "Can't open $known_issues";
+open $data_fh, '<:bytes', $known_issues or die "Can't open $known_issues";
my %counts; # For --counts param, count of each issue type
my %suppressed_files; # Files with at least one issue type to suppress
+my $HEADER = <<END;
+# This file is the data file for $0.
+# There are three types of lines.
+# Comment lines are white-space only or begin with a '#', like this one. Any
+# changes you make to the comment lines will be lost when the file is
+# regen'd.
+# Lines without tab characters are simply NAMES of pods that the program knows
+# will have links to them and the program does not check if those links are
+# valid.
+# All other lines should have three fields, each separated by a tab. The
+# first field is the name of a pod; the second field is an error message
+# generated by this program; and the third field is a count of how many
+# known instances of that message there are in the pod. -1 means that the
+# program can expect any number of this type of message.
+END
+
+my @existing_issues;
+
while (<$data_fh>) { # Read the data base
chomp;
next if /^\s*(?:#|$)/; # Skip comment and empty lines
if (/\t/) {
next if $show_all;
+ if ($add_link) { # The issues are saved and later output unchanged
+ push @existing_issues, $_;
+ next;
+ }
# Keep track of counts of each issue type for each file
my ($filename, $message, $count) = split /\t/;
}
close $data_fh;
+if ($add_link) {
+ $copy_fh = open_new($known_issues);
+
+ # Check for basic sanity, and add each command line argument
+ foreach my $module (@files) {
+ die "\"$module\" does not look like a module or man page"
+ # Must look like (A or A::B or A::B::C ..., or foo(3C)
+ if $module !~ /^ (?: \w+ (?: :: \w+ )* | \w+ \( \d \w* \) ) $/x;
+ $valid_modules{$module} = 1
+ }
+ my_safer_print($copy_fh, $HEADER);
+ foreach (sort { lc $a cmp lc $b } keys %valid_modules) {
+ my_safer_print($copy_fh, $_, "\n");
+ }
+
+ # The rest of the db file is output unchanged.
+ my_safer_print($copy_fh, join "\n", @existing_issues, "");
+
+ close_and_rename($copy_fh);
+ exit;
+}
+
if ($show_counts) {
my $total = 0;
foreach my $message (sort keys %counts) {
}
+# Not really pods, but can look like them.
my %excluded_files = (
"lib/unicore/mktables" => 1,
"Porting/perldelta_template.pod" => 1,
"configpm" => 1,
"miniperl" => 1,
"perl" => 1,
-
- # It would be nice if we didn't have to skip this,
- # but the errors in it are too variable.
- "pod/perltoc.pod" => 1,
);
# Convert to more generic form.
foreach my $file (keys %excluded_files) {
- $excluded_files{canonicalize($excluded_files{$file})}
- = $excluded_files{$file};
+ delete $excluded_files{$file};
+ $excluded_files{canonicalize($file)} = 1;
}
# re to match files that are to be parsed only if there is an internal link
# to them. It does not include cpan, as whether those are parsed depends
-# on a switch. Currently, only the stable perldelta.pod's are included.
-# These all have characters between 'perl' and 'delta'. (Actually the
-# currently developed one matches as well, but is a duplicate of
-# perldelta.pod, so can be skipped, so fine for it to match this.
-my $only_for_interior_links_re = qr/ \b perl \d+ delta \. pod \b/x;
+# on a switch. Currently, only perltoc and the stable perldelta.pod's
+# are included. The latter all have characters between 'perl' and
+# 'delta'. (Actually the currently developed one matches as well, but
+# is a duplicate of perldelta.pod, so can be skipped, so fine for it to
+# match this.
+my $only_for_interior_links_re = qr/ ^ pod\/perltoc.pod $
+ /x;
+unless ($do_deltas) {
+ $only_for_interior_links_re = qr/$only_for_interior_links_re |
+ \b perl \d+ delta \. pod \b
+ /x;
+}
{ # Closure
my $first_time = 1;
# Arrange for the output of Pod::Parser to be collected in an array we can
# look at instead of being printed
tie *ALREADY_FH, 'Tie_Array_to_FH', \@pod;
- open my $in_fh, '<', $filename
+ open my $in_fh, '<:bytes', $filename
+
+ # The file should already have been opened once to get here, so if
+ # fails, just die. It's possible that a transitory file containing a
+ # pod would get here, but not bothering to add code for that very
+ # unlikely event.
or die "Can't open '$filename': $!\n";
my $parser = Pod::Parser->new();
my $digest = Digest->new($digest_type);
sub is_pod_file {
+ # If $_ is a pod file, add it to the lists and do other prep work.
+
if (-d $_) {
# Don't look at files in directories that are for tests, nor those
# beginning with a dot
return;
}
- return if $_ =~ /^\./; # No hidden Unix files
- return if $_ =~ $non_pods;
-
+ if ($_ =~ /^\./ # No hidden Unix files
+ || $_ =~ $non_pods) {
+ note("Not considering $_") if DEBUG;
+ return;
+ }
+
my $filename = $File::Find::name;
+ # In pod directories, skip .pl files. This is a workaround for VMS which
+ # can't by default distnguish between .PL and .pl. We usually want to
+ # examine .pl files but not .PL, but the one case where there is a current
+ # conflict is in /pod, and there's only one .PL file there.
+ if ($File::Find::dir =~ /pod$/ && $filename =~ /\.pl$/i) {
+ note("Not considering $_") if DEBUG;
+ return;
+ }
+
# Assumes that the path separator is exactly one character.
$filename =~ s/^\..//;
my $contents = do {
local $/;
- open my $candidate, '<', $_
- or die "Can't open '$File::Find::name': $!\n";
+ my $candidate;
+ if (! open $candidate, '<:bytes', $_) {
+
+ # If a transitory file was found earlier, the open could fail
+ # legitimately and we just skip the file; also skip it if it is a
+ # broken symbolic link, as it is probably just a build problem;
+ # certainly not a file that we would want to check the pod of.
+ # Otherwise fail it here and no reason to process it further.
+ # (But the test count will be off too)
+ ok(0, "Can't open '$filename': $!")
+ if -e $filename && ! -l $filename;
+ return;
+ }
<$candidate>;
};
}
}
}
+
+ return;
} # End of is_pod_file()
-# Start of real code that isn't processing the command line.
+# Start of real code that isn't processing the command line (except the
+# db is read in above, as is processing of the --add_link option).
# Here, @files contains list of files on the command line. If have any of
# these, unconditionally test them, and show all the errors, even the known
# ones, and, since not testing other pods, don't do cross-pod link tests.
# (Could add extra code to do cross-pod tests for the ones in the list.)
+
if ($has_input_files) {
undef %known_problems;
- $do_upstream_cpan = 1; # In case one of the inputs is from cpan
-
+ $do_upstream_cpan = $do_deltas = 1; # In case one of the inputs is one
+ # of these types
}
else { # No input files -- go find all the possibilities.
if ($regen) {
$copy_fh = open_new($known_issues);
note("Regenerating $known_issues, please be patient...");
- print $copy_fh <<END;
-# This file is the data file for $0.
-# There are three types of lines.
-# Comment lines are white-space only or begin with a '#', like this one. Any
-# changes you make to the comment lines will be lost when the file is
-# regen'd.
-# Lines without tab characters are simply NAMES of pods that the program knows
-# will have links to them and the program does not check if those links are
-# valid.
-# All other lines should have three fields, each separated by a tab. The
-# first field is the name of a pod; the second field is an error message
-# generated by this program; and the third field is a count of how many
-# known instances of that message there are in the pod. -1 means that the
-# program can expect any number of this type of message.
-END
+ print $copy_fh $HEADER;
}
# Move to the directory above us, but have to adjust @INC to account for
$checker->set_skip("$prior_filename is a README apparently for $filename");
} elsif ($filename =~ /\breadme\b/i) {
$checker->set_skip("$filename is a README apparently for $prior_filename");
+ } elsif (! $do_upstream_cpan && $filename =~ /^cpan/) {
+ $checker->set_skip("CPAN is upstream for $filename");
} else { # Here have two pods with identical names that differ
$prior_checker->poderror(
{ -msg => $duplicate_name,
if ($filename =~ /^cpan/) {
$checker->set_skip("CPAN is upstream for $filename");
}
- elsif ($filename =~ /perl\d+delta/) {
+ elsif ($filename =~ /perl\d+delta/ && ! $do_deltas) {
$checker->set_skip("$filename is a stable perldelta");
}
+ elsif ($filename =~ /perltoc/) {
+ $checker->set_skip("$filename dependent on component pods");
+ }
else {
croak("Unexpected file '$filename' encountered that has parsing for interior-linking only");
}
# Here, is a link to a target that we can't find. Check if
# there is an internal link on the page with the target name.
# If so, it could be that they just forgot the initial '/'
- if ($filename_to_pod{$filename}
- && $nodes{$filename_to_pod{$filename}}{$linked_to_page})
- {
- $problem{-msg} = $broken_internal_link;
+ # But perldelta is handled specially: only do this if the
+ # broken link isn't one of the known bad ones (that are
+ # placemarkers and should be removed for the final)
+ my $NAME = $filename_to_pod{$filename};
+ if (! defined $NAME) {
+ $checker->poderror(\%problem);
+ }
+ else {
+ if ($nodes{$NAME}{$linked_to_page}) {
+ $problem{-msg} = $broken_internal_link;
+ }
+ $checker->poderror(\%problem);
}
- $checker->poderror(\%problem);
}
}
}
ok(@diagnostics == 0, $output);
if (@diagnostics) {
note(join "", @diagnostics,
- "See end of this test output for your options");
+ "See end of this test output for your options on silencing this");
}
}
}
HOW TO GET THIS .t TO PASS
-There $were_count_files that had new potential problems identified. To get
-this .t to pass, do the following:
+There $were_count_files that had new potential problems identified.
+Some of them may be real, and some of them may be false positives because
+this program isn't as smart as it likes to think it is. You can teach this
+program to ignore the issues it has identified, and hence pass, by doing the
+following:
-1) If a problem is about a link to an unknown module that you know exists,
- simply edit the file,
- $known_issues
- and add anywhere a line that contains just the module's name.
- (Don't do this for a module that you aren't sure about; instead treat
- as another type of issue and follow the instructions below.)
+1) If a problem is about a link to an unknown module or man page that
+ you know exists, re-run the command something like:
+ ./perl -I../lib porting/podcheck.t --add_link MODULE man_page ...
+ (MODULEs should look like Foo::Bar, and man_pages should look like
+ bar(3c); don't do this for a module or man page that you aren't sure
+ about; instead treat as another type of issue and follow the
+ instructions below.)
2) For other issues, decide if each should be fixed now or not. Fix the
ones you decided to, and rerun this test to verify that the fixes
worked.
-3) If there remain potential problems that you don't plan to fix right
- now (or aren't really problems),
+3) If there remain false positive or problems that you don't plan to fix right
+ now,
$how_to
- That should cause all current potential problems to be accepted by the
- program, so that the next time it runs, they won't be flagged.
+ That should cause all current potential problems to be accepted by
+ the program, so that the next time it runs, they won't be flagged.
EOF
if (%files_with_fixes) {
$message .= " This step will also take care of the files that have fixes in them\n";
https://perl5.git.perl.org / perl5.git / blobdiff