-use File::Find;
-use Cwd;
+#!/usr/bin/perl -w
+
+use strict;
+use File::Spec;
+use FindBin;
use Text::Wrap;
+use Getopt::Long;
+
+our $Quiet;
+no locale;
+
+# Assumption is that we're either already being run from the top level (*nix,
+# VMS), or have absolute paths in @INC (Win32, pod/Makefile)
+BEGIN {
+ my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
+ chdir $Top or die "Can't chdir to $Top: $!";
+ require './Porting/pod_lib.pl';
+}
+
+die "$0: Usage: $0 [--quiet]\n"
+ unless GetOptions ('q|quiet' => \$Quiet) && !@ARGV;
+
+my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
+
+my $found = pods_to_install();
+
+my_die "Can't find any pods!\n" unless %$found;
-sub output ($);
+# 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
+# and this code was in a subroutine do_toc(). In turn, the use of a file scoped
+# lexical instead of a parameter or return value is because the code dates back
+# further still, and used *only* to create pod/perltoc.pod by printing direct
-@pods = qw(
- perl perldelta perldata perlsyn perlop perlre perlrun perlfunc
- perlvar perlsub perlmod perlform perllocale perlref perldsc
- perllol perltoot perlobj perltie perlbot perlipc perldebug
- perldiag perlsec perltrap perlstyle perlpod perlbook perlembed
- perlapio perlxs perlxstut perlguts perlcall
- );
+my $OUT;
+my $roffitall;
-for (@pods) { s/$/.pod/ }
+($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
-$/ = '';
-@ARGV = @pods;
+ # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ # This file is autogenerated by buildtoc from all the other pods.
+ # Edit those files and run $0 to effect changes.
-($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
+ =encoding UTF-8
=head1 NAME
=head1 BASIC DOCUMENTATION
EOPOD2B
-#' make emacs happy
-podset(@pods);
+# All the things in the master list that happen to be pod filenames
+foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
+ $roffitall .= " \$mandir/$_->[0].1 \\\n";
+ podset($_->[0], $_->[1]);
+}
-find \&getpods => qw(../lib ../ext);
+foreach my $type (qw(PRAGMA MODULE)) {
+ ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
-sub getpods {
- if (/\.p(od|m)$/) {
- # Skip .pm files that have corresponding .pod files, and Functions.pm.
- return if /(.*)\.pm$/ && -f "$1.pod";
- my $file = $File::Find::name;
- return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
- die "tut $name" if $file =~ /TUT/;
- unless (open (F, "< $_\0")) {
- warn "bogus <$file>: $!";
- system "ls", "-l", $file;
- }
- else {
- my $line;
- while ($line = <F>) {
- if ($line =~ /^=head1\s+NAME\b/) {
- push @modpods, $file;
- #warn "GOOD $file\n";
- return;
- }
- }
- warn "EVIL $file\n";
- }
- }
-}
-die "no pods" unless @modpods;
+ =head1 $type DOCUMENTATION
-for (@modpods) {
- #($name) = /(\w+)\.p(m|od)$/;
- $name = path2modname($_);
- if ($name =~ /^[a-z]/) {
- push @pragmata, $_;
- } else {
- if ($done{$name}++) {
- # warn "already did $_\n";
- next;
- }
- push @modules, $_;
- push @modname, $name;
+EOPOD2B
+
+ foreach my $name (sort keys %{$found->{$type}}) {
+ $roffitall .= " \$libdir/$name.3 \\\n";
+ podset($name, $found->{$type}{$name});
}
}
-($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
+$_= <<"EOPOD2B";
+ =head1 AUXILIARY DOCUMENTATION
+
+ Here should be listed all the extra programs' documentation, but they
+ don't all have manual pages yet:
- =head1 PRAGMA DOCUMENTATION
+ =over 4
EOPOD2B
-podset(sort @pragmata);
+$_ .= join "\n", map {"\t=item $_\n"} @{$state->{aux}};
+$_ .= <<"EOPOD2B" ;
-($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
+ =back
+ =head1 AUTHOR
+ Larry Wall <F<larry\@wall.org>>, with the help of oodles
+ of other folks.
- =head1 MODULE DOCUMENTATION
EOPOD2B
-podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
+s/^\t//gm;
+$OUT .= "$_\n";
-($_= <<EOPOD2B) =~ s/^\t//gm;
+$OUT =~ s/\n\s+\n/\n\n/gs;
+$OUT =~ s/\n{3,}/\n\n/g;
+$OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
- =head1 AUXILIARY DOCUMENTATION
+write_or_die('pod/perltoc.pod', $OUT);
- Here should be listed all the extra programs' documentation, but they
- don't all have manual pages yet:
+write_or_die('pod/roffitall', <<'EOH' . $roffitall . <<'EOT');
+#!/bin/sh
+#
+# Usage: roffitall [-nroff|-psroff|-groff]
+#
+# Authors: Tom Christiansen, Raphael Manfredi
- =item a2p
+me=roffitall
+tmp=.
- =item s2p
+if test -f ../config.sh; then
+ . ../config.sh
+fi
- =item find2perl
+mandir=$installman1dir
+libdir=$installman3dir
- =item h2ph
+test -d $mandir || mandir=/usr/new/man/man1
+test -d $libdir || libdir=/usr/new/man/man3
- =item c2ph
+case "$1" in
+-nroff) cmd="nroff -man"; ext='txt';;
+-psroff) cmd="psroff -t"; ext='ps';;
+-groff) cmd="groff -man"; ext='ps';;
+*)
+ echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2
+ exit 1
+ ;;
+esac
- =item h2xs
+toroff=`
+ echo \
+EOH
+ | perl -ne 'map { -r && print "$_ " } split'`
- =item xsubpp
+ # Bypass internal shell buffer limit -- can't use case
+ if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then
+ echo "$me: empty file list -- did you run install?" >&2
+ exit 1
+ fi
- =item pod2man
+ #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
+ #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw
- =item wrapsuid
+ # First, create the raw data
+ run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
+ echo "$me: running $run"
+ eval $run $toroff
+ #Now create the TOC
+ echo "$me: parsing TOC"
+ perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
+ run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
+ echo "$me: running $run"
+ eval $run
- =head1 AUTHOR
+ # Finally, recreate the Doc, without the blank page 0
+ run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
+ echo "$me: running $run"
+ eval $run $toroff
+ rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
+ echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
+EOT
- Larry Wall <F<larry\@wall.org>>, with the help of oodles
- of other folks.
+exit(0);
+# Below are all the auxiliary routines for generating perltoc.pod
-EOPOD2B
-output $_;
-output "\n"; # flush $LINE
-exit;
+my ($inhead1, $inhead2, $initem);
sub podset {
- local @ARGV = @_;
+ my ($pod, $file) = @_;
+
+ open my $fh, '<:raw', $file or my_die "Can't open file '$file' for $pod: $!";
+
+ local *_;
+ my $found_pod;
+ while (<$fh>) {
+ if (/^=head1\s+NAME\b/) {
+ ++$found_pod;
+ last;
+ }
+ }
- while(<>) {
+ 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 /) {
- $pod = path2modname($ARGV);
- unitem();
- unhead2();
- output "\n \n\n=head2 ";
- $_ = <>;
- if ( /^\s*$pod\b/ ) {
+ unhead1();
+ $OUT .= "\n\n=head2 ";
+ $_ = <$fh>;
+ # Remove svn keyword expansions from the Perl FAQ
+ s/ \(\$Revision: \d+ \$\)//g;
+ if ( /^\s*\Q$pod\E\b/ ) {
s/$pod\.pm/$pod/; # '.pm' in NAME !?
- output $_;
} else {
s/^/$pod, /;
- output $_;
}
- next;
}
- if (s/^=head1 (.*)/=item $1/) {
- unitem(); unhead2();
- output $_; nl(); next;
+ elsif (s/^=head1 (.*)/=item $1/) {
+ unhead2();
+ $OUT .= "=over 4\n\n" unless $inhead1;
+ $inhead1 = 1;
+ $_ .= "\n";
}
- if (s/^=head2 (.*)/=item $1/) {
+ elsif (s/^=head2 (.*)/=item $1/) {
unitem();
- output "=over\n\n" unless $inhead2;
+ $OUT .= "=over 4\n\n" unless $inhead2;
$inhead2 = 1;
- output $_; nl(); next;
-
+ $_ .= "\n";
}
- if (s/^=item (.*)\n/$1/) {
+ elsif (s/^=item ([^=].*)/$1/) {
next if $pod eq 'perldiag';
s/^\s*\*\s*$// && next;
s/^\s*\*\s*//;
+ s/\n/ /g;
s/\s+$//;
next if /^[\d.]+$/;
- next if $pod eq 'perlmod' && /^ftp:/;
- ##print "=over\n\n" unless $initem;
- output ", " if $initem;
+ next if $pod eq 'perlmodlib' && /^ftp:/;
+ $OUT .= ", " if $initem;
$initem = 1;
s/\.$//;
s/^-X\b/-I<X>/;
- output $_; next;
}
+ else {
+ unhead1() if /^=cut\s*\n/;
+ next;
+ }
+ $OUT .= $_;
}
}
-sub path2modname {
- local $_ = shift;
- s/\.p(m|od)$//;
- s-.*?/(lib|ext)/--;
- s-/-::-g;
- s/(\w+)::\1/$1/;
- return $_;
+sub unhead1 {
+ unhead2();
+ if ($inhead1) {
+ $OUT .= "\n\n=back\n\n";
+ }
+ $inhead1 = 0;
}
sub unhead2 {
+ unitem();
if ($inhead2) {
- output "\n\n=back\n\n";
+ $OUT .= "\n\n=back\n\n";
}
$inhead2 = 0;
- $initem = 0;
}
sub unitem {
if ($initem) {
- output "\n\n";
- ##print "\n\n=back\n\n";
+ $OUT .= "\n\n";
}
$initem = 0;
}
-sub nl {
- output "\n";
-}
-
-my $NEWLINE; # how many newlines have we seen recently
-my $LINE; # what remains to be printed
-
-sub output ($) {
- for (split /(\n)/, shift) {
- if ($_ eq "\n") {
- if ($LINE) {
- print wrap('', '', $LINE);
- $LINE = '';
- }
- if ($NEWLINE < 2) {
- print;
- $NEWLINE++;
- }
- }
- elsif (/\S/ && length) {
- $LINE .= $_;
- $NEWLINE = 0;
- }
- }
-}
+# ex: set ts=8 sts=4 sw=4 et:
https://perl5.git.perl.org / perl5.git / blobdiff