scripts/bioperl_application_installer.PLS

   1 #!/usr/local/bin/perl
   2 # BioPerl script for Bio::Installer
   3 #
   4 # Cared for by Albert Vilella
   5 #
   6 #       based on the CPAN::FirstTime module
   7 #
   8 # Copyright Albert Vilella
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 bioperl_application_installer - downloads and installs runnables
  17
  18 =head1 SYNOPSIS
  19
  20 bioperl_application_installer
  21
  22 =head1 DESCRIPTION
  23
  24 This script will ask the user which programs wants to install and
  25 where. It will download the packages, decompress them (if necessary)
  26 and compile/install them in the specified directory.
  27
  28 =head1 AUTHOR
  29
  30 Albert Vilella, avilella-AT-gmail-DOT-com
  31
  32 =head1 TODO
  33
  34 Check if the programs are already installed in the computer and prompt
  35 it so that the user is at least aware of it.
  36
  37 Check for the available installers, instead of hard-coding
  38 $INSTALLERLIST in this script.
  39
  40 =cut
  41
  42 use strict;
  43 use ExtUtils::MakeMaker;
  44 use Data::Dumper;
  45 use Bio::Factory::ObjectFactory;
  46
  47 use vars qw($DEFAULT $CONFIG $INSTALLERLIST);
  48
  49 BEGIN {
  50     $DEFAULT = 'bioperl-runnables';
  51     $INSTALLERLIST = [
  52                       'Clustalw',
  53                       'EMBOSS',
  54                       'TCoffee',
  55                       'PAML',
  56                       'Hyphy',
  57                       'SLR',
  58                       'Probcons',
  59                      ];
  60 }
  61
  62 my $dir = shift @ARGV || $DEFAULT;
  63 init($dir);
  64
  65 1;
  66
  67
  68 ################################################################################
  69
  70 sub init {
  71     my($configpm) = @_;
  72     use Config;
  73     local($/) = "\n";
  74     local($\) = "";
  75     local($|) = 1;
  76
  77     my($ans,$default);
  78
  79     #
  80     # Files, directories
  81     #
  82
  83     print qq[
  84
  85 This script will install the runnable programs associated with
  86 bioperl-run.
  87
  88 Bioperl-run contain modules that provides a PERL interface to various
  89 bioinformatics applications. This allows various applications to be
  90 used with common bioperl objects.
  91
  92 If you do not want to enter a dialog now, you can answer 'no' to this
  93 question.
  94
  95 ];
  96
  97     my $manual_conf =
  98         ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
  99                                     "yes");
 100     my $fastread;
 101     {
 102         local $^W;
 103         if ($manual_conf =~ /^\s*y/i) {
 104             $fastread = 0;
 105             *prompt = \&ExtUtils::MakeMaker::prompt;
 106         } else {
 107             print "Done.\n\n";
 108             exit;
 109         }
 110     }
 111     print qq{
 112
 113 The following questions are intended to help you with the
 114 installation.
 115
 116 };
 117
 118     $default = File::Spec->catdir( $ENV{'HOME'}, $configpm);
 119     while ($ans = prompt("Where do you want to install the runnables in your computer?",$default)) {
 120         unless (File::Spec->file_name_is_absolute($ans)) {
 121             require Cwd;
 122             my $cwd = Cwd::cwd();
 123             my $absans = File::Spec->catdir($cwd,$ans);
 124             warn "The path '$ans' is not an absolute path. Please specify an absolute path\n";
 125             $default = $absans;
 126             next;
 127         }
 128         eval { File::Path::mkpath($ans); }; # dies if it can't
 129         if ($@) {
 130             warn "Couldn't create directory $ans.
 131 Please retry.\n";
 132             next;
 133         }
 134         if (-d $ans && -w _) {
 135             print qq{
 136 Directory $ans successfully created.
 137
 138 };
 139
 140             last;
 141         } else {
 142             warn "Couldn't find directory $ans
 143   or directory is not writable. Please retry.\n";
 144         }
 145     }
 146
 147     print qq{
 148
 149 The script will need a few external programs to work properly.
 150 Please correct me, if I guess the wrong path for a program. Don\'t
 151 panic if you do not have some of them, just press ENTER for those.
 152
 153 };
 154
 155     my $old_warn = $^W;
 156     local $^W if $^O eq 'MacOS';
 157     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
 158     local $^W = $old_warn;
 159     my $progname;
 160     for $progname (qw/gzip tar unzip make links wget ncftpget ncftp ftp gpg/) {
 161         if ($^O eq 'MacOS') {
 162             $CONFIG->{$progname} = 'not_here';
 163             next;
 164         }
 165         my $progcall = $progname;
 166         # we don't need ncftp if we have ncftpget
 167         next if $progname eq "ncftp" && $CONFIG->{ncftpget} gt " ";
 168         my $path = $CONFIG->{$progname}
 169             || $Config::Config{$progname}
 170                 || "";
 171         if (File::Spec->file_name_is_absolute($path)) {
 172             # testing existence is not good enough, some have these exe
 173             # extensions
 174
 175             # warn "Warning: configured $path does not exist\n" unless -e $path;
 176             # $path = "";
 177         } else {
 178             $path = '';
 179         }
 180         unless ($path) {
 181             # e.g. make -> nmake
 182             $progcall = $Config::Config{$progname} if $Config::Config{$progname};
 183         }
 184
 185         $path ||= find_exe($progcall,[@path]);
 186         warn "Warning: $progcall not found in PATH\n" unless
 187             $path; # not -e $path, because find_exe already checked that
 188         $ans = prompt("Where is your $progname program?",$path) || $path;
 189         $CONFIG->{$progname} = $ans;
 190     }
 191     my $path = $CONFIG->{'pager'} ||
 192         $ENV{PAGER} || find_exe("less",[@path]) ||
 193             find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
 194                 || "more";
 195     $ans = prompt("What is your favorite pager program?",$path);
 196     $CONFIG->{'pager'} = $ans;
 197     $path = $CONFIG->{'shell'};
 198     if (File::Spec->file_name_is_absolute($path)) {
 199         warn "Warning: configured $path does not exist\n" unless -e $path;
 200         $path = "";
 201     }
 202     $path ||= $ENV{SHELL};
 203     if ($^O eq 'MacOS') {
 204         $CONFIG->{'shell'} = 'not_here';
 205     } else {
 206         $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
 207         $ans = prompt("What is your favorite shell?",$path);
 208         $CONFIG->{'shell'} = $ans;
 209     }
 210
 211     print qq{
 212
 213 Which programs would you like to install?
 214
 215 };
 216     my @selected_programs;
 217     my $prompt = "Select the programs you would like to install (by number),
 218 put them on one line, separated by blanks, e.g. '1 2 4'";
 219
 220     push (@selected_programs, @$INSTALLERLIST);
 221     @selected_programs = picklist (\@selected_programs, $prompt);
 222     push @{$CONFIG->{selected_programs_list}}, @selected_programs;
 223
 224     print qq{
 225
 226 The selected programs will now be installed
 227
 228 };
 229
 230 # TODO: Check for the available installers, instead of hard-coding
 231 # $INSTALLERLIST in this script.
 232 #     my @l;
 233 #     for my $i (@INC) {
 234 #         next unless (-e $i."/My/Stuff/");
 235 #         opendir(X,$i."/My/Stuff")|| warn "$!";
 236 #         push @l,readdir(X);
 237 #     }
 238
 239 #     find sub { push(@l, $File::Find::name) if -f && /\.pm$/ },
 240 #         map { "$_/My/Module" } @INC;
 241
 242     foreach my $program (@selected_programs) {
 243         my $type = 'Bio::Installer::' . $program;
 244         my $factory = new Bio::Factory::ObjectFactory(-type => $type);
 245         my $instance = $factory->create_object();
 246         $instance->destination_install_dir($default);
 247         $instance->download();
 248         $instance->install();
 249     }
 250
 251
 252 }
 253
 254 sub picklist {
 255     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
 256     $default ||= '';
 257
 258     my $pos = 0;
 259
 260     my @nums;
 261     while (1) {
 262
 263         # display, at most, 15 items at a time
 264         my $limit = $#{ $items } - $pos;
 265         $limit = 15 if $limit > 15;
 266
 267         # show the next $limit items, get the new position
 268         $pos = display_some($items, $limit, $pos);
 269         $pos = 0 if $pos >= @$items;
 270
 271         my $num = prompt($prompt,$default);
 272
 273         @nums = split (' ', $num);
 274         my $i = scalar @$items;
 275         (warn "invalid items entered, try again\n"), next
 276             if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
 277         if ($require_nonempty) {
 278             (warn "$empty_warning\n");
 279         }
 280         print "\n";
 281
 282         # a blank line continues...
 283         next unless @nums;
 284         last;
 285     }
 286     for (@nums) { $_-- }
 287     @{$items}[@nums];
 288 }
 289
 290
 291 sub display_some {
 292         my ($items, $limit, $pos) = @_;
 293         $pos ||= 0;
 294
 295         my @displayable = @$items[$pos .. ($pos + $limit)];
 296     for my $item (@displayable) {
 297                 printf "(%d) %s\n", ++$pos, $item;
 298     }
 299         printf("%d more items, hit SPACE RETURN to show them\n",
 300                (@$items - $pos)
 301               )
 302             if $pos < @$items;
 303         return $pos;
 304 }
 305
 306
 307 sub find_exe {
 308     my($exe,$path) = @_;
 309     my($dir);
 310     #warn "in find_exe exe[$exe] path[@$path]";
 311     for $dir (@$path) {
 312         my $abs = File::Spec->catfile($dir,$exe);
 313         if (($abs = MM->maybe_command($abs))) {
 314             return $abs;
 315         }
 316     }
 317 }
 318