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