1#!/usr/bin/perl -w
2
3use strict;
4use vars qw($masterpodfile %Build %Targets $Verbose $Up %Ignore
5	    @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
6	    %Copies);
7use File::Spec;
8use File::Find;
9use FindBin;
10use Text::Tabs;
11use Text::Wrap;
12use Getopt::Long;
13
14no 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
77if ($Verbose) {
78  print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
79}
80
81chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
82
83open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
84
85my ($delta_source, $delta_target);
86
87foreach (<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}
137if (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
151close 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
280sub 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
289sub output ($);
290
291sub 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
314EOPOD2B
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
327EOPOD2B
328
329  podset(sort values %Pragmata);
330
331  ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
332
333
334
335	=head1 MODULE DOCUMENTATION
336
337EOPOD2B
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
351EOPOD2B
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
364EOPOD2B
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
373my ($inhead1, $inhead2, $initem);
374
375sub 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
429sub unhead1 {
430    unhead2();
431    if ($inhead1) {
432	output "\n\n=back\n\n";
433    }
434    $inhead1 = 0;
435}
436
437sub unhead2 {
438    unitem();
439    if ($inhead2) {
440	output "\n\n=back\n\n";
441    }
442    $inhead2 = 0;
443}
444
445sub unitem {
446    if ($initem) {
447	output "\n\n";
448	##print "\n\n=back\n\n";
449    }
450    $initem = 0;
451}
452
453sub nl {
454    output "\n";
455}
456
457my $NEWLINE = 0;	# how many newlines have we seen recently
458my $LINE;		# what remains to be printed
459
460sub 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
482sub 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
514sub 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}
521sub generate_manifest_pod {
522  generate_manifest map {["pod/$_.pod", $Pods{$_}]}
523    grep {!$Copies{"$_.pod"}} sort keys %Pods;
524}
525sub generate_manifest_readme {
526  generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
527}
528
529sub 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
540sub 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.pods]$_.pod",
545		     sort keys %Pods, keys %Readmepods);
546  @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
547}
548
549sub generate_descrip_mms_2 {
550  map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
551[.lib.pods]%s.pod : [.%s]%s.pod
552	@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
553	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
554SNIP
555   sort keys %Pods, keys %Readmepods;
556}
557
558sub 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
566sub 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
576sub 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
586sub 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
600sub 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
620sub 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
636sub 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
647sub 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.pods]perl.pod : [.pod]perl.pod
662#	@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
663#	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
664
665  $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
666		 [^\n]+\n	# Another line
667		 [^\n]+\Q[.lib.pods]\E\n		# ends [.lib.pods]
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
677sub 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
700my $built;
701while (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
730warn "$0: was not instructed to build anything\n" unless $built;
731