#!/usr/bin/perl
=head1 NAME
gbrowse_netinstall.pl
=head1 SYNOPSIS
gbrowse_netinstall.pl -b|--build_param_str BUILD_STRING [options]
options:
-h|--help Show this message
-d|--dev Use the developement version of both GBrowse
and bioperl from CVS
--bioperl_dev Use the development version of BioPerl from git
--gbrowse_dev Use the development version of GBrowse from SVN
--build_param_str=<args> Use this string to set Makefile.PL parameters
such as CONF or PREFIX for GBrowse
installation
--install_param_str=<args>
Use this string to predefine 'make install'
parameters such as CONF or PREFIX for
GBrowse installation
--wincvs WinCVS is present--allow cvs install on Windows
NOTE: This will not work; GBrowse is in
svn now, so this script will have to be updated
--gbrowse_path Path to GBrowse tarball (will not download
GBrowse); Assumes a resulting
'Generic-Genome-Browser' directory
--bioperl_path Path to BioPerl tarball (will not download
BioPerl); Assumes a resulting'bioperl-live'
directory
--skip_start Don't wait for 'Enter' at program start
--skip_bioperl Don't fetch and install BioPerl; assumes a
working bioperl is already installed
=head1 DESCRIPTION
Net-based installer of GBrowse
Save this to disk as "gbrowse_netinstall.pl" and run:
[sudo] perl gbrowse_netinstall.pl
=cut
# Universal Net-based installer
# Save this to disk as "gbrowse_netinstall.pl" and run:
# perl gbrowse_netinstall.pl
use warnings;
use strict;
use CPAN '!get';
use Config;
use Getopt::Long;
use Pod::Usage;
use File::Copy qw( cp move );
use File::Temp qw(tempdir);
use LWP::Simple;
use Cwd;
use constant NMAKE => 'http://download.microsoft.com/download/vc15/patch/1.52/w95/en-us/nmake15.exe';
my ( $show_help, $get_from_cvs, $build_param_string, $working_dir,
$get_gbrowse_cvs, $get_bioperl_svn, $is_cygwin, $windows,
$binaries, $make, $tmpdir, $wincvs, $gbrowse_path,$bioperl_path,
$skip_start, $install_param_string, $skip_bioperl, $perl_path);
BEGIN {
GetOptions(
'h|help' => \$show_help, # Show help and exit
'd|dev' => \$get_from_cvs, # Use the dev svn
'build_param_str=s' => \$build_param_string, # Build parameters
'bioperl_dev' => \$get_bioperl_svn,
'gbrowse_dev' => \$get_gbrowse_cvs,
'wincvs' => \$wincvs,
'gbrowse_path=s' => \$gbrowse_path,
'bioperl_path=s' => \$bioperl_path,
'install_param_str=s' => \$install_param_string,
'skip_start' => \$skip_start,
'skip_bioperl' => \$skip_bioperl,
)
or pod2usage(2);
pod2usage(2) if $show_help;
$perl_path = $Config{perlpath};
print STDERR "\nAbout to install GBrowse and all its prerequisites.\n";
print STDERR "\nYou will be asked various questions during this process. You can almost always";
print STDERR "\naccept the default answer (with a notable exception of libgd on MacOSX;\n";
print STDERR "see the documentation on the GMOD website for more information.)\n";
print STDERR "The whole process will take several minutes and will generate lots of messages.\n";
print STDERR "\nPress return when you are ready to start!\n";
my $h = <> unless $skip_start;
print STDERR "*** Installing Perl files needed for a net-based install ***\n";
$windows = $Config{osname} =~ /mswin/i;
if ($windows and $] == 5.010) {
print STDERR "\n\nActiveState Perl 5.10 is not compatible with GBrowse due to problems\n";
print STDERR "with the AS implementation. Please remove it and install Perl 5.8 instead.\n\n\n";
exit(0);
}
if ($windows) {
print STDERR "\n\nInstalling Win32 perl module\n\n";
system("ppm install Win32");
}
eval "CPAN::Config->load";
eval "CPAN::Config->commit";
$working_dir = getcwd;
$tmpdir = tempdir(CLEANUP=>1)
or die "Could not create temporary directory: $!";
$binaries = $Config{'binexp'};
$make = $Config{'make'};
if ($windows) {
system("ppm install YAML");
}
else {
CPAN::Shell->install('YAML');
}
CPAN::Shell->install('Archive::Zip');
CPAN::Shell->install('HTML::Tagset');
CPAN::Shell->install('LWP::Simple');
eval "use Archive::Zip ':ERROR_CODES',':CONSTANTS'";
if ($windows && !-e "$binaries/${make}.exe") {
print STDERR "Installing make utility...\n";
-w $binaries or die "$binaries directory is not writeable. Please re-login as Admin.\n";
chdir $tmpdir;
my $rc = mirror(NMAKE,"nmake.zip");
die "Could not download nmake executable from Microsoft web site."
unless $rc == RC_OK() or $rc == RC_NOT_MODIFIED();
my $zip = Archive::Zip->new('nmake.zip') or die "Couldn't open nmake zip file for decompression: $!";
$zip->extractTree == AZ_OK() or die "Couldn't unzip file: $!";
-e 'NMAKE.EXE' or die "Couldn't extract nmake.exe";
cp('NMAKE.EXE',"$binaries/${make}.EXE") or die "Couldn't install nmake.exe: $!";
cp('NMAKE.ERR',"$binaries/${make}.ERR"); # or die "Couldn't install nmake.err: $!"; # not fatal
}
CPAN::Shell->install('Archive::Tar');
#print STDERR $@;
#print STDERR "at end of BEGIN{}\n";
1;
};
#print STDERR "here i am\n";
#print STDERR $@;
use Archive::Tar;
#use CPAN '!get';
$is_cygwin = 1 if ( $^O eq 'cygwin' );
if ($get_from_cvs) {
$get_bioperl_svn = $get_gbrowse_cvs = 1;
}
if ($wincvs or ($windows and $get_from_cvs)) {
die "\n\nGBrowse is now in svn and fetching from svn on Windows\nis not currently supported\n ";
}
if ($windows and !$wincvs and $get_gbrowse_cvs ) {
die "\n\nThe development/cvs tags are not supported on Windows when\n"
."WinCVS is not installed; exiting...\n";
}
$build_param_string ||="";
$install_param_string ||="";
use constant BIOPERL_VERSION => 'BioPerl-1.6.1';
use constant BIOPERL_REQUIRES => '1.006001'; # sorry for the redundancy
use constant BIOPERL_LIVE_URL => 'http://github.com/bioperl/bioperl-live/tarball/master';
use constant GBROWSE_DEFAULT => 'Generic-Genome-Browser-1.70';
use constant SOURCEFORGE_MIRROR2 => 'http://superb-west.dl.sourceforge.net/sourceforge/gmod/';
use constant SOURCEFORGE_MIRROR1 => 'http://easynews.dl.sourceforge.net/sourceforge/gmod/';
use constant SOURCEFORGE_GBROWSE => 'http://sourceforge.net/project/showfiles.php?group_id=27707&package_id=34513';
use constant BIOPERL => 'http://bioperl.org/DIST/'.BIOPERL_VERSION.'.tar.gz';
my %REPOSITORIES = (
#'BioPerl-Release-Candidates' => 'http://bioperl.org/DIST/RC',
'BioPerl-Regular-Releases' => 'http://bioperl.org/DIST',
'Kobes' => 'http://theoryx5.uwinnipeg.ca/ppms',
'Bribes' => 'http://www.Bribes.org/perl/ppm',
'tcool' => 'http://ppm.tcool.org/archives/',
);
# this is so that ppm can be called in a pipe
$ENV{COLUMNS} = 80; # why do we have to do this?
$ENV{LINES} = 24;
setup_ppm() if $windows;
unless ( eval "use GD 2.31; 1" ) {
if ($windows) {
print STDERR "Installing GD via ppm.\n";
print STDERR "(This may take a while...\n";
system("ppm install GD");
}
else {
print STDERR "Installing GD via CPAN...\n";
CPAN::Shell->install('GD') unless eval "use GD 2.31; 1";
}
}
print STDERR "\n*** Installing prerequisites for BioPerl ***\n";
if ($windows and !eval "use DB_File; 1") {
print STDERR "Installing DB_File for BioPerl.\n";
# GBrowse doesn't like DB_File 1.820, so we explicitly get DB_File by url
system("ppm install http://ppm.tcool.org/archives/DB_File.ppd");
}
system("ppm install SVG") if $windows;
CPAN::Shell->install('GD::SVG');
CPAN::Shell->install('IO::String');
CPAN::Shell->install('Text::Shellwords');
if ($windows) {
#CGI::Session and Digest::MD5 both fail to install via cpan on windows
system("ppm install CGI-Session");
system("ppm install Digest-MD5");
}
else {
CPAN::Shell->install('CGI::Session');
CPAN::Shell->install('Digest::MD5');
}
CPAN::Shell->install('File::Temp');
CPAN::Shell->install('Class::Base');
CPAN::Shell->install('Statistics::Descriptive');
CPAN::Shell->install('Data::Stag');
unless ($skip_bioperl) {
my $version = BIOPERL_REQUIRES;
if (!(eval "use Bio::Perl $version; 1") or $get_bioperl_svn or $bioperl_path) {
print STDERR "\n*** Installing BioPerl ***\n";
#would like to use ppm, but ppm won't install 1.6
#if ($windows and !$get_bioperl_svn and !$bioperl_path) {
# my $bioperl_index = find_bioperl_ppm();
# system("ppm install --force $bioperl_index");
#} else {
# recent versions of Module::Build fail to install without force!
CPAN::Shell->force('Module::Build') unless eval "require Module::Build; 1";
do_install(BIOPERL,
'bioperl.tgz',
BIOPERL_VERSION,
'Build',
$get_bioperl_svn ? 'svn' : '',
'',
$bioperl_path,
'',
$perl_path);
#}
}
else {
print STDERR "BioPerl is up to date.\n";
}
}
print STDERR "\n *** Installing Bio::Graphics ***\n";
CPAN::Shell->install('Bio::Graphics');
print STDERR "\n *** Installing Generic-Genome-Browser ***\n";
my $latest_version = find_gbrowse_latest();
##the find_gbrowse_latest function is broken at the moment; since
##the version of GBrowse 1 is unlike to change more than once in the
##near future, we'll just hard code the value
$latest_version = 'Generic-Genome-Browser-1.70';
my $gbrowse = SOURCEFORGE_MIRROR1.$latest_version.'.tar.gz';
eval {do_install($gbrowse,
'gbrowse.tgz',
$latest_version,
'make',
$get_gbrowse_cvs ? 'svn' : '',
$build_param_string,
$gbrowse_path,
$install_param_string,
$perl_path)};
if ($@ =~ /Could not download/) {
print STDERR "Could not download: server down? Trying a different server...\n";
$gbrowse = SOURCEFORGE_MIRROR2.$latest_version.'.tar.gz';
do_install($gbrowse,
'gbrowse.tgz',
$latest_version,
'make',
$get_gbrowse_cvs? 'svn' : '',
$build_param_string,
$gbrowse_path,
$install_param_string,
$perl_path,);
}
exit 0;
END {
open STDERR,">/dev/null"; # windows has an annoying message when cleaning up temp file
}
sub do_install {
my ($download,$local_name,$distribution,$method,
$from_cvs,$build_param_string,$file_path,$install_param_string,
$perl_path) = @_;
$install_param_string ||= '';
chdir $tmpdir;
do_get_distro($download,$local_name,$distribution,$from_cvs,$file_path);
my $build_str = $windows ? "Build" : "./Build";
if ($method eq 'make') {
system("$perl_path Makefile.PL $build_param_string") == 0
or die "Couldn't run perl Makefile.PL command\n";
system("$make install UNINST=1 $install_param_string") == 0 ;
}
elsif ($method eq 'Build') {
system("$perl_path $build_str.PL --yes=1") == 0
or die "Couldn't run perl Build.PL command\n";
system("$build_str install --uninst 1") == 0;
}
}
sub do_get_distro {
my ($download,$local_name,$distribution,$distribution_method,$file_path) = @_;
if ($file_path) {
chdir $working_dir;
if (-e $file_path) { #must be an absolute path
cp($file_path, "$tmpdir/$local_name");
}
elsif (-e "$working_dir/$file_path") { #assume it's a rel path from the original directory
cp("$working_dir/$file_path", "$tmpdir/$local_name");
}
else {
print "Couldn't find $file_path; nothing to do so quitting...\n";
exit(-1);
}
$distribution = ($local_name =~ /gbrowse/)
? "Generic-Genome-Browser" : "bioperl-live";
chdir $tmpdir;
extract_tarball($local_name,$distribution);
}
elsif ($distribution_method) {
my $distribution_dir;
if ($local_name =~ /gbrowse/) {
$distribution_dir = 'Generic-Genome-Browser';
unless (
#should do an svn checkout of the stable branch
(system(
"$distribution_method co https://gmod.svn.sourceforge.net/svnroot/gmod/Generic-Genome-Browser/branches/stable $distribution_dir") == 0
or $is_cygwin)
)
{
print STDERR "Failed to check out the GBrowse from svn: $!\n";
return undef;
}
}
else { #bioperl
print STDERR "Downloading bioperl-live...\n";
$distribution_dir = 'bioperl-live';
my $filename = 'bioperl-live.tar.gz'; # =determine_filename();
my $url = BIOPERL_LIVE_URL."/$filename";
my $rc = mirror($url, $filename);
unless ($rc == RC_OK or $rc == RC_NOT_MODIFIED){
print STDERR "Failed to get nightly bioperl-live file: $rc\n";
return undef;
}
extract_tarball($filename,$distribution_dir);
return 1;
}
chdir $distribution_dir
or die "Couldn't enter $distribution_dir directory: $@";
}
else {
print STDERR "Downloading $download...\n";
my $rc = mirror($download,$local_name);
die "Could not download $distribution distribution from $download."
unless $rc == RC_OK or $rc == RC_NOT_MODIFIED;
extract_tarball($local_name,$distribution);
}
return 1;
}
#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 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;
}