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