Skip to content
This repository
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

executable file 80 lines (64 sloc) 2.428 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
#!/usr/local/bin/perl

use strict;
use warnings;
use DBI;
use Data::Dumper;
use LWP::UserAgent;
use FindBin;

$| = 1;

chdir $FindBin::Bin;
my $dbname = ($FindBin::Bin =~ /dev/) ? 'cpandepsdev' : 'cpandeps';

use lib "$FindBin::Bin/lib";
use CPANdeps;
my $limit = CPANdeps::concurrency_limit("/tmp/$dbname/populate-cache/lock");

my $VERSION = 1.0;
my $ua = LWP::UserAgent->new(
    agent => "cpandeps-cache/$VERSION",
    from => 'cpandeps@cantrell.org.uk'
);

my $dbh = DBI->connect("dbi:mysql:database=$dbname", "root", "");

print "Updating cache ...\n";

mkdir 'db';
mkdir 'db/META.yml';
mkdir 'db/MANIFEST'; # not populated by this script, as not often used
chmod 0777, qw(db db/META.yml db/MANIFEST);

print "Caching list of perls\n";
open(PERLS, ">db/perls") || die("Can't cache list of perl versions\n");
print PERLS Dumper([map { $_->[0] } @{$dbh->selectall_arrayref("SELECT DISTINCT perl FROM cpanstats")}]);
close(PERLS);

print "Caching list of OSes\n";
open(OSES, ">db/oses") || die("Can't cache list of OSes\n");
print OSES Dumper([map { $_->[0] } @{$dbh->selectall_arrayref("SELECT DISTINCT os FROM cpanstats")}]);
close(OSES);

my @files = map { @{$_} } @{$dbh->selectall_arrayref("
SELECT DISTINCT(file) FROM packages
")};

print "Getting META.ymls and META.jsons\n";
foreach my $file (@files) {
    $file =~ m{^./../([^/]+)(/.*)?/([^/]*).(tar.gz|tgz|zip)$};
    my($author, $dist) = ($1, $3);
    next if(!defined($author) || !defined($dist));

    next if(
        -e "db/META.yml/$dist.yml" || -e "db/META.yml/$dist.json" ||
        (-e "db/META.yml/$dist.yml.404" && -e "db/META.yml/$dist.json.404")
    );
    foreach my $tuple (
        { local => "db/META.yml/$dist.yml", remote => "http://search.cpan.org/src/$author/$dist/META.yml" },
        { local => "db/META.yml/$dist.json", remote => "http://search.cpan.org/src/$author/$dist/META.json" },
    ) {
        my $local_file = $tuple->{local};
        my $remote_file = $tuple->{remote};
  
        print '.';

        my $res = $ua->request(HTTP::Request->new(GET => $remote_file));
        if(!$res->is_success()) {
            open(FILE, '>', "$local_file.404") || die("Can't write $local_file.404\n");
            close(FILE);
        } else {
          my $yaml = $res->content();
          open(FILE, '>', $local_file) || die("Can't write $local_file\n");
          print FILE $yaml;
          close(FILE);
        }
    }
}
print "\n";
Something went wrong with that request. Please try again.