pod/buildtoc

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw(%Found $Quiet);
   5 use File::Spec;
   6 use File::Find;
   7 use FindBin;
   8 use Text::Wrap;
   9 use Getopt::Long;
  10
  11 no locale;
  12
  13 # Assumption is that we're either already being run from the top level (*nix,
  14 # VMS), or have absolute paths in @INC (Win32, pod/Makefile)
  15 BEGIN {
  16   my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
  17   chdir $Top or die "Can't chdir to $Top: $!";
  18   require 'Porting/pod_lib.pl';
  19 }
  20
  21 die "$0: Usage: $0 [--quiet]\n"
  22     unless GetOptions (quiet => \$Quiet) && !@ARGV;
  23
  24 my $state = get_pod_metadata(0, 'pod/perltoc.pod');
  25
  26 warn @{$state->{inconsistent}} if @{$state->{inconsistent}};
  27
  28 # Find all the modules
  29 my @modpods;
  30 find(sub {
  31     if (/\.p(od|m)$/) {
  32       my $file = $File::Find::name;
  33       return if $file =~ qr!/Pod/Functions.pm\z!; # Used only by pod itself
  34       return if $file =~ m!(?:^|/)t/!;
  35       return if $file =~ m!lib/Attribute/Handlers/demo/!;
  36       return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
  37       return if $file =~ m!lib/Math/BigInt/t/!;
  38       return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
  39       return if $file =~ m!XS/(?:APItest|Typemap)!;
  40       my $pod = $file;
  41       return if $pod =~ s/pm$/pod/ && -e $pod;
  42       unless (open my $f, '<', $_) {
  43         warn "$0: bogus <$file>: $!";
  44         system "ls", "-l", $file;
  45       }
  46       else {
  47         my $line;
  48         while ($line = <$f>) {
  49           if ($line =~ /^=head1\s+NAME\b/) {
  50             push @modpods, $file;
  51             return;
  52           }
  53         }
  54         warn "$0: NOTE: cannot find '=head1 NAME' in:\n  $file\n" unless $Quiet;
  55       }
  56     }
  57   }, 'lib');
  58
  59 my_die "Can't find any pods!\n" unless @modpods;
  60
  61 my %done;
  62 for (@modpods) {
  63     my $name = $_;
  64     $name =~ s/\.p(m|od)$//;
  65     $name =~ s-\Alib/--;
  66     $name =~ s-/-::-g;
  67     next if $done{$name}++;
  68
  69     $Found{$name =~ /^[a-z]/ ? 'PRAGMA' : 'MODULE'}{$name} = $_;
  70 }
  71
  72 # Accumulating everything into a lexical before writing to disk dates from the
  73 # time when this script also provided the functionality of regen/pod_rules.pl
  74 # and this code was in a subroutine do_toc(). In turn, the use of a file scoped
  75 # lexical instead of a parameter or return value is because the code dates back
  76 # further still, and used *only* to create pod/perltoc.pod by printing direct
  77
  78 my $OUT;
  79
  80 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
  81
  82         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  83         # This file is autogenerated by buildtoc from all the other pods.
  84         # Edit those files and run $0 to effect changes.
  85
  86         =head1 NAME
  87
  88         perltoc - perl documentation table of contents
  89
  90         =head1 DESCRIPTION
  91
  92         This page provides a brief table of contents for the rest of the Perl
  93         documentation set.  It is meant to be scanned quickly or grepped
  94         through to locate the proper section you're looking for.
  95
  96         =head1 BASIC DOCUMENTATION
  97
  98 EOPOD2B
  99
 100 # All the things in the master list that happen to be pod filenames
 101 foreach (grep {defined $_ && @$_ == 5 && !$_->[0]{toc_omit}} @{$state->{master}}) {
 102     podset($_->[1], $_->[2]);
 103 }
 104
 105 foreach my $type (qw(PRAGMA MODULE)) {
 106     ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
 107
 108
 109
 110         =head1 $type DOCUMENTATION
 111
 112 EOPOD2B
 113
 114     foreach my $name (sort keys %{$Found{$type}}) {
 115         podset($name, $Found{$type}{$name});
 116     }
 117 }
 118
 119 $_= <<"EOPOD2B";
 120
 121
 122         =head1 AUXILIARY DOCUMENTATION
 123
 124         Here should be listed all the extra programs' documentation, but they
 125         don't all have manual pages yet:
 126
 127         =over 4
 128
 129 EOPOD2B
 130
 131 $_ .=  join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
 132 $_ .= <<"EOPOD2B" ;
 133
 134         =back
 135
 136         =head1 AUTHOR
 137
 138         Larry Wall <F<larry\@wall.org>>, with the help of oodles
 139         of other folks.
 140
 141
 142 EOPOD2B
 143
 144 s/^\t//gm;
 145 $OUT .= "$_\n";
 146
 147 $OUT =~ s/\n\s+\n/\n\n/gs;
 148 $OUT =~ s/\n{3,}/\n\n/g;
 149
 150 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
 151
 152 write_or_die('pod/perltoc.pod', $OUT);
 153
 154 exit(0);
 155
 156 # Below are all the auxiliary routines for generating perltoc.pod
 157
 158 my ($inhead1, $inhead2, $initem);
 159
 160 sub podset {
 161     my ($pod, $file) = @_;
 162
 163     local $/ = '';
 164
 165     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
 166
 167     while(<$fh>) {
 168         tr/\015//d;
 169         if (s/^=head1 (NAME)\s*/=head2 /) {
 170             unhead1();
 171             $OUT .= "\n\n=head2 ";
 172             $_ = <$fh>;
 173             # Remove svn keyword expansions from the Perl FAQ
 174             s/ \(\$Revision: \d+ \$\)//g;
 175             if ( /^\s*\Q$pod\E\b/ ) {
 176                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
 177             } else {
 178                 s/^/$pod, /;
 179             }
 180         }
 181         elsif (s/^=head1 (.*)/=item $1/) {
 182             unhead2();
 183             $OUT .= "=over 4\n\n" unless $inhead1;
 184             $inhead1 = 1;
 185             $_ .= "\n";
 186         }
 187         elsif (s/^=head2 (.*)/=item $1/) {
 188             unitem();
 189             $OUT .= "=over 4\n\n" unless $inhead2;
 190             $inhead2 = 1;
 191             $_ .= "\n";
 192         }
 193         elsif (s/^=item ([^=].*)/$1/) {
 194             next if $pod eq 'perldiag';
 195             s/^\s*\*\s*$// && next;
 196             s/^\s*\*\s*//;
 197             s/\n/ /g;
 198             s/\s+$//;
 199             next if /^[\d.]+$/;
 200             next if $pod eq 'perlmodlib' && /^ftp:/;
 201             $OUT .= ", " if $initem;
 202             $initem = 1;
 203             s/\.$//;
 204             s/^-X\b/-I<X>/;
 205         }
 206         else {
 207             unhead1() if /^=cut\s*\n/;
 208             next;
 209         }
 210         $OUT .= $_;
 211     }
 212 }
 213
 214 sub unhead1 {
 215     unhead2();
 216     if ($inhead1) {
 217         $OUT .= "\n\n=back\n\n";
 218     }
 219     $inhead1 = 0;
 220 }
 221
 222 sub unhead2 {
 223     unitem();
 224     if ($inhead2) {
 225         $OUT .= "\n\n=back\n\n";
 226     }
 227     $inhead2 = 0;
 228 }
 229
 230 sub unitem {
 231     if ($initem) {
 232         $OUT .= "\n\n";
 233     }
 234     $initem = 0;
 235 }
 236
 237 # Code added in commit 416302502f485afa, but never used.
 238 # Probably roffitall should become something that buildtoc generates, instead
 239 # of something that we ship in the distribution.
 240
 241 sub generate_roffitall {
 242   (map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{pods}}),
 243    "\t\t\\",
 244    map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{aux}}),
 245    "\t\t\\",
 246    map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{PRAGMA}}),
 247    "\t\t\\",
 248    map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{MODULE}}),
 249   )
 250 }