collapse threading doc changes as suggested by Nicholas, adding in notes on the addit...
[p5sagit/p5-mst-13.2.git] / pod / buildtoc
1 #!/usr/bin/perl -w
2
3 use strict;
4 use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore
5             @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
6             %Copies %Generated);
7 use File::Spec;
8 use File::Find;
9 use FindBin;
10 use Text::Tabs;
11 use Text::Wrap;
12 use Getopt::Long;
13 use Carp;
14
15 no locale;
16
17 $Up = File::Spec->updir;
18 $masterpodfile = File::Spec->catfile($Up, "pod.lst");
19
20 # Generate any/all of these files
21 # --verbose gives slightly more output
22 # --quiet suppresses routine warnings
23 # --build-all tries to build everything
24 # --build-foo updates foo as follows
25 # --showfiles shows the files to be changed
26
27 %Targets
28   = (
29      toc => "perltoc.pod",
30      manifest => File::Spec->catdir($Up, "MANIFEST"),
31      perlpod => "perl.pod",
32      vms => File::Spec->catfile($Up, "vms", "descrip_mms.template"),
33      nmake => File::Spec->catfile($Up, "win32", "Makefile"),
34      dmake => File::Spec->catfile($Up, "win32", "makefile.mk"),
35      podmak => File::Spec->catfile($Up, "win32", "pod.mak"),
36      # plan9 =>  File::Spec->catdir($Up, "plan9", "mkfile"),
37      unix => File::Spec->catfile($Up, "Makefile.SH"),
38      # TODO: add roffitall
39     );
40
41 {
42   my @files = keys %Targets;
43   my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
44   my $showfiles;
45   die <<__USAGE__
46 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
47 __USAGE__
48   unless @ARGV
49         && GetOptions (verbose => \$Verbose,
50                        quiet => \$Quiet,
51                        showfiles => \$showfiles,
52                        map {+"build-$_", \$Build{$_}} @files, 'all');
53   # Set them all to true
54   @Build{@files} = @files if ($Build{all});
55   if ($showfiles) {
56       print
57           join(" ",
58                sort { lc $a cmp lc $b }
59                map {
60                    my ($v, $d, $f) = File::Spec->splitpath($_);
61                    my @d;
62                    @d = defined $d ? File::Spec->splitdir($d) : ();
63                    shift @d if @d;
64                    File::Spec->catfile(@d ?
65                                        (@d == 1 && $d[0] eq '' ? () : @d)
66                                        : "pod", $f);
67                } @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
68           "\n";
69       exit(0);
70   }
71 }
72
73 # Don't copy these top level READMEs
74 %Ignore
75   = (
76      micro => 1,
77 #     vms => 1,
78      );
79
80 if ($Verbose) {
81   print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
82 }
83
84 chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
85
86 open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
87
88 my ($delta_source, $delta_target);
89
90 foreach (<MASTER>) {
91   next if /^\#/;
92
93   # At least one upper case letter somewhere in the first group
94   if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
95     # it's a heading
96     my $flags = $1;
97     $flags =~ tr/h//d;
98     my %flags = (header => 1);
99     $flags{toc_omit} = 1 if $flags =~ tr/o//d;
100     $flags{aux} = 1 if $flags =~ tr/a//d;
101     die "$0: Unknown flag found in heading line: $_" if length $flags;
102     push @Master, [\%flags, $2];
103
104   } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
105     # it's a section
106     my ($flags, $filename, $desc) = ($1, $2, $3);
107
108     my %flags = (indent => 0);
109     $flags{indent} = $1 if $flags =~ s/(\d+)//;
110     $flags{toc_omit} = 1 if $flags =~ tr/o//d; 
111     $flags{aux} = 1 if $flags =~ tr/a//d;
112
113     if ($flags =~ tr/D//d) {
114       $flags{perlpod_omit} = 1;
115       $delta_source = "$filename.pod";
116     }
117     if ($flags =~ tr/d//d) {
118       $flags{manifest_omit} = 1;
119       $delta_target = "$filename.pod";
120     }
121     $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
122
123     if ($flags =~ tr/r//d) {
124       my $readme = $filename;
125       $readme =~ s/^perl//;
126       $Readmepods{$filename} = $Readmes{$readme} = $desc;
127       $flags{readme} = 1;
128     } elsif ($flags{aux}) {
129       $Aux{$filename} = $desc;
130     } else {
131       $Pods{$filename} = $desc;
132     }
133     die "$0: Unknown flag found in section line: $_" if length $flags;
134     push @Master, [\%flags, $filename, $desc];
135   } elsif (/^$/) {
136     push @Master, undef;
137   } else {
138     die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
139   }
140 }
141 if (defined $delta_source) {
142   if (defined $delta_target) {
143     # This way round so that keys can act as a MANIFEST skip list
144     # Targets will aways be in the pod directory. Currently we can only cope
145     # with sources being in the same directory.
146     $Copies{$delta_target} = $delta_source;
147   } else {
148     die "$0: delta source defined but not target";
149   }
150 } elsif (defined $delta_target) {
151   die "$0: delta target defined but not target";
152 }
153
154 close MASTER;
155
156 # Sanity cross check
157 {
158   my (%disk_pods, @disk_pods);
159   my (@manipods, %manipods);
160   my (@manireadmes, %manireadmes);
161   my (@perlpods, %perlpods);
162   my (%our_pods);
163   my (%sources);
164
165   # Convert these to a list of filenames.
166   foreach (keys %Pods, keys %Readmepods) {
167     $our_pods{"$_.pod"}++;
168   }
169
170   # None of these filenames will be boolean false
171   @disk_pods = glob("*.pod");
172   @disk_pods{@disk_pods} = @disk_pods;
173
174   # Things we copy from won't be in perl.pod
175   # Things we copy to won't be in MANIFEST
176   @sources{values %Copies} = ();
177
178   open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
179   while (<MANI>) {
180     if (m!^pod/([^.]+\.pod)\s+!i) {
181       push @manipods, $1;
182     } elsif (m!^README\.(\S+)\s+!i) {
183       next if $Ignore{$1};
184       push @manireadmes, "perl$1.pod";
185     }
186   }
187   close(MANI);
188   @manipods{@manipods} = @manipods;
189   @manireadmes{@manireadmes} = @manireadmes;
190
191   open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
192   while (<PERLPOD>) {
193     if (/^For ease of access, /../^\(If you're intending /) {
194       if (/^\s+(perl\S*)\s+\w/) {
195         push @perlpods, "$1.pod";
196       }
197     }
198   }
199   close(PERLPOD);
200   die "$0: could not find the pod listing of perl.pod\n"
201     unless @perlpods;
202   @perlpods{@perlpods} = @perlpods;
203
204   foreach my $i (sort keys %disk_pods) {
205     warn "$0: $i exists but is unknown by buildtoc\n"
206       unless $our_pods{$i};
207     warn "$0: $i exists but is unknown by ../MANIFEST\n"
208       if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
209     warn "$0: $i exists but is unknown by perl.pod\n"
210         if !$perlpods{$i} && !exists $sources{$i};
211   }
212   my @BuildTargets = grep {defined} @Targets{grep $_ ne 'all', keys %Build};
213   my %BuildFiles;
214   @BuildFiles{@BuildTargets} = @BuildTargets;
215   
216   foreach my $i (sort keys %our_pods) {
217     warn "$0: $i is known by buildtoc but does not exist\n"
218       unless $disk_pods{$i} or $BuildFiles{$i};
219   }
220   foreach my $i (sort keys %manipods) {
221     warn "$0: $i is known by ../MANIFEST but does not exist\n"
222       unless $disk_pods{$i};
223     warn "$0: $i is known by ../MANIFEST but is marked as generated\n"
224       if $Generated{$i};
225   }
226   foreach my $i (sort keys %perlpods) {
227     warn "$0: $i is known by perl.pod but does not exist\n"
228       unless $disk_pods{$i} or $BuildFiles{$i};
229   }
230 }
231
232 # Find all the modules
233 {
234   my @modpods;
235   find \&getpods => qw(../lib ../ext);
236
237   sub getpods {
238     if (/\.p(od|m)$/) {
239       my $file = $File::Find::name;
240       return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
241       return if $file =~ m!(?:^|/)t/!;
242       return if $file =~ m!lib/Attribute/Handlers/demo/!;
243       return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
244       return if $file =~ m!lib/Math/BigInt/t/!;
245       return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
246       return if $file =~ m!XS/(?:APItest|Typemap)!;
247       my $pod = $file;
248       return if $pod =~ s/pm$/pod/ && -e $pod;
249       die "$0: tut $File::Find::name" if $file =~ /TUT/;
250       unless (open (F, "< $_\0")) {
251         warn "$0: bogus <$file>: $!";
252         system "ls", "-l", $file;
253       }
254       else {
255         my $line;
256         while ($line = <F>) {
257           if ($line =~ /^=head1\s+NAME\b/) {
258             push @modpods, $file;
259             #warn "GOOD $file\n";
260             close F;
261             return;
262           }
263         }
264         close F;
265         warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
266       }
267     }
268   }
269
270   die "$0: no pods" unless @modpods;
271
272   my %done;
273   for (@modpods) {
274     #($name) = /(\w+)\.p(m|od)$/;
275     my $name = path2modname($_);
276     if ($name =~ /^[a-z]/) {
277       $Pragmata{$name} = $_;
278     } else {
279       if ($done{$name}++) {
280         # warn "already did $_\n";
281         next;
282       }
283       $Modules{$name} = $_;
284     }
285   }
286 }
287
288 # OK. Now a lot of ancillary function definitions follow
289 # Main program returns at "Do stuff"
290
291 sub path2modname {
292     local $_ = shift;
293     s/\.p(m|od)$//;
294     s-.*?/(lib|ext)/--;
295     s-/-::-g;
296     s/(\w+)::\1/$1/;
297     return $_;
298 }
299
300 sub output ($);
301
302 sub output_perltoc {
303   open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
304
305   local $/ = '';
306
307   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
308
309         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
310         # This file is autogenerated by buildtoc from all the other pods.
311         # Edit those files and run buildtoc --build-toc to effect changes.
312
313         =head1 NAME
314
315         perltoc - perl documentation table of contents
316
317         =head1 DESCRIPTION
318
319         This page provides a brief table of contents for the rest of the Perl
320         documentation set.  It is meant to be scanned quickly or grepped
321         through to locate the proper section you're looking for.
322
323         =head1 BASIC DOCUMENTATION
324
325 EOPOD2B
326 #' make emacs happy
327
328   # All the things in the master list that happen to be pod filenames
329   podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
330
331
332   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
333
334
335
336         =head1 PRAGMA DOCUMENTATION
337
338 EOPOD2B
339
340   podset(sort values %Pragmata);
341
342   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
343
344
345
346         =head1 MODULE DOCUMENTATION
347
348 EOPOD2B
349
350   podset( @Modules{ sort keys %Modules } );
351
352   $_= <<"EOPOD2B";
353
354
355         =head1 AUXILIARY DOCUMENTATION
356
357         Here should be listed all the extra programs' documentation, but they
358         don't all have manual pages yet:
359
360         =over 4
361
362 EOPOD2B
363
364   $_ .=  join "\n", map {"\t=item $_\n"} sort keys %Aux;
365   $_ .= <<"EOPOD2B" ;
366
367         =back
368
369         =head1 AUTHOR
370
371         Larry Wall <F<larry\@wall.org>>, with the help of oodles
372         of other folks.
373
374
375 EOPOD2B
376
377   s/^\t//gm;
378   output $_;
379   output "\n";                    # flush $LINE
380   close OUT;
381 }
382
383 # Below are all the auxiliary routines for generating perltoc.pod
384
385 my ($inhead1, $inhead2, $initem);
386
387 sub podset {
388     local @ARGV = @_;
389     my $pod;
390
391     return unless scalar(@ARGV);
392
393     while(<>) {
394         tr/\015//d;
395         if (s/^=head1 (NAME)\s*/=head2 /) {
396             $pod = path2modname($ARGV);
397             unhead1();
398             output "\n \n\n=head2 ";
399             $_ = <>;
400             # Remove svn keyword expansions from the Perl FAQ
401             s/ \(\$Revision: \d+ \$\)//g;
402             if ( /^\s*$pod\b/ ) {
403                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
404                 output $_;
405             } else {
406                 s/^/$pod, /;
407                 output $_;
408             }
409             next;
410         }
411         if (s/^=head1 (.*)/=item $1/) {
412             unhead2();
413             output "=over 4\n\n" unless $inhead1;
414             $inhead1 = 1;
415             output $_; nl(); next;
416         }
417         if (s/^=head2 (.*)/=item $1/) {
418             unitem();
419             output "=over 4\n\n" unless $inhead2;
420             $inhead2 = 1;
421             output $_; nl(); next;
422         }
423         if (s/^=item ([^=].*)/$1/) {
424             next if $pod eq 'perldiag';
425             s/^\s*\*\s*$// && next;
426             s/^\s*\*\s*//;
427             s/\n/ /g;
428             s/\s+$//;
429             next if /^[\d.]+$/;
430             next if $pod eq 'perlmodlib' && /^ftp:/;
431             ##print "=over 4\n\n" unless $initem;
432             output ", " if $initem;
433             $initem = 1;
434             s/\.$//;
435             s/^-X\b/-I<X>/;
436             output $_; next;
437         }
438         if (s/^=cut\s*\n//) {
439             unhead1();
440             next;
441         }
442     }
443 }
444
445 sub unhead1 {
446     unhead2();
447     if ($inhead1) {
448         output "\n\n=back\n\n";
449     }
450     $inhead1 = 0;
451 }
452
453 sub unhead2 {
454     unitem();
455     if ($inhead2) {
456         output "\n\n=back\n\n";
457     }
458     $inhead2 = 0;
459 }
460
461 sub unitem {
462     if ($initem) {
463         output "\n\n";
464         ##print "\n\n=back\n\n";
465     }
466     $initem = 0;
467 }
468
469 sub nl {
470     output "\n";
471 }
472
473 my $NEWLINE = 0;        # how many newlines have we seen recently
474 my $LINE;               # what remains to be printed
475
476 sub output ($) {
477     for (split /(\n)/, shift) {
478         if ($_ eq "\n") {
479             if ($LINE) {
480                 print OUT wrap('', '', $LINE);
481                 $LINE = '';
482             }
483             if (($NEWLINE) < 2) {
484                 print OUT;
485                 $NEWLINE++;
486             }
487         }
488         elsif (/\S/ && length) {
489             $LINE .= $_;
490             $NEWLINE = 0;
491         }
492     }
493 }
494
495 # End of original buildtoc. From here on are routines to generate new sections
496 # for and inplace edit other files
497
498 sub generate_perlpod {
499   my @output;
500   my $maxlength = 0;
501   foreach (@Master) {
502     my $flags = $_->[0];
503     next if $flags->{aux};
504     next if $flags->{perlpod_omit};
505
506     if (@$_ == 2) {
507       # Heading
508       push @output, "=head2 $_->[1]\n";
509     } elsif (@$_ == 3) {
510       # Section
511       my $start = " " x (4 + $flags->{indent}) . $_->[1];
512       $maxlength = length $start if length ($start) > $maxlength;
513       push @output, [$start, $_->[2]];
514     } elsif (@$_ == 0) {
515       # blank line
516       push @output, "\n";
517     } else {
518       die "$0: Illegal length " . scalar @$_;
519     }
520   }
521   # want at least 2 spaces padding
522   $maxlength += 2;
523   $maxlength = ($maxlength + 3) & ~3;
524   # sprintf gives $1.....$2 where ... are spaces:
525   return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
526                    @output);
527 }
528
529
530 sub generate_manifest {
531   # Annyoingly unexpand doesn't consider it good form to replace a single
532   # space before a tab with a tab
533   # Annoyingly (2) it returns read only values.
534   my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
535   map {s/ \t/\t\t/g; $_} @temp;
536 }
537 sub generate_manifest_pod {
538   generate_manifest map {["pod/$_.pod", $Pods{$_}]}
539     sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
540 }
541 sub generate_manifest_readme {
542   generate_manifest sort {$a->[0] cmp $b->[0]}
543     ["README.vms", "Notes about installing the VMS port"],
544       map {["README.$_", $Readmes{$_}]} keys %Readmes;
545 }
546
547 sub generate_roffitall {
548   (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
549    "\t\t\\",
550    map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
551    "\t\t\\",
552    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
553    "\t\t\\",
554    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
555   )
556 }
557
558 sub generate_descrip_mms_1 {
559   local $Text::Wrap::columns = 150;
560   my $count = 0;
561   my @lines = map {"pod" . $count++ . " = $_"}
562     split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
563                      sort keys %Pods, keys %Readmepods);
564   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
565 }
566
567 sub generate_descrip_mms_2 {
568   map {<<"SNIP"}
569 [.lib.pods]$_.pod : [.pod]$_.pod
570         \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
571         Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
572 SNIP
573    sort keys %Pods, keys %Readmepods;
574 }
575
576 sub generate_descrip_mms_3 {
577   map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
578     sort keys %Generated, keys %Copies;
579 }
580
581 sub generate_nmake_1 {
582   # XXX Fix this with File::Spec
583   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
584     sort keys %Readmes),
585       (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
586 }
587
588 # This doesn't have a trailing newline
589 sub generate_nmake_2 {
590   # Spot the special case
591   local $Text::Wrap::columns = 76;
592   my $line = wrap ("\t    ", "\t    ",
593                    join " ", sort keys %Copies, keys %Generated,
594                                   map {"perl$_.pod"} keys %Readmes);
595   $line =~ s/$/ \\/mg;
596   $line;
597 }
598
599 sub generate_pod_mak {
600   my $variable = shift;
601   my @lines;
602   my $line = join "\\\n", "\U$variable = ",
603     map {"\t$_.$variable\t"} sort keys %Pods;
604   # Special case
605   $line =~ s/.*perltoc.html.*\n//m;
606   $line;
607 }
608
609 sub verify_contiguous {
610   my ($name, $content, $what) = @_;
611   my $sections = () = $content =~ m/\0+/g;
612   croak("$0: $name contains no $what") if $sections < 1;
613   croak("$0: $name contains discontiguous $what") if $sections > 1;
614 }
615
616 sub do_manifest {
617   my $name = shift;
618   my @manifest =
619     grep {! m!^pod/[^.]+\.pod.*\n!}
620       grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
621   # Dictionary order - fold and handle non-word chars as nothing
622   map  { $_->[0] }
623   sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
624   map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
625     @manifest,
626       &generate_manifest_pod(),
627         &generate_manifest_readme();
628 }
629
630 sub do_nmake {
631   my $name = shift;
632   my $makefile = join '', @_;
633   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
634   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
635   verify_contiguous($name, $makefile, 'README copies');
636   # Now remove the other copies that follow
637   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
638   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
639
640   $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
641     {"$1\n" . &generate_nmake_2."\n\t    $2"}se;
642   $makefile;
643 }
644
645 # shut up used only once warning
646 *do_dmake = *do_dmake = \&do_nmake;
647
648 sub do_perlpod {
649   my $name = shift;
650   my $pod = join '', @_;
651
652   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
653                     (?:\s+[a-z]{4,}.*\n #   fooo
654                     |=head.*\n          # =head foo
655                     |\s*\n              # blank line
656                    )+
657                   }
658           {$1 . join "", &generate_perlpod}mxe) {
659     die "$0: Failed to insert amendments in do_perlpod";
660   }
661   $pod;
662 }
663
664 sub do_podmak {
665   my $name = shift;
666   my $body = join '', @_;
667   foreach my $variable (qw(pod man html tex)) {
668     die "$0: could not find $variable in $name"
669       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
670         {"\n" . generate_pod_mak ($variable)}se;
671   }
672   $body;
673 }
674
675 sub do_vms {
676   my $name = shift;
677   my $makefile = join '', @_;
678   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
679   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
680   verify_contiguous($name, $makefile, 'pod assignments');
681   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
682
683   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
684
685 # Looking for rules like this
686 # [.lib.pods]perl.pod : [.pod]perl.pod
687 #       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
688 #       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
689
690   $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
691                  [^\n]+\n       # Another line
692                  [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
693                     /\0/gsx;
694   verify_contiguous($name, $makefile, 'copy rules');
695   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
696
697 # Looking for rules like this:
698 #       - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
699   $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;
700   verify_contiguous($name, $makefile, 'delete rules');
701   $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
702
703   $makefile;
704 }
705
706 sub do_unix {
707   my $name = shift;
708   my $makefile_SH = join '', @_;
709   die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
710
711   $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
712                    {join ' ', $1, map "pod/$_",
713                         sort keys %Copies, grep {!/perltoc/} keys %Generated
714                     }mge;
715
716 # pod/perldelta.pod: pod/perl511delta.pod
717 #       cd pod && $(LNS) perl511delta.pod perldelta.pod
718
719   $makefile_SH =~ s!(
720 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
721         \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
722 )+!\0!gm;
723
724   verify_contiguous($name, $makefile_SH, 'copy rules');
725
726   my @copy_rules = map "
727 pod/$_: pod/$Copies{$_}
728         \$(LNS) $Copies{$_} pod/$_
729 ", keys %Copies;
730
731   $makefile_SH =~ s/\0+/join '', @copy_rules/se;
732   $makefile_SH;
733
734 }
735
736 # Do stuff
737
738 my $built;
739 while (my ($target, $name) = each %Targets) {
740   print "Working on target $target\n" if $Verbose;
741   next unless $Build{$target};
742   $built++;
743   if ($target eq "toc") {
744     print "Now processing $name\n" if $Verbose;
745     &output_perltoc;
746     print "Finished\n" if $Verbose;
747     next;
748   }
749   print "Now processing $name\n" if $Verbose;
750   open THING, $name or die "Can't open $name: $!";
751   binmode THING;
752   my @orig = <THING>;
753   my $orig = join '', @orig;
754   close THING;
755   my @new = do {
756     no strict 'refs';
757     &{"do_$target"}($target, @orig);
758   };
759   my $new = join '', @new;
760   if ($new eq $orig) {
761     print "Was not modified\n" if $Verbose;
762     next;
763   }
764   rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
765   open THING, ">$name" or die "$0: Can't open $name for writing: $!";
766   binmode THING;
767   print THING $new or die "$0: print to $name failed: $!";
768   close THING or die "$0: close $name failed: $!";
769 }
770
771 warn "$0: was not instructed to build anything\n" unless $built;