gitpan.pl

#!/usr/bin/perl
use strict;
use warnings;
use DirHandle;
use JSON::XS;
use LWP::UserAgent;
use Carp;
use CPAN::Inject;
use CPAN ();
use URI;
use Pod::Usage;

our $VERSION = "0.01";

my $gitpan = "$ENV{HOME}/gitpan";
mkdir $gitpan, 0777 unless -e $gitpan;

my $verbose = 1;

my $cmd = shift @ARGV or pod2usage(0);
my %commands = ( fetch => \&fetch, install => \&install, list => \&list, reload => \&reload );
my $main = $commands{$cmd} or pod2usage(0);
$main->(@ARGV);

sub fetch {
    my @authors = @_;
    @authors or pod2usage(0);

    my $ua = LWP::UserAgent->new(agent => "gitpan/$VERSION");

    for my $author (@authors) {
        warn "Fetching $author\n" if $verbose;
        my $data = get_api($ua, "http://github.com/api/v1/json/$author") or next;
        my $author_dir = "$gitpan/$author";
        mkdir $author_dir, 0777 unless -e $author_dir;
        for my $repo (@{ $data->{user}{repositories} }) {
            my $tarball = "http://github.com/$author/$repo->{name}/tarball/master";
            my $local   = "$author_dir/$author-$repo->{name}.master.tgz";
            $ua->mirror($tarball, $local);
            if (-f $local) {
                my $cpan = CPAN::Inject->from_cpan_config(author => "GITHUB");
                $cpan->add(file => $local);
                warn "Added $author/$repo->{name}\n" if $verbose;
            }
        }
    }
}

sub install {
    my @modules = @_;
    @modules or pod2usage(0);

    my @dists = map {
        s!^(\w+)/!GITHUB/$1-!;
        "$_.master.tgz";
    } @modules;
    CPAN::Shell->install(@dists);
}

sub list {
    if (@_) {
        for my $author (@_) {
            list_author($author);
        }
    } else {
        list_authors();
    }
}

sub list_author {
    my $author = shift;
    print "$author:\n";
    for my $tar (list_files("$gitpan/$author")) {
        $tar =~ s/^$author-|\.master\.tgz$//g;
        print "  $tar\n";
    }
}

sub list_authors {
    for my $dir (list_files($gitpan)) {
        print $dir, "\n";
    }
}

sub list_files {
    my $dir = DirHandle->new(shift) or die $!;
    my @files;
    while (my $ent = $dir->read) {
        push @files, $ent unless $ent =~ /^\./;
    }
    return @files;
}

sub reload {
    my @authors = list_files($gitpan);
    for my $author (@authors) {
        fetch($author);
    }
}

sub get_api {
    my $ua   = shift;
    my $uri  = URI->new(shift);

    my $res = $ua->get($uri);
    unless ($res->is_success) {
        carp "GET $uri failed";
        return;
    }
    return JSON::XS->new->decode($res->content);
}

__END__

=head1 NAME

gitpan - Fetch and install stuff from Github using CPAN shell

=head1 SYNOPSIS

  gitpan fetch miyagawa
  gitpan install miyagawa/geo-coder-google
  gitpan list
  gitpan list miyagawa

=cut