File Coverage

blib/lib/R/Setup/Local.pm

Criterion	Covered	Total	%
statement	12	54	22.2
branch	0	28	0.0
condition	0	6	0.0
subroutine	5	10	50.0
pod	0	5	0.0
total	17	103	16.5

# perl program
# requires: R instance with local repo
# pulls: a list of package ids and the package tars
# isntalls: R binary, R packages on local machine
#
# Copyright (C) 2015, Snehasis Sinha
#

package R::Setup::Local;

use 5.010001;
use strict;
use warnings;
use LWP::UserAgent;

our @ISA = qw();
our $VERSION = '0.01';

BEGIN { $| = 1 } # flush STDOUT buffer

# package methods

sub new {
	my $class = shift;
	my %params = @_;
	my $self = {
		_url      => $params{'urlbase'}, # local url
		_pkglist  => $params{'packagelist'} || 'tarlist', #list of tars
		_binary   => $params{'binary'} || 'R-3.1.2.tar.gz',
		_lwp      => undef,
		_verbose  => $params{'verbose'} || 1, # default:yes
	};
	bless $self, $class;
	return $self;
}

# wget implementation
# package=>pkg_ver.tar.gz or R-3.1.2.tar.gz
# type=>package index source
sub p_wget {
	my ($self, %args) = (@_);
	my $res;
	my $uri = $self->{'_url'};

	$uri .= "/".$args{'package'};
	$res = $self->{'_lwp'}->get ( $uri );

	if ( $res->is_success ) {
		open TARGZ, '>'.$args{'package'} or die $!;
		print TARGZ $res->decoded_content;
		close TARGZ;
	}
	return $res->is_success;
}

sub p_connect {
	my ($self) = (@_);

	unless (defined $self->{'_lwp'}) {
		$self->{'_lwp'} = LWP::UserAgent->new;
		$self->{'_lwp'}->timeout(10);
		print "user agent connected\n" if $self->{'_verbose'};
	}
}

sub pr {
	my ($self, %args) = (@_);
	return unless $self->{'_verbose'};
	print sprintf "%-40s ... ", $args{message} if defined $args{message};
	print sprintf " _%s_\n", $args{state} if defined $args{state};
}

sub download_local {
	my ($self) = (@_);

	# connect
	$self->p_connect;

	# download binary
	if ( -f $self->{'_binary'} ) {
		$self->pr ( message=>$self->{'_binary'}, state=>'here' );
	} else {
		$self->pr ( message=>$self->{'_binary'} );
		$self->p_wget( package => $self->{'_binary'} )
			? $self->pr ( state=>'done' )
			: $self->pr ( state=>'failed' )
	}

	# download package list
	unless ( -f $self->{'_pkglist'} ) {
		$self->pr ( message=>$self->{'_pkglist'} );
		$self->p_wget( package => $self->{'_pkglist'} )
			? $self->pr ( state=>'done' )
			: $self->pr ( state=>'failed' )
	}

	# download packages
	open PACKAGES, '<'.$self->{'_pkglist'} or die $!;
	while (  ) {
		chomp;
		if ( -f $_ ) {
			$self->pr ( message=>$_, state=>'here' );
			next;
		}
		$self->pr ( message=>$_ );
		$self->p_wget( package => $_ )
			? $self->pr ( state=>'done' )
			: $self->pr ( state=>'failed' )
	}
	close PACKAGES;
}

1;

__END__