|
0
|
1 # POD documentation - main docs before the code
|
|
|
2
|
|
|
3 # $Id: Registry.pm,v 1.12.2.2 2003/06/26 11:07:10 heikki Exp $
|
|
|
4
|
|
|
5
|
|
|
6 =head1 NAME
|
|
|
7
|
|
|
8 Bio::DB::Registry - Access to the Open Bio Database Access registry scheme
|
|
|
9
|
|
|
10 =head1 SYNOPSIS
|
|
|
11
|
|
|
12 use Bio::DB::Registry();
|
|
|
13
|
|
|
14 $registry = new Bio::DB::Registry();
|
|
|
15
|
|
|
16 @available_services = $registry->services;
|
|
|
17
|
|
|
18 $db = $registry->get_database('embl');
|
|
|
19 # $db is a Bio::DB::SeqI implementing class
|
|
|
20
|
|
|
21 $seq = $db->get_Seq_by_acc("J02231");
|
|
|
22
|
|
|
23 =head1 DESCRIPTION
|
|
|
24
|
|
|
25 This module provides access to the Open Bio Database Access scheme,
|
|
|
26 which provides a cross language and cross platform specification of how
|
|
|
27 to get to databases.
|
|
|
28
|
|
|
29 If the user or system administrator has not installed the default init
|
|
|
30 file, seqdatabase.ini, in /etc/bioinformatics or ${HOME}/.bioinformatics
|
|
|
31 then creating the first Registry object copies the default settings from
|
|
|
32 the net. The Registry object will attempt to store these settings in
|
|
|
33 ${HOME}/.bioinformatics/seqdatabase.ini.
|
|
|
34
|
|
|
35 Users can specify one or more custom locations for the init file by
|
|
|
36 setting $OBDA_SEARCH_PATH to those directories, where multiple
|
|
|
37 directories should be separated by ';'.
|
|
|
38
|
|
|
39 =head1 CONTACT
|
|
|
40
|
|
|
41 Ewan Birney originally wrote this class.
|
|
|
42
|
|
|
43 =head2 Reporting Bugs
|
|
|
44
|
|
|
45 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
46 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
47 or the web:
|
|
|
48
|
|
|
49 bioperl-bugs@bio.perl.org
|
|
|
50 http://bugzilla.bioperl.org/
|
|
|
51
|
|
|
52 =head1 APPENDIX
|
|
|
53
|
|
|
54 The rest of the documentation details each of the object
|
|
|
55 methods. Internal methods are usually preceded with a _
|
|
|
56
|
|
|
57 =cut
|
|
|
58
|
|
|
59
|
|
|
60 # Let the code begin...
|
|
|
61
|
|
|
62 package Bio::DB::Registry;
|
|
|
63
|
|
|
64 use vars qw(@ISA $VERSION $OBDA_SPEC_VERSION $OBDA_SEARCH_PATH);
|
|
|
65 use strict;
|
|
|
66
|
|
|
67 use Bio::Root::Root;
|
|
|
68 @ISA = qw(Bio::Root::Root);
|
|
|
69 use Bio::DB::Failover;
|
|
|
70 use Bio::Root::HTTPget;
|
|
|
71
|
|
|
72 $VERSION = '1.2';
|
|
|
73 BEGIN {
|
|
|
74 $OBDA_SPEC_VERSION = 1.0;
|
|
|
75 if (defined $ENV{OBDA_SEARCH_PATH}) {
|
|
|
76 $OBDA_SEARCH_PATH = $ENV{OBDA_SEARCH_PATH} || '';
|
|
|
77
|
|
|
78 }
|
|
|
79 }
|
|
|
80
|
|
|
81 my %implement = (
|
|
|
82 'biocorba' => 'Bio::CorbaClient::SeqDB',
|
|
|
83 'flat' => 'Bio::DB::Flat',
|
|
|
84 'biosql' => 'Bio::DB::BioSQL::BioDatabaseAdaptor',
|
|
|
85 'biofetch' => 'Bio::DB::BioFetch'
|
|
|
86 );
|
|
|
87
|
|
|
88 my $fallbackRegistryURL = 'http://www.open-bio.org/registry/seqdatabase.ini';
|
|
|
89
|
|
|
90
|
|
|
91 sub new {
|
|
|
92 my ($class,@args) = shift;
|
|
|
93 my $self = $class->SUPER::new(@args);
|
|
|
94
|
|
|
95 # open files in order
|
|
|
96 $self->{'_dbs'} = {};
|
|
|
97 $self->_load_registry();
|
|
|
98 return $self;
|
|
|
99 }
|
|
|
100
|
|
|
101
|
|
|
102 sub _load_registry {
|
|
|
103 my ($self) = @_;
|
|
|
104
|
|
|
105 my $home = (getpwuid($>))[7];
|
|
|
106 my $f;
|
|
|
107
|
|
|
108 if ( $OBDA_SEARCH_PATH ) {
|
|
|
109 foreach ( split /;/,$OBDA_SEARCH_PATH ) {
|
|
|
110 next unless -e $_;
|
|
|
111 open(F,"$OBDA_SEARCH_PATH/seqdatabase.ini");
|
|
|
112 $f = \*F;
|
|
|
113 last;
|
|
|
114 }
|
|
|
115 }
|
|
|
116 elsif( -e "$home/.bioinformatics/seqdatabase.ini" ) {
|
|
|
117 open(F,"$home/.bioinformatics/seqdatabase.ini");
|
|
|
118 $f = \*F;
|
|
|
119 } elsif ( -e "/etc/bioinformatics/seqdatabase.ini" ) {
|
|
|
120 open(F,"/etc/bioinformatics/seqdatabase.ini");
|
|
|
121 $f = \*F;
|
|
|
122 } else {
|
|
|
123 # waiting for information
|
|
|
124 $self->warn("No seqdatabase.ini file found in ~/.bioinformatics/ \nor in /etc/bioinformatics/.\nor in directory specified by $OBDA_SEARCH_PATH".
|
|
|
125 "Using web to get database registry from \n$fallbackRegistryURL");
|
|
|
126
|
|
|
127 # Last gasp. Try to use HTTPget module to retrieve the registry from
|
|
|
128 # the web...
|
|
|
129
|
|
|
130 $f = Bio::Root::HTTPget::getFH($fallbackRegistryURL);
|
|
|
131
|
|
|
132 # store the default registry file
|
|
|
133 mkdir "$home/.bioinformatics" unless -e "$home/.bioinformatics";
|
|
|
134 open(F,">$home/.bioinformatics/seqdatabase.ini");
|
|
|
135 print F while (<$f>);
|
|
|
136 close F;
|
|
|
137
|
|
|
138 $self->warn("Stored the default registry configuration into:\n".
|
|
|
139 " $home/.bioinformatics/seqdatabase.ini");
|
|
|
140
|
|
|
141 open(F,"$home/.bioinformatics/seqdatabase.ini");
|
|
|
142 $f = \*F;
|
|
|
143
|
|
|
144 }
|
|
|
145
|
|
|
146 while( <$f> ) {
|
|
|
147 /^VERSION=([\d\.]+)/;
|
|
|
148 $self->throw("Do not know about this version [$1] > $OBDA_SPEC_VERSION")
|
|
|
149 if $1 > $OBDA_SPEC_VERSION or !$1;
|
|
|
150 last;
|
|
|
151 }
|
|
|
152
|
|
|
153 while( <$f> ) {
|
|
|
154 if( /^#/ ) {
|
|
|
155 next;
|
|
|
156 }
|
|
|
157 if( /^\s/ ) {
|
|
|
158 next;
|
|
|
159 }
|
|
|
160
|
|
|
161 if( /\[(\w+)\]/ ) {
|
|
|
162 my $db = $1;
|
|
|
163 my $hash = {};
|
|
|
164 while( <$f> ) {
|
|
|
165 chomp();
|
|
|
166 /^#/ && next;
|
|
|
167 /^$/ && last;
|
|
|
168 my ($tag,$value) = split('=',$_);
|
|
|
169 $value =~ s/\s//g;
|
|
|
170 $tag =~ s/\s//g;
|
|
|
171 $hash->{"\L$tag"} = lc $value;
|
|
|
172 }
|
|
|
173
|
|
|
174 if( !exists $self->{'_dbs'}->{$db} ) {
|
|
|
175 my $failover = Bio::DB::Failover->new();
|
|
|
176 $self->{'_dbs'}->{$db}=$failover;
|
|
|
177 }
|
|
|
178 my $class;
|
|
|
179 if (defined $implement{$hash->{'protocol'}}) {
|
|
|
180 $class = $implement{$hash->{'protocol'}};
|
|
|
181 }
|
|
|
182 else {
|
|
|
183 $self->warn("Registry does not support protocol ".$hash->{'protocol'});
|
|
|
184 next;
|
|
|
185 }
|
|
|
186 eval "require $class";
|
|
|
187
|
|
|
188 if ($@) {
|
|
|
189 $self->verbose && $self->warn("Couldn't load $class");
|
|
|
190 next;
|
|
|
191 }
|
|
|
192
|
|
|
193 else {
|
|
|
194 eval {
|
|
|
195 my $randi = $class->new_from_registry(%$hash);
|
|
|
196 $self->{'_dbs'}->{$db}->add_database($randi); };
|
|
|
197 if ($@) {
|
|
|
198 $self->warn("Couldn't call new_from_registry on [$class]\n$@");
|
|
|
199 }
|
|
|
200 }
|
|
|
201 next; # back to main loop
|
|
|
202 }
|
|
|
203 $self->warn("Uninterpretable line in registry, $_");
|
|
|
204 }
|
|
|
205 }
|
|
|
206
|
|
|
207 =head2 get_database
|
|
|
208
|
|
|
209 Title : get_database
|
|
|
210 Usage : my $db = $registry->get_database($dbname);
|
|
|
211 Function: Retrieve a Database object which implements Bio::DB::SeqI interface
|
|
|
212 Returns : Bio::DB::SeqI object
|
|
|
213 Args : string describing the name of the database
|
|
|
214
|
|
|
215 =cut
|
|
|
216
|
|
|
217 sub get_database {
|
|
|
218 my ($self,$dbname) = @_;
|
|
|
219
|
|
|
220 $dbname = lc $dbname;
|
|
|
221 if( !defined $dbname ) {
|
|
|
222 $self->warn("must get_database with a database name");
|
|
|
223 return undef;
|
|
|
224 }
|
|
|
225 if( !exists $self->{'_dbs'}->{$dbname} ) {
|
|
|
226 $self->warn("No database in with $dbname in registry");
|
|
|
227 return undef;
|
|
|
228 }
|
|
|
229 return $self->{'_dbs'}->{$dbname};
|
|
|
230 }
|
|
|
231
|
|
|
232 =head2 services
|
|
|
233
|
|
|
234 Title : services
|
|
|
235 Usage : my @available = $registry->services();
|
|
|
236 Function: returns list of possible services
|
|
|
237 Returns : list of strings
|
|
|
238 Args : none
|
|
|
239
|
|
|
240
|
|
|
241 =cut
|
|
|
242
|
|
|
243 sub services{
|
|
|
244 my ($self) = @_;
|
|
|
245 return () unless ( defined $self->{'_dbs'} &&
|
|
|
246 ref( $self->{'_dbs'} ) =~ /HASH/i);
|
|
|
247 return keys %{$self->{'_dbs'}};
|
|
|
248 }
|
|
|
249
|
|
|
250
|
|
|
251 ## End of Package
|
|
|
252
|
|
|
253 1;
|
|
|
254
|
|
|
255 __END__
|
|
|
256
|
