view release on metacpan or  search on metacpan

GMOD/Util/Mirror.pm  view on Meta::CPAN

package Bio::GMOD::Util::Mirror;

use strict;
use vars qw/@ISA/;
use Carp;
use Net::FTP;
use File::Path;
use Bio::GMOD;
use Bio::GMOD::Util::Rearrange;

@ISA = qw/Bio::GMOD/;

# options:
# host  -- ftp host
# path  -- ftp path
# localpath -- localpath
# verbose -- verbose listing
# user  -- username
# pass  -- password
# passive -- use passive FTP
sub new {
  my ($class,@p) = @_;
  my ($host,$path,$localpath,$verbose,$user,$pass,$passive,$hash)
    = rearrange([qw/HOST PATH LOCALPATH VERBOSE USER PASS PASSIVE HASH/],@p);
  croak "Usage: Mirror->new(\$host:/path)" unless $host && $path;
  if ($host =~ /(.+):(.+)/) {
    ($host,$path) = ($1,$2);
  }
  $path ||= '/';
  $user ||= 'anonymous';
  $pass ||= "$user\@localhost.localdomain";
  
  my %transfer_opts;
  $transfer_opts{Passive} = 1 if $passive;
  $transfer_opts{Timeout} = 600;
  my $ftp = Net::FTP->new($host,%transfer_opts) || croak "Can't connect: $@\n";
  $ftp->login($user,$pass) || croak "Can't login: ",$ftp->message;
  $ftp->binary;
  $ftp->hash(1) if $hash;
  my %opts = (host  => $host,
	      path   => $path,
	      localpath => $localpath,
	      verbose   => $verbose,
	      user      => $user,
	      pass      => $pass,
	      passive   => $passive,
	      ftp       => $ftp);
  return bless { %opts },$class;
}

sub path {
  # return shift->{path};}
  my $p = $_[0]->{path};
  $_[0]->{path} = $_[1] if defined $_[1];
  $p;
}

sub ftp  {
  # return shift->{ftp}; }
  my $p = $_[0]->{ftp};
  $_[0]->{ftp} = $_[1] if defined $_[1];
  $p;
}

sub verbose {
  # return shift->{verbose}; }
  my $p = $_[0]->{verbose};
  $_[0]->{verbose} = $_[1] if defined $_[1];
  $p;
}

# top-level entry point for mirroring.
sub mirror {
  my $self = shift;
  $self->path(shift) if @_;
  my $path = $self->path;
  
  my $cd;
  if ($self->{localpath}) {
    chomp($cd = `pwd`);
    chdir($self->{localpath}) or croak "can't chdir to $self->{localpath}: $!";
  }

  my $type = $self->find_type($self->path) or croak "top level file/directory not found";
  my ($prefix,$leaf) = $path =~ m!^(.*?)([^/]+)/?$!;
  $self->ftp->cwd($prefix) if $prefix;

  my $ok;
  if ($type eq '-') {  # ordinary file
    $ok = $self->get_file($leaf);
  } elsif ($type eq 'd') {  # directory
    $ok = $self->get_dir($leaf);
  } else {
    carp "Can't parse file type for $leaf\n";
    return;