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