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