--- Index.pm.dist 2008-01-31 12:26:30.000000000 -0800
+++ Index.pm 2008-02-12 15:12:27.000000000 -0800
@@ -3,12 +3,11 @@
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 1.03.
+package CPAN::Site::Index;
use warnings;
use strict;
-package CPAN::Site::Index;
-use vars '$VERSION';
-$VERSION = '0.17';
+our $VERSION = '0.172';
use base 'Exporter';
our @EXPORT_OK = qw/cpan_index/;
@@ -125,8 +124,10 @@
{ my ($package, $version, $dist) = @_;
print "reg(@_)\n" if $debug;
+ my $registered_version = $findpkgs->{$package}[0] || '';
+
return if exists $findpkgs->{$package}
- && $findpkgs->{$package}[0] ge $version;
+ && $registered_version ge $version;
$findpkgs->{$package} = [ $version, $dist ];
}
@@ -160,6 +161,8 @@
my $in_buf = '';
my $out_buf = '';
my $readme_fh;
+ my $tarball_name = basename $dist;
+ my ($dist_name) = ( $tarball_name =~ / (.*) \.tar\.gz /x );
BLOCK:
while ($fh->sysread($in_buf, 512))
@@ -167,6 +170,12 @@
if($in_buf =~ /^(\S*?)\0/)
{
$file = $1;
+ if ( ! length $file ) {
+ next BLOCK;
+ }
+ if ( $file !~ /^$dist_name/ ) {
+ next BLOCK;
+ }
# when the package contains non-text files, this produces garbage
# print "file=$file\n" if $debug && length $file;
@@ -177,8 +186,7 @@
# my $outputfn = File::Spec->catfile($File::Find::dir, $readme_file);
# $outputfn =~ s/\bREADME$/\.readme/;
- my $readmefn = basename $dist;
- $readmefn =~ s/\.tar\.gz/\.readme/;
+ my $readmefn = $dist_name . '.readme';
my $outputfn = File::Spec->catfile($File::Find::dir, $readmefn);
print "README full path '$outputfn'\n" if $debug;
@@ -206,6 +214,7 @@
while ($out_buf =~ s/^([^\n]*)\n//)
{
local $_ = $1;
+ local $VERSION;
if( m/^\s* package \s* ((\w+\:\:)*\w+) \s* ;/x )
{ $package = $1;
print "package=$package\n" if $debug;
@@ -214,13 +223,41 @@
{ $version = eval "my \$v = $1";
print "version=$version\n" if $debug;
- register $package, $version, $dist
- if $file && $file =~ m/\.pm$/ && $package;
+ if ( ok_to_register($package,$file) )
+ {
+ register $package, $version, $dist;
+ }
}
}
}
}
+sub ok_to_register($$)
+{
+ my ($package,$path) = @_;
+
+ if ( ! $path )
+ {
+ return;
+ }
+
+ if ( $path !~ m/\.pm$/ )
+ {
+ return;
+ }
+
+ if ( ! $package ) {
+ return;
+ }
+
+ if ( ! path_is_in_lib_or_at_top_level($path) )
+ {
+ return;
+ }
+
+ return 1;
+}
+
sub merge_core_cpan($$$)
{ my ($cpan, $pkgs, $bigcpan_url) = @_;
@@ -267,12 +304,12 @@
my $module = __PACKAGE__;
$fh->print (<<__HEADER);
File: 02packages.details.txt
-URL: file:$details
+URL: file://$details
Description: Packages listed in CPAN and local repository
Columns: package name, version, path
Intended-For: Standard CPAN with additional private resources
Line-Count: $lines
-Written-By: $program with $module $VERSION ($how)
+Written-By: $program with $module $CPAN::Site::Index::VERSION ($how)
Last-Updated: $date
__HEADER
@@ -376,4 +413,23 @@
$ftp->close;
}
+sub path_is_in_lib_or_at_top_level($)
+{
+ my ($path) = @_;
+
+ my @path_parts = File::Spec->splitdir($path);
+ if ( ! defined $path_parts[0] ) {
+ warn "no parts in '$path'";
+ }
+ my $second_thing_in_path = $path_parts[1] || '';
+ if ( $second_thing_in_path eq 'lib' ) {
+ # path is in lib directory
+ return 1;
+ }
+ if ( @path_parts == 2 ) {
+ # path is at top-level of distro
+ return 1;
+ }
+ return;
+}
1;
