File Coverage

Bio/DB/Registry.pm
Criterion Covered Total %
statement 19 106 17.9
branch 2 54 3.7
condition 1 11 9.0
subroutine 6 12 50.0
pod 3 3 100.0
total 31 186 16.6


line stmt bran cond sub pod time code
1             #
2             # POD documentation - main docs before the code
3              
4             =head1 NAME
5              
6             Bio::DB::Registry - Access to the Open Bio Database Access registry scheme
7              
8             =head1 SYNOPSIS
9              
10             use Bio::DB::Registry();
11              
12             $registry = Bio::DB::Registry->new();
13              
14             @available_services = $registry->services;
15              
16             $db = $registry->get_database('embl');
17             # $db is a Bio::DB::SeqI implementing class
18              
19             $seq = $db->get_Seq_by_acc("J02231");
20              
21             =head1 DESCRIPTION
22              
23             This module provides access to the Open Bio Database Access (OBDA)
24             scheme, which provides a single cross-language and cross-platform
25             specification of how to get to databases. These databases may be
26             accessible through the Web, they may be BioSQL databases, or
27             they may be local, indexed flatfile 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 www.open-bio.org. The Registry object will attempt to store these
33             settings in a new file, ${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             Please see the OBDA Access HOWTO for more information
40             (L).
41              
42             =head2 Support
43              
44             Please direct usage questions or support issues to the mailing list:
45              
46             I
47              
48             rather than to the module maintainer directly. Many experienced and
49             reponsive experts will be able look at the problem and quickly
50             address it. Please include a thorough description of the problem
51             with code and data examples if at all possible.
52              
53             =head2 Reporting Bugs
54              
55             Report bugs to the Bioperl bug tracking system to help us keep track
56             the bugs and their resolution. Bug reports can be submitted via the
57             web:
58              
59             https://github.com/bioperl/bioperl-live/issues
60              
61             =head1 APPENDIX
62              
63             The rest of the documentation details each of the object
64             methods. Internal methods are usually preceded with a _
65              
66             =cut
67              
68             # Let the code begin...
69              
70             package Bio::DB::Registry;
71              
72 1         64 use vars qw($OBDA_SPEC_VERSION $OBDA_SEARCH_PATH
73             $HOME $PRIVATE_DIR $PUBLIC_DIR $REGISTRY
74 1     1   487 $FALLBACK_REGISTRY);
  1         1  
75 1     1   4 use strict;
  1         1  
  1         14  
76              
77 1     1   247 use Bio::DB::Failover;
  1         4  
  1         24  
78 1     1   273 use Bio::Root::HTTPget;
  1         2  
  1         40  
79 1     1   5 use base qw(Bio::Root::Root);
  1         1  
  1         87  
80              
81             BEGIN {
82 1     1   2 $OBDA_SPEC_VERSION = 1.0;
83 1 50       4 $HOME = $ENV{HOME} if (defined $ENV{HOME});
84 1 50       3 if (defined $ENV{OBDA_SEARCH_PATH}) {
85 1   50     853 $OBDA_SEARCH_PATH = $ENV{OBDA_SEARCH_PATH} || '';
86             }
87             }
88              
89             my %implement = ('flat' => 'Bio::DB::Flat',
90             'biosql' => 'Bio::DB::BioSQL::OBDA',
91             'biofetch' => 'Bio::DB::BioFetch'
92             # 'biocorba' => 'Bio::CorbaClient::SeqDB',
93             );
94              
95             $FALLBACK_REGISTRY = 'http://www.open-bio.org/registry/seqdatabase.ini';
96             $PRIVATE_DIR = '.bioinformatics';
97             $PUBLIC_DIR = '/etc/bioinformatics';
98             $REGISTRY = 'seqdatabase.ini';
99              
100             sub new {
101 0     0 1   my ($class,@args) = shift;
102 0           my $self = $class->SUPER::new(@args);
103             # open files in order
104 0           $self->{'_dbs'} = {};
105 0           $self->_load_registry();
106 0           return $self;
107             }
108              
109             =head2 _load_registry
110              
111             Title : _load_registry
112             Usage :
113             Function: Looks for seqdatabase.ini files in the expected locations and
114             in the directories specified by $OBDA_SEARCH_PATH. If no files
115             are found download a default file from www.open-bio.org
116             Returns : nothing
117             Args : none
118              
119             =cut
120              
121             sub _load_registry {
122 0     0     my $self = shift;
123 0 0         eval { $HOME = (getpwuid($>))[7]; } unless $HOME;
  0            
124 0 0         if ($@) {
125             # Windows can have Win32::LoginName to get the Username, so check if it works before giving up
126 0 0         ( defined &Win32::LoginName ) ? ( $HOME = Win32::LoginName() )
127             : $self->warn("This Perl doesn't implement function getpwuid(), no \$HOME");
128             }
129 0           my @ini_files = $self->_get_ini_files();
130              
131 0 0         @ini_files = $self->_make_private_registry() unless (@ini_files);
132              
133 0           my ($db,$hash) = ();
134 0           for my $file (@ini_files) {
135 0 0         open my $FH, '<', $file or $self->throw("Could not read file '$file': $!");
136 0           while( <$FH> ) {
137 0 0         if (/^VERSION=([\d\.]+)/) {
138 0 0 0       if ($1 > $OBDA_SPEC_VERSION or !$1) {
139 0           $self->throw("Do not know about this version [$1] > $OBDA_SPEC_VERSION");
140 0           last;
141             }
142 0           next;
143             }
144 0 0         next if( /^#/ );
145 0 0         next if( /^\s/ );
146 0 0         if ( /^\[(\S+)\]/ ) {
147 0           $db = $1;
148 0           next;
149             }
150 0           my ($tag,$value) = split('=',$_);
151 0           $value =~ s/\s//g;
152 0           $tag =~ s/\s//g;
153 0           $hash->{$db}->{"\L$tag"} = $value;
154             }
155             }
156              
157 0           for my $db ( keys %{$hash} ) {
  0            
158 0 0         if ( !exists $self->{'_dbs'}->{$db} ) {
159 0           my $failover = Bio::DB::Failover->new();
160 0           $self->{'_dbs'}->{$db} = $failover;
161             }
162 0           my $class;
163 0 0         if (defined $implement{$hash->{$db}->{'protocol'}}) {
164 0           $class = $implement{$hash->{$db}->{'protocol'}};
165             } else {
166             $self->warn("Registry does not support protocol " .
167 0           $hash->{$db}->{'protocol'});
168 0           next;
169             }
170 0           eval "require $class";
171 0 0         if ($@) {
172 0           $self->warn("Couldn't load $class");
173 0           next;
174             } else {
175 0           eval {
176 0           my $randi = $class->new_from_registry( %{$hash->{$db}} );
  0            
177 0           $self->{'_dbs'}->{$db}->add_database($randi);
178             };
179 0 0         if ($@) {
180 0           $self->warn("Couldn't call new_from_registry() on [$class]\n$@");
181             }
182             }
183             }
184             }
185              
186              
187             =head2 get_database
188              
189             Title : get_database
190             Usage : my $db = $registry->get_database($dbname);
191             Function: Retrieve a Database object which implements Bio::DB::SeqI interface
192             Returns : Bio::DB::SeqI object
193             Args : string describing the name of the database
194              
195             =cut
196              
197             sub get_database {
198 0     0 1   my ($self,$dbname) = @_;
199              
200 0           $dbname = lc $dbname;
201 0 0         if( !defined $dbname ) {
202 0           $self->warn("must get_database with a database name");
203 0           return;
204             }
205 0 0         if( !exists $self->{'_dbs'}->{$dbname} ) {
206 0           $self->warn("No database with name $dbname in Registry");
207 0           return;
208             }
209 0           return $self->{'_dbs'}->{$dbname};
210             }
211              
212             =head2 services
213              
214             Title : services
215             Usage : my @available = $registry->services();
216             Function: returns list of possible services
217             Returns : list of strings
218             Args : none
219              
220             =cut
221              
222             sub services {
223 0     0 1   my ($self) = @_;
224             return () unless ( defined $self->{'_dbs'} &&
225 0 0 0       ref( $self->{'_dbs'} ) =~ /HASH/i);
226 0           return keys %{$self->{'_dbs'}};
  0            
227             }
228              
229             =head2 _get_ini_files
230              
231             Title : _get_ini_files
232             Usage : my @files = $self->_get_ini_files
233             Function: To find all the seqdatabase.ini files
234             Returns : list of seqdatabase.ini paths
235             Args : None
236              
237             =cut
238              
239             sub _get_ini_files {
240 0     0     my $self = shift;
241 0           my @ini_files = ();
242 0 0         if ( $OBDA_SEARCH_PATH ) {
243 0           foreach my $dir ( split /;/, $OBDA_SEARCH_PATH ) {
244 0           my $file = $dir . "/" . $REGISTRY;
245 0 0         next unless -e $file;
246 0           push @ini_files,$file;
247             }
248             }
249 0 0 0       push @ini_files,"$HOME/$PRIVATE_DIR/$REGISTRY"
250             if ( $HOME && -e "$HOME/$PRIVATE_DIR/$REGISTRY" );
251 0 0         push @ini_files, "$PUBLIC_DIR/$REGISTRY"
252             if ( -e "$PUBLIC_DIR/$REGISTRY" );
253 0           @ini_files;
254             }
255              
256             =head2 _make_private_registry
257              
258             Title : _make_private_registry
259             Usage :
260             Function: Make private registry in file in $HOME
261             Returns : Path to private registry file
262             Args : None
263              
264             =cut
265              
266             sub _make_private_registry {
267 0     0     my $self = shift;
268 0           my @ini_file;
269              
270 0 0         my $nor_in = $OBDA_SEARCH_PATH ?
271             "nor in directory specified by\n$OBDA_SEARCH_PATH" :
272             "and environment variable OBDA_SEARCH_PATH wasn't set";
273              
274 0           $self->warn("No $REGISTRY file found in $HOME/$PRIVATE_DIR/\n" .
275             "nor in $PUBLIC_DIR $nor_in.\n" .
276             "Using web to get registry from\n$FALLBACK_REGISTRY");
277              
278             # Last gasp. Try to use HTTPget module to retrieve the registry from
279             # the web...
280 0           my $f = Bio::Root::HTTPget::getFH($FALLBACK_REGISTRY);
281              
282             # store the default registry file
283 0           eval {
284 0 0         mkdir "$HOME/$PRIVATE_DIR" unless -e "$HOME/$PRIVATE_DIR";
285             };
286 0 0         $self->throw("Could not make directory $HOME/$PRIVATE_DIR, " .
287             "no $REGISTRY file available") if $@;
288              
289 0 0         open my $F, '>', "$HOME/$PRIVATE_DIR/$REGISTRY"
290             or $self->throw("Could not write file '$HOME/$PRIVATE_DIR/$REGISTRY': $!");
291 0           print $F while (<$F>);
292 0           close $F;
293              
294 0           $self->warn("Stored $REGISTRY file in $HOME/$PRIVATE_DIR");
295              
296 0           push @ini_file,"$HOME/$PRIVATE_DIR/$REGISTRY";
297 0           @ini_file;
298             }
299              
300             1;
301              
302             __END__