tokuhirom
2/19/2010 - 9:13 AM

gistfile1.perl

#!/usr/bin/perl
use strict;
use File::Basename qw(basename);

sub get($);
sub mirror($$);
sub untar;

if (eval { require LWP::Simple }) {
    *get = \&LWP::Simple::get;
    *mirror = \&LWP::Simple::mirror;
}

# TODO curl, wget
if (eval { require Archive::Tar }) {
    *untar = sub {
        my $t = Archive::Tar->new($_[0]);
        my $root = ($t->list_files)[0];
        $t->extract;
        return -d $root ? $root : undef;
    };
}

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

for my $module (@ARGV) {
    install_module($module);
}

sub run($) {
    my $cmd = shift;
    !system $cmd;
}

sub install_module {
    my $module = shift;
    my $uri = $module =~ /^(ftp|https?|file):/ ? $module : find_module($module);

    unless ($uri) {
        warn "Can't find module $module\n";
        return;
    }

    chdir $Base;
    warn "Fetching $uri ...\n";

    my $name = basename $uri;
    mirror($uri, $name);

    unless (-e $name) {
        warn "Failed to download $uri\n";
        return;
    }

    warn "Unpacking $name ...\n";
    my $dir = untar $name;
    unless ($dir) {
        warn "Failed to unpack $name: no directory\n";
        return;
    }

    warn "Buidling $dir ...\n";
    chdir $dir;

    if (-e 'Build.PL') {
        run "$^X Build.PL" &&
        run './Build'      &&
        run './Build test' &&
        run './Build install';
    } elsif (-e 'Makefile.PL') {
        run "$^X Makefile.PL" &&
        run 'make'            &&
        run 'make test'       &&
        run 'make install';
    } else {
        warn "Don't know how to build $dir\n";
        return;
    }
}

sub find_module {
    my $module = shift;
    $module =~ s/::/-/g;
    my $html = get("http://search.cpan.org/dist/$module");
    $html =~ m!\[<a href="(/CPAN/.*)">Download</a>\]!
        and return "http://search.cpan.org$1";

    return;
}