[Bioperl-guts-l] bioperl-live ModuleBuildBioperl.pm,1.24,1.25

Senduran Balasubramaniam sendu at dev.open-bio.org
Mon Jan 22 12:17:43 EST 2007


Update of /home/repository/bioperl/bioperl-live
In directory dev.open-bio.org:/tmp/cvs-serv22556

Modified Files:
	ModuleBuildBioperl.pm 
Log Message:
removed code that kept pre-reqs ordered, improved detection of running under CPAN

Index: ModuleBuildBioperl.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/ModuleBuildBioperl.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** ModuleBuildBioperl.pm	6 Dec 2006 17:02:01 -0000	1.24
--- ModuleBuildBioperl.pm	22 Jan 2007 17:17:41 -0000	1.25
***************
*** 44,48 ****
      }
      
!     eval "use base qw(Module::Build Tie::Hash); 1" or die $@;
      
      # ensure we'll be able to reload this module later by adding its path to inc
--- 44,48 ----
      }
      
!     eval "use base Module::Build; 1" or die $@;
      
      # ensure we'll be able to reload this module later by adding its path to inc
***************
*** 54,58 ****
  use warnings;
  
! our $VERSION = 1.005002100;
  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);
--- 54,58 ----
  use warnings;
  
! 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);
***************
*** 428,444 ****
  }
  
! # 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
  sub under_cpan {
      my $self = shift;
      
      unless (defined $self->{under_cpan}) {
!         require Cwd;
!         my $cwd = Cwd::cwd();
!         if ($cwd =~ /cpan/i) {
              $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 {
--- 428,465 ----
  }
  
! # 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}) {
!         ## 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");
          }
          else {
***************
*** 687,692 ****
  }
  
! # let us store extra things persistently in _build, and keep recommends and
! # requires hashes in insertion order
  sub _construct {
      my $self = shift;
--- 708,712 ----
  }
  
! # let us store extra things persistently in _build
  sub _construct {
      my $self = shift;
***************
*** 701,741 ****
      }
      
-     my %tied;
-     tie %tied, "ModuleBuildBioperl";
-     if (ref($p->{recommends}) eq 'HASH') {
-         while (my ($key, $val) = each %{$p->{recommends}}) {
-             $tied{$key} = $val;
-         }
-     }
-     else {
-         foreach my $hash_ref (@{$p->{recommends}}) {
-             while (my ($key, $val) = each %{$hash_ref}) {
-                 $tied{$key} = $val;
-             }
-         }
-     }
-     $self->{properties}->{recommends} = \%tied;
-     my %tied2;
-     tie %tied2, "ModuleBuildBioperl";
-     while (my ($key, $val) = each %{$p->{requires}}) {
-         $tied2{$key} = $val;
-     }
-     $self->{properties}->{requires} = \%tied2;
-     
      return $self;
  }
  sub write_config {
      my $self = shift;
-     
-     # turn $self->{properties}->{requires} into an array of hash refs to
-     # maintain its order when retrieved (don't care about recommends now,
-     # this is only relevant on a resume)
-     my @required;
-     my $orig_requires = $self->{properties}->{requires};
-     while (my ($key, $val) = each %{$self->{properties}->{requires}}) {
-         push(@required, { $key => $val });
-     }
-     $self->{properties}->{requires} = \@required;
-     
      $self->SUPER::write_config;
      
--- 721,728 ----
***************
*** 743,752 ****
      $self->{phash}{$_}->write() foreach qw(manifest_skip post_install_scripts);
      
-     # re-write the prereqs file to keep future versions of CPAN happy
-     $self->{properties}->{requires} = $orig_requires;
-     my @items = @{ $self->prereq_action_types };
-     $self->_write_data('prereqs', { map { $_, $self->$_() } @items });
-     $self->{properties}->{requires} = \@required;
-     
      # be even more certain we can reload ourselves during a resume by copying
      # ourselves to _build\lib
--- 730,733 ----
***************
*** 760,777 ****
      warn "Unable to copy 'ModuleBuildBioperl.pm' to '$filename'\n" unless -e $filename;
  }
- sub read_config {
-     my $self = shift;
-     $self->SUPER::read_config(@_);
-     
-     # restore the requires order into a tied hash from the stored array
-     my %tied;
-     tie %tied, "ModuleBuildBioperl";
-     foreach my $hash_ref (@{$self->{properties}->{requires}}) {
-         while (my ($key, $val) = each %{$hash_ref}) {
-             $tied{$key} = $val;
-         }
-     }
-     $self->{properties}->{requires} = \%tied;
- }
  
  # add a file to the default MANIFEST.SKIP
--- 741,744 ----
***************
*** 1092,1169 ****
  }
  
- # 
- # Below is ripped straight from Tie::IxHash. We need ordered hashes for our
- # recommends and required hashes, needed to generate our pre-reqs.
- # This means we can't have Tie::IxHash as a pre-req!
- # We could include Tie::IxHash in t/lib or something, but this is simpler
- # and suffers fewer potential problems
- #
- # Again, code below written by Gurusamy Sarathy
- #
- 
- sub TIEHASH {
-   my($c) = shift;
-   my($s) = [];
-   $s->[0] = {};   # hashkey index
-   $s->[1] = [];   # array of keys
-   $s->[2] = [];   # array of data
-   $s->[3] = 0;    # iter count
- 
-   bless $s, $c;
- 
-   $s->Push(@_) if @_;
- 
-   return $s;
- }
- 
- sub FETCH {
-   my($s, $k) = (shift, shift);
-   return exists( $s->[0]{$k} ) ? $s->[2][ $s->[0]{$k} ] : undef;
- }
- 
- sub STORE {
-   my($s, $k, $v) = (shift, shift, shift);
-   
-   if (exists $s->[0]{$k}) {
-     my($i) = $s->[0]{$k};
-     $s->[1][$i] = $k;
-     $s->[2][$i] = $v;
-     $s->[0]{$k} = $i;
-   }
-   else {
-     push(@{$s->[1]}, $k);
-     push(@{$s->[2]}, $v);
-     $s->[0]{$k} = $#{$s->[1]};
-   }
- }
- 
- sub DELETE {
-   my($s, $k) = (shift, shift);
- 
-   if (exists $s->[0]{$k}) {
-     my($i) = $s->[0]{$k};
-     for ($i+1..$#{$s->[1]}) {    # reset higher elt indexes
-       $s->[0]{$s->[1][$_]}--;    # timeconsuming, is there is better way?
-     }
-     delete $s->[0]{$k};
-     splice @{$s->[1]}, $i, 1;
-     return (splice(@{$s->[2]}, $i, 1))[0];
-   }
-   return undef;
- }
- 
- sub EXISTS {
-   exists $_[0]->[0]{ $_[1] };
- }
- 
- sub FIRSTKEY {
-   $_[0][3] = 0;
-   &NEXTKEY;
- }
- 
- sub NEXTKEY {
-   return $_[0][1][$_[0][3]++] if ($_[0][3] <= $#{$_[0][1]});
-   return undef;
- }
- 
  1;
--- 1059,1061 ----



More information about the Bioperl-guts-l mailing list