Skip to content
This repository has been archived by the owner on Mar 7, 2019. It is now read-only.

Commit

Permalink
Moved FTP (and HTTP) logic to A::B::MB::Repo. Overload M::B::new to c…
Browse files Browse the repository at this point in the history 
…onvert Repo specs to Repo objects
  • Loading branch information
@jberger
jberger committed Jan 13, 2012
1 parent c1fd0be commit e157369
Show file tree
Hide file tree
Showing 3 changed files with 200 additions and 138 deletions.
146 changes: 26 additions & 120 deletions lib/Alien/Base/ModuleBuild.pm
View file
Expand Up @@ -7,11 +7,12 @@ use parent 'Module::Build';

use Capture::Tiny 'capture_stderr';
use Sort::Versions;
use Net::FTP;
use File::chdir;
use Sort::Versions;
use Carp;

use Alien::Base::ModuleBuild::Repository;

our $VERSION = 0.01;
$VERSION = eval $VERSION;

Expand All @@ -22,13 +23,33 @@ our $Verbose ||= 0;
# alien_temp_folder -- folder name or File::Temp object for download/build
# alien_build_commands -- arrayref of commands for building
# alien_version_check -- command to execute to check if install/version
# alien_source_ftp -- hash of information about source repo on ftp
# server -- ftp server for source
# alien_repository -- hash of information about source repo on ftp
# protocol -- ftp or http
# host -- ftp server for source
# folder -- ftp folder containing source
# ftp -- holder for Net::FTP object (non-api)
# data -- holder for data (non-api)
# platform -- src or platform
# pattern
# files -- holder for found files (on ftp server)
# versions -- holder for version=>file
# connection -- holder for Net::FTP object (non-api)

sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);

my @repos =
(ref $self->{alien_repository})
? @{ $self->{alien_repository}
: $self->{alien_repository};

@repos =
map { Alien::Base::ModuleBuild::Repository->new($_) }
@repos;

$self->{alien_repository} = \@repos;

return $self;
}

sub alien_main_procedure {
my $self = shift;
Expand Down Expand Up @@ -116,115 +137,6 @@ sub alien_build {
return 1;
}

###################
# FTP Methods #
###################

sub alien_connection_ftp {
my $self = shift;
my $type = shift || croak "Must specify the type of FTP repository";

my $key = "alien_${type}_ftp";

return $self->{$key}{ftp}
if defined $self->{$key}{ftp};

my $server = $self->{$key}{server}
or croak "Must specify a server when using ftp service";

my $ftp = Net::FTP->new($server, Debug => 0)
or croak "Cannot connect to $server: $@";

$ftp->login()
or croak "Cannot login ", $ftp->message;

if (defined $self->{$key}{folder}) {
$ftp->cwd($self->{$key}{folder})
or croak "Cannot change working directory ", $ftp->message;
}

$ftp->binary();
$self->{$key}{ftp} = $ftp;

return $ftp;
}

sub alien_probe_ftp {
my $self = shift;
my $type = shift || croak "Must specify the type of FTP repository";

my $key = "alien_${type}_ftp";

my $pattern = $self->{$key}{pattern};

my @files;
if (scalar keys %{ $self->{$key}{data}{versions} || {} }) {

return $self->{$key}{data}{versions};

} elsif (scalar @{ $self->{$key}{data}{files} || [] }) {

return $self->{$key}{data}{files}
unless $pattern;

@files = @{ $self->{$key}{data}{files} };

} else {

croak "No alien_source_ftp information given"
unless scalar keys %{ $self->{$key} || {} };

@files = $self->alien_connection_ftp($type)->ls();

$self->{$key}{data}{files} = \@files;

return \@files unless $pattern;

}

# only get here if $pattern exists

@files = grep { $_ =~ $pattern } @files;
carp "Could not find any matching files" unless @files;
$self->{$key}{data}{files} = \@files;

return \@files
unless _alien_has_capture_groups($pattern);

my %versions =
map {
if ($_ =~ $pattern and defined $1) {
( $1 => $_ )
} else {
()
}
}
@files;

if (scalar keys %versions) {
$self->{$key}{data}{versions} = \%versions;
return \%versions;
} else {
return \@files;
}

}

sub alien_get_file_ftp {
my $self = shift;
my $type = shift || croak "Must specify the type of FTP repository";
my $key = "alien_${type}_ftp";
my $file = shift || croak "Must specify file to download";

my $ftp = $self->alien_connection_ftp($type);
my $tempdir = $self->alien_temp_folder;

local $CWD = "$tempdir";
$ftp->get( $file ) or croak "Download failed: " . $ftp->message();

return 1;
}

########################
# Helper Functions #
########################
Expand All @@ -237,11 +149,5 @@ sub alien_exec_prefix {
}
}

sub _alien_has_capture_groups {
my $re = shift;
"" =~ /|$re/;
return $#+;
}

1;

155 changes: 155 additions & 0 deletions lib/Alien/Base/ModuleBuild/Repository.pm
View file
@@ -0,0 +1,155 @@
use strict;
use warnings;

package Alien::Base::ModuleBuild::Repository;

use Carp;

sub new {
my $class = shift;
my ($spec) = @_;

my $protocol = $spec->{protocol} = uc $spec->{protocol};
croak "Unsupported protocol: $protocol"
unless grep {$_ eq $protocol} qw/FTP HTTP/;

my $obj = bless $spec, "Alien::Base::ModuleBuild::Repository::$protocol";

return $obj;
}

