This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change t/pragma/warn oct()/hex() overflow tests to use %Config
[perl5.git] / pod / buildtoc
index 9ca5e92..2574b10 100644 (file)
@@ -1,19 +1,28 @@
 use File::Find;
 use Cwd;
+use Text::Wrap;
 
-@pods = qw{
-           perl perldata perlsyn perlop perlre perlrun perlfunc perlvar
-           perlsub perlmod perlref perldsc perllol perlobj perltie
-           perlbot perldebug perldiag perlform perlipc perlsec perltrap
-           perlstyle perlxs perlxstut perlguts perlcall perlembed perlpod
-           perlbook 
-       };
-for (@pods) { s/$/.pod/ } 
+sub output ($);
+
+@pods = qw(
+          perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
+          perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata
+          perlsyn perlop perlre perlrun perlfunc perlvar perlsub
+          perlmod perlmodlib perlmodinstall perlform perllocale 
+          perlref perlreftut perldsc
+          perllol perltoot perltootc perlobj perltie perlbot perlipc
+          perldbmfilter perldebug
+          perldiag perlsec perltrap perlport perlstyle perlpod perlbook
+          perlembed perlapio perlxs perlxstut perlguts perlcall
+          perlhist
+         );
+
+for (@pods) { s/$/.pod/ }
 
 $/ = '';
 @ARGV = @pods;
 
-($_= <<EOPOD2B) =~ s/^\t//gm && print;
+($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
 
        =head1 NAME
 
@@ -21,38 +30,40 @@ $/ = '';
 
        =head1 DESCRIPTION
 
-       This page provides a brief table of contents for the rest of the Perl 
-       documentation set.  It is meant to be be quickly scanned or grepped 
+       This page provides a brief table of contents for the rest of the Perl
+       documentation set.  It is meant to be scanned quickly or grepped
        through to locate the proper section you're looking for.
 
        =head1 BASIC DOCUMENTATION
 
 EOPOD2B
+#' make emacs happy
 
 podset(@pods);
 
 find \&getpods => qw(../lib ../ext);
+
 sub getpods {
-    if (/\.p(od|m)$/) { 
-       my $tmp;
+    if (/\.p(od|m)$/) {
        # Skip .pm files that have corresponding .pod files, and Functions.pm.
-       return if (($tmp = $_) =~ s/\.pm$/.pod/ && -f $tmp);
-       return if ($_ eq '../lib/Pod/Functions.pm');####Used only by pod itself
-
+       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 { 
+       }
+       else {
            my $line;
            while ($line = <F>) {
                if ($line =~ /^=head1\s+NAME\b/) {
                    push @modpods, $file;
                    #warn "GOOD $file\n";
                    return;
-               } 
-           } 
+               }
+           }
            warn "EVIL $file\n";
        }
     }
@@ -69,14 +80,14 @@ for (@modpods) {
        if ($done{$name}++) {
            # warn "already did $_\n";
            next;
-       } 
+       }
        push @modules, $_;
        push @modname, $name;
-    } 
-} 
+    }
+}
+
+($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
 
-($_= <<EOPOD2B) =~ s/^\t//gm && print;
 
 
        =head1 PRAGMA DOCUMENTATION
@@ -85,8 +96,8 @@ EOPOD2B
 
 podset(sort @pragmata);
 
-($_= <<EOPOD2B) =~ s/^\t//gm && print;
+($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
+
 
 
        =head1 MODULE DOCUMENTATION
@@ -96,41 +107,41 @@ EOPOD2B
 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
 
 ($_= <<EOPOD2B) =~ s/^\t//gm;
+
 
        =head1 AUXILIARY DOCUMENTATION
 
-       Here should be listed all the extra program's docs, but they
-       don't all have man pages yet:
+       Here should be listed all the extra programs' documentation, but they
+       don't all have manual pages yet:
 
        =item a2p
 
        =item s2p
 
        =item find2perl
-       
+
        =item h2ph
-       
+
        =item c2ph
 
        =item h2xs
 
        =item xsubpp
 
-       =item pod2man 
+       =item pod2man
 
        =item wrapsuid
 
 
        =head1 AUTHOR
 
-       Larry Wall E<lt>F<lwall\@sems.com>E<gt>, with the help of oodles 
+       Larry Wall <F<larry\@wall.org>>, with the help of oodles
        of other folks.
 
 
 EOPOD2B
-print;
-
+output $_;
+output "\n";                    # flush $LINE
 exit;
 
 sub podset {
@@ -139,69 +150,94 @@ sub podset {
     while(<>) {
        if (s/^=head1 (NAME)\s*/=head2 /) {
            $pod = path2modname($ARGV);
-           sub path2modname {
-               local $_ = shift;
-               s/\.p(m|od)$//;
-               s-.*?/(lib|ext)/--;
-               s-/-::-g;
-               s/(\w+)::\1/$1/;
-               return $_;
-           }
-           unitem(); unhead2();
-           print "\n \n\n=head2 ";
+           unitem();
+           unhead2();
+           output "\n \n\n=head2 ";
            $_ = <>;
            if ( /^\s*$pod\b/ ) {
-               print;
+               s/$pod\.pm/$pod/;       # '.pm' in NAME !?
+               output $_;
            } else {
                s/^/$pod, /;
-               print;
-           } 
+               output $_;
+           }
            next;
        }
        if (s/^=head1 (.*)/=item $1/) {
            unitem(); unhead2();
-           print; nl(); next;
-       } 
+           output $_; nl(); next;
+       }
        if (s/^=head2 (.*)/=item $1/) {
            unitem();
-           print "=over\n\n" unless $inhead2;
+           output "=over\n\n" unless $inhead2;
            $inhead2 = 1;
-           print; nl(); next;
+           output $_; nl(); next;
 
-       } 
-       if (s/^=item (.*)\n/$1/) {
+       }
+       if (s/^=item ([^=].*)\n/$1/) {
            next if $pod eq 'perldiag';
            s/^\s*\*\s*$// && next;
            s/^\s*\*\s*//;
            s/\s+$//;
            next if /^[\d.]+$/;
-           next if $pod eq 'perlmod' && /^ftp:/;
+           next if $pod eq 'perlmodlib' && /^ftp:/;
            ##print "=over\n\n" unless $initem;
-           print ", " if $initem;
+           output ", " if $initem;
            $initem = 1;
            s/\.$//;
-           print; next;
-       } 
-    } 
+           s/^-X\b/-I<X>/;
+           output $_; next;
+       }
+    }
+}
 
-} 
+sub path2modname {
+    local $_ = shift;
+    s/\.p(m|od)$//;
+    s-.*?/(lib|ext)/--;
+    s-/-::-g;
+    s/(\w+)::\1/$1/;
+    return $_;
+}
 
 sub unhead2 {
     if ($inhead2) {
-       print "\n\n=back\n\n";
-    } 
-    $inhead2 = 0; 
-    $initem = 0;
-} 
+       output "\n\n=back\n\n";
+    }
+    $inhead2 = 0;
+    $initem  = 0;
+}
 
 sub unitem {
     if ($initem) {
-       print "\n\n";
+       output "\n\n";
        ##print "\n\n=back\n\n";
-    } 
+    }
     $initem = 0;
-} 
+}
 
 sub nl {
-    print "\n";
-} 
+    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;
+       }
+    }
+}