[Bioperl-guts-l] bioperl commit

[Heikki Lehvaslaiho]

Mon Feb 17 07:18:54 EST 2003
Update of /home/repository/bioperl/bioperl-live/Bio/DB
In directory dev:/tmp/cvs-serv890

Modified Files:
	Registry.pm 
Log Message:
* finds seqdatabase.ini from directory in env variable $BIOINFORMATICS
* if ini file not found from local directories, copies the default one from net
  into users home directory

bioperl-live/Bio/DB Registry.pm,1.13,1.14
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/DB/Registry.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- /tmp/T0pZaaXb	2003-02-17 07:18:54.290010247 -0500
+++ /tmp/T1qZaaXb	2003-02-17 07:18:54.300003888 -0500
@@ -26,6 +26,8 @@
 which provides a cross language and cross platform specification of how
 to get to databases.
 
+If the user or system administrator has not installed the default init file,
+creating the first Registry object copies the default settings from the net.
 
 =head1 CONTACT
 
@@ -52,7 +54,7 @@
 
 package Bio::DB::Registry;
 
-use vars qw(@ISA);
+use vars qw(@ISA $BIOINFORMATICS);
 use strict;
 
 use Bio::Root::Root;
@@ -60,6 +62,14 @@
 use Bio::DB::Failover;
 use Bio::Root::HTTPget;
 
+BEGIN {
+
+    if (defined $ENV{BIOINFORMATICS}) {
+        $BIOINFORMATICS = $ENV{BIOINFORMATICS} || '';
+
+    }
+}
+
 my %implement = (
 		 'biocorba'         => 'Bio::CorbaClient::SeqDB',
 		 'flat-index'       => 'Bio::DB::Flat::BDB',
@@ -74,7 +84,7 @@
 sub new {
     my ($class, at args) = shift;
     my $self = $class->SUPER::new(@args);
-    
+
     # open files in order
     $self->{'_dbs'} = {};
     $self->_load_registry();
@@ -87,21 +97,38 @@
 
     my $home = (getpwuid($>))[7];
     my $f;
-    if( -e "$home/.bioinformatics/seqdatabase.ini" ) {
+
+    if( $BIOINFORMATICS ) {
+        open(F,"$BIOINFORMATICS/seqdatabase.ini");
+        $f = \*F;
+    } elsif( -e "$home/.bioinformatics/seqdatabase.ini" ) {
 	open(F,"$home/.bioinformatics/seqdatabase.ini");
 	$f = \*F;
     } elsif ( -e "/etc/bioinformatics/seqdatabase.ini" ) {
-	open(F,"$home/.bioinformatics/seqdatabase.ini");
+	open(F,"/etc/bioinformatics/seqdatabase.ini");
 	$f = \*F;
     } else {
 	# waiting for information
-	$self->warn("No conf file found in ~/.bioinformatics/ \nor in /etc/.bioinformatics/ using web to get database registry from \n$fallbackRegistryURL\n");
+	$self->warn("No conf file found in ~/.bioinformatics/ \nor in /etc/.bioinformatics/.\n".
+                    "Using web to get database registry from \n$fallbackRegistryURL");
 
 	# Last gasp. Try to use HTTPget module to retrieve the registry from
         # the web...
 
 	$f = Bio::Root::HTTPget::getFH($fallbackRegistryURL);
 
+        # store the default registry file
+        mkdir "$home/.bioinformatics" unless -e "$home/.bioinformatics";
+	open(F,">$home/.bioinformatics/seqdatabase.ini");
+        print F while (<$f>);
+        close F;
+
+	$self->warn("Stored the default registry configuration into:\n".
+                    "  $home/.bioinformatics/seqdatabase.ini");
+
+	open(F,"$home/.bioinformatics/seqdatabase.ini");
+	$f = \*F;
+
     }
 
     while( <$f> ) {
@@ -125,7 +152,7 @@
 		$tag =~ s/\s//g;
 		$hash->{$tag} = $value;
 	    }
-	    
+
 	    if( !exists $self->{'_dbs'}->{$db} ) {
 		my $failover = Bio::DB::Failover->new();
 		$self->{'_dbs'}->{$db}=$failover;
@@ -139,12 +166,12 @@
 		next;
 	    }
 	    eval "require $class";
-	    
+
 	    if ($@) {
 		$self->verbose && $self->warn("Couldn't load $class");
 		next;
 	    }
-	    
+
 	    else {
 		eval {
 		    my $randi = $class->new_from_registry(%$hash);