xref: /openbsd-src/gnu/usr.bin/perl/pod/buildtoc (revision 898184e3e61f9129feb5978fad5a8c6865f00b92) 
1#!/usr/bin/perl -w
2
3use strict;
4use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore
5	    @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
6	    %Copies %Generated);
7use File::Spec;
8use File::Find;
9use FindBin;
10use Text::Tabs;
11use Text::Wrap;
12use Getopt::Long;
13use Carp;
14
15no 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
80if ($Verbose) {
81  print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
82}
83
84chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
85
86open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
87
88my ($delta_source, $delta_target);
89
90foreach (<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}
141if (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
154close 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
291sub 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
300sub output ($);
301
302sub 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
325EOPOD2B
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
338EOPOD2B
339
340  podset(sort values %Pragmata);
341
342  ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
343
344
345
346	=head1 MODULE DOCUMENTATION
347
348EOPOD2B
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
362EOPOD2B
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
375EOPOD2B
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
385my ($inhead1, $inhead2, $initem);
386
387sub 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/ \(\045Revision: \d+ \045\)//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
445sub unhead1 {
446    unhead2();
447    if ($inhead1) {
448	output "\n\n=back\n\n";
449    }
450    $inhead1 = 0;
451}
452
453sub unhead2 {
454    unitem();
455    if ($inhead2) {
456	output "\n\n=back\n\n";
457    }
458    $inhead2 = 0;
459}
460
461sub unitem {
462    if ($initem) {
463	output "\n\n";
464	##print "\n\n=back\n\n";
465    }
466    $initem = 0;
467}
468
469sub nl {
470    output "\n";
471}
472
473my $NEWLINE = 0;	# how many newlines have we seen recently
474my $LINE;		# what remains to be printed
475
476sub 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
498sub 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
530sub 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}
537sub generate_manifest_pod {
538  generate_manifest map {["pod/$_.pod", $Pods{$_}]}
539    sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
540}
541sub 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
547sub 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
558sub 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
567sub 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]
572SNIP
573   sort keys %Pods, keys %Readmepods;
574}
575
576sub 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
581sub 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
589sub 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
599sub 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
609sub 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
616sub 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
630sub 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
648sub 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
664sub 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
675sub 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
706sub 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!(
720pod/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 "
727pod/$_: 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
738my $built;
739while (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
771warn "$0: was not instructed to build anything\n" unless $built;
772