Merge pull request #1 from miyagawa/metacpan

use MetaCPAN API
Songmu · Aug 5, 2014 · 7ad3885 · 7ad3885
2 parents 920e39c + 625c8b0
commit 7ad3885
Show file tree

Hide file tree

Showing 4 changed files with 27 additions and 105 deletions.
diff --git a/cpanfile b/cpanfile
@@ -1,10 +1,7 @@
-requires 'CPAN::DistnameInfo';
 requires 'Class::Accessor::Lite::Lazy', '0.03';
 requires 'Getopt::Long';
-requires 'JSON';
-requires 'List::UtilsBy';
 requires 'Module::CPANfile';
-requires 'Module::Metadata';
+requires 'MetaCPAN::Client', '1.005000';
 requires 'Pod::Usage';
 requires 'perl', '5.008001';
 requires 'version', '0.77';

diff --git a/lib/App/CPANGhq.pm b/lib/App/CPANGhq.pm
@@ -6,36 +6,19 @@ use warnings;
 our $VERSION = "0.02";
 
 use Config;
-use CPAN::DistnameInfo;
 use File::Basename qw/basename/;
-use JSON;
-use List::UtilsBy qw/max_by/;
-use Module::Metadata;
 use version 0.77 ();
 use Getopt::Long ();
 use Pod::Usage ();
+use MetaCPAN::Client;
 
 our @MIRRORS = qw/http%www.cpan.org http%cpan.metacpan.org/;
 
 use Class::Accessor::Lite::Lazy 0.03 (
     new     => 1,
     ro_lazy => {
-        packages_file => sub {
-            max_by { +(stat($_))[9] } #mtime
-            grep {-f $_}
-            map  {
-                "$ENV{HOME}/.cpanm/sources/$_/02packages.details.txt";
-            } @MIRRORS;
-        },
-        installed_base => sub { $Config{sitelibexp} },
-        search_inc     => sub {
-            my $d = shift->installed_base;
-            [$d, "$d/$Config{archname}"];
-        },
-        meta_dir => sub {
-            shift->installed_base . "/$Config{archname}/.meta";
-        }
-    },
+        client => sub { MetaCPAN::Client->new },
+    }
 );
 
 ## class methods
@@ -45,12 +28,7 @@ sub run {
     my ($opt, $argv) = $class->parse_options(@argv);
     my @modules = @$argv;
 
-    if ($opt->{cpanfile}) {
-        push @modules, $class->resolve_modules_from_cpanfile;
-    }
-
     my $self = $class->new;
-
     $self->clone_modules(@modules);
 }
 
@@ -92,22 +70,7 @@ sub clone_modules {
     my ($self, @modules) = @_;
 
     for my $module (@modules) {
-        my $dist_path = $self->search_mirror_index($module);
-        unless ($dist_path) {
-            warn "skip $module: distribution is not found in packages file.\n";
-            next;
-        }
-
-        my $d = CPAN::DistnameInfo->new($dist_path);
-        my $dist_name = $d->dist;
-
-        unless (Module::Metadata->new_from_module($module, inc => $self->search_inc)) {
-            warn "skip $module: not installed in site_perl.\n";
-            next;
-        }
-
-        my $repo = $self->resolve_repo($dist_name);
-
+        my $repo = $self->resolve_repo($module);
         if ($repo) {
             !system 'ghq', 'get', $repo or do { warn $! if $! };
         }
@@ -118,49 +81,18 @@ sub clone_modules {
 }
 
 sub resolve_repo {
-    my ($self, $dist_name) = @_;
-
-    my $base = $self->meta_dir;
-    my @dirs = glob "$base/$dist_name*";
-
-    my @candidate_metas;
-    for my $d (@dirs) {
-        my $dirbase = basename $d;
-        next unless $dirbase =~ m!\A\Q$dist_name\E-[^-]+\z!ms;
-
-        my $meta_json = "$d/MYMETA.json";
-        next unless -f $meta_json && -r $meta_json;
-
-        my $meta = decode_json(do {
-            local $/;
-            open my $fh, '<', $meta_json or die $!;
-            <$fh>
-        });
-
-        push @candidate_metas, $meta;
-    }
-
-    my $meta = max_by { version->parse($_->{version})->numify } @candidate_metas;
-
-    $meta && $meta->{resources}{repository}{url};
-}
-
-sub search_mirror_index {
-    my ($self, $module) = @_;
-
-    my $packages_file = $self->packages_file or die 'no packages file found';
-    open my $fh, '<', $packages_file or die $!;
-    while (<$fh>) {
-        if (my (undef, $tar_path) = $_ =~ m!^
-            \Q$module\E
-            \s+
-            ([\w\.]+)  # version
-            \s+
-            (\S*)      # tar path
-        !mx) {
-            return $tar_path;
+    my ($self, $name) = @_;
+
+    my $repo;
+    eval {
+        my $module = $self->client->module($name);
+        my $release = $self->client->release($module->distribution);
+        if ($release->resources->{repository}) {
+            $repo = $release->resources->{repository}{url};
         }
-    }
+    };
+
+    return $repo;
 }
 
 1;

diff --git a/t/01_basic.t b/t/01_basic.t
diff --git a/xt/author/resolve.t b/xt/author/resolve.t
@@ -0,0 +1,11 @@
+use strict;
+use Test::More tests => 1;
+
+use App::CPANGhq;
+
+my $app = App::CPANGhq->new;
+my $repo = $app->resolve_repo('Plack');
+is $repo, 'https://github.com/plack/Plack.git';
+
+done_testing;
+