This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix multiple perldelta entries from buildtoc on VMS.
[perl5.git] / pod / buildtoc
index e12bb29..418133b 100644 (file)
@@ -10,11 +10,12 @@ 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
@@ -28,12 +29,12 @@ $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->catdir($Up, "Makefile.SH"),
+     unix => File::Spec->catfile($Up, "Makefile.SH"),
      # TODO: add roffitall
     );
 
@@ -110,11 +111,11 @@ foreach (<MASTER>) {
     $flags{aux} = 1 if $flags =~ tr/a//d;
 
     if ($flags =~ tr/D//d) {
-      $flags{perlpod_omit} = 1;
+      $flags{manifest_omit} = 1;
       $delta_source = "$filename.pod";
     }
     if ($flags =~ tr/d//d) {
-      $flags{manifest_omit} = 1;
+      $flags{perlpod_omit} = 1;
       $delta_target = "$filename.pod";
     }
     $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
@@ -141,8 +142,7 @@ 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. Fix this and do perlvms.pod
-    # with this?
+    # with sources being in the same directory.
     $Copies{$delta_target} = $delta_source;
   } else {
     die "$0: delta source defined but not target";
@@ -160,7 +160,6 @@ 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) {
@@ -173,7 +172,6 @@ close MASTER;
 
   # 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>) {
@@ -207,11 +205,15 @@ close MASTER;
     warn "$0: $i exists but is unknown by ../MANIFEST\n"
       if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
     warn "$0: $i exists but is unknown by perl.pod\n"
-       if !$perlpods{$i} && !exists $sources{$i};
+       if !$perlpods{$i} && !exists $Copies{$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"
@@ -221,11 +223,11 @@ close MASTER;
   }
   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);
@@ -253,9 +255,11 @@ close MASTER;
          if ($line =~ /^=head1\s+NAME\b/) {
            push @modpods, $file;
            #warn "GOOD $file\n";
+           close F;
            return;
          }
        }
+       close F;
        warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
       }
     }
@@ -371,6 +375,7 @@ EOPOD2B
   s/^\t//gm;
   output $_;
   output "\n";                    # flush $LINE
+  close OUT;
 }
 
 # Below are all the auxiliary routines for generating perltoc.pod
@@ -381,6 +386,8 @@ sub podset {
     local @ARGV = @_;
     my $pod;
 
+    return unless scalar(@ARGV);
+
     while(<>) {
        tr/\015//d;
        if (s/^=head1 (NAME)\s*/=head2 /) {
@@ -530,7 +537,9 @@ sub generate_manifest_pod {
     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 {
@@ -554,14 +563,19 @@ sub generate_descrip_mms_1 {
 }
 
 sub generate_descrip_mms_2 {
-  map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
-[.lib.pods]%s.pod : [.%s]%s.pod
-       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
-       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
+  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 {
   # XXX Fix this with File::Spec
   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
@@ -574,9 +588,10 @@ sub generate_nmake_2 {
   # Spot the special case
   local $Text::Wrap::columns = 76;
   my $line = wrap ("\t    ", "\t    ",
-                  join " ", sort keys %Copies,
-                                 map {"perl$_.pod"} "vms", keys %Readmes);
+                  join " ", sort keys %Copies, keys %Generated,
+                                 map {"perl$_.pod"} keys %Readmes);
   $line =~ s/$/ \\/mg;
+  $line =~ s/ \\$//;
   $line;
 }
 
@@ -590,6 +605,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 =
@@ -609,15 +631,13 @@ 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;
+  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{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
-    {"$1\n" . &generate_nmake_2."\n\t    $2"}se;
+  $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
+    {"$1\n" . &generate_nmake_2."\n\t$2"}se;
   $makefile;
 }
 
@@ -656,10 +676,7 @@ 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/;
@@ -673,11 +690,15 @@ sub do_vms {
                 [^\n]+\n       # Another line
                 [^\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\d*[a-z]+\Q.pod").nes."" Then Delete/NoConfirm/Log [.pod]perl\E\d*[a-z]+\.pod;\*\n)+!\0!sg;
+  verify_contiguous($name, $makefile, 'delete rules');
+  $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
+
   $makefile;
 }
 
@@ -686,18 +707,27 @@ sub do_unix {
   my $makefile_SH = join '', @_;
   die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
 
-  $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm;
+  $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
+                  {join ' ', $1, map "pod/$_",
+                       sort keys %Copies, grep {!/perltoc/} keys %Generated
+                   }mge;
+
+# pod/perl511delta.pod: pod/perldelta.pod
+#      cd pod && $(LNS) perldelta.pod perl511delta.pod
 
-  my $sections = () = $makefile_SH =~ m/\0+/g;
+  $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;
 
-  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_SH, 'copy rules');
 
-  my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc",
-    keys %Copies;
+  my @copy_rules = map "
+pod/$_: pod/$Copies{$_}
+       \$(LNS) $Copies{$_} pod/$_
+", keys %Copies;
 
-  $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se;
+  $makefile_SH =~ s/\0+/join '', @copy_rules/se;
   $makefile_SH;
 
 }
@@ -706,6 +736,7 @@ sub do_unix {
 
 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") {
@@ -716,6 +747,7 @@ while (my ($target, $name) = each %Targets) {
   }
   print "Now processing $name\n" if $Verbose;
   open THING, $name or die "Can't open $name: $!";
+  binmode THING;
   my @orig = <THING>;
   my $orig = join '', @orig;
   close THING;
@@ -728,10 +760,13 @@ while (my ($target, $name) = each %Targets) {
     print "Was not modified\n" if $Verbose;
     next;
   }
+  my $mode = (stat $name)[2] // die "$0: Can't stat $name: $!";
   rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
   open THING, ">$name" or die "$0: Can't open $name for writing: $!";
+  binmode THING;
   print THING $new or die "$0: print to $name failed: $!";
-  close THING or die die "$0: close $name failed: $!";
+  close THING or die "$0: close $name failed: $!";
+  chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!";
 }
 
 warn "$0: was not instructed to build anything\n" unless $built;