view release on metacpan or  search on metacpan

scripts/utilities/bp_netinstall.pl  view on Meta::CPAN

#this is probably not going to be needed again, as the nightly
#bioperl build names have been simplified
sub determine_filename {
  my $listing = "dirlisting.html";
  my $rc = mirror(BIOPERL_LIVE_URL, $listing);
  die "Could not get directory listing of bioperl nightly build url: $rc\n"
      unless ($rc == RC_OK or $rc == RC_NOT_MODIFIED);

  my $filename;
  open my $LIST, '<', $listing or die "Could not read file '$listing': $!\n";
  while (my $line = <$LIST>) {
    if ($line =~ /href="(bioperl-live.*?\.tar\.gz)"/) {
      $filename = $1;
      last;
    }
  }
  close $LIST;
  unlink $listing;
  return $filename;
}

sub extract_tarball {
  my ($local_name,$distribution) = @_;

  print STDERR "Unpacking $local_name...\n";
  my $z = Archive::Tar->new($local_name,1)
        or die "Couldn't open $distribution archive: $@";
  my @extracted = $z->extract()
        or die "Couldn't extract $distribution archive: $@";

  if ($extracted[0]->{'name'} =~ /^(bioperl.*?)\//) {
    my $bioperl_dir = $1;
    move($bioperl_dir, $distribution) or die "couldn't move bioperl dir: $@";
  }

  chdir $distribution
        or die "Couldn't enter $distribution directory: $@";
  return;
}

# make sure ppm repositories are correct!
sub setup_ppm {
  open my $S, "ppm repo list --csv|" or die "Could not open ppm for listing: $!\n";
  my %repository;
  while (my $line = <$S>) {
     chomp $line;
     my ($index, $package_count, $name) = split /,/, $line;
     $repository{$name} = $index;
  }
  close $S;
  print STDERR "Adding needed PPM repositories. This may take a while....\n";
  for my $name (keys %REPOSITORIES) {
     next if $repository{$name};
     system("ppm rep add $name $REPOSITORIES{$name}");
  }
}

sub find_bioperl_ppm {
  print STDERR "Finding most recent bioperl...";
  open my $S,"ppm search bioperl |" or die "Could not open ppm for listing: $!\n";
  local $/ = ''; # paragraph mode
  my ($blessed_one, $blessed_version);
  my $best = 0;
  while (my $line = <$S>) {
    chomp $line;
    my ($number)     = ($line =~ /^(\d+): bioperl/m);
    my ($version)    = ($line =~ /^\s+Version: (.+)/m);
    my ($repository) = ($line =~ /^\s+Repo: (.+)/m);
    my $multiplier = 10000000;
    my $magnitude  = 0;
    # this dumb thing converts 1.5.1 into a real number
    foreach my $piece (split /[._]/, $version) {
      $magnitude += $piece * ($multiplier/=10);
    }
    ($blessed_one,$best,$blessed_version) = ($number,$magnitude,$version) if $best < $magnitude;
  }
  close $S;
  print STDERR $blessed_version ? "found $blessed_version\n" : "not found\n";
  return $blessed_one;
}