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