[Bioperl-guts-l] [14822] bioperl-network/trunk/ModuleBuildBioperl.pm: reinstated latest version from bioperl-live: doesn' t complain about no scripts directory
Senduran Balasubramaniam
sendu at dev.open-bio.org
Fri Aug 22 10:36:43 EDT 2008
Revision: 14822
Author: sendu
Date: 2008-08-22 10:36:42 -0400 (Fri, 22 Aug 2008)
Log Message:
-----------
reinstated latest version from bioperl-live: doesn't complain about no scripts directory
Modified Paths:
--------------
bioperl-network/trunk/ModuleBuildBioperl.pm
Modified: bioperl-network/trunk/ModuleBuildBioperl.pm
===================================================================
--- bioperl-network/trunk/ModuleBuildBioperl.pm 2008-08-22 14:35:38 UTC (rev 14821)
+++ bioperl-network/trunk/ModuleBuildBioperl.pm 2008-08-22 14:36:42 UTC (rev 14822)
@@ -1,12 +1,13 @@
#!/usr/bin/perl -w
-# $Id$
# This is a subclass of Module::Build so we can override certain methods and do
-# fancy stuff.
+# fancy stuff
+
# It was first written against Module::Build::Base v0.2805. Many of the methods
# here are copy/pasted from there in their entirety just to change one or two
# minor things, since for the most part Module::Build::Base code is hard to
# cleanly override.
+
# This was written by Sendu Bala and is released under the same license as
# Bioperl itself
@@ -42,17 +43,17 @@
chdir $cwd or die "Cannot chdir() back to $cwd: $!\n\n***\nInstallation will probably work fine if you now quit CPAN and try again.\n***\n\n";
}
- eval "use base qw(Module::Build Tie::Hash); 1" or die $@;
+ eval "use base Module::Build; 1" or die $@;
# ensure we'll be able to reload this module later by adding its path to inc
use Cwd;
use lib Cwd::cwd();
}
-use strict qw(vars);
+use strict;
use warnings;
-our $VERSION = 1.005002100;
+our $VERSION = 1.005002101;
our @extra_types = qw(options excludes_os feature_requires test); # test must always be last in the list!
our $checking_types = "requires|conflicts|".join("|", @extra_types);
@@ -67,7 +68,117 @@
$self->_find_file_by_type('pm', 'lib');
}
+# ask what scripts to install (this method is unique to bioperl)
+sub choose_scripts {
+ my $self = shift;
+ my $accept = shift;
+
+ # we can offer interactive installation by groups only if we have subdirs
+ # in scripts and no .PLS files there
+ opendir(my $scripts_dir, 'scripts') or die "Can't open directory 'scripts': $!\n";
+ my $int_ok = 0;
+ my @group_dirs;
+ while (my $thing = readdir($scripts_dir)) {
+ next if $thing =~ /^\./;
+ next if $thing eq 'CVS';
+ if ($thing =~ /PLS$|pl$/) {
+ $int_ok = 0;
+ last;
+ }
+ $thing = File::Spec->catfile('scripts', $thing);
+ if (-d $thing) {
+ $int_ok = 1;
+ push(@group_dirs, $thing);
+ }
+ }
+ closedir($scripts_dir);
+ my $question = $int_ok ? "Install [a]ll Bioperl scripts, [n]one, or choose groups [i]nteractively?" : "Install [a]ll Bioperl scripts or [n]one?";
+
+ my $prompt = $accept ? 'a' : $self->prompt($question, 'a');
+
+ if ($prompt =~ /^[aA]/) {
+ $self->log_info(" - will install all scripts\n");
+ $self->notes(chosen_scripts => 'all');
+ }
+ elsif ($prompt =~ /^[iI]/) {
+ $self->log_info(" - will install interactively:\n");
+
+ my @chosen_scripts;
+ foreach my $group_dir (@group_dirs) {
+ my $group = File::Basename::basename($group_dir);
+ print " * group '$group' has:\n";
+
+ my @script_files = @{$self->rscan_dir($group_dir, qr/\.PLS$|\.pl$/)};
+ foreach my $script_file (@script_files) {
+ my $script = File::Basename::basename($script_file);
+ print " $script\n";
+ }
+
+ my $result = $self->prompt(" Install scripts for group '$group'? [y]es [n]o [q]uit", 'n');
+ die if $result =~ /^[qQ]/;
+ if ($result =~ /^[yY]/) {
+ $self->log_info(" + will install group '$group'\n");
+ push(@chosen_scripts, @script_files);
+ }
+ else {
+ $self->log_info(" - will not install group '$group'\n");
+ }
+ }
+
+ my $chosen_scripts = @chosen_scripts ? join("|", @chosen_scripts) : 'none';
+
+ $self->notes(chosen_scripts => $chosen_scripts);
+ }
+ else {
+ $self->log_info(" - won't install any scripts\n");
+ $self->notes(chosen_scripts => 'none');
+ }
+
+ print "\n";
+}
+# our version of script_files doesn't take args but just installs those scripts
+# requested by the user after choose_scripts() is called. If it wasn't called,
+# installs all scripts in scripts directory
+sub script_files {
+ my $self = shift;
+
+ unless (-d 'scripts') {
+ return {};
+ }
+
+ my $chosen_scripts = $self->notes('chosen_scripts');
+ if ($chosen_scripts) {
+ return if $chosen_scripts eq 'none';
+ return { map {$_, 1} split(/\|/, $chosen_scripts) } unless $chosen_scripts eq 'all';
+ }
+
+ return $_ = { map {$_,1} @{$self->rscan_dir('scripts', qr/\.PLS$|\.pl$/)} };
+}
+
+# process scripts normally, except that we change name from *.PLS to bp_*.pl
+sub process_script_files {
+ my $self = shift;
+ my $files = $self->find_script_files;
+ return unless keys %$files;
+
+ my $script_dir = File::Spec->catdir($self->blib, 'script');
+ File::Path::mkpath( $script_dir );
+
+ foreach my $file (keys %$files) {
+ my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
+ $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
+ $self->make_executable($result);
+
+ my $final = File::Basename::basename($result);
+ $final =~ s/\.PLS$/\.pl/; # change from .PLS to .pl
+ $final =~ s/^/bp_/ unless $final =~ /^bp/; # add the "bp" prefix
+ $final = File::Spec->catfile($script_dir, $final);
+ $self->log_info("$result -> $final\n");
+ File::Copy::move($result, $final) or die "Can't rename '$result' to '$final': $!";
+ }
+}
+
# extended to handle extra checking types
sub features {
my $self = shift;
@@ -174,7 +285,17 @@
my $status = {};
if ($type eq 'test') {
unless (keys %$out) {
- $status->{message} = &{$prereqs};
+ if (ref($prereqs) eq 'CODE') {
+ $status->{message} = &{$prereqs};
+
+ # drop the code-ref to avoid Module::Build trying to store
+ # it with Data::Dumper, generating warnings. (And also, may
+ # be expensive to run the sub multiple times.)
+ $info->{$type} = $status->{message};
+ }
+ else {
+ $status->{message} = $prereqs;
+ }
$out->{$type}{'test'} = $status if $status->{message};
}
}
@@ -228,6 +349,11 @@
}
elsif ($type =~ /^feature_requires/) {
next if $status->{ok};
+
+ # if there is a test code-ref, drop it to avoid
+ # Module::Build trying to store it with Data::Dumper,
+ # generating warnings.
+ delete $info->{test};
}
else {
next if $status->{ok};
@@ -269,7 +395,8 @@
CPAN::Shell->install($desired);
my $msg;
- if (CPAN::Shell->expand("Module", $desired)->uptodate) {
+ my $expanded = CPAN::Shell->expand("Module", $desired);
+ if ($expanded && $expanded->uptodate) {
$self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n * You chose to install $desired and it installed fine\n");
$msg = 'ok';
}
@@ -299,7 +426,8 @@
my ($self, $desired, $version, $msg) = @_;
unless (defined $self->{ask_optional}) {
- $self->{ask_optional} = $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
+ $self->{ask_optional} = $self->args->{accept}
+ ? 'n' : $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
}
return 'skip' if $self->{ask_optional} =~ /^n/i;
@@ -321,19 +449,40 @@
}
}
-# there's no official way to discover if being run by CPAN, and the method
-# here is hardly ideal since user could change their build_dir in CPAN config.
-# NB: Module::AutoInstall has more robust detection, and is promising in other
-# ways; could consider converting over to it in the future
+# there's no official way to discover if being run by CPAN, we take an approach
+# similar to that of Module::AutoInstall
sub under_cpan {
my $self = shift;
unless (defined $self->{under_cpan}) {
- require Cwd;
- my $cwd = Cwd::cwd();
- if ($cwd =~ /cpan/i) {
+ ## modified from Module::AutoInstall
+
+ # load cpan config
+ require CPAN;
+ if ($CPAN::HandleConfig::VERSION) {
+ # Newer versions of CPAN have a HandleConfig module
+ CPAN::HandleConfig->load;
+ }
+ else {
+ # Older versions had the load method in Config directly
+ CPAN::Config->load;
+ }
+
+ # Find the CPAN lock-file
+ my $lock = File::Spec->catfile($CPAN::Config->{cpan_home}, '.lock');
+ if (-f $lock) {
+ # Module::AutoInstall now goes on to open the lock file and compare
+ # its pid to ours, but we're not in a situation where we expect
+ # the pids to match, so we take the windows approach for all OSes:
+ # find out if we're in cpan_home
+ my $cwd = File::Spec->canonpath(Cwd::cwd());
+ my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home});
+
+ $self->{under_cpan} = index($cwd, $cpan) > -1;
+ }
+
+ if ($self->{under_cpan}) {
$self->log_info("(I think I'm being run by CPAN, so will rely on CPAN to handle prerequisite installation)\n");
- $self->{under_cpan} = 1;
}
else {
$self->log_info("(I think you ran Build.PL directly, so will use CPAN to install prerequisites on demand)\n");
@@ -580,69 +729,28 @@
return $node;
}
-# let us store extra things persistently in _build, and keep recommends and
@@ Diff output truncated at 10000 characters. @@
More information about the Bioperl-guts-l
mailing list