Bio/DB/Registry.pm

   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<http://bioperl.open-bio.org/wiki/HOWTO:OBDA>).
  41
  42 =head2 Support
  43
  44 Please direct usage questions or support issues to the mailing list:
  45
  46 I<bioperl-l@bioperl.org>
  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 use vars qw($OBDA_SPEC_VERSION $OBDA_SEARCH_PATH
  73                            $HOME $PRIVATE_DIR $PUBLIC_DIR $REGISTRY
  74                            $FALLBACK_REGISTRY);
  75 use strict;
  76
  77 use Bio::DB::Failover;
  78 use Bio::Root::HTTPget;
  79 use base qw(Bio::Root::Root);
  80
  81 BEGIN {
  82    $OBDA_SPEC_VERSION = 1.0;
  83         $HOME = $ENV{HOME} if (defined $ENV{HOME});
  84         if (defined $ENV{OBDA_SEARCH_PATH}) {
  85                 $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     my ($class,@args) = shift;
 102     my $self = $class->SUPER::new(@args);
 103     # open files in order
 104     $self->{'_dbs'} = {};
 105     $self->_load_registry();
 106     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    my $self = shift;
 123         eval { $HOME = (getpwuid($>))[7]; } unless $HOME;
 124         if ($@) {
 125                 $self->warn("This Perl doesn't implement function getpwuid(), no \$HOME");
 126         }
 127         my @ini_files = $self->_get_ini_files();
 128
 129         @ini_files = $self->_make_private_registry() unless (@ini_files);
 130
 131    my ($db,$hash) = ();
 132    for my $file (@ini_files) {
 133       open my $FH, '<', $file or $self->throw("Could not read file '$file': $!");
 134       while( <$FH> ) {
 135                         if (/^VERSION=([\d\.]+)/) {
 136                                 if ($1 > $OBDA_SPEC_VERSION or !$1) {
 137                                         $self->throw("Do not know about this version [$1] > $OBDA_SPEC_VERSION");
 138                                         last;
 139                                 }
 140                                 next;
 141          }
 142                         next if( /^#/ );
 143                         next if( /^\s/ );
 144                         if ( /^\[(\S+)\]/ ) {
 145                                 $db = $1;
 146                                 next;
 147                         }
 148                         my ($tag,$value) = split('=',$_);
 149                         $value =~ s/\s//g;
 150                         $tag =~ s/\s//g;
 151                         $hash->{$db}->{"\L$tag"} = $value;
 152       }
 153    }
 154
 155    for my $db ( keys %{$hash} ) {
 156       if ( !exists $self->{'_dbs'}->{$db} ) {
 157                         my $failover = Bio::DB::Failover->new();
 158                         $self->{'_dbs'}->{$db} = $failover;
 159       }
 160       my $class;
 161       if (defined $implement{$hash->{$db}->{'protocol'}}) {
 162                         $class = $implement{$hash->{$db}->{'protocol'}};
 163       } else {
 164                         $self->warn("Registry does not support protocol " .
 165                                                         $hash->{$db}->{'protocol'});
 166                         next;
 167       }
 168       eval "require $class";
 169       if ($@) {
 170                         $self->warn("Couldn't load $class");
 171                         next;
 172       } else {
 173                         eval {
 174                                 my $randi = $class->new_from_registry( %{$hash->{$db}} );
 175                                 $self->{'_dbs'}->{$db}->add_database($randi);
 176                         };
 177                         if ($@) {
 178                                 $self->warn("Couldn't call new_from_registry() on [$class]\n$@");
 179                         }
 180       }
 181    }
 182 }
 183
 184
 185 =head2 get_database
 186
 187  Title   : get_database
 188  Usage   : my $db = $registry->get_database($dbname);
 189  Function: Retrieve a Database object which implements Bio::DB::SeqI interface
 190  Returns : Bio::DB::SeqI object
 191  Args    : string describing the name of the database
 192
 193 =cut
 194
 195 sub get_database {
 196         my ($self,$dbname) = @_;
 197
 198         $dbname = lc $dbname;
 199         if( !defined $dbname ) {
 200                 $self->warn("must get_database with a database name");
 201                 return;
 202         }
 203         if( !exists $self->{'_dbs'}->{$dbname} ) {
 204                 $self->warn("No database with name $dbname in Registry");
 205                 return;
 206         }
 207         return $self->{'_dbs'}->{$dbname};
 208 }
 209
 210 =head2 services
 211
 212  Title   : services
 213  Usage   : my @available = $registry->services();
 214  Function: returns list of possible services
 215  Returns : list of strings
 216  Args    : none
 217
 218 =cut
 219
 220 sub services {
 221     my ($self) = @_;
 222     return () unless ( defined $self->{'_dbs'} &&
 223                        ref( $self->{'_dbs'} ) =~ /HASH/i);
 224     return keys %{$self->{'_dbs'}};
 225 }
 226
 227 =head2 _get_ini_files
 228
 229  Title   : _get_ini_files
 230  Usage   : my @files = $self->_get_ini_files
 231  Function: To find all the seqdatabase.ini files
 232  Returns : list of seqdatabase.ini paths
 233  Args    : None
 234
 235 =cut
 236
 237 sub _get_ini_files {
 238         my $self = shift;
 239    my @ini_files = ();
 240    if ( $OBDA_SEARCH_PATH ) {
 241       foreach my $dir ( split /;/, $OBDA_SEARCH_PATH ) {
 242                         my $file = $dir . "/" . $REGISTRY;
 243                         next unless -e $file;
 244                         push @ini_files,$file;
 245       }
 246    }
 247    push @ini_files,"$HOME/$PRIVATE_DIR/$REGISTRY"
 248      if ( $HOME && -e "$HOME/$PRIVATE_DIR/$REGISTRY" );
 249    push @ini_files, "$PUBLIC_DIR/$REGISTRY"
 250      if ( -e "$PUBLIC_DIR/$REGISTRY" );
 251    @ini_files;
 252 }
 253
 254 =head2 _make_private_registry
 255
 256  Title   : _make_private_registry
 257  Usage   :
 258  Function: Make private registry in file in $HOME
 259  Returns : Path to private registry file
 260  Args    : None
 261
 262 =cut
 263
 264 sub _make_private_registry {
 265         my $self = shift;
 266    my @ini_file;
 267
 268         my $nor_in = $OBDA_SEARCH_PATH ?
 269           "nor in directory specified by\n$OBDA_SEARCH_PATH" :
 270           "and environment variable OBDA_SEARCH_PATH wasn't set";
 271
 272         $self->warn("No $REGISTRY file found in $HOME/$PRIVATE_DIR/\n" .
 273                                         "nor in $PUBLIC_DIR $nor_in.\n" .
 274                                         "Using web to get registry from\n$FALLBACK_REGISTRY");
 275
 276         # Last gasp. Try to use HTTPget module to retrieve the registry from
 277         # the web...
 278         my $f = Bio::Root::HTTPget::getFH($FALLBACK_REGISTRY);
 279
 280         # store the default registry file
 281         eval {
 282                 mkdir "$HOME/$PRIVATE_DIR" unless -e "$HOME/$PRIVATE_DIR";
 283         };
 284         $self->throw("Could not make directory $HOME/$PRIVATE_DIR, " .
 285                                          "no $REGISTRY file available") if $@;
 286
 287         open my $F, '>', "$HOME/$PRIVATE_DIR/$REGISTRY"
 288           or $self->throw("Could not write file '$HOME/$PRIVATE_DIR/$REGISTRY': $!");
 289         print $F while (<$F>);
 290         close $F;
 291
 292         $self->warn("Stored $REGISTRY file in $HOME/$PRIVATE_DIR");
 293
 294         push @ini_file,"$HOME/$PRIVATE_DIR/$REGISTRY";
 295         @ini_file;
 296 }
 297
 298 1;
 299
 300 __END__