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 # 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 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 ancillary 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 # Remove svn keyword expansions from the Perl FAQ 387 s/ \(\$Revision: \d+ \$\)//g; 388 if ( /^\s*$pod\b/ ) { 389 s/$pod\.pm/$pod/; # '.pm' in NAME !? 390 output $_; 391 } else { 392 s/^/$pod, /; 393 output $_; 394 } 395 next; 396 } 397 if (s/^=head1 (.*)/=item $1/) { 398 unhead2(); 399 output "=over 4\n\n" unless $inhead1; 400 $inhead1 = 1; 401 output $_; nl(); next; 402 } 403 if (s/^=head2 (.*)/=item $1/) { 404 unitem(); 405 output "=over 4\n\n" unless $inhead2; 406 $inhead2 = 1; 407 output $_; nl(); next; 408 } 409 if (s/^=item ([^=].*)/$1/) { 410 next if $pod eq 'perldiag'; 411 s/^\s*\*\s*$// && next; 412 s/^\s*\*\s*//; 413 s/\n/ /g; 414 s/\s+$//; 415 next if /^[\d.]+$/; 416 next if $pod eq 'perlmodlib' && /^ftp:/; 417 ##print "=over 4\n\n" unless $initem; 418 output ", " if $initem; 419 $initem = 1; 420 s/\.$//; 421 s/^-X\b/-I<X>/; 422 output $_; next; 423 } 424 if (s/^=cut\s*\n//) { 425 unhead1(); 426 next; 427 } 428 } 429} 430 431sub unhead1 { 432 unhead2(); 433 if ($inhead1) { 434 output "\n\n=back\n\n"; 435 } 436 $inhead1 = 0; 437} 438 439sub unhead2 { 440 unitem(); 441 if ($inhead2) { 442 output "\n\n=back\n\n"; 443 } 444 $inhead2 = 0; 445} 446 447sub unitem { 448 if ($initem) { 449 output "\n\n"; 450 ##print "\n\n=back\n\n"; 451 } 452 $initem = 0; 453} 454 455sub nl { 456 output "\n"; 457} 458 459my $NEWLINE = 0; # how many newlines have we seen recently 460my $LINE; # what remains to be printed 461 462sub output ($) { 463 for (split /(\n)/, shift) { 464 if ($_ eq "\n") { 465 if ($LINE) { 466 print OUT wrap('', '', $LINE); 467 $LINE = ''; 468 } 469 if (($NEWLINE) < 2) { 470 print OUT; 471 $NEWLINE++; 472 } 473 } 474 elsif (/\S/ && length) { 475 $LINE .= $_; 476 $NEWLINE = 0; 477 } 478 } 479} 480 481# End of original buildtoc. From here on are routines to generate new sections 482# for and inplace edit other files 483 484sub generate_perlpod { 485 my @output; 486 my $maxlength = 0; 487 foreach (@Master) { 488 my $flags = $_->[0]; 489 next if $flags->{aux}; 490 next if $flags->{perlpod_omit}; 491 492 if (@$_ == 2) { 493 # Heading 494 push @output, "=head2 $_->[1]\n"; 495 } elsif (@$_ == 3) { 496 # Section 497 my $start = " " x (4 + $flags->{indent}) . $_->[1]; 498 $maxlength = length $start if length ($start) > $maxlength; 499 push @output, [$start, $_->[2]]; 500 } elsif (@$_ == 0) { 501 # blank line 502 push @output, "\n"; 503 } else { 504 die "$0: Illegal length " . scalar @$_; 505 } 506 } 507 # want at least 2 spaces padding 508 $maxlength += 2; 509 $maxlength = ($maxlength + 3) & ~3; 510 # sprintf gives $1.....$2 where ... are spaces: 511 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_} 512 @output); 513} 514 515 516sub generate_manifest { 517 # Annyoingly unexpand doesn't consider it good form to replace a single 518 # space before a tab with a tab 519 # Annoyingly (2) it returns read only values. 520 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_); 521 map {s/ \t/\t\t/g; $_} @temp; 522} 523sub generate_manifest_pod { 524 generate_manifest map {["pod/$_.pod", $Pods{$_}]} 525 grep {!$Copies{"$_.pod"}} sort keys %Pods; 526} 527sub generate_manifest_readme { 528 generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes; 529} 530 531sub generate_roffitall { 532 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods), 533 "\t\t\\", 534 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux), 535 "\t\t\\", 536 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata), 537 "\t\t\\", 538 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules), 539 ) 540} 541 542sub generate_descrip_mms_1 { 543 local $Text::Wrap::columns = 150; 544 my $count = 0; 545 my @lines = map {"pod" . $count++ . " = $_"} 546 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod", 547 sort keys %Pods, keys %Readmepods); 548 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1; 549} 550 551sub generate_descrip_mms_2 { 552 map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_} 553[.lib.pods]%s.pod : [.%s]%s.pod 554 @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods] 555 Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods] 556SNIP 557 sort keys %Pods, keys %Readmepods; 558} 559 560sub generate_nmake_1 { 561 # XXX Fix this with File::Spec 562 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_} 563 sort keys %Readmes), 564 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies); 565} 566 567# This doesn't have a trailing newline 568sub generate_nmake_2 { 569 # Spot the special case 570 local $Text::Wrap::columns = 76; 571 my $line = wrap ("\t ", "\t ", 572 join " ", sort keys %Copies, 573 map {"perl$_.pod"} "vms", keys %Readmes); 574 $line =~ s/$/ \\/mg; 575 $line; 576} 577 578sub generate_pod_mak { 579 my $variable = shift; 580 my @lines; 581 my $line = join "\\\n", "\U$variable = ", 582 map {"\t$_.$variable\t"} sort keys %Pods; 583 # Special case 584 $line =~ s/.*perltoc.html.*\n//m; 585 $line; 586} 587 588sub do_manifest { 589 my $name = shift; 590 my @manifest = 591 grep {! m!^pod/[^.]+\.pod.*\n!} 592 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_; 593 # Dictionary order - fold and handle non-word chars as nothing 594 map { $_->[0] } 595 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] } 596 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] } 597 @manifest, 598 &generate_manifest_pod(), 599 &generate_manifest_readme(); 600} 601 602sub do_nmake { 603 my $name = shift; 604 my $makefile = join '', @_; 605 die "$0: $name contains NUL bytes" if $makefile =~ /\0/; 606 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm; 607 my $sections = () = $makefile =~ m/\0+/g; 608 die "$0: $name contains no README copies" if $sections < 1; 609 die "$0: $name contains discontiguous README copies" if $sections > 1; 610 # Now remove the other copies that follow 611 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm; 612 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se; 613 614 $makefile =~ s{(del /f [^\n]+checkpods[^\n]+).*?(pod2html)} 615 {"$1\n" . &generate_nmake_2."\n\t $2"}se; 616 $makefile; 617} 618 619# shut up used only once warning 620*do_dmake = *do_dmake = \&do_nmake; 621 622sub do_perlpod { 623 my $name = shift; 624 my $pod = join '', @_; 625 626 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n) 627 (?:\s+[a-z]{4,}.*\n # fooo 628 |=head.*\n # =head foo 629 |\s*\n # blank line 630 )+ 631 } 632 {$1 . join "", &generate_perlpod}mxe) { 633 die "$0: Failed to insert amendments in do_perlpod"; 634 } 635 $pod; 636} 637 638sub do_podmak { 639 my $name = shift; 640 my $body = join '', @_; 641 foreach my $variable (qw(pod man html tex)) { 642 die "$0: could not find $variable in $name" 643 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*} 644 {"\n" . generate_pod_mak ($variable)}se; 645 } 646 $body; 647} 648 649sub do_vms { 650 my $name = shift; 651 my $makefile = join '', @_; 652 die "$0: $name contains NUL bytes" if $makefile =~ /\0/; 653 $makefile =~ s/\npod\d* =[^\n]*/\0/gs; 654 my $sections = () = $makefile =~ m/\0+/g; 655 die "$0: $name contains no pod assignments" if $sections < 1; 656 die "$0: $name contains $sections discontigous pod assignments" 657 if $sections > 1; 658 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se; 659 660 die "$0: $name contains NUL bytes" if $makefile =~ /\0/; 661 662# Looking for rules like this 663# [.lib.pods]perl.pod : [.pod]perl.pod 664# @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods] 665# Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods] 666 667 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n 668 [^\n]+\n # Another line 669 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods] 670 /\0/gsx; 671 $sections = () = $makefile =~ m/\0+/g; 672 die "$0: $name contains no copy rules" if $sections < 1; 673 die "$0: $name contains $sections discontigous copy rules" 674 if $sections > 1; 675 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se; 676 $makefile; 677} 678 679sub do_unix { 680 my $name = shift; 681 my $makefile_SH = join '', @_; 682 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/; 683 684 $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm; 685 686 my $sections = () = $makefile_SH =~ m/\0+/g; 687 688 die "$0: $name contains no copy rules" if $sections < 1; 689 die "$0: $name contains $sections discontigous copy rules" 690 if $sections > 1; 691 692 my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc", 693 keys %Copies; 694 695 $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se; 696 $makefile_SH; 697 698} 699 700# Do stuff 701 702my $built; 703while (my ($target, $name) = each %Targets) { 704 next unless $Build{$target}; 705 $built++; 706 if ($target eq "toc") { 707 print "Now processing $name\n" if $Verbose; 708 &output_perltoc; 709 print "Finished\n" if $Verbose; 710 next; 711 } 712 print "Now processing $name\n" if $Verbose; 713 open THING, $name or die "Can't open $name: $!"; 714 my @orig = <THING>; 715 my $orig = join '', @orig; 716 close THING; 717 my @new = do { 718 no strict 'refs'; 719 &{"do_$target"}($target, @orig); 720 }; 721 my $new = join '', @new; 722 if ($new eq $orig) { 723 print "Was not modified\n" if $Verbose; 724 next; 725 } 726 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!"; 727 open THING, ">$name" or die "$0: Can't open $name for writing: $!"; 728 print THING $new or die "$0: print to $name failed: $!"; 729 close THING or die die "$0: close $name failed: $!"; 730} 731 732warn "$0: was not instructed to build anything\n" unless $built; 733