[Bioperl-guts-l] bioperl-db/Bio/DB BioDB.pm,1.9,1.10

[Hilmar Lapp]

Update of /home/repository/bioperl/bioperl-db/Bio/DB
In directory pub.open-bio.org:/tmp/cvs-serv13130/Bio/DB

Modified Files:
	BioDB.pm 
Log Message:
Added the capability to read in an initialization file.


Index: BioDB.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-db/Bio/DB/BioDB.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** BioDB.pm	11 Aug 2004 15:46:16 -0000	1.9
--- BioDB.pm	14 Apr 2005 17:01:52 -0000	1.10
***************
*** 19,23 ****
  =head1 NAME
  
! Bio::DB::BioDB - class providing the base adaptor for a particular database
  
  =head1 SYNOPSIS
--- 19,23 ----
  =head1 NAME
  
! Bio::DB::BioDB - class creating the adaptor factory for a particular database
  
  =head1 SYNOPSIS
***************
*** 70,73 ****
--- 70,74 ----
  
  my $default_prefix = "Bio::DB::";
+ my $initrc_name = ".bioperldb";
  
  my @DBC_MODULES = ("DBAdaptor", "dbadaptor");
***************
*** 91,98 ****
--- 92,117 ----
   Returns : a Bio::DB::DBAdaptorI implementing object
   Args    : Named parameters. Currently recognized are
+ 
               -database    the name of the database for which the
                            encapsulating adaptor is sought (biosql|markerdb)
+ 
               -dbcontext   a Bio::DB::DBContextI implementing object
  
+              -initrc      a scalar denoting a file which when
+                           evaluated by perl results in a hash
+                           reference or an array reference (to an array
+                           with an even number of elements)
+                           representing the arguments for this method
+                           and for creating an instance of
+                           Bio::DB::SimpleDBContext. The special value
+                           DEFAULT means to use the file .bioperldb in
+                           either the current directory or the home
+                           directory, in this order.
+ 
+              -printerror  whether or not the database and statement
+                           handles to be created when necessary should
+                           print all errors (the adaptor modules will
+                           handle errors themselves, too)
+ 
             Instead of -dbcontext, you can also pass all parameters
             accepted by Bio::DB::SimpleDBContext::new(), and this
***************
*** 103,106 ****
--- 122,129 ----
             reflect the created adaptor.
  
+            Note also that if using the -initrc argument any separately
+            supplied arguments will override and supplement the
+            arguments defined in that file.
+ 
  
  =cut
***************
*** 111,121 ****
      my $self = $pkg->SUPER::new(@args);
  
!     my ($biodb, $dbc, $prerr) = 
          $self->_rearrange([qw(DATABASE 
                                DBCONTEXT
                                PRINTERROR
                                )
                             ], @args);
  
      $self->throw("you must provide the database (schema)") unless $biodb;
      if(exists($db_map{lc($biodb)})) {
--- 134,192 ----
      my $self = $pkg->SUPER::new(@args);
  
!     my ($biodb, $dbc, $prerr, $initrc) = 
          $self->_rearrange([qw(DATABASE 
                                DBCONTEXT
                                PRINTERROR
+                               INITRC
                                )
                             ], @args);
  
+     # first check whether we need to read an initialization record
+     if ($initrc && ($initrc eq "DEFAULT")) {
+         foreach my $dir (".",$ENV{HOME}) {
+             $initrc = Bio::Root::IO->catfile($dir,$initrc_name);
+             last if -e $initrc;
+             # the default behavior is to ignore if the file isn't
+             # present in any of the possible locations
+             $initrc = undef;
+         }
+     }
+     if ($initrc) {
+         eval {
+             $initrc = do $initrc;
+         };
+         $self->throw("error in evaluating '$initrc': $@") if $@;
+         $self->throw("unable to read file '$initrc': $!") if $!;
+         $self->throw("'$initrc' failed to return an array ref or hash ref")
+             unless $initrc || !ref($initrc);
+         if ($initrc->isa("Bio::DB::DBContextI")) {
+             # we allow this too
+             $dbc = $initrc;
+             $initrc = undef;
+         } else {
+             # if necessary convert to array reference
+             if (ref($initrc) eq "HASH") {
+                 $initrc = [%$initrc];
+             }
+             # append explicitly supplied arguments
+             push(@$initrc, @args);
+             # build parameter hash while lower-casing all keys; this will
+             # also let supplied arguments override those read from file
+             my %params = ();
+             while (@$initrc) {
+                 my $key = lc(shift(@$initrc));
+                 $params{$key} = shift(@$initrc);
+             }
+             # check for our arguments; they may have come through the file
+             $biodb = $params{-database} unless $biodb;
+             $prerr = $params{-printerror} unless defined($prerr);
+             $self->verbose($params{-verbose}) 
+                 unless defined($self->verbose) || !exists($params{-verbose});
+             # restore argument list from consolidated parameter map
+             @args = %params;
+         }
+     }
+ 
+     # all arguments should be there now
      $self->throw("you must provide the database (schema)") unless $biodb;
      if(exists($db_map{lc($biodb)})) {