From d7816c475cbc968366ca171e609094df68734963 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Tue, 8 Nov 2011 09:29:33 +0100 Subject: [PATCH] Extract from buildtoc the code that processes pod.lst, MANIFEST and perl.pod This will permit splitting pod/buildtoc into two - one script used during the build process to build pod/perltoc.pod, and used by maintainers to regenerate sections of various Makefiles. --- MANIFEST | 1 + Porting/pod_lib.pl | 208 +++++++++++++++++++++++++++++++++++++++++++++++++++++ pod/buildtoc | 199 +------------------------------------------------- 3 files changed, 211 insertions(+), 197 deletions(-) create mode 100644 Porting/pod_lib.pl diff --git a/MANIFEST b/MANIFEST index dc75cfe..b9a399b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4695,6 +4695,7 @@ Porting/manisort Sort the MANIFEST Porting/newtests-perldelta.pl Generate Perldelta stub for newly added tests Porting/perldelta_template.pod Template for creating new perldelta.pod files Porting/perlhist_calculate.pl Perform calculations to update perlhist +Porting/pod_lib.pl Code for handling pod.lst Porting/podtidy Reformat pod using Pod::Tidy Porting/pumpkin.pod Guidelines and hints for Perl maintainers Porting/README.y2038 Perl notes for the 2038 fix diff --git a/Porting/pod_lib.pl b/Porting/pod_lib.pl new file mode 100644 index 0000000..484c050 --- /dev/null +++ b/Porting/pod_lib.pl @@ -0,0 +1,208 @@ +#!/usr/bin/perl -w + +use strict; + +# make it clearer when we haven't run to completion, as we can be quite +# noisy when things are working ok + +sub my_die { + print STDERR "$0: ", @_; + print STDERR "\n" unless $_[-1] =~ /\n\z/; + print STDERR "ABORTED\n"; + exit 255; +} + +sub open_or_die { + my $filename = shift; + open my $fh, '<', $filename or my_die "Can't open $filename: $!"; + return $fh; +} + +sub get_pod_metadata { + my %BuildFiles; + + foreach my $path (@_) { + $path =~ m!([^/]+)$!; + ++$BuildFiles{$1}; + } + + my %state = + ( + # Don't copy these top level READMEs + ignore => + { + micro => 1, + # vms => 1, + }, + ); + + my $source = 'perldelta.pod'; + my $filename = "pod/$source"; + my $fh = open_or_die($filename); + my $contents = do {local $/; <$fh>}; + my @want = + $contents =~ /perldelta - what is new for perl v5\.(\d+)\.(\d+)\n/; + die "Can't extract version from $filename" unless @want; + $state{delta_target} = "perl5$want[0]$want[1]delta.pod"; + + # This way round so that keys can act as a MANIFEST skip list + # Targets will always be in the pod directory. Currently we can only cope + # with sources being in the same directory. + $state{copies}{$state{delta_target}} = $source; + + + # process pod.lst + my %Readmepods; + my $master = open_or_die('pod.lst'); + + foreach (<$master>) { + next if /^\#/; + + # At least one upper case letter somewhere in the first group + if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) { + # it's a heading + my $flags = $1; + $flags =~ tr/h//d; + my %flags = (header => 1); + $flags{toc_omit} = 1 if $flags =~ tr/o//d; + $flags{aux} = 1 if $flags =~ tr/a//d; + my_die "Unknown flag found in heading line: $_" if length $flags; + + push @{$state{master}}, [\%flags, $2]; + } elsif (/^(\S*)\s+(\S+)\s+(.*)/) { + # it's a section + my ($flags, $podname, $desc) = ($1, $2, $3); + my $filename = "${podname}.pod"; + $filename = "pod/${filename}" if $filename !~ m{/}; + + my %flags = (indent => 0); + $flags{indent} = $1 if $flags =~ s/(\d+)//; + $flags{toc_omit} = 1 if $flags =~ tr/o//d; + $flags{aux} = 1 if $flags =~ tr/a//d; + $flags{perlpod_omit} = "$podname.pod" eq $state{delta_target}; + + $state{generated}{"$podname.pod"}++ if $flags =~ tr/g//d; + + if ($flags =~ tr/r//d) { + my $readme = $podname; + $readme =~ s/^perl//; + $Readmepods{$podname} = $state{readmes}{$readme} = $desc; + $flags{readme} = 1; + } elsif ($flags{aux}) { + $state{aux}{$podname} = $desc; + } else { + $state{pods}{$podname} = $desc; + } + my_die "Unknown flag found in section line: $_" if length $flags; + my $shortname = $podname =~ s{.*/}{}r; + push @{$state{master}}, + [\%flags, $podname, $filename, $desc, $shortname]; + } elsif (/^$/) { + push @{$state{master}}, undef; + } else { + my_die "Malformed line: $_" if $1 =~ tr/A-Z//; + } + } + close $master or my_die "close pod.lst: $!"; + + # Sanity cross check + + my (%disk_pods, @disk_pods); + my (@manipods, %manipods); + my (@manireadmes, %manireadmes); + my (@perlpods, %perlpods); + my (@cpanpods, %cpanpods, %cpanpods_short); + my (%our_pods); + + # These are stub files for deleted documents. We don't want them to show up + # in perl.pod, they just exist so that if someone types "perldoc perltoot" + # they get some sort of pointer to the new docs. + my %ignoredpods + = map { ( "$_.pod" => 1 ) } qw( perlboot perlbot perltooc perltoot ); + + # Convert these to a list of filenames. + foreach (keys %{$state{pods}}, keys %Readmepods) { + $our_pods{"$_.pod"}++; + } + + opendir my $dh, 'pod'; + while (defined ($_ = readdir $dh)) { + next unless /\.pod\z/; + push @disk_pods, $_; + ++$disk_pods{$_}; + } + + # Things we copy from won't be in perl.pod + # Things we copy to won't be in MANIFEST + + my $mani = open_or_die('MANIFEST'); + while (<$mani>) { + chomp; + s/\s+.*$//; + if (m!^pod/([^.]+\.pod)!i) { + push @manipods, $1; + } elsif (m!^README\.(\S+)!i) { + next if $state{ignore}{$1}; + push @manireadmes, "perl$1.pod"; + } elsif (exists $our_pods{$_}) { + push @cpanpods, $_; + $disk_pods{$_}++ + if -e $_; + } + } + close $mani or my_die "close MANIFEST: $!\n"; + + @manipods{@manipods} = @manipods; + @manireadmes{@manireadmes} = @manireadmes; + @cpanpods{@cpanpods} = map { s/.*\///r } @cpanpods; + %cpanpods_short = reverse %cpanpods; + + my $perlpod = open_or_die('pod/perl.pod'); + while (<$perlpod>) { + if (/^For ease of access, /../^\(If you're intending /) { + if (/^\s+(perl\S*)\s+\w/) { + push @perlpods, "$1.pod"; + } + } + } + close $perlpod or my_die "close perlpod: $!\n"; + my_die "could not find the pod listing of perl.pod\n" + unless @perlpods; + @perlpods{@perlpods} = @perlpods; + + my @inconsistent; + foreach my $i (sort keys %disk_pods) { + push @inconsistent, "$0: $i exists but is unknown by buildtoc\n" + unless $our_pods{$i}; + push @inconsistent, "$0: $i exists but is unknown by MANIFEST\n" + if !$manipods{$i} && !$manireadmes{$i} && !$state{copies}{$i} + && !$state{generated}{$i} && !$cpanpods{$i}; + push @inconsistent, "$0: $i exists but is unknown by perl.pod\n" + if !$perlpods{$i} && !exists $state{copies}{$i} && !$cpanpods{$i} && !$ignoredpods{$i}; + } + foreach my $i (sort keys %our_pods) { + push @inconsistent, "$0: $i is known by buildtoc but does not exist\n" + unless $disk_pods{$i} or $BuildFiles{$i}; + } + foreach my $i (sort keys %manipods) { + push @inconsistent, "$0: $i is known by MANIFEST but does not exist\n" + unless $disk_pods{$i}; + push @inconsistent, "$0: $i is known by MANIFEST but is marked as generated\n" + if $state{generated}{$i}; + } + foreach my $i (sort keys %perlpods) { + push @inconsistent, "$0: $i is known by perl.pod but does not exist\n" + unless $disk_pods{$i} or $BuildFiles{$i} or $cpanpods_short{$i}; + } + $state{inconsistent} = \@inconsistent; + return \%state; +} + +1; + +# Local variables: +# cperl-indent-level: 4 +# indent-tabs-mode: nil +# End: +# +# ex: set ts=8 sts=4 sw=4 et: diff --git a/pod/buildtoc b/pod/buildtoc index 6b9e9d6..c1dc6bf 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -15,25 +15,10 @@ require 5.010; # Assumption is that we're either already being run from the top level (*nix, # VMS), or have absolute paths in @INC (Win32, pod/Makefile) -{ +BEGIN { my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir); chdir $Top or die "Can't chdir to $Top: $!"; -} - -# make it clearer when we haven't run to completion, as we can be quite -# noisy when things are working ok - -sub my_die { - print STDERR "$0: ", @_; - print STDERR "\n" unless $_[-1] =~ /\n\z/; - print STDERR "ABORTED\n"; - exit 255; -} - -sub open_or_die { - my $filename = shift; - open my $fh, '<', $filename or my_die "Can't open $filename: $!"; - return $fh; + require 'Porting/pod_lib.pl'; } # Generate any/all of these files @@ -92,186 +77,6 @@ if ($Verbose) { print "I will be building $_\n" foreach keys %Build; } -sub get_pod_metadata { - my %BuildFiles; - - foreach my $path (@_) { - $path =~ m!([^/]+)$!; - ++$BuildFiles{$1}; - } - - my %state = - ( - # Don't copy these top level READMEs - ignore => - { - micro => 1, - # vms => 1, - }, - ); - - my $source = 'perldelta.pod'; - my $filename = "pod/$source"; - my $fh = open_or_die($filename); - my $contents = do {local $/; <$fh>}; - my @want = - $contents =~ /perldelta - what is new for perl v5\.(\d+)\.(\d+)\n/; - die "Can't extract version from $filename" unless @want; - $state{delta_target} = "perl5$want[0]$want[1]delta.pod"; - - # This way round so that keys can act as a MANIFEST skip list - # Targets will always be in the pod directory. Currently we can only cope - # with sources being in the same directory. - $state{copies}{$state{delta_target}} = $source; - - - # process pod.lst - my %Readmepods; - my $master = open_or_die('pod.lst'); - - foreach (<$master>) { - next if /^\#/; - - # At least one upper case letter somewhere in the first group - if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) { - # it's a heading - my $flags = $1; - $flags =~ tr/h//d; - my %flags = (header => 1); - $flags{toc_omit} = 1 if $flags =~ tr/o//d; - $flags{aux} = 1 if $flags =~ tr/a//d; - my_die "Unknown flag found in heading line: $_" if length $flags; - - push @{$state{master}}, [\%flags, $2]; - } elsif (/^(\S*)\s+(\S+)\s+(.*)/) { - # it's a section - my ($flags, $podname, $desc) = ($1, $2, $3); - my $filename = "${podname}.pod"; - $filename = "pod/${filename}" if $filename !~ m{/}; - - my %flags = (indent => 0); - $flags{indent} = $1 if $flags =~ s/(\d+)//; - $flags{toc_omit} = 1 if $flags =~ tr/o//d; - $flags{aux} = 1 if $flags =~ tr/a//d; - $flags{perlpod_omit} = "$podname.pod" eq $state{delta_target}; - - $state{generated}{"$podname.pod"}++ if $flags =~ tr/g//d; - - if ($flags =~ tr/r//d) { - my $readme = $podname; - $readme =~ s/^perl//; - $Readmepods{$podname} = $state{readmes}{$readme} = $desc; - $flags{readme} = 1; - } elsif ($flags{aux}) { - $state{aux}{$podname} = $desc; - } else { - $state{pods}{$podname} = $desc; - } - my_die "Unknown flag found in section line: $_" if length $flags; - my $shortname = $podname =~ s{.*/}{}r; - push @{$state{master}}, - [\%flags, $podname, $filename, $desc, $shortname]; - } elsif (/^$/) { - push @{$state{master}}, undef; - } else { - my_die "Malformed line: $_" if $1 =~ tr/A-Z//; - } - } - close $master or my_die "close pod.lst: $!"; - - # Sanity cross check - - my (%disk_pods, @disk_pods); - my (@manipods, %manipods); - my (@manireadmes, %manireadmes); - my (@perlpods, %perlpods); - my (@cpanpods, %cpanpods, %cpanpods_short); - my (%our_pods); - - # These are stub files for deleted documents. We don't want them to show up - # in perl.pod, they just exist so that if someone types "perldoc perltoot" - # they get some sort of pointer to the new docs. - my %ignoredpods - = map { ( "$_.pod" => 1 ) } qw( perlboot perlbot perltooc perltoot ); - - # Convert these to a list of filenames. - foreach (keys %{$state{pods}}, keys %Readmepods) { - $our_pods{"$_.pod"}++; - } - - opendir my $dh, 'pod'; - while (defined ($_ = readdir $dh)) { - next unless /\.pod\z/; - push @disk_pods, $_; - ++$disk_pods{$_}; - } - - # Things we copy from won't be in perl.pod - # Things we copy to won't be in MANIFEST - - my $mani = open_or_die('MANIFEST'); - while (<$mani>) { - chomp; - s/\s+.*$//; - if (m!^pod/([^.]+\.pod)!i) { - push @manipods, $1; - } elsif (m!^README\.(\S+)!i) { - next if $state{ignore}{$1}; - push @manireadmes, "perl$1.pod"; - } elsif (exists $our_pods{$_}) { - push @cpanpods, $_; - $disk_pods{$_}++ - if -e $_; - } - } - close $mani or my_die "close MANIFEST: $!\n"; - - @manipods{@manipods} = @manipods; - @manireadmes{@manireadmes} = @manireadmes; - @cpanpods{@cpanpods} = map { s/.*\///r } @cpanpods; - %cpanpods_short = reverse %cpanpods; - - my $perlpod = open_or_die('pod/perl.pod'); - while (<$perlpod>) { - if (/^For ease of access, /../^\(If you're intending /) { - if (/^\s+(perl\S*)\s+\w/) { - push @perlpods, "$1.pod"; - } - } - } - close $perlpod or my_die "close perlpod: $!\n"; - my_die "could not find the pod listing of perl.pod\n" - unless @perlpods; - @perlpods{@perlpods} = @perlpods; - - my @inconsistent; - foreach my $i (sort keys %disk_pods) { - push @inconsistent, "$0: $i exists but is unknown by buildtoc\n" - unless $our_pods{$i}; - push @inconsistent, "$0: $i exists but is unknown by MANIFEST\n" - if !$manipods{$i} && !$manireadmes{$i} && !$state{copies}{$i} - && !$state{generated}{$i} && !$cpanpods{$i}; - push @inconsistent, "$0: $i exists but is unknown by perl.pod\n" - if !$perlpods{$i} && !exists $state{copies}{$i} && !$cpanpods{$i} && !$ignoredpods{$i}; - } - foreach my $i (sort keys %our_pods) { - push @inconsistent, "$0: $i is known by buildtoc but does not exist\n" - unless $disk_pods{$i} or $BuildFiles{$i}; - } - foreach my $i (sort keys %manipods) { - push @inconsistent, "$0: $i is known by MANIFEST but does not exist\n" - unless $disk_pods{$i}; - push @inconsistent, "$0: $i is known by MANIFEST but is marked as generated\n" - if $state{generated}{$i}; - } - foreach my $i (sort keys %perlpods) { - push @inconsistent, "$0: $i is known by perl.pod but does not exist\n" - unless $disk_pods{$i} or $BuildFiles{$i} or $cpanpods_short{$i}; - } - $state{inconsistent} = \@inconsistent; - return \%state; -} - my $state = get_pod_metadata(values %Build); if ($Test) { -- 2.7.4