From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 13 Jun 2009 19:09:47 +0000 (+0100)
Subject: Improve perlmodlib.PL. Reduce the amount of special case logic.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cf9cbb1fcbe6c43ec204ccc0203775f22364127c;p=p5sagit%2Fp5-mst-13.2.git

Improve perlmodlib.PL. Reduce the amount of special case logic.
Get the module name from the Pod, rather than using heuristics on the filename
(sometimes wrong). Parse .pm_PL files too. Special cases now are only Config
and 8 files that don't use their package name in =head NAME.
---

diff --git a/pod/perlmodlib.PL b/pod/perlmodlib.PL
index 0a75208..99fca65 100644
--- a/pod/perlmodlib.PL
+++ b/pod/perlmodlib.PL
@@ -8,44 +8,27 @@ chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
 my $Quiet = @ARGV && $ARGV[0] eq '-q';
 
 open (OUT, ">perlmodlib.pod") or die $!;
-my (@pragma, @mod, @MANIFEST);
+my (@pragma, @mod, @files);
 
 # MANIFEST itself is Unix style filenames, so we have to assume that Unix style
 # filenames will work.
 
 open (MANIFEST, "../MANIFEST") or die $!;
-@MANIFEST = grep !m</(?:t|demo)/>, <MANIFEST>;
-push @MANIFEST, 'lib/Config.pod', 'lib/Errno.pm', 'lib/lib.pm',
-    'lib/DynaLoader.pm', 'lib/XSLoader.pm';
-
-# If run in a clean source tree, these will be missing because they are
-# generated by the build.
-my %generated = (
-    'encoding' => 'Allows you to write your script in non-ascii or non-utf8',
-    'lib' => 'Manipulate @INC at compile time',
-    'ops' => 'Restrict unsafe operations when compiling',
-    'Config' => 'Access Perl configuration information',
-    'DynaLoader' => 'Dynamically load C libraries into Perl code',
-    'Errno' => 'System errno constants',
-    'O' => 'Generic interface to Perl Compiler backends',
-    'Safe' => 'Compile and execute code in restricted compartments',
-    'XSLoader' => 'Dynamically load C libraries into Perl code',
+@files = grep m#(?:\.pm|\.pod|_pm\.PL)#, map {s/\s.*//s; $_}
+    grep {m#^lib# || m#^ext#} grep !m#/(?:t|demo)/#, <MANIFEST>;
+
+my %exceptions = (
+    'abbrev' => 'Text::Abbrev',
+    'carp' => 'Carp',
+    'getopt' => 'Getopt::Std',
+    'B<CGI::Carp>' => 'CGI::Carp',
+    'ModuleInfo' => 'Module::Build::ModuleInfo',
+    '$notes_name' => 'Module::Build::Notes',
+    'Encode::MIME::NAME' => 'Encode::MIME::Name',
+    'libnetFAQ' => 'Net::libnetFAQ',
 );
 
-# If run in a clean source tree, these should not be reported.
-# These are considered 'modules' by this script, but they really are not.
-my %suppressed = map {$_ => 1} qw(
-    B::O
-    Encode::encoding
-    Opcode::Safe
-    Opcode::ops
-);
-
-for (@MANIFEST) {
-    my $filename;
-    next unless m|^lib/| or m|^ext/|;
-    my ($filename) = m|^(\S+)|;
-    next unless $filename =~ m!\.p(m|od)$!;
+for my $filename (@files) {
     unless (open MOD, '<', "../$filename") {
 	warn "Couldn't open ../$filename: $!";
 	next;
@@ -71,16 +54,6 @@ for (@MANIFEST) {
      chomp($title);
      close MOD;
 
-     my $perlname = $filename;
-     $perlname =~ s!^.*\b(ext|lib)/!!;
-     $perlname =~ s!\.p(m|od)$!!;
-     $perlname =~ s!\b(\w+)/\1\b!$1!;
-     $perlname =~ s!/!::!g;
-     $perlname =~ s!-!::!g;
-
-     # modules with non standard locations
-     $perlname =~ s{Base64::QuotedPrint}{QuotedPrint};
-
      ($name, $thing) = split / --? /, $title, 2;
 
      unless ($name and $thing) {
@@ -89,30 +62,30 @@ for (@MANIFEST) {
          next;
      }
 
-     next if $suppressed{$perlname};
-
+     $name =~ s/[^A-Za-z0-9_:\$<>].*//;
+     $name = $exceptions{$name} || $name;
      $thing =~ s/^perl pragma to //i;
      $thing = ucfirst($thing);
-     $title = "=item $perlname\n\n$thing\n\n";
+     $title = "=item $name\n\n$thing\n\n";
 
-     if ($filename =~ /[A-Z]/) {
+     if ($name =~ /[A-Z]/) {
           push @mod, $title;
      } else {
           push @pragma, $title;
      }
 
-     # if we find a generated one via the MANIFEST, no need to add later.
-     delete $generated{$perlname};
-}
-while (my ($name,$desc) = each %generated) {
-    my $title = "=item $name\n\n$desc\n\n";
-    if ($name =~ /[A-Z]/) {
-        push @mod, $title;
-    } else {
-        push @pragma, $title;
-    }
 }
 
+# Much easier to special case it like this than special case the depending on
+# and parsing lib/Config.pod, or special case opening configpm and finding its
+# =head1 (which is not found with the $/="" above)
+push @mod, <<'CONFIG';
+=item Config
+
+Access Perl configuration information
+
+CONFIG
+
 print OUT <<'EOF';
 =for maintainers
 Generated by perlmodlib.PL -- DO NOT EDIT!