view release on metacpan or  search on metacpan

bin/gbrowse_netinstall.pl  view on Meta::CPAN

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 LIST, $listing or die "unable to open $listing: $!\n";
  while (<LIST>) {
    if (/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;
    warn $bioperl_dir;
    move($bioperl_dir, $distribution) or die "couldn't move bioperl dir: $@"; 
  }

  $distribution =~ s/--/-/;
  chdir $distribution
        or die "Couldn't enter $distribution directory: $@";
  return;
}

# make sure ppm repositories are correct!
sub setup_ppm {
  open S,"ppm repo list --csv|" or die "Couldn't open ppm for listing: $!";
  my %repository;
  while (<S>) {
     chomp;
     my($index,$package_count,$name) = split /,/;
     $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 S,"ppm search bioperl |" or die "Couldn't open ppm for listing: $!";
  local $/ = ''; # paragraph mode
  my ($blessed_one,$blessed_version);
  my $best = 0;
  while (<S>) {
    chomp;
    my ($number)     = /^(\d+): bioperl/m;
    my ($version)    = /^\s+Version: (.+)/m;
    my ($repository) = /^\s+Repo: (.+)/m;
    my $multiplier = 10000000;
    my $magnitude  = 0;
    # this dumb thing converts 1.5.1 into a real number
    foreach (split /[._]/,$version) {
      $magnitude += $_ * ($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;
}

sub find_gbrowse_latest {
#  print STDERR "Looking up most recent version...";
  my $download_page = get(SOURCEFORGE_GBROWSE);
  my @files         = $download_page =~ /(Generic-Genome-Browser--?\d+\.\d+)/g;
  my %versions      = map {/(\d+\.\d+)/ => $_} @files;
  my @versions      = sort {$b<=>$a} keys %versions;
  my $version = $versions[0] || GBROWSE_DEFAULT ;
#  print STDERR $version,"\n";
  return $version;
}