[Bps-public-commit] r13688 - CPAN2RT/lib

ruz at bestpractical.com ruz at bestpractical.com
Mon Jun 30 08:43:58 EDT 2008


Author: ruz
Date: Mon Jun 30 08:43:58 2008
New Revision: 13688

Modified:
   CPAN2RT/lib/CPAN2RT.pm

Log:
* add parsing of find-ls index file

Modified: CPAN2RT/lib/CPAN2RT.pm
==============================================================================
--- CPAN2RT/lib/CPAN2RT.pm	(original)
+++ CPAN2RT/lib/CPAN2RT.pm	Mon Jun 30 08:43:58 2008
@@ -86,6 +86,7 @@
     debug { "Syncing files from '$mirror'\n" };
 
     my @files = qw(
+        indices/find-ls.gz
         authors/01mailrc.txt.gz
         modules/06perms.txt.gz
         modules/02packages.details.txt.gz
@@ -220,6 +221,46 @@
     return \%res;
 }
 
+
+{ my $cache;
+sub all_distributions {
+    my $self = shift;
+    $cache = $self->_all_distributions() unless $cache;
+    return $cache;
+} }
+
+sub _all_distributions {
+    my $self = shift;
+    my $file = 'find-ls';
+    debug { "Parsing $file...\n" };
+    my $path = $self->file_path( $file );
+    open my $fh, "<:utf8", $path or die "Couldn't open '$path': $!";
+
+    my %res;
+    while ( my $str = <$fh> ) {
+        next if $str =~ /^\d+\s+0\s+l\s+1/; # skip symbolic links
+        chomp $str;
+
+        my ($mode, $file) = (split /\s+/, $str)[2, -1];
+        next if index($mode, 'x') >= 0; # skip executables (dirs)
+        # we're only interested in files in authors/id/ dir
+        next unless index($file, "authors/id/") == 0;
+        next unless $file =~ /\.(bz2|zip|tgz|tar\.gz)$/i;
+
+        my $info = CPAN::DistnameInfo->new( $file );
+        my $dist = $info->dist;
+        unless ( $dist ) {
+            debug { "Couldn't parse distribution name from '$file'\n" };
+            next;
+        }
+        push @{ $res{ $dist }{'versions'} ||= [] }, $info->version;
+        push @{ $res{ $dist }{'uploaders'} ||= [] }, $info->cpanid;
+    }
+    close $fh;
+
+    return \%res;
+}
+
 sub sync_authors {
     my $self = shift;
     my $force = shift;



More information about the Bps-public-commit mailing list