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.org/howtos/OBDA_HOWTO.html>).
  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                 # Windows can have Win32::LoginName to get the Username, so check if it works before giving up
 126                  ( defined &Win32::LoginName ) ? ( $HOME =  Win32::LoginName() )
 127                 :                                 $self->warn("This Perl doesn't implement function getpwuid(), no \$HOME");
 128         }
 129         my @ini_files = $self->_get_ini_files();
 130
 131         @ini_files = $self->_make_private_registry() unless (@ini_files);
 132
 133    my ($db,$hash) = ();
 134    for my $file (@ini_files) {
 135       open my $FH, '<', $file or $self->throw("Could not read file '$file': $!");
 136       while( <$FH> ) {
 137                         if (/^VERSION=([\d\.]+)/) {
 138                                 if ($1 > $OBDA_SPEC_VERSION or !$1) {
 139                                         $self->throw("Do not know about this version [$1] > $OBDA_SPEC_VERSION");
 140                                         last;
 141                                 }
 142                                 next;
 143          }
 144                         next if( /^#/ );
 145                         next if( /^\s/ );
 146                         if ( /^\[(\S+)\]/ ) {
 147                                 $db = $1;
 148                                 next;
 149                         }
 150                         my ($tag,$value) = split('=',$_);
 151                         $value =~ s/\s//g;
 152                         $tag =~ s/\s//g;
 153                         $hash->{$db}->{"\L$tag"} = $value;
 154       }
 155    }
 156
 157    for my $db ( keys %{$hash} ) {
 158       if ( !exists $self->{'_dbs'}->{$db} ) {
 159                         my $failover = Bio::DB::Failover->new();
 160                         $self->{'_dbs'}->{$db} = $failover;
 161       }
 162       my $class;
 163       if (defined $implement{$hash->{$db}->{'protocol'}}) {
 164                         $class = $implement{$hash->{$db}->{'protocol'}};
 165       } else {
 166                         $self->warn("Registry does not support protocol " .
 167                                                         $hash->{$db}->{'protocol'});
 168                         next;
 169       }
 170       eval "require $class";
 171       if ($@) {
 172                         $self->warn("Couldn't load $class");
 173                         next;
 174       } else {
 175                         eval {
 176                                 my $randi = $class->new_from_registry( %{$hash->{$db}} );
 177                                 $self->{'_dbs'}->{$db}->add_database($randi);
 178                         };
 179                         if ($@) {
 180                                 $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         my ($self,$dbname) = @_;
 199
 200         $dbname = lc $dbname;
 201         if( !defined $dbname ) {
 202                 $self->warn("must get_database with a database name");
 203                 return;
 204         }
 205         if( !exists $self->{'_dbs'}->{$dbname} ) {
 206                 $self->warn("No database with name $dbname in Registry");
 207                 return;
 208         }
 209         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     my ($self) = @_;
 224     return () unless ( defined $self->{'_dbs'} &&
 225                        ref( $self->{'_dbs'} ) =~ /HASH/i);
 226     return keys %{$self->{'_dbs'}};
 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         my $self = shift;
 241    my @ini_files = ();
 242    if ( $OBDA_SEARCH_PATH ) {
 243       foreach my $dir ( split /;/, $OBDA_SEARCH_PATH ) {
 244                         my $file = $dir . "/" . $REGISTRY;
 245                         next unless -e $file;
 246                         push @ini_files,$file;
 247       }
 248    }
 249    push @ini_files,"$HOME/$PRIVATE_DIR/$REGISTRY"
 250      if ( $HOME && -e "$HOME/$PRIVATE_DIR/$REGISTRY" );
 251    push @ini_files, "$PUBLIC_DIR/$REGISTRY"
 252      if ( -e "$PUBLIC_DIR/$REGISTRY" );
 253    @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         my $self = shift;
 268    my @ini_file;
 269
 270         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         $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         my $f = Bio::Root::HTTPget::getFH($FALLBACK_REGISTRY);
 281
 282         # store the default registry file
 283         eval {
 284                 mkdir "$HOME/$PRIVATE_DIR" unless -e "$HOME/$PRIVATE_DIR";
 285         };
 286         $self->throw("Could not make directory $HOME/$PRIVATE_DIR, " .
 287                                          "no $REGISTRY file available") if $@;
 288
 289         open my $F, '>', "$HOME/$PRIVATE_DIR/$REGISTRY"
 290           or $self->throw("Could not write file '$HOME/$PRIVATE_DIR/$REGISTRY': $!");
 291         print $F while (<$F>);
 292         close $F;
 293
 294         $self->warn("Stored $REGISTRY file in $HOME/$PRIVATE_DIR");
 295
 296         push @ini_file,"$HOME/$PRIVATE_DIR/$REGISTRY";
 297         @ini_file;
 298 }
 299
 300 1;
 301
 302 __END__