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