buildtoc revision 1.14
1#!/usr/bin/perl -w 2 3use strict; 4use vars qw($Quiet); 5use File::Spec; 6use FindBin; 7use Text::Wrap; 8use Getopt::Long; 9 10no locale; 11 12# Assumption is that we're either already being run from the top level (*nix, 13# VMS), or have absolute paths in @INC (Win32, pod/Makefile) 14BEGIN { 15 my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir); 16 chdir $Top or die "Can't chdir to $Top: $!"; 17 require 'Porting/pod_lib.pl'; 18} 19 20die "$0: Usage: $0 [--quiet]\n" 21 unless GetOptions (quiet => \$Quiet) && !@ARGV; 22 23my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod'); 24 25my $found = pods_to_install(); 26 27my_die "Can't find any pods!\n" unless %$found; 28 29# Accumulating everything into a lexical before writing to disk dates from the 30# time when this script also provided the functionality of regen/pod_rules.pl 31# and this code was in a subroutine do_toc(). In turn, the use of a file scoped 32# lexical instead of a parameter or return value is because the code dates back 33# further still, and used *only* to create pod/perltoc.pod by printing direct 34 35my $OUT; 36my $roffitall; 37 38($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_; 39 40 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 41 # This file is autogenerated by buildtoc from all the other pods. 42 # Edit those files and run $0 to effect changes. 43 44 =head1 NAME 45 46 perltoc - perl documentation table of contents 47 48 =head1 DESCRIPTION 49 50 This page provides a brief table of contents for the rest of the Perl 51 documentation set. It is meant to be scanned quickly or grepped 52 through to locate the proper section you're looking for. 53 54 =head1 BASIC DOCUMENTATION 55 56EOPOD2B 57 58# All the things in the master list that happen to be pod filenames 59foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) { 60 $roffitall .= " \$mandir/$_->[0].1 \\\n"; 61 podset($_->[0], $_->[1]); 62} 63 64foreach my $type (qw(PRAGMA MODULE)) { 65 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_; 66 67 68 69 =head1 $type DOCUMENTATION 70 71EOPOD2B 72 73 foreach my $name (sort keys %{$found->{$type}}) { 74 $roffitall .= " \$libdir/$name.3 \\\n"; 75 podset($name, $found->{$type}{$name}); 76 } 77} 78 79$_= <<"EOPOD2B"; 80 81 82 =head1 AUXILIARY DOCUMENTATION 83 84 Here should be listed all the extra programs' documentation, but they 85 don't all have manual pages yet: 86 87 =over 4 88 89EOPOD2B 90 91$_ .= join "\n", map {"\t=item $_\n"} @{$state->{aux}}; 92$_ .= <<"EOPOD2B" ; 93 94 =back 95 96 =head1 AUTHOR 97 98 Larry Wall <F<larry\@wall.org>>, with the help of oodles 99 of other folks. 100 101 102EOPOD2B 103 104s/^\t//gm; 105$OUT .= "$_\n"; 106 107$OUT =~ s/\n\s+\n/\n\n/gs; 108$OUT =~ s/\n{3,}/\n\n/g; 109 110$OUT =~ s/([^\n]+)/wrap('', '', $1)/ge; 111 112write_or_die('pod/perltoc.pod', $OUT); 113 114write_or_die('pod/roffitall', <<'EOH' . $roffitall . <<'EOT'); 115#!/bin/sh 116# 117# Usage: roffitall [-nroff|-psroff|-groff] 118# 119# Authors: Tom Christiansen, Raphael Manfredi 120 121me=roffitall 122tmp=. 123 124if test -f ../config.sh; then 125 . ../config.sh 126fi 127 128mandir=$installman1dir 129libdir=$installman3dir 130 131test -d $mandir || mandir=/usr/new/man/man1 132test -d $libdir || libdir=/usr/new/man/man3 133 134case "$1" in 135-nroff) cmd="nroff -man"; ext='txt';; 136-psroff) cmd="psroff -t"; ext='ps';; 137-groff) cmd="groff -man"; ext='ps';; 138*) 139 echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2 140 exit 1 141 ;; 142esac 143 144toroff=` 145 echo \ 146EOH 147 | perl -ne 'map { -r && print "$_ " } split'` 148 149 # Bypass internal shell buffer limit -- can't use case 150 if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then 151 echo "$me: empty file list -- did you run install?" >&2 152 exit 1 153 fi 154 155 #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw 156 #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw 157 158 # First, create the raw data 159 run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" 160 echo "$me: running $run" 161 eval $run $toroff 162 163 #Now create the TOC 164 echo "$me: parsing TOC" 165 perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man 166 run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext" 167 echo "$me: running $run" 168 eval $run 169 170 # Finally, recreate the Doc, without the blank page 0 171 run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" 172 echo "$me: running $run" 173 eval $run $toroff 174 rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw 175 echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" 176EOT 177 178exit(0); 179 180# Below are all the auxiliary routines for generating perltoc.pod 181 182my ($inhead1, $inhead2, $initem); 183 184sub podset { 185 my ($pod, $file) = @_; 186 187 open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!"; 188 189 local *_; 190 my $found_pod; 191 while (<$fh>) { 192 if (/^=head1\s+NAME\b/) { 193 ++$found_pod; 194 last; 195 } 196 } 197 198 unless ($found_pod) { 199 warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet; 200 return; 201 } 202 203 seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!"; 204 local $/ = ''; 205 206 while(<$fh>) { 207 tr/\015//d; 208 if (s/^=head1 (NAME)\s*/=head2 /) { 209 unhead1(); 210 $OUT .= "\n\n=head2 "; 211 $_ = <$fh>; 212 # Remove svn keyword expansions from the Perl FAQ 213 s/ \(\$Revision: \d+ \$\)//g; 214 if ( /^\s*\Q$pod\E\b/ ) { 215 s/$pod\.pm/$pod/; # '.pm' in NAME !? 216 } else { 217 s/^/$pod, /; 218 } 219 } 220 elsif (s/^=head1 (.*)/=item $1/) { 221 unhead2(); 222 $OUT .= "=over 4\n\n" unless $inhead1; 223 $inhead1 = 1; 224 $_ .= "\n"; 225 } 226 elsif (s/^=head2 (.*)/=item $1/) { 227 unitem(); 228 $OUT .= "=over 4\n\n" unless $inhead2; 229 $inhead2 = 1; 230 $_ .= "\n"; 231 } 232 elsif (s/^=item ([^=].*)/$1/) { 233 next if $pod eq 'perldiag'; 234 s/^\s*\*\s*$// && next; 235 s/^\s*\*\s*//; 236 s/\n/ /g; 237 s/\s+$//; 238 next if /^[\d.]+$/; 239 next if $pod eq 'perlmodlib' && /^ftp:/; 240 $OUT .= ", " if $initem; 241 $initem = 1; 242 s/\.$//; 243 s/^-X\b/-I<X>/; 244 } 245 else { 246 unhead1() if /^=cut\s*\n/; 247 next; 248 } 249 $OUT .= $_; 250 } 251} 252 253sub unhead1 { 254 unhead2(); 255 if ($inhead1) { 256 $OUT .= "\n\n=back\n\n"; 257 } 258 $inhead1 = 0; 259} 260 261sub unhead2 { 262 unitem(); 263 if ($inhead2) { 264 $OUT .= "\n\n=back\n\n"; 265 } 266 $inhead2 = 0; 267} 268 269sub unitem { 270 if ($initem) { 271 $OUT .= "\n\n"; 272 } 273 $initem = 0; 274} 275 276# Local variables: 277# cperl-indent-level: 4 278# indent-tabs-mode: nil 279# End: 280# 281# ex: set ts=8 sts=4 sw=4 et: 282