Move the common Pod scanning code from installman and buildtoc to pod_lib.pl

[perl5.git] / pod / buildtoc

diff --git a/pod/buildtoc b/pod/buildtoc
index 25ff14a..06307c4 100644 (file)
--- a/pod/buildtoc
+++ b/pod/buildtoc
@@ -1,13 +1,11 @@
 #!/usr/bin/perl -w
 
 use strict;
-use vars qw(%Found $Quiet %Lengths %MD5s);
+use vars qw($Quiet);
 use File::Spec;
-use File::Find;
 use FindBin;
 use Text::Wrap;
 use Getopt::Long;
-use Digest::MD5 'md5';
 
 no locale;
 
@@ -22,49 +20,11 @@ BEGIN {
 die "$0: Usage: $0 [--quiet]\n"
     unless GetOptions (quiet => \$Quiet) && !@ARGV;
 
-my $state = get_pod_metadata(0, 'pod/perltoc.pod');
-
-warn @{$state->{inconsistent}} if @{$state->{inconsistent}};
-
-# Find all the modules
-my @modpods;
-find(sub {
-    if (/\.p(od|m)$/) {
-      my $file = $File::Find::name;
-      return if $file =~ qr!/Pod/Functions.pm\z!; # Used only by pod itself
-      return if $file =~ m!(?:^|/)t/!;
-      return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
-      return if $file =~ m!XS/(?:APItest|Typemap)!;
-      my $pod = $_;
-      return if $pod =~ s/pm$/pod/ && -e $pod;
-      open my $f, '<', $_ or my_die "Can't open file '$_': $!";
-      {
-       my $line;
-       while ($line = <$f>) {
-         if ($line =~ /^=head1\s+NAME\b/) {
-           push @modpods, $file;
-           return;
-         }
-       }
-       warn "$0: NOTE: cannot find '=head1 NAME' in:\n  $file\n" unless $Quiet;
-      }
-    }
-  }, 'lib');
+my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
 
-my_die "Can't find any pods!\n" unless @modpods;
+my $found = pods_to_install();
 
-my %done;
-for (@modpods) {
-    my $name = $_;
-    $name =~ s/\.p(m|od)$//;
-    $name =~ s-\Alib/--;
-    $name =~ s-/-::-g;
-    my_die("Duplicate files for $name, '$done{$name}' and '$_'")
-        if exists $done{$name};
-    $done{$name} = $_;
-
-    $Found{$name =~ /^[a-z]/ ? 'PRAGMA' : 'MODULE'}{$name} = $_;
-}
+my_die "Can't find any pods!\n" unless %$found;
 
 # Accumulating everything into a lexical before writing to disk dates from the
 # time when this script also provided the functionality of regen/pod_rules.pl
@@ -96,9 +56,9 @@ my $roffitall;
 EOPOD2B
 
 # All the things in the master list that happen to be pod filenames
-foreach (grep {defined $_ && @$_ == 5 && !$_->[0]{toc_omit}} @{$state->{master}}) {
-    $roffitall .= "    \$mandir/$_->[4].1 \\\n";
-    podset($_->[4], $_->[2], $_->[1] ne $_->[4]);
+foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
+    $roffitall .= "    \$mandir/$_->[0].1 \\\n";
+    podset($_->[0], $_->[1]);
 }
 
 foreach my $type (qw(PRAGMA MODULE)) {
@@ -110,9 +70,9 @@ foreach my $type (qw(PRAGMA MODULE)) {
 
 EOPOD2B
 
-    foreach my $name (sort keys %{$Found{$type}}) {
-       $roffitall .= "    \$libdir/$name.3 \\\n"
-           if podset($name, $Found{$type}{$name});
+    foreach my $name (sort keys %{$found->{$type}}) {
+        $roffitall .= "    \$libdir/$name.3 \\\n";
+        podset($name, $found->{$type}{$name});
     }
 }
 
@@ -128,7 +88,7 @@ $_= <<"EOPOD2B";
 
 EOPOD2B
 
-$_ .=  join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
+$_ .=  join "\n", map {"\t=item $_\n"} @{$state->{aux}};
 $_ .= <<"EOPOD2B" ;
 
        =back
@@ -222,23 +182,27 @@ exit(0);
 my ($inhead1, $inhead2, $initem);
 
 sub podset {
-    my ($pod, $file, $possibly_duplicated) = @_;
-
-    local $/ = '';
+    my ($pod, $file) = @_;
 
     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
-    if ($possibly_duplicated) {
-       # We are a dual-life perl*.pod file, which will have be copied to lib/
-       # by the build process, and hence also found there.
-       ++$Lengths{-s $file};
-       ++$MD5s{md5(slurp_or_die($file))};
-    } elsif (!defined $possibly_duplicated) {
-       # We are a file in lib. Are we a duplicate?
-       # Don't bother calculating the MD5 if there's no intersting file of this
-       # length.
-       return if $Lengths{-s $file} && $MD5s{md5(slurp_or_die($file))};
+
+    local *_;
+    my $found_pod;
+    while (<$fh>) {
+        if (/^=head1\s+NAME\b/) {
+            ++$found_pod;
+            last;
+        }
+    }
+
+    unless ($found_pod) {
+       warn "$0: NOTE: cannot find '=head1 NAME' in:\n  $file\n" unless $Quiet;
+        return;
     }
 
+    seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!";
+    local $/ = '';
+
     while(<$fh>) {
        tr/\015//d;
        if (s/^=head1 (NAME)\s*/=head2 /) {
@@ -284,7 +248,6 @@ sub podset {
        }
        $OUT .= $_;
     }
-    return 1;
 }
 
 sub unhead1 {