cd t
./perl -I../lib porting/podcheck.t [--show_all] [--cpan] [--counts]
[ FILE ...]
+ ./perl -I../lib porting/podcheck.t --add_link MODULE ...
+
./perl -I../lib porting/podcheck.t --regen
=head1 DESCRIPTION
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
=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 --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
# 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" );
+
# 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 $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 $non_pods = qr/ (?: \.
+ (?: [achot] | zip | gz | bz2 | jar | tar | tgz | PL | so
+ | orig | rej | patch # Patch program output
+ | sw[op] | \#.* # Editor droppings
+ )
+ $
+ ) | ~$ # Another editor dropping
+ /x;
# Pod::Checker messages to suppress
my $show_counts = 0;
my $regen = 0;
+my $add_link = 0;
my $show_all = 0;
# Assume that are to skip anything in /cpan
if ($arg eq '-regen') {
$regen = 1;
}
+ elsif ($arg eq '-add_link') {
+ $add_link = 1;
+ }
elsif ($arg eq '-cpan') {
$do_upstream_cpan = 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.
--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";
+if (($regen + $show_all + $show_counts + $do_upstream_cpan + $add_link) > 1) {
+ croak "--regen, --show_all, --cpan, --counts, and --add_link are mutually exclusive";
}
my $has_input_files = @files;
croak "--regen, --counts 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
package My::Pod::Checker { # Extend Pod::Checker
$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]))
}
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
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
+
+if ($add_link) {
+ $copy_fh = open_new($known_issues);
+ my @existing_db = <$data_fh>;
+ my_safer_print($copy_fh, @existing_db);
+
+ 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;
+ $module .= "\n";
+ next if grep { $module eq $_ } @existing_db;
+ my_safer_print($copy_fh, $module);
+ }
+ close_and_rename($copy_fh);
+ exit;
+}
+
while (<$data_fh>) { # Read the data base
chomp;
next if /^\s*(?:#|$)/; # Skip comment and empty lines
# 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
# 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
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
# 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})
+ # 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);
+ }
+ elsif ($NAME ne "perldelta"
+ || ! grep { $linked_to_page eq $_ } @perldelta_ignore_links)
{
- $problem{-msg} = $broken_internal_link;
+ 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 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
3) If there remain potential problems that you don't plan to fix right
now (or aren't really problems),
$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";