scripts/utilities/bp_netinstall.pl

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 bp_netinstall.pl - Net-based installer of BioPerl
   6
   7 =head1 SYNOPSIS
   8
   9   bp_netinstall.pl -b|--build_param_str BUILD_STRING [options]
  10
  11   options:
  12
  13  -h|--help                Show this message
  14  -d|--dev                 Use the development version of bioperl from git
  15  --build_param_str=<args> Parameters that are passed in at 'perl Build.PL'
  16  --install_param_str=<args>
  17                           Use this string to predefine './Build install'
  18                             parameters such as 'install_base' for
  19                             bioperl installation
  20  --bioperl_path           Path to BioPerl tarball (will not download BioPerl)
  21  --skip_start             Don't wait for 'Enter' at program start
  22
  23 =head1 DESCRIPTION
  24
  25 Net-based installer of BioPerl; this is based on the GBrowse netinstaller
  26 and hopefully all references to GBrowse have been removed.  Let me know if not.
  27
  28 Save this to disk as "bp_netinstall.pl" and run:
  29
  30    [sudo] perl bp_netinstall.pl
  31
  32 =head1 AUTHOR
  33
  34 Scott Cain scain@cpan.org
  35
  36 =head1 COPYRIGHT
  37
  38 2010. This script may be distributed under the same license as perl.
  39
  40 =cut
  41
  42 # Universal Net-based installer
  43 # Save this to disk as "bp_netinstall.pl" and run:
  44 #   perl bp_netinstall.pl
  45
  46 use warnings;
  47 use strict;
  48 use CPAN '!get';
  49 use Config;
  50 use Getopt::Long;
  51 use Pod::Usage;
  52 use File::Copy qw( cp move );
  53 use File::Temp qw(tempdir);
  54 use LWP::Simple;
  55 use Cwd;
  56
  57 use constant NMAKE => 'http://download.microsoft.com/download/vc15/patch/1.52/w95/en-us/nmake15.exe';
  58
  59 my ( $show_help, $get_from_cvs, $build_param_string, $working_dir,
  60      $get_bioperl_svn, $is_cygwin, $windows,
  61      $binaries, $make, $tmpdir, $bioperl_path,
  62      $skip_start, $install_param_string, $perl_path);
  63
  64 BEGIN {
  65
  66   GetOptions(
  67         'h|help'              => \$show_help,             # Show help and exit
  68         'd|dev'               => \$get_from_cvs,          # Use the dev svn
  69         'build_param_str=s'   => \$build_param_string,    # Build parameters
  70         'bioperl_dev'         => \$get_bioperl_svn,
  71         'bioperl_path=s'      => \$bioperl_path,
  72         'install_param_str=s' => \$install_param_string,
  73         'skip_start'          => \$skip_start,
  74         )
  75         or pod2usage(2);
  76   pod2usage(2) if $show_help;
  77
  78   $perl_path = $Config{perlpath};
  79
  80   print STDERR "\nAbout to install BioPerl and all its prerequisites.\n";
  81   print STDERR "\nYou will be asked various questions during this process. You can almost always";
  82   print STDERR "\naccept the default answer.\n";
  83   print STDERR "The whole process will take several minutes and will generate lots of messages.\n";
  84   print STDERR "\nPress return when you are ready to start!\n";
  85   my $h = <> unless $skip_start;
  86   print STDERR "*** Installing Perl files needed for a net-based install ***\n";
  87
  88   $windows = $Config{osname} =~ /mswin/i;
  89
  90
  91 # MAY not be necessary--we'll have to see.
  92 #  if ($windows and $] == 5.010) {
  93 #     print STDERR "\n\nActiveState Perl 5.10 is not compatible with GBrowse due to problems\n";
  94 #     print STDERR "with the AS implementation.  Please remove it and install Perl 5.8 instead.\n\n\n";
  95 #     exit(0);
  96 #  }
  97
  98 # Also MAY not be necessary
  99 #  if ($windows) {
 100 #     print STDERR "\n\nInstalling Win32 perl module\n\n";
 101 #     system("ppm install Win32");
 102 #  }
 103
 104   eval "CPAN::Config->load";
 105   eval "CPAN::Config->commit";
 106
 107   $working_dir = getcwd;
 108
 109   $tmpdir = tempdir(CLEANUP=>1)
 110     or die "Could not create temporary directory: $!";
 111
 112   $binaries = $Config{'binexp'};
 113   $make     = $Config{'make'};
 114
 115   if ($windows) {
 116     system("ppm install YAML");
 117   }
 118   else {
 119     CPAN::Shell->install('YAML');
 120   }
 121   CPAN::Shell->install('Archive::Zip');
 122   CPAN::Shell->install('HTML::Tagset');
 123   CPAN::Shell->install('LWP::Simple');
 124   eval "use Archive::Zip ':ERROR_CODES',':CONSTANTS'";
 125
 126   if ($windows && !-e "$binaries/${make}.exe") {
 127
 128     print STDERR "Installing make utility...\n";
 129     -w $binaries or die "$binaries directory is not writeable. Please re-login as Admin.\n";
 130     chdir $tmpdir;
 131
 132     my $rc = mirror(NMAKE,"nmake.zip");
 133     die "Could not download nmake executable from Microsoft web site."
 134       unless $rc == RC_OK() or $rc == RC_NOT_MODIFIED();
 135
 136     my $zip = Archive::Zip->new('nmake.zip') or die "Couldn't open nmake zip file for decompression: $!";
 137     $zip->extractTree == AZ_OK() or die "Couldn't unzip file: $!";
 138     -e 'NMAKE.EXE' or die "Couldn't extract nmake.exe";
 139
 140     cp('NMAKE.EXE',"$binaries/${make}.EXE") or die "Couldn't install nmake.exe: $!";
 141     cp('NMAKE.ERR',"$binaries/${make}.ERR"); # or die "Couldn't install nmake.err: $!"; # not fatal
 142   }
 143
 144   CPAN::Shell->install('Archive::Tar');
 145   #print STDERR $@;
 146   #print STDERR "at end of BEGIN{}\n";
 147   1;
 148 };
 149
 150 #print STDERR "here i am\n";
 151 #print STDERR $@;
 152
 153 use Archive::Tar;
 154 #use CPAN '!get';
 155
 156 $is_cygwin = 1 if ( $^O eq 'cygwin' );
 157
 158 if ($get_from_cvs) {
 159     $get_bioperl_svn = 1;
 160 }
 161
 162 #if ($wincvs or ($windows and $get_from_cvs)) {
 163 #    die "\n\nGBrowse is now in svn and fetching from svn on Windows\nis not currently supported\n ";
 164 #}
 165
 166 #if ($windows and !$wincvs and $get_gbrowse_cvs ) {
 167 #    die "\n\nThe development/cvs tags are not supported on Windows when\n"
 168 #        ."WinCVS is not installed; exiting...\n";
 169 #}
 170
 171 $build_param_string ||="";
 172 $install_param_string ||="";
 173
 174 use constant BIOPERL_VERSION      => 'BioPerl-1.6.1';
 175 use constant BIOPERL_REQUIRES     => '1.006001';  # sorry for the redundancy
 176 use constant BIOPERL_LIVE_URL     => 'http://github.com/bioperl/bioperl-live/tarball/master';
 177 use constant BIOPERL              => 'http://bioperl.org/DIST/'.BIOPERL_VERSION.'.tar.gz';
 178
 179 my %REPOSITORIES = (
 180                     #'BioPerl-Release-Candidates' => 'http://bioperl.org/DIST/RC',
 181                     'BioPerl-Regular-Releases'   => 'http://bioperl.org/DIST',
 182                     'Kobes'                      => 'http://theoryx5.uwinnipeg.ca/ppms',
 183                     'Bribes'                     => 'http://www.Bribes.org/perl/ppm',
 184                      'tcool'                     => 'http://ppm.tcool.org/archives/',
 185                     );
 186
 187
 188 # this is so that ppm can be called in a pipe
 189 $ENV{COLUMNS} = 80; # why do we have to do this?
 190 $ENV{LINES}   = 24;
 191
 192 setup_ppm() if $windows;
 193
 194 unless ( eval "use GD 2.31; 1" ) {
 195    if ($windows) {
 196      print STDERR "Installing GD via ppm.\n";
 197      print STDERR "(This may take a while...\n";
 198      system("ppm install GD");
 199   }
 200   else {
 201      print STDERR "Installing GD via CPAN...\n";
 202      CPAN::Shell->install('GD') unless eval "use GD 2.31; 1";
 203   }
 204 }
 205
 206 print STDERR "\n*** Installing prerequisites for BioPerl ***\n";
 207
 208 if ($windows and !eval "use DB_File; 1") {
 209   print STDERR "Installing DB_File for BioPerl.\n";
 210
 211   # GBrowse doesn't like DB_File 1.820, so we explicitly get DB_File by url
 212   system("ppm install http://ppm.tcool.org/archives/DB_File.ppd");
 213 }
 214 #system("ppm install SVG") if $windows;
 215 #CPAN::Shell->install('GD::SVG');
 216
 217 #needed?
 218 CPAN::Shell->install('IO::String');
 219 #CPAN::Shell->install('Text::Shellwords');
 220 #if ($windows) {
 221 #    #CGI::Session and Digest::MD5 both fail to install via cpan on windows
 222 #    system("ppm install CGI-Session");
 223 #    system("ppm install Digest-MD5");
 224 #}
 225 #else {
 226 #    CPAN::Shell->install('CGI::Session');
 227 #    CPAN::Shell->install('Digest::MD5');
 228 #}
 229 #CPAN::Shell->install('File::Temp');
 230 #CPAN::Shell->install('Class::Base');
 231 #CPAN::Shell->install('Statistics::Descriptive');
 232 #CPAN::Shell->install('Data::Stag');
 233
 234 my $version = BIOPERL_REQUIRES;
 235 if (!(eval "use Bio::Perl $version; 1") or $get_bioperl_svn or $bioperl_path) {
 236     print STDERR "\n*** Installing BioPerl ***\n";
 237
 238     #would like to use ppm, but ppm won't install 1.6
 239     #if ($windows and !$get_bioperl_svn and !$bioperl_path) {
 240     #  my $bioperl_index = find_bioperl_ppm();
 241     #  system("ppm install --force $bioperl_index");
 242     #} else {
 243         # recent versions of Module::Build fail to install without force!
 244         CPAN::Shell->force('Module::Build') unless eval "require Module::Build; 1";
 245         do_install(BIOPERL,
 246                    'bioperl.tgz',
 247                    BIOPERL_VERSION,
 248                    'Build',
 249                    $get_bioperl_svn ? 'svn' : '',
 250                    $build_param_string,
 251                    $bioperl_path,
 252                    $install_param_string,
 253                    $perl_path);
 254     #}
 255 }
 256 else {
 257     print STDERR "BioPerl is up to date.\n";
 258 }
 259
 260 print STDERR "\n *** Installing Bio::Graphics ***\n";
 261
 262
 263 #install biographics?
 264 CPAN::Shell->install('Bio::Graphics');
 265
 266 exit 0;
 267
 268 END {
 269   my $null = ($^O =~ m/mswin/i) ? 'NUL' : '/dev/null';
 270   open STDERR,">$null"; # windows has an annoying message when cleaning up temp file
 271 }
 272
 273 sub do_install {
 274   my ($download,$local_name,$distribution,$method,
 275          $from_cvs,$build_param_string,$file_path,$install_param_string,
 276          $perl_path) = @_;
 277
 278   $install_param_string ||= '';
 279   chdir $tmpdir;
 280
 281   do_get_distro($download,$local_name,$distribution,$from_cvs,$file_path);
 282
 283   my $build_str = $windows ? "Build" : "./Build";
 284
 285   if ($method eq 'make') {
 286       system("$perl_path Makefile.PL $build_param_string") == 0
 287             or die "Couldn't run perl Makefile.PL command\n";
 288       system("$make install UNINST=1 $install_param_string")    == 0 ;
 289   }
 290   elsif ($method eq 'Build') {
 291       system("$perl_path $build_str.PL --yes=1 $build_param_string")   == 0
 292             or die "Couldn't run perl Build.PL command\n";
 293       system("$build_str install --uninst 1 $install_param_string") == 0;
 294   }
 295 }
 296
 297 sub do_get_distro {
 298     my ($download,$local_name,$distribution,$distribution_method,$file_path) = @_;
 299
 300     if ($file_path) {
 301         chdir $working_dir;
 302         if (-e $file_path) { #must be an absolute path
 303             cp($file_path, "$tmpdir/$local_name");
 304         }
 305         elsif (-e "$working_dir/$file_path") { #assume it's a rel path from the original directory
 306             cp("$working_dir/$file_path", "$tmpdir/$local_name");
 307         }
 308         else {
 309             print "Couldn't find $file_path; nothing to do so quitting...\n";
 310             exit(-1);
 311         }
 312         $distribution = ($local_name =~ /gbrowse/)
 313                       ? "Generic-Genome-Browser" : "bioperl-live";
 314         chdir $tmpdir;
 315         extract_tarball($local_name,$distribution);
 316     }
 317     elsif ($distribution_method) {
 318         my $distribution_dir;
 319         print STDERR "Downloading bioperl-live...\n";
 320         $distribution_dir = 'bioperl-live';
 321
 322         my $filename = 'bioperl-live.tar.gz'; # =determine_filename();
 323         my $url = BIOPERL_LIVE_URL."/$filename";
 324
 325         my $rc = mirror($url, $filename);
 326         unless ($rc == RC_OK or $rc == RC_NOT_MODIFIED){
 327             print STDERR "Failed to get nightly bioperl-live file: $rc\n";
 328             return undef;
 329         }
 330         extract_tarball($filename,$distribution_dir);
 331         return 1;
 332         chdir $distribution_dir
 333             or die "Couldn't enter $distribution_dir directory: $@";
 334     }
 335     else {
 336         print STDERR "Downloading $download...\n";
 337         my $rc = mirror($download,$local_name);
 338         die "Could not download $distribution distribution from $download."
 339             unless $rc == RC_OK or $rc == RC_NOT_MODIFIED;
 340
 341         extract_tarball($local_name,$distribution);
 342     }
 343     return 1;
 344 }
 345
 346 #this is probably not going to be needed again, as the nightly
 347 #bioperl build names have been simplified
 348 sub determine_filename {
 349   my $listing = "dirlisting.html";
 350   my $rc = mirror(BIOPERL_LIVE_URL, $listing);
 351   die "Could not get directory listing of bioperl nightly build url: $rc\n"
 352       unless ($rc == RC_OK or $rc == RC_NOT_MODIFIED);
 353
 354   my $filename;
 355   open my $LIST, '<', $listing or die "Could not read file '$listing': $!\n";
 356   while (my $line = <$LIST>) {
 357     if ($line =~ /href="(bioperl-live.*?\.tar\.gz)"/) {
 358       $filename = $1;
 359       last;
 360     }
 361   }
 362   close $LIST;
 363   unlink $listing;
 364   return $filename;
 365 }
 366
 367 sub extract_tarball {
 368   my ($local_name,$distribution) = @_;
 369
 370   print STDERR "Unpacking $local_name...\n";
 371   my $z = Archive::Tar->new($local_name,1)
 372         or die "Couldn't open $distribution archive: $@";
 373   my @extracted = $z->extract()
 374         or die "Couldn't extract $distribution archive: $@";
 375
 376   if ($extracted[0]->{'name'} =~ /^(bioperl.*?)\//) {
 377     my $bioperl_dir = $1;
 378     move($bioperl_dir, $distribution) or die "couldn't move bioperl dir: $@";
 379   }
 380
 381   chdir $distribution
 382         or die "Couldn't enter $distribution directory: $@";
 383   return;
 384 }
 385
 386 # make sure ppm repositories are correct!
 387 sub setup_ppm {
 388   open my $S, "ppm repo list --csv|" or die "Could not open ppm for listing: $!\n";
 389   my %repository;
 390   while (my $line = <$S>) {
 391      chomp $line;
 392      my ($index, $package_count, $name) = split /,/, $line;
 393      $repository{$name} = $index;
 394   }
 395   close $S;
 396   print STDERR "Adding needed PPM repositories. This may take a while....\n";
 397   for my $name (keys %REPOSITORIES) {
 398      next if $repository{$name};
 399      system("ppm rep add $name $REPOSITORIES{$name}");
 400   }
 401 }
 402
 403 sub find_bioperl_ppm {
 404   print STDERR "Finding most recent bioperl...";
 405   open my $S,"ppm search bioperl |" or die "Could not open ppm for listing: $!\n";
 406   local $/ = ''; # paragraph mode
 407   my ($blessed_one, $blessed_version);
 408   my $best = 0;
 409   while (my $line = <$S>) {
 410     chomp $line;
 411     my ($number)     = ($line =~ /^(\d+): bioperl/m);
 412     my ($version)    = ($line =~ /^\s+Version: (.+)/m);
 413     my ($repository) = ($line =~ /^\s+Repo: (.+)/m);
 414     my $multiplier = 10000000;
 415     my $magnitude  = 0;
 416     # this dumb thing converts 1.5.1 into a real number
 417     foreach my $piece (split /[._]/, $version) {
 418       $magnitude += $piece * ($multiplier/=10);
 419     }
 420     ($blessed_one,$best,$blessed_version) = ($number,$magnitude,$version) if $best < $magnitude;
 421   }
 422   close $S;
 423   print STDERR $blessed_version ? "found $blessed_version\n" : "not found\n";
 424   return $blessed_one;
 425 }