Build HTML module list based on what's actually installed.
authorSean O'Rourke <seano@foobar.local>
Mon, 1 Oct 2012 00:31:41 +0000 (30 17:31 -0700)
committerSean O'Rourke <seano@foobar.local>
Mon, 1 Oct 2012 00:31:41 +0000 (30 17:31 -0700)
ChangeLog
lib/Sepia.pm

index d9f079d..f24c891 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-09-30  Sean O'Rourke  <seano@cpan.org>
+
+       * lib/Sepia.pm (html_module_list): Find all .pm and .pod files,
+       rather than relying on packlists.
+
 2012-01-30  Sean O'Rourke  <seano@cpan.org>
 
        * sepia.el (sepia-complete-symbol): Finally fix method completion
index 76ac49d..5deacdc 100644 (file)
@@ -39,7 +39,7 @@ BEGIN {
     if ($] >= 5.012) {
         eval 'no warnings "deprecated"'; # undo some of the 5.12 suck.
     }
-    if ($] > 5.012003Z) {
+    if ($] > 5.012003) {
         warn <<EOS;
 Perl $] (newer than 5.12.3) may break Sepia.  Please let the author
 (seano\@cpan.org) know what happens.
@@ -1929,56 +1929,23 @@ sub html_module_list
 {
     my ($file, $base) = @_;
     $base ||= 'about://perldoc/';
-    my $inst = inst();
-    return unless $inst;
     my $out;
     open OUT, ">", $file || \$out or return;
     print OUT "<html><body>";
     my $pfx = '';
-    my %ns;
-    for (package_list) {
-        push @{$ns{$1}}, $_ if /^([^:]+)/;
-    }
-    # Handle core modules.
     my %fs;
-    undef $fs{$_} for map {
-        s/.*man.\///; s|/|::|g; s/\.\d(?:pm)?$//; $_
-    } grep {
-        /\.\d(?:pm)?$/ && !/man1/ && !/usr\/bin/ # && !/^(?:\/|perl)/
-    } $inst->files('Perl');
-    my @fs = sort keys %fs;
-    print OUT qq{<h2>Core Modules</h2><ul>};
-    for (@fs) {
-        print OUT qq{<li><a href="$base$_">$_</a>};
+    require File::Find;
+    my $incre = join '|', map quotemeta, sort { length $b <=> length $a } @INC;
+    $incre = qr!^(?:$incre)/*(.+)!;
+    find(sub {
+             return unless /\.p(?:m|pod)$/ && -r $_;
+             $File::Find::name =~ /$incre/ and $fs{$1} = 1;
+         }, @INC);
+    for (sort keys %fs) {
+        (my $name = $_) =~ s!/!::!g;
+        $name =~ s/\.pm$//;
+        print OUT qq{<li><a href="$base$_">$name</a>};
     }
-    print OUT '</ul><h2>Installed Modules</h2><ul>';
-
-    # handle the rest
-    for (sort keys %ns) {
-        next if $_ eq 'Perl';   # skip Perl core.
-        print OUT qq{<li><b>$_</b><ul>} if @{$ns{$_}} > 1;
-        for (sort @{$ns{$_}}) {
-            my %fs;
-            undef $fs{$_} for map {
-                s/.*man.\///; s|/|::|g; s/\.\d(?:pm)?$//; $_
-            } grep {
-                /\.\d(?:pm)?$/ && !/man1/
-            } $inst->files($_);
-            my @fs = sort keys %fs;
-            next unless @fs > 0;
-            if (@fs == 1) {
-                print OUT qq{<li><a href="$base$fs[0]">$fs[0]</a>};
-            } else {
-                print OUT qq{<li>$_<ul>};
-                for (@fs) {
-                    print OUT qq{<li><a href="$base$_">$_</a>};
-                }
-                print OUT '</ul>';
-            }
-        }
-        print OUT qq{</ul>} if @{$ns{$_}} > 1;
-    }
-
     print OUT "</ul></body></html>\n";
     close OUT;
     $file ? 1 : $out;