[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