sub protocol { return shift->{protocol} }

sub host {
my $self = shift;
$self->{host} = shift if @_;
return $self->{host};
}

sub folder {
my $self = shift;
$self->{folder} = shift if @_;
return $self->{folder};
}

sub _has_capture_groups {
my $self = shift;
my $re = shift;
"" =~ /|$re/;
return $#+;
}

package Alien::Base::ModuleBuild::Repository::HTTP;

our @ISA = 'Alien::Base::ModuleBuild::Repository';



package Alien::Base::ModuleBuild::Repository::FTP;

our @ISA = 'Alien::Base::ModuleBuild::Repository';

use Carp;
use Net::FTP;
use File::chdir;

sub connection {
my $self = shift;

return $self->{connection}
if $self->{connection};

my $server = $self->{host}
or croak "Must specify a host for FTP service";

my $ftp = Net::FTP->new($server, Debug => 0)
or croak "Cannot connect to $server: $@";

$ftp->login()
or croak "Cannot login ", $ftp->message;

if (defined $self->{folder}) {
$ftp->cwd($self->{folder})
or croak "Cannot change working directory ", $ftp->message;
}

$ftp->binary();
$self->{connection} = $ftp;

return $ftp;
}

sub probe {
my $self = shift;
my $platform = shift || 'src';

croak "Unknown platform $platform"
unless exists $self->{$platform};

my $pattern = $self->{$platform}{pattern};

my @files;
if (scalar keys %{ $self->{$platform}{versions} || {} }) {

return $self->{$platform}{versions};

} elsif (scalar @{ $self->{$platform}{files} || [] }) {

return $self->{$platform}{files}
unless $pattern;

@files = @{ $self->{$platform}{files} };

} else {

@files = $self->connection()->ls();

$self->{$platform}{files} = \@files;

return \@files unless $pattern;

}

# only get here if $pattern exists

@files = grep { $_ =~ $pattern } @files;
carp "Could not find any matching files" unless @files;
$self->{$platform}{files} = \@files;

return \@files
unless $self->_has_capture_groups($pattern);

my %versions =
map {
if ($_ =~ $pattern and defined $1) {
( $1 => $_ )
} else {
()
}
}
@files;

if (scalar keys %versions) {
$self->{$platform}{versions} = \%versions;
return \%versions;
} else {
return \@files;
}

}

sub get_file {
my $self = shift;
my $file = shift || croak "Must specify file to download";
my $folder = shift || die "get_file needs folder";

my $ftp = $self->connection();

local $CWD = "$folder";
$ftp->get( $file ) or croak "Download failed: " . $ftp->message();

return 1;
}

1;

37 changes: 19 additions & 18 deletions t/ftp.t
View file
Expand Up @@ -2,44 +2,45 @@ use strict;
use warnings;

use File::chdir;
use File::Temp ();

use Test::More;
use_ok( 'Alien::Base::ModuleBuild' );
use_ok( 'Alien::Base::ModuleBuild::Repository' );

my $builder = bless {
alien_source_ftp => {
server => 'ftp.gnu.org',
folder => '/gnu/gsl',
}
}, 'Alien::Base::ModuleBuild';
my $repo = Alien::Base::ModuleBuild::Repository->new({
protocol => 'ftp',
host => 'ftp.gnu.org',
folder => '/gnu/gsl',
src => {},
});

my $files = $builder->alien_probe_ftp('source');
is( ref $files, 'ARRAY', 'without pattern, alien_probe_ftp returns arrayref');
my $files = $repo->probe();
is( ref $files, 'ARRAY', 'without pattern, probe returns arrayref');
ok( scalar @$files, 'GSL has available files');

my $pattern = qr/^gsl-[\d\.]+\.tar\.gz\.sig$/;
$builder->{alien_source_ftp}{pattern} = $pattern;
$files = $builder->alien_probe_ftp('source');
$repo->{src}{pattern} = $pattern;
$files = $repo->probe();
my @non_matching = grep{ $_ !~ $pattern } @$files;
is( ref $files, 'ARRAY', 'with non-capturing pattern, alien_probe_ftp returns arrayref');
is( ref $files, 'ARRAY', 'with non-capturing pattern, probe returns arrayref');
ok( ! @non_matching, 'with non-capturing pattern, only matching results are returned' );

my $tempdir = $builder->alien_temp_folder;
my $tempdir = File::Temp->newdir();
ok( -d "$tempdir", 'Temporary folder exists');
my $file = $files->[0];
$builder->alien_get_file_ftp('source', $file);
$repo->get_file($file, $tempdir);
{
local $CWD = "$tempdir";
ok( -e $file, 'Downloaded file exists');
}

#reset
$builder->{alien_source_ftp}{data}{files} = [];
$repo->{src}{files} = [];

$pattern = qr/^gsl-([\d\.])+\.tar\.gz$/;
$builder->{alien_source_ftp}{pattern} = $pattern;
$files = $builder->alien_probe_ftp('source');
is( ref $files, 'HASH', 'with capturing pattern, alien_probe_ftp returns hashref');
$repo->{src}{pattern} = $pattern;
$files = $repo->probe();
is( ref $files, 'HASH', 'with capturing pattern, probe returns hashref');

done_testing;

0 comments on commit e157369

Please sign in to comment.