view release on metacpan or  search on metacpan

GMOD/Admin/Update.pm  view on Meta::CPAN

package Bio::GMOD::Admin::Update;

use strict;
use vars qw/@ISA $AUTOLOAD/;

use Bio::GMOD;
use Bio::GMOD::Util::Mirror;
use Bio::GMOD::Util::CheckVersions;
use Bio::GMOD::Util::Rearrange;

@ISA = qw/Bio::GMOD Bio::GMOD::Util::CheckVersions/;

# Currently, there is no generic update method.  Bio::GMOD::Admin::Update
# must be subclassed for your particular MOD
sub update {
  my $self = shift;
  my $adaptor = $self->adaptor;
  my $name = $adaptor->name;
  $self->logit("$name does not currently support automated updates at this time. Please ask the administrators of $name to add this functionality.",
	       -die => 1);
}


# MORE TWEAKS NEEDED - configuration, verbosity, etc
sub mirror {
  my ($self,@p) = @_;
  my ($remote_path,$local_path,$is_optional)
    = rearrange([qw/REMOTE_PATH LOCAL_PATH IS_OPTIONAL/],@p);
  my $adaptor = $self->adaptor;
  $local_path ||= $adaptor->tmp_path;
  $self->logit(-msg => "Must supply a local path in which to download files",
	       -die => 1) unless $local_path;
  my $ftp = Bio::GMOD::Util::Mirror->new(-host      => $adaptor->ftp_site,
					 -path      => $remote_path,
					 -localpath => $local_path,
					 -verbose   => 1);
  my $result = $ftp->mirror();

  # TODO: Clear out the local directory if mirroring fails
  # TODO: Resumable downloads.
  if ($result) {
    $self->logit(-msg     => "$remote_path successfully downloaded");
  } else {
    if ($is_optional) {
      $self->logit(-msg => "$remote_path failed to download, installation is optional: $!");
    } else {
      $self->logit(-msg         => "$remote_path failed to download: $!",
		   -die         => 1);
    }
  }
  return 1;
}



#########################################################
# Rsync tasks
#########################################################
sub rsync_software {
  my ($self,@p) = @_;
  my ($rsync_module,$exclude,$install_root) = rearrange([qw/MODULE EXCLUDE INSTALL_ROOT/],@p);
  $self->logit(-msg=>"Rsync'ing software",-emphasis=>1);
  my $adaptor     = $self->adaptor;
  $adaptor->parse_params(@p);
  $install_root ||= $adaptor->install_root;
  $rsync_module .= '/' unless ($rsync_module =~ /\/$/);  # Add trailing slash

  my $rsync_url   = $adaptor->rsync_url;
  $rsync_module ||= $adaptor->rsync_module;
  my $rsync_path   = $rsync_url . ($rsync_module ? "/$rsync_module" : '');
  # print "$install_root $rsync_module $exclude $rsync_path\n";
  my $result = system("rsync -rztpovl $exclude $rsync_path $install_root");
  $self->test_for_error($result,"Rsync'ing the mirror site");
}