File Coverage

blib/lib/JSAN/Shell.pm

Criterion	Covered	Total	%
statement	27	85	31.7
branch	0	26	0.0
condition			n/a
subroutine	9	15	60.0
pod	1	5	20.0
total	37	131	28.2

package JSAN::Shell;

# Provides the main functionality for the JSAN CLI installer

use strict;
use warnings;

use base 'Class::Accessor::Fast';
use File::Spec ();
use File::Path ();
use File::Temp ();
use Cwd;
use JSAN::Indexer;
use LWP::Simple;

our $VERSION = '0.05';
our $SHELL;

__PACKAGE__->mk_accessors(qw[_index my_mirror]);

sub new {
    return $SHELL if $SHELL;
    my ($class) = shift;
    my $self = $class->SUPER::new({@_});
    $self->my_mirror('http://openjsan.org') unless $self->my_mirror;
    return $SHELL = $self;
}

sub index {
    my ($self) = @_;
    return $self->_index if $self->_index;
    $self->_index(JSAN::Indexer->new);
    return $self->_index;
}

sub install {
    my ($self, $lib, $prefix) = @_;
    die "You must supply a prefix to install to" unless $prefix;
    $prefix = File::Spec->rel2abs($prefix);
    File::Path::mkpath($prefix);
    my $library = $self->index->library->retrieve($lib);
    die "No such library $lib" unless $library;

    die "$lib is up to date: " . $library->version . "\n"
      if $self->_check_uptodate($library, $prefix);

    my $release = $library->release;

    my $deps = $release->meta->requires;
    foreach my $dep ( @{$deps} ) {
        eval { $self->install($dep->{name}, $prefix) };
    }

    my $link = join '', $self->my_mirror, $release->source;
    my $dir  = File::Temp::tempdir(CLEANUP => 0);
    my $file = (split /\//, $link)[-1];
    print $release->source . " -> $dir/$file\n";
    my $tarball = LWP::Simple::get($link);
    die "Downloading dist [$link] failed." unless $tarball;

    my $pwd = getcwd();
    chdir "$dir";
    print "Unpacking $file\n";
    open DIST, "> $file" or die $!;
    print DIST $tarball;
    close DIST;
    `tar xzvf $file`;

    print "Installing libraries to $prefix\n";
    chdir $release->srcdir;
    `cp -r lib/* $prefix`;

    chdir $pwd;
}

sub index_create {
    my ($self) = @_;
    my $mirror = join '/', $self->my_mirror, 'index.yaml';
    JSAN::Indexer->create_index_db($mirror);
}

sub index_get {
    my ($self) = @_;
    my $rc = LWP::Simple::mirror($self->my_mirror . "/index.sqlite", $JSAN::Indexer::INDEX_DB);
    die "Could not mirror index" unless -e $JSAN::Indexer::INDEX_DB;
    print "Downloaded index.\n";
}

sub _check_uptodate {
   my ($self, $library, $prefix) = @_;
   my $lib = $library->name;
   $lib =~ s[\.][/]g;
   $lib = "$prefix/$lib.js";

   if ( -e $lib ) {
       open LIB, $lib or die "Up to date check failed for " . $library->name;
       while () {
           my ($version) = $_ =~ /VERSION\s*(?:=|:)\s*[^\d._]*([\d._]+)/;
           next unless $version;
           return 1 if $version eq $library->version;
       }
       close LIB;
   }
   return;
}

1;

__END__