This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement facility to plug in syntax triggered by keywords
[perl5.git] / pod / buildtoc
old mode 100644 (file)
new mode 100755 (executable)
index d66b712..83eb447
@@ -1,22 +1,25 @@
 #!/usr/bin/perl -w
 
 use strict;
-use vars qw($masterpodfile %Build %Targets $Verbose $Up %Ignore
-           @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules);
+use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore
+           @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
+           %Copies %Generated);
 use File::Spec;
 use File::Find;
 use FindBin;
 use Text::Tabs;
 use Text::Wrap;
 use Getopt::Long;
+use Carp;
 
 no locale;
 
 $Up = File::Spec->updir;
-$masterpodfile = File::Spec->catdir($Up, "pod.lst");
+$masterpodfile = File::Spec->catfile($Up, "pod.lst");
 
 # Generate any/all of these files
 # --verbose gives slightly more output
+# --quiet suppresses routine warnings
 # --build-all tries to build everything
 # --build-foo updates foo as follows
 # --showfiles shows the files to be changed
@@ -26,11 +29,13 @@ $masterpodfile = File::Spec->catdir($Up, "pod.lst");
      toc => "perltoc.pod",
      manifest => File::Spec->catdir($Up, "MANIFEST"),
      perlpod => "perl.pod",
-     vms => File::Spec->catdir($Up, "vms", "descrip_mms.template"),
-     nmake => File::Spec->catdir($Up, "win32", "Makefile"),
-     dmake => File::Spec->catdir($Up, "win32", "makefile.mk"),
-     podmak => File::Spec->catdir($Up, "win32", "pod.mak"),
+     vms => File::Spec->catfile($Up, "vms", "descrip_mms.template"),
+     nmake => File::Spec->catfile($Up, "win32", "Makefile"),
+     dmake => File::Spec->catfile($Up, "win32", "makefile.mk"),
+     podmak => File::Spec->catfile($Up, "win32", "pod.mak"),
      # plan9 =>  File::Spec->catdir($Up, "plan9", "mkfile"),
+     unix => File::Spec->catfile($Up, "Makefile.SH"),
+     # TODO: add roffitall
     );
 
 {
@@ -42,6 +47,7 @@ $0: Usage: $0 [--verbose] [--showfiles] $filesopts
 __USAGE__
   unless @ARGV
        && GetOptions (verbose => \$Verbose,
+                      quiet => \$Quiet,
                       showfiles => \$showfiles,
                       map {+"build-$_", \$Build{$_}} @files, 'all');
   # Set them all to true
@@ -67,7 +73,6 @@ __USAGE__
 # Don't copy these top level READMEs
 %Ignore
   = (
-     Y2K => 1,
      micro => 1,
 #     vms => 1,
      );
@@ -80,17 +85,19 @@ chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
 
 open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
 
+my ($delta_source, $delta_target);
+
 foreach (<MASTER>) {
   next if /^\#/;
 
   # At least one upper case letter somewhere in the first group
-  if (/^(\S+)\s(.*)/ && $1 =~ tr/A-Z//) {
+  if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
     # it's a heading
     my $flags = $1;
+    $flags =~ tr/h//d;
     my %flags = (header => 1);
-    $flags{toc_omit} = 1 if $flags =~ tr/O//d;
-    $flags{include} = 1 if $flags =~ tr/I//d;
-    $flags{aux} = 1 if $flags =~ tr/A//d;
+    $flags{toc_omit} = 1 if $flags =~ tr/o//d;
+    $flags{aux} = 1 if $flags =~ tr/a//d;
     die "$0: Unknown flag found in heading line: $_" if length $flags;
     push @Master, [\%flags, $2];
 
@@ -100,8 +107,19 @@ foreach (<MASTER>) {
 
     my %flags = (indent => 0);
     $flags{indent} = $1 if $flags =~ s/(\d+)//;
-    $flags{toc_omit} = 1 if $flags =~ tr/o//d;
+    $flags{toc_omit} = 1 if $flags =~ tr/o//d; 
     $flags{aux} = 1 if $flags =~ tr/a//d;
+
+    if ($flags =~ tr/D//d) {
+      $flags{perlpod_omit} = 1;
+      $delta_source = "$filename.pod";
+    }
+    if ($flags =~ tr/d//d) {
+      $flags{manifest_omit} = 1;
+      $delta_target = "$filename.pod";
+    }
+    $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
+
     if ($flags =~ tr/r//d) {
       my $readme = $filename;
       $readme =~ s/^perl//;
@@ -120,6 +138,18 @@ foreach (<MASTER>) {
     die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
   }
 }
+if (defined $delta_source) {
+  if (defined $delta_target) {
+    # This way round so that keys can act as a MANIFEST skip list
+    # Targets will aways be in the pod directory. Currently we can only cope
+    # with sources being in the same directory.
+    $Copies{$delta_target} = $delta_source;
+  } else {
+    die "$0: delta source defined but not target";
+  }
+} elsif (defined $delta_target) {
+  die "$0: delta target defined but not target";
+}
 
 close MASTER;
 
@@ -130,6 +160,7 @@ close MASTER;
   my (@manireadmes, %manireadmes);
   my (@perlpods, %perlpods);
   my (%our_pods);
+  my (%sources);
 
   # Convert these to a list of filenames.
   foreach (keys %Pods, keys %Readmepods) {
@@ -140,6 +171,10 @@ close MASTER;
   @disk_pods = glob("*.pod");
   @disk_pods{@disk_pods} = @disk_pods;
 
+  # Things we copy from won't be in perl.pod
+  # Things we copy to won't be in MANIFEST
+  @sources{values %Copies} = ();
+
   open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
   while (<MANI>) {
     if (m!^pod/([^.]+\.pod)\s+!i) {
@@ -170,25 +205,31 @@ close MASTER;
     warn "$0: $i exists but is unknown by buildtoc\n"
       unless $our_pods{$i};
     warn "$0: $i exists but is unknown by ../MANIFEST\n"
-      if !$manipods{$i} && !$manireadmes{$i};
+      if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
     warn "$0: $i exists but is unknown by perl.pod\n"
-       unless $perlpods{$i};
+       if !$perlpods{$i} && !exists $sources{$i};
   }
+  my @BuildTargets = grep {defined} @Targets{grep $_ ne 'all', keys %Build};
+  my %BuildFiles;
+  @BuildFiles{@BuildTargets} = @BuildTargets;
+  
   foreach my $i (sort keys %our_pods) {
     warn "$0: $i is known by buildtoc but does not exist\n"
-      unless $disk_pods{$i};
+      unless $disk_pods{$i} or $BuildFiles{$i};
   }
   foreach my $i (sort keys %manipods) {
     warn "$0: $i is known by ../MANIFEST but does not exist\n"
       unless $disk_pods{$i};
+    warn "$0: $i is known by ../MANIFEST but is marked as generated\n"
+      if $Generated{$i};
   }
   foreach my $i (sort keys %perlpods) {
     warn "$0: $i is known by perl.pod but does not exist\n"
-      unless $disk_pods{$i};
+      unless $disk_pods{$i} or $BuildFiles{$i};
   }
 }
 
-# Find all the mdoules
+# Find all the modules
 {
   my @modpods;
   find \&getpods => qw(../lib ../ext);
@@ -203,6 +244,8 @@ close MASTER;
       return if $file =~ m!lib/Math/BigInt/t/!;
       return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
       return if $file =~ m!XS/(?:APItest|Typemap)!;
+      my $pod = $file;
+      return if $pod =~ s/pm$/pod/ && -e $pod;
       die "$0: tut $File::Find::name" if $file =~ /TUT/;
       unless (open (F, "< $_\0")) {
        warn "$0: bogus <$file>: $!";
@@ -214,10 +257,12 @@ close MASTER;
          if ($line =~ /^=head1\s+NAME\b/) {
            push @modpods, $file;
            #warn "GOOD $file\n";
+           close F;
            return;
          }
        }
-       warn "$0: $file: cannot find =head1 NAME\n";
+       close F;
+       warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
       }
     }
   }
@@ -240,7 +285,7 @@ close MASTER;
   }
 }
 
-# OK. Now a lot of ancillay function definitions follow
+# OK. Now a lot of ancillary function definitions follow
 # Main program returns at "Do stuff"
 
 sub path2modname {
@@ -257,7 +302,7 @@ sub output ($);
 sub output_perltoc {
   open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
 
-  $/ = '';
+  local $/ = '';
 
   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
 
@@ -332,6 +377,7 @@ EOPOD2B
   s/^\t//gm;
   output $_;
   output "\n";                    # flush $LINE
+  close OUT;
 }
 
 # Below are all the auxiliary routines for generating perltoc.pod
@@ -342,6 +388,8 @@ sub podset {
     local @ARGV = @_;
     my $pod;
 
+    return unless scalar(@ARGV);
+
     while(<>) {
        tr/\015//d;
        if (s/^=head1 (NAME)\s*/=head2 /) {
@@ -349,6 +397,8 @@ sub podset {
            unhead1();
            output "\n \n\n=head2 ";
            $_ = <>;
+           # Remove svn keyword expansions from the Perl FAQ
+           s/ \(\$Revision: \d+ \$\)//g;
            if ( /^\s*$pod\b/ ) {
                s/$pod\.pm/$pod/;       # '.pm' in NAME !?
                output $_;
@@ -451,6 +501,7 @@ sub generate_perlpod {
   foreach (@Master) {
     my $flags = $_->[0];
     next if $flags->{aux};
+    next if $flags->{perlpod_omit};
 
     if (@$_ == 2) {
       # Heading
@@ -484,10 +535,13 @@ sub generate_manifest {
   map {s/ \t/\t\t/g; $_} @temp;
 }
 sub generate_manifest_pod {
-  generate_manifest map {["pod/$_.pod", $Pods{$_}]} sort keys %Pods;
+  generate_manifest map {["pod/$_.pod", $Pods{$_}]}
+    sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
 }
 sub generate_manifest_readme {
-  generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
+  generate_manifest sort {$a->[0] cmp $b->[0]}
+    ["README.vms", "Notes about installing the VMS port"],
+      map {["README.$_", $Readmes{$_}]} keys %Readmes;
 }
 
 sub generate_roffitall {
@@ -505,23 +559,30 @@ sub generate_descrip_mms_1 {
   local $Text::Wrap::columns = 150;
   my $count = 0;
   my @lines = map {"pod" . $count++ . " = $_"}
-    split /\n/, wrap('', '', join " ", map "[.lib.pod]$_.pod",
+    split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
                     sort keys %Pods, keys %Readmepods);
   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
 }
 
 sub generate_descrip_mms_2 {
-  map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
-[.lib.pod]%s.pod : [.%s]%s.pod
-       @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
-       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+  map {<<"SNIP"}
+[.lib.pods]$_.pod : [.pod]$_.pod
+       \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
+       Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
 SNIP
    sort keys %Pods, keys %Readmepods;
 }
 
+sub generate_descrip_mms_3 {
+  map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
+    sort keys %Generated, keys %Copies;
+}
+
 sub generate_nmake_1 {
-  map {sprintf "\tcopy ..\\README.%-8s .\\perl$_.pod\n", $_}
-    sort keys %Readmes;
+  # XXX Fix this with File::Spec
+  (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
+    sort keys %Readmes),
+      (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
 }
 
 # This doesn't have a trailing newline
@@ -529,7 +590,8 @@ sub generate_nmake_2 {
   # Spot the special case
   local $Text::Wrap::columns = 76;
   my $line = wrap ("\t    ", "\t    ",
-                  join " ", sort map {"perl$_.pod"} "vms", keys %Readmes);
+                  join " ", sort keys %Copies, keys %Generated,
+                                 map {"perl$_.pod"} keys %Readmes);
   $line =~ s/$/ \\/mg;
   $line;
 }
@@ -544,6 +606,13 @@ sub generate_pod_mak {
   $line;
 }
 
+sub verify_contiguous {
+  my ($name, $content, $what) = @_;
+  my $sections = () = $content =~ m/\0+/g;
+  croak("$0: $name contains no $what") if $sections < 1;
+  croak("$0: $name contains discontiguous $what") if $sections > 1;
+}
+
 sub do_manifest {
   my $name = shift;
   my @manifest =
@@ -563,12 +632,12 @@ sub do_nmake {
   my $makefile = join '', @_;
   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
-  my $sections = () = $makefile =~ m/\0+/g;
-  die "$0: $name contains no README copies" if $sections < 1;
-  die "$0: $name contains discontiguous README copies" if $sections > 1;
-  $makefile =~ s/\0+/join "", &generate_nmake_1/se;
+  verify_contiguous($name, $makefile, 'README copies');
+  # Now remove the other copies that follow
+  1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
+  $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
 
-  $makefile =~ s{(cd \$\(PODDIR\) && del /f [^\n]+).*?(pod2html)}
+  $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
     {"$1\n" . &generate_nmake_2."\n\t    $2"}se;
   $makefile;
 }
@@ -587,7 +656,7 @@ sub do_perlpod {
                   )+
                  }
          {$1 . join "", &generate_perlpod}mxe) {
-    die "$0: Failed to insert ammendments in do_perlpod";
+    die "$0: Failed to insert amendments in do_perlpod";
   }
   $pod;
 }
@@ -595,7 +664,7 @@ sub do_perlpod {
 sub do_podmak {
   my $name = shift;
   my $body = join '', @_;
-  foreach my $variable qw(pod man html tex) {
+  foreach my $variable (qw(pod man html tex)) {
     die "$0: could not find $variable in $name"
       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
        {"\n" . generate_pod_mak ($variable)}se;
@@ -608,39 +677,73 @@ sub do_vms {
   my $makefile = join '', @_;
   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
-  my $sections = () = $makefile =~ m/\0+/g;
-  die "$0: $name contains no pod assignments" if $sections < 1;
-  die "$0: $name contains $sections discontigous pod assignments"
-    if $sections > 1;
+  verify_contiguous($name, $makefile, 'pod assignments');
   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
 
   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 
 # Looking for rules like this
-# [.lib.pod]perl.pod : [.pod]perl.pod
-#      @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
-#      Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+# [.lib.pods]perl.pod : [.pod]perl.pod
+#      @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
+#      Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
 
-  $makefile =~ s/\n\Q[.lib.pod]\Eperl[^\n\.]*\.pod[^\n]+\n
+  $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
                 [^\n]+\n       # Another line
-                [^\n]+\Q[.lib.pod]\E\n         # ends [.lib.pod]
+                [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
                    /\0/gsx;
-  $sections = () = $makefile =~ m/\0+/g;
-  die "$0: $name contains no copy rules" if $sections < 1;
-  die "$0: $name contains $sections discontigous copy rules"
-    if $sections > 1;
+  verify_contiguous($name, $makefile, 'copy rules');
   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
+
+# Looking for rules like this:
+#      - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
+  $makefile =~ s!(?:\t- If F\$Search\("\[\.pod\]perl[a-z]+\Q.pod").nes."" Then Delete/NoConfirm/Log [.pod]perl\E[a-z]+\.pod;\*\n)+!\0!sg;
+  verify_contiguous($name, $makefile, 'delete rules');
+  $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
+
   $makefile;
 }
 
+sub do_unix {
+  my $name = shift;
+  my $makefile_SH = join '', @_;
+  die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
+
+  $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
+                  {join ' ', $1, map "pod/$_",
+                       sort keys %Copies, grep {!/perltoc/} keys %Generated
+                   }mge;
+
+# pod/perldelta.pod: pod/perl511delta.pod
+#      cd pod && $(LNS) perl511delta.pod perldelta.pod
+
+  $makefile_SH =~ s!(
+pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
+       \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
+)+!\0!gm;
+
+  verify_contiguous($name, $makefile_SH, 'copy rules');
+
+  my @copy_rules = map "
+pod/$_: pod/$Copies{$_}
+       \$(LNS) $Copies{$_} pod/$_
+", keys %Copies;
+
+  $makefile_SH =~ s/\0+/join '', @copy_rules/se;
+  $makefile_SH;
+
+}
+
 # Do stuff
 
 my $built;
 while (my ($target, $name) = each %Targets) {
+  print "Working on target $target\n" if $Verbose;
   next unless $Build{$target};
   $built++;
   if ($target eq "toc") {
+    print "Now processing $name\n" if $Verbose;
     &output_perltoc;
+    print "Finished\n" if $Verbose;
     next;
   }
   print "Now processing $name\n" if $Verbose;