From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 8 Nov 2011 08:29:33 +0000 (+0100)
Subject: Extract from buildtoc the code that processes pod.lst, MANIFEST and perl.pod
X-Git-Tag: accepted/trunk/20130322.191538~2111^2~10
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=d7816c475cbc968366ca171e609094df68734963;p=platform%2Fupstream%2Fperl.git

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.
---

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) {