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