use cpanmetadb history API.

Allow fetching from backpan unless the release is the latest.
miyagawa · Apr 30, 2015 · 97f4691 · 97f4691
1 parent ebe5994
commit 97f4691
Show file tree

Hide file tree

Showing 3 changed files with 52 additions and 13 deletions.
diff --git a/lib/App/cpanminus/script.pm b/lib/App/cpanminus/script.pm
@@ -683,9 +683,8 @@ sub search_database {
     my($self, $module, $version) = @_;
 
     my $found;
-    my $range = ($self->with_version_range($version) || $self->{dev_release});
 
-    if ($range or $self->{metacpan}) {
+    if ($self->{dev_release} or $self->{metacpan}) {
         $found = $self->search_metacpan($module, $version)   and return $found;
         $found = $self->search_cpanmetadb($module, $version) and return $found;
     } else {
@@ -697,9 +696,20 @@ sub search_database {
 sub search_cpanmetadb {
     my($self, $module, $version) = @_;
 
-    require CPAN::Meta::YAML;
 
-    $self->chat("Searching $module on cpanmetadb ...\n");
+    $self->chat("Searching $module ($version) on cpanmetadb ...\n");
+
+    if ($self->with_version_range($version)) {
+        return $self->search_cpanmetadb_history($module, $version);
+    } else {
+        return $self->search_cpanmetadb_package($module, $version);
+    }
+}
+
+sub search_cpanmetadb_package {
+    my($self, $module, $version) = @_;
+
+    require CPAN::Meta::YAML;
 
     (my $uri = $self->{cpanmetadb}) =~ s{/?$}{/package/$module};
     my $yaml = $self->get($uri);
@@ -712,6 +722,42 @@ sub search_cpanmetadb {
     return;
 }
 
+sub search_cpanmetadb_history {
+    my($self, $module, $version) = @_;
+
+    (my $uri = $self->{cpanmetadb}) =~ s{/?$}{/history/$module};
+    my $content = $self->get($uri) or return;
+
+    my @found;
+    for my $line (split /\r?\n/, $content) {
+        if ($line =~ /^$module\s+(\S+)\s+(\S+)$/) {
+            push @found, {
+                version => $1,
+                version_obj => version::->parse($1),
+                distfile => $2,
+            };
+        }
+    }
+
+    return unless @found;
+
+    $found[-1]->{latest} = 1;
+
+    my $match;
+    for my $try (sort { $b->{version_obj} cmp $a->{version_obj} } @found) {
+        if ($self->satisfy_version($module, $try->{version_obj}, $version)) {
+            local $self->{mirrors} = $self->{mirrors};
+            unshift @{$self->{mirrors}}, 'http://backpan.perl.org'
+              unless $try->{latest};
+            return $self->cpan_module($module, $try->{distfile}, $try->{version});
+        }
+    }
+
+    $self->diag_fail("Finding $module ($version) on cpanmetadb failed.");
+    return;
+}
+
+
 sub search_module {
     my($self, $module, $version) = @_;
 

diff --git a/xt/backpan_search.t b/xt/backpan_search.t
@@ -13,12 +13,6 @@ use Test::More;
     unlike last_build_log, qr/backpan/;
 }
 
-{
-    my $out = run '--info', 'Moose::Util::TypeConstraints@2.0402';
-    like $out, qr/Moose-2.0402/;
-    unlike $out, qr/Crixa/;
-}
-
 {
     my $out = run '--info', 'Moose::Util::TypeConstraints~<=2.0402';
     like $out, qr/Moose-2.0402/;

diff --git a/xt/module_args_exact_at.t b/xt/module_args_exact_at.t
@@ -12,15 +12,14 @@ use xt::Run;
 }
 
 {
-    # metacpan releases
-
+    # historical releases
     run_L '--mirror-only', 'Try::Tiny@0.10';
     like last_build_log, qr/Found Try::Tiny .* doesn't satisfy == 0.10/;
 
     run_L 'Try::Tiny'; # pull latest from CPAN
 
     run_L '--skip-installed', 'Try::Tiny@0.11';
-    like last_build_log, qr/Searching Try::Tiny \(== 0.11\) on metacpan/;
+    like last_build_log, qr/Searching Try::Tiny \(== 0.11\) on cpanmetadb/;
     unlike last_build_log, qr/Try::Tiny is up to date/;
 
     run_L 'CPAN::Meta@2.150003';