view release on metacpan or  search on metacpan

Bio/DB/Registry.pm  view on Meta::CPAN

The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _

=cut

# Let the code begin...

package Bio::DB::Registry;

use vars qw($OBDA_SPEC_VERSION $OBDA_SEARCH_PATH
			   $HOME $PRIVATE_DIR $PUBLIC_DIR $REGISTRY
			   $FALLBACK_REGISTRY);
use strict;

use Bio::DB::Failover;
use Bio::Root::HTTPget;
use base qw(Bio::Root::Root);

BEGIN {
   $OBDA_SPEC_VERSION = 1.0;
	$HOME = $ENV{HOME} if (defined $ENV{HOME});
	if (defined $ENV{OBDA_SEARCH_PATH}) {
		$OBDA_SEARCH_PATH = $ENV{OBDA_SEARCH_PATH} || '';
   }
}

my %implement = ('flat'     => 'Bio::DB::Flat',
					   'biosql'   => 'Bio::DB::BioSQL::OBDA',
					   'biofetch' => 'Bio::DB::BioFetch'
					   # 'biocorba' => 'Bio::CorbaClient::SeqDB',
					   );

$FALLBACK_REGISTRY = 'http://www.open-bio.org/registry/seqdatabase.ini';
$PRIVATE_DIR = '.bioinformatics';
$PUBLIC_DIR = '/etc/bioinformatics';
$REGISTRY = 'seqdatabase.ini';

sub new {
    my ($class,@args) = shift;
    my $self = $class->SUPER::new(@args);
    # open files in order
    $self->{'_dbs'} = {};
    $self->_load_registry();
    return $self;
}

=head2 _load_registry

 Title   : _load_registry
 Usage   :
 Function: Looks for seqdatabase.ini files in the expected locations and
           in the directories specified by $OBDA_SEARCH_PATH. If no files
           are found download a default file from www.open-bio.org
 Returns : nothing
 Args    : none

=cut

sub _load_registry {
   my $self = shift;
	eval { $HOME = (getpwuid($>))[7]; } unless $HOME;
	if ($@) {
		# Windows can have Win32::LoginName to get the Username, so check if it works before giving up
		 ( defined &Win32::LoginName ) ? ( $HOME =  Win32::LoginName() )
		:                                 $self->warn("This Perl doesn't implement function getpwuid(), no \$HOME");
	}
	my @ini_files = $self->_get_ini_files();

	@ini_files = $self->_make_private_registry() unless (@ini_files);

   my ($db,$hash) = ();
   for my $file (@ini_files) {
      open my $FH, '<', $file or $self->throw("Could not read file '$file': $!");
      while( <$FH> ) {
			if (/^VERSION=([\d\.]+)/) {
				if ($1 > $OBDA_SPEC_VERSION or !$1) {
					$self->throw("Do not know about this version [$1] > $OBDA_SPEC_VERSION");
					last;
				}
				next;
         }
			next if( /^#/ );
			next if( /^\s/ );
			if ( /^\[(\S+)\]/ ) {
				$db = $1;
				next;
			}
			my ($tag,$value) = split('=',$_);
			$value =~ s/\s//g;
			$tag =~ s/\s//g;
			$hash->{$db}->{"\L$tag"} = $value;
      }
   }

   for my $db ( keys %{$hash} ) {
      if ( !exists $self->{'_dbs'}->{$db} ) {
			my $failover = Bio::DB::Failover->new();
			$self->{'_dbs'}->{$db} = $failover;
      }
      my $class;
      if (defined $implement{$hash->{$db}->{'protocol'}}) {
			$class = $implement{$hash->{$db}->{'protocol'}};
      } else {
			$self->warn("Registry does not support protocol " .
							$hash->{$db}->{'protocol'});
			next;
      }
      eval "require $class";
      if ($@) {
			$self->warn("Couldn't load $class");
			next;
      } else {
			eval {
				my $randi = $class->new_from_registry( %{$hash->{$db}} );
				$self->{'_dbs'}->{$db}->add_database($randi);
			};
			if ($@) {
				$self->warn("Couldn't call new_from_registry() on [$class]\n$@");
			}
      }
   }
}


=head2 get_database