[Bioperl-guts-l] [15616] bioperl-dev/trunk: I christen thee "bioperl-dev".
Mark Allen Jensen
maj at dev.open-bio.org
Sat Mar 28 00:49:44 EDT 2009
Revision: 15616
Author: maj
Date: 2009-03-28 00:49:43 -0400 (Sat, 28 Mar 2009)
Log Message:
-----------
I christen thee "bioperl-dev". Bless her and all who sail in her.
Added Paths:
-----------
bioperl-dev/trunk/AUTHORS
bioperl-dev/trunk/Bio/
bioperl-dev/trunk/Bio/Root/
bioperl-dev/trunk/Bio/Root/Build.pm
bioperl-dev/trunk/Bio/Root/Exception.pm
bioperl-dev/trunk/Bio/Root/HTTPget.pm
bioperl-dev/trunk/Bio/Root/IO.pm
bioperl-dev/trunk/Bio/Root/Root.pm
bioperl-dev/trunk/Bio/Root/RootI.pm
bioperl-dev/trunk/Bio/Root/Storable.pm
bioperl-dev/trunk/Bio/Root/Test/
bioperl-dev/trunk/Bio/Root/Test/Warn.pm
bioperl-dev/trunk/Bio/Root/Test.pm
bioperl-dev/trunk/Bio/Root/Utilities.pm
bioperl-dev/trunk/Bio/Root/Version.pm
bioperl-dev/trunk/Build.PL
bioperl-dev/trunk/Changes
bioperl-dev/trunk/INSTALL
bioperl-dev/trunk/INSTALL.SKIP
bioperl-dev/trunk/LICENSE
bioperl-dev/trunk/README
bioperl-dev/trunk/doc/
bioperl-dev/trunk/examples/
bioperl-dev/trunk/scripts/
bioperl-dev/trunk/t/
bioperl-dev/trunk/t/data/
bioperl-dev/trunk/t/lib/
bioperl-dev/trunk/t/lib/Array/
bioperl-dev/trunk/t/lib/Array/Compare.pm
bioperl-dev/trunk/t/lib/Error.pm
bioperl-dev/trunk/t/lib/Sub/
bioperl-dev/trunk/t/lib/Sub/Uplevel.pm
bioperl-dev/trunk/t/lib/Test/
bioperl-dev/trunk/t/lib/Test/Builder/
bioperl-dev/trunk/t/lib/Test/Builder/Module.pm
bioperl-dev/trunk/t/lib/Test/Builder/Tester/
bioperl-dev/trunk/t/lib/Test/Builder/Tester/Color.pm
bioperl-dev/trunk/t/lib/Test/Builder/Tester.pm
bioperl-dev/trunk/t/lib/Test/Builder.pm
bioperl-dev/trunk/t/lib/Test/Exception.pm
bioperl-dev/trunk/t/lib/Test/Harness/
bioperl-dev/trunk/t/lib/Test/Harness/Assert.pm
bioperl-dev/trunk/t/lib/Test/Harness/Iterator.pm
bioperl-dev/trunk/t/lib/Test/Harness/Point.pm
bioperl-dev/trunk/t/lib/Test/Harness/Results.pm
bioperl-dev/trunk/t/lib/Test/Harness/Straps.pm
bioperl-dev/trunk/t/lib/Test/Harness/TAP.pod
bioperl-dev/trunk/t/lib/Test/Harness/Util.pm
bioperl-dev/trunk/t/lib/Test/Harness.pm
bioperl-dev/trunk/t/lib/Test/More.pm
bioperl-dev/trunk/t/lib/Test/Simple.pm
bioperl-dev/trunk/t/lib/Test/Tutorial.pod
bioperl-dev/trunk/t/lib/Test/Warn/
bioperl-dev/trunk/t/lib/Test/Warn.pm
Added: bioperl-dev/trunk/AUTHORS
===================================================================
--- bioperl-dev/trunk/AUTHORS (rev 0)
+++ bioperl-dev/trunk/AUTHORS 2009-03-28 04:49:43 UTC (rev 15616)
@@ -0,0 +1,7 @@
+=head1 CONTRIBUTORS TO BIOPERL-DEV
+
+=over
+
+=item * Mark A. Jensen <maj at fortinbras.us>
+
+=back
Property changes on: bioperl-dev/trunk/AUTHORS
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:keywords
+ Id Author Date Rev
Added: bioperl-dev/trunk/Bio/Root/Build.pm
===================================================================
--- bioperl-dev/trunk/Bio/Root/Build.pm (rev 0)
+++ bioperl-dev/trunk/Bio/Root/Build.pm 2009-03-28 04:49:43 UTC (rev 15616)
@@ -0,0 +1,1205 @@
+#!/usr/bin/perl -w
+
+# $Id: Build.pm 15549 2009-02-21 00:48:48Z maj $
+#
+# BioPerl module for Bio::Root::Build
+#
+# Please direct questions and support issues to <bioperl-l at bioperl.org>
+#
+# Cared for by Sendu Bala <bix at sendu.me.uk>
+#
+# Copyright Sendu Bala
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Root::Build - A common Module::Build subclass base for BioPerl distributions
+
+=head1 SYNOPSIS
+
+ ...TO BE ADDED
+
+=head1 DESCRIPTION
+
+This is a subclass of Module::Build so we can override certain methods and do
+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.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l at bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Support
+
+Please direct usage questions or support issues to the mailing list:
+
+L<bioperl-l at bioperl.org>
+
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
+with code and data examples if at all possible.
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR - Sendu Bala
+
+Email bix at sendu.me.uk
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+package Bio::Root::Build;
+
+BEGIN {
+ # we really need Module::Build to be installed
+ unless (eval "use Module::Build 0.2805; 1") {
+ print "This package requires Module::Build v0.2805 or greater to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt(' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require File::Copy;
+ require CPAN;
+
+ # Save this because CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+
+ my $build_pl = File::Spec->catfile($cwd, "Build.PL");
+
+ File::Copy::move($build_pl, $build_pl."hidden"); # avoid bizarre bug with Module::Build tests using the wrong Build.PL if it happens to be in PERL5LIB
+ CPAN::Shell->install('Module::Build');
+ File::Copy::move($build_pl."hidden", $build_pl);
+ CPAN::Shell->expand("Module", "Module::Build")->uptodate or die "Couldn't install Module::Build, giving up.\n";
+
+ 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 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;
+use warnings;
+
+our $VERSION = '1.006900'; # pre-1.7
+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);
+
+
+# our modules are in Bio, not lib
+sub find_pm_files {
+ my $self = shift;
+ foreach my $pm (@{$self->rscan_dir('Bio', qr/\.pm$/)}) {
+ $self->{properties}{pm_files}->{$pm} = File::Spec->catfile('lib', $pm);
+ }
+
+ $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;
+ my $ph = $self->{phash};
+
+ if (@_) {
+ my $key = shift;
+ if ($ph->{features}->exists($key)) {
+ return $ph->{features}->access($key, @_);
+ }
+
+ if (my $info = $ph->{auto_features}->access($key)) {
+ my $failures = $self->prereq_failures($info);
+ my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
+ return !$disabled;
+ }
+
+ return $ph->{features}->access($key, @_);
+ }
+
+ # No args - get the auto_features & overlay the regular features
+ my %features;
+ my %auto_features = $ph->{auto_features}->access();
+ while (my ($name, $info) = each %auto_features) {
+ my $failures = $self->prereq_failures($info);
+ my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
+ $features{$name} = $disabled ? 0 : 1;
+ }
+ %features = (%features, $ph->{features}->access());
+
+ return wantarray ? %features : \%features;
+}
+*feature = \&features;
@@ Diff output truncated at 10000 characters. @@
More information about the Bioperl-guts-l
mailing list