Archive Ensembl HomeArchive Ensembl Home
Registry.pm
Go to the documentation of this file.
00001 =head1 LICENSE
00002 
00003   Copyright (c) 1999-2012 The European Bioinformatics Institute and
00004   Genome Research Limited.  All rights reserved.
00005 
00006   This software is distributed under a modified Apache license.
00007   For license details, please see
00008 
00009     http://www.ensembl.org/info/about/code_licence.html
00010 
00011 =head1 CONTACT
00012 
00013   Please email comments or questions to the public Ensembl
00014   developers list at <dev@ensembl.org>.
00015 
00016   Questions may also be sent to the Ensembl help desk at
00017   <helpdesk@ensembl.org>.
00018 
00019 =cut
00020 
00021 =head1 NAME
00022 
00023 Bio::EnsEMBL::Registry
00024 
00025 =head1 SYNOPSIS
00026 
00027   use Bio::EnsEMBL::Registry;
00028 
00029   my $registry = 'Bio::EnsEMBL::Registry';
00030 
00031   $registry->load_all("configuration_file");
00032 
00033   $gene_adaptor = $registry->get_adaptor( 'Human', 'Core', 'Gene' );
00034 
00035 =head1 DESCRIPTION
00036 
00037 All Adaptors are stored/registered using this module. This module should
00038 then be used to get the adaptors needed.
00039 
00040 The registry can be loaded from a configuration file using the load_all
00041 method.
00042 
00043 If a filename is passed to load_all then this is used.  Else if the
00044 enviroment variable ENSEMBL_REGISTRY is set to the name on an existing
00045 configuration file, then this is used.  Else if the file .ensembl_init
00046 in your home directory exist, it is used.
00047 
00048 For the Web server ENSEMBL_REGISTRY should be set in SiteDefs.pm.  This
00049 will then be passed on to load_all.
00050 
00051 
00052 The registry can also be loaded via the method load_registry_from_db
00053 which given a database host will load the latest versions of the Ensembl
00054 databases from it.
00055 
00056 The four types of registries are for db adaptors, dba adaptors, dna
00057 adaptors and the standard type.
00058 
00059 =head2 db
00060 
00061 These are registries for backwards compatibility and enable the
00062 subroutines to add other adaptors to connections.
00063 
00064 e.g. get_all_db_adaptors, get_db_adaptor, add_db_adaptor,
00065 remove_db_adaptor are the old DBAdaptor subroutines which are now
00066 redirected to the Registry.
00067 
00068 So if before we had
00069 
00070   my $sfa = $self->adaptor()->db()->get_db_adaptor('blast');
00071 
00072 We now want to change this to
00073 
00074   my $sfa =
00075     Bio::EnsEMBL::Registry->get_adaptor( "human", "core", "blast" );
00076 
00077 
00078 =head2 DBA
00079 
00080 These are the stores for the DBAdaptors
00081 
00082 The Registry will create all the DBConnections needed now if you set up
00083 the configuration correctly. So instead of the old commands like
00084 
00085   my $db           = Bio::EnsEMBL::DBSQL::DBAdaptor->new(...);
00086   my $exon_adaptor = $db->get_ExonAdaptor;
00087 
00088 we should now have just
00089 
00090   my $exon_adaptor =
00091     Bio::EnsEMBL::Registry->get_adaptor( "human", "core", "exon" );
00092 
00093 
00094 =head2 DNA
00095 
00096 This is an internal Registry and allows the configuration of a dnadb.
00097 An example here is to set the est database to get its dna data from the
00098 core database.
00099 
00100   ## set the est db to use the core for getting dna data.
00101   # Bio::EnsEMBL::Utils::ConfigRegistry->dnadb_add( "Homo Sapiens",
00102   #   "core", "Homo Sapiens", "est" );
00103 
00104 
00105 =head2 adaptors
00106 
00107 This is the registry for all the general types of adaptors like
00108 GeneAdaptor, ExonAdaptor, Slice Adaptor etc.
00109 
00110 These are accessed by the get_adaptor subroutine i.e.
00111 
00112   my $exon_adaptor =
00113     Bio::EnsEMBL::Registry->get_adaptor( "human", "core", "exon" );
00114 
00115 =head1 METHODS
00116 
00117 =cut
00118 
00119 
00120 
00121 package Bio::EnsEMBL::Registry;
00122 use strict;
00123 use warnings;
00124 
00125 use Bio::EnsEMBL::DBSQL::DBAdaptor;
00126 use Bio::EnsEMBL::Utils::Exception qw( deprecate throw warning );
00127 use Bio::EnsEMBL::Utils::Argument qw(rearrange);
00128 use Bio::EnsEMBL::Utils::ConfigRegistry;
00129 use Bio::EnsEMBL::ApiVersion;
00130 use Bio::EnsEMBL::Utils::URI qw/parse_uri/;
00131 
00132 use DBI qw(:sql_types);
00133 
00134 use vars qw(%registry_register);
00135 
00136 # This is a map from group names to Ensembl DB adaptors.  Used by
00137 # load_all() and reset_DBAdaptor().
00138 my %group2adaptor = (
00139       'blast'      => 'Bio::EnsEMBL::External::BlastAdaptor',
00140       'compara'    => 'Bio::EnsEMBL::Compara::DBSQL::DBAdaptor',
00141       'core'       => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
00142       'estgene'    => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
00143       'funcgen'    => 'Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor',
00144       'regulation' => 'Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor',
00145       'haplotype' => 'Bio::EnsEMBL::ExternalData::Haplotype::DBAdaptor',
00146       'hive'      => 'Bio::EnsEMBL::Hive::DBSQL::DBAdaptor',
00147       'ontology'  => 'Bio::EnsEMBL::DBSQL::OntologyDBAdaptor',
00148       'otherfeatures' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
00149       'pipeline'      => 'Bio::EnsEMBL::Pipeline::DBSQL::DBAdaptor',
00150       'snp'       => 'Bio::EnsEMBL::ExternalData::SNPSQL::DBAdaptor',
00151       'variation' => 'Bio::EnsEMBL::Variation::DBSQL::DBAdaptor',
00152       'vega'      => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
00153       'vega_update' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
00154 );
00155 
00156 
00157 =head2 load_all
00158 
00159  Will load the registry with the configuration file which is
00160  obtained from the first in the following and in that order.
00161 
00162   1) If an argument is passed to this method, this is used as the
00163      name of the configuration file to read.
00164 
00165   2) If the enviroment variable ENSEMBL_REGISTRY is set, this is
00166      used as the name of the configuration file to read.
00167 
00168   3) If the file .ensembl_init exist in the home directory, it is
00169      used as the configuration file.
00170 
00171   Arg [1]    : (optional) string
00172                Name of file to load the registry from.
00173 
00174   Arg [2]    : (optional) integer
00175                If not 0, will print out all information.
00176 
00177   Arg [3]    : (optional) integer
00178                If not 0, the database connection will not be
00179                cleared, if 0 or if not set the database connections
00180                will be cleared (this is the default).
00181 
00182   Arg [4]:     (optional) boolean
00183                This option will turn off caching for slice features,
00184                so, every time a set of features is retrieved,
00185                they will come from the database instead of the
00186                cache.  This option is only recommended for advanced
00187                users, specially if you need to store and retrieve
00188                features.  It might reduce performance when querying
00189                the database if not used properly.  If in doubt, do
00190                not use it or ask in the developer mailing list.
00191 
00192   Example    : Bio::EnsEMBL::Registry->load_all();
00193   Returntype : Int count of the DBAdaptor instances which can be found in the 
00194                registry
00195   Exceptions : none
00196   Status     : Stable
00197 
00198 =cut
00199 
00200 sub load_all {
00201     my ($class, $config_file, $verbose, $no_clear, $no_cache ) = @_;
00202 
00203     if ( !defined($config_file) ) {
00204       if ( defined( $ENV{ENSEMBL_REGISTRY} ) ) {
00205         $config_file = $ENV{ENSEMBL_REGISTRY};
00206       } elsif ( defined( $ENV{HOME} ) ) {
00207         $config_file = $ENV{HOME} . "/.ensembl_init";
00208       }
00209     }
00210 
00211     $verbose  ||= 0;
00212     $no_clear ||= 0;
00213     $no_cache ||= 0;
00214     
00215     my $original_count = $class->get_DBAdaptor_count();
00216 
00217     if ( !defined($config_file) ) {
00218         if ($verbose) {
00219             print( STDERR
00220                    "No default registry configuration to load.\n" );
00221         }
00222     } elsif ( !-e $config_file ) {
00223         if ($verbose) {
00224             printf( STDERR "Configuration file '%s' does not exist. "
00225                       . "Registry configuration not loaded.\n",
00226                     $config_file );
00227         }
00228     } else {
00229         if ( defined( $registry_register{'seen'} ) ) {
00230             if ( !$no_clear ) {
00231                 if ($verbose) {
00232                     print( STDERR "Clearing previously loaded "
00233                            . "registry configuration\n" );
00234                 }
00235                 $class->clear();
00236             }
00237         }
00238         $registry_register{'seen'} = 1;
00239 
00240         if ($verbose) {
00241             printf( STDERR
00242                       "Loading registry configuration from '%s'.\n",
00243                     $config_file );
00244         }
00245 
00246         my $cfg;
00247 
00248         my $test_eval = eval { require Config::IniFiles };
00249 
00250         if ($@ or (!$test_eval)) {
00251           # The user does not have the 'Config::IniFiles' module.
00252           if ($verbose) {
00253             print( STDERR "No Config::IniFiles module found, "
00254                    . "assuming this is not an ini-file\n" );
00255           }
00256           # If the configuration file *is* an ini-file, we can expect a
00257           # load of compilation errors from the next eval...
00258         } else {
00259           # The user has the 'Config::IniFiles' module installed.  See
00260           # if this is an ini-file or not...
00261           $cfg = Config::IniFiles->new( -file => $config_file );
00262         }
00263 
00264         if ( defined $cfg ) {
00265                   my %default_adaptor_args = ();
00266 
00267             if ( $cfg->SectionExists('default') ) {
00268                 # The 'default' section is special.  It contain default
00269                 # values that should be implicit to all other section in
00270                 # this configuration file.  Aliases are added if there
00271                 # is also a 'species' setting.
00272 
00273                 my $alias = $cfg->val( 'default', 'alias' );
00274                 $cfg->delval( 'default', 'alias' );
00275 
00276                 my $species = $cfg->val( 'default', 'species' );
00277 
00278                 if ( defined($alias) && defined($species) ) {
00279                     Bio::EnsEMBL::Utils::ConfigRegistry->add_alias(
00280                                      -species => $species,
00281                                      -alias => [ split( /\n/, $alias ) ]
00282                     );
00283                 }
00284 
00285                 %default_adaptor_args =
00286                   map { '-' . $_ => $cfg->val( 'default', $_ ) }
00287                   $cfg->Parameters('default');
00288             }
00289 
00290             foreach my $section ( $cfg->Sections() ) {
00291                 if ( $section eq 'default' )
00292                 {    # We have already done the 'default' section.
00293                     next;
00294                 }
00295 
00296                 my $group = $cfg->val( $section, 'group' )
00297                   || $cfg->val( 'default', 'group' );
00298 
00299                 if ( !defined($group) ) {
00300                     printf( STDERR "Key 'group' is undefined "
00301                               . "for configuration section '%s', "
00302                               . "skipping this section.\n",
00303                             $section );
00304                     next;
00305                 }
00306 
00307                 my $adaptor = $group2adaptor{ lc($group) };
00308                 if ( !defined($adaptor) ) {
00309                     printf( STDERR "Unknown group '%s' "
00310                               . "for configuration section '%s', "
00311                               . "skipping this section.\n",
00312                             $group, $section );
00313                     next;
00314                 }
00315 
00316                 # Handle aliases.  A section must have both an 'alias'
00317                 # setting and a 'species' setting for aliases to be
00318                 # added.  The 'species' setting might be inherited from
00319                 # the 'default' section.
00320 
00321                 my $alias = $cfg->val( $section, 'alias' );
00322                 $cfg->delval( $section, 'alias' );
00323 
00324                 my $species = $cfg->val( $section, 'species' )
00325                   || $cfg->val( 'default', 'species' );
00326 
00327                 if ( defined($alias) && defined($species) ) {
00328                     Bio::EnsEMBL::Utils::ConfigRegistry->add_alias(
00329                                      -species => $species,
00330                                      -alias => [ split( /\n/, $alias ) ]
00331                     );
00332                 }
00333 
00334                 # Fill in the adaptor initialization arguments.
00335                 # We trust the user to provide sensible key-value pairs.
00336                 my %adaptor_args = %default_adaptor_args;
00337                 foreach my $parameter ( $cfg->Parameters($section) ) {
00338                   $adaptor_args{ '-' . $parameter } =
00339                     $cfg->val( $section, $parameter );
00340 
00341                   # when set, do not use the feature cache in the
00342                   # different adaptors
00343                   if ($no_cache) {
00344                     $adaptor_args{'-no_cache'} = 1;
00345                   }
00346                 }
00347 
00348                 if ($verbose) {
00349                     printf( "Configuring adaptor '%s' "
00350                               . "for configuration section '%s'...\n",
00351                             $adaptor, $section );
00352                 }
00353 
00354                 my $test_eval = eval "require $adaptor";
00355                 if ($@ or (!$test_eval)) { die($@) }
00356 
00357                 $adaptor->new(%adaptor_args);
00358 
00359             } ## end foreach my $section ( $cfg->Sections...
00360         } else {
00361             # This is probably no ini-file but an old style piece
00362             # of configuration written in Perl.  We need to try to
00363             # require() it.
00364 
00365             my $test_eval = eval { require($config_file) };
00366             if ($@ or (!$test_eval)) { die($@) }
00367 
00368             # To make the web code avoid doing this again:
00369             delete $INC{$config_file};
00370         }
00371     } ## end else [ if ( !defined($config_file...
00372     
00373     return $class->get_DBAdaptor_count() - $original_count;
00374 } ## end sub load_all
00375 
00376 =head2 clear
00377 
00378  Will clear the registry and disconnect from all databases.
00379 
00380   Example    : Bio::EnsEMBL::Registry->clear();
00381   Returntype : none
00382   Exceptions : none
00383   Status     : Stable
00384 
00385 =cut
00386 
00387 sub clear{
00388   my ($self);
00389   
00390   foreach my $dba (@{$registry_register{'_DBA'}}){
00391     if($dba->dbc->connected){
00392       $dba->dbc->db_handle->disconnect();
00393     }
00394   }
00395   %registry_register = ();
00396   return;
00397 }
00398 
00399 #
00400 # db adaptors. (for backwards compatibility)
00401 #
00402 
00403 =head2 add_db
00404 
00405   Arg [1]    : db (DBAdaptor) to add adaptor to.
00406   Arg [2]    : name of the name to add the adaptor to in the registry.
00407   Arg [3]    : The adaptor to be added to the registry.
00408   Example    : Bio::EnsEMBL::Registry->add_db($db, "lite", $dba);
00409   Returntype : none
00410   Exceptions : none
00411   Status     : At Risk.
00412              : This is here for backwards compatibility only and may
00413              : be removed eventually.  Solution is to make sure the
00414              : db and the adaptor have the same species and the call
00415              : is then no longer needed.
00416 
00417 =cut
00418 
00419 sub add_db {
00420   my ( $class, $db, $name, $adap ) = @_;
00421 
00422   if ( lc( $db->species() ) ne lc( $adap->species ) ) {
00423     $registry_register{_SPECIES}{ lc( $db->species() ) }
00424       { lc( $db->group() ) }{'_special'}{ lc($name) } = $adap;
00425   }
00426   return;
00427 }
00428 
00429 =head2 remove_db
00430 
00431   Arg [1]    : db (DBAdaptor) to remove adaptor from.
00432   Arg [2]    : name to remove the adaptor from in the registry.
00433   Example    : my $db = Bio::EnsEMBL::Registry->remove_db($db, "lite");
00434   Returntype : adaptor
00435   Exceptions : none
00436   Status     : At Risk.
00437              : This is here for backwards compatibility only and may
00438              : be removed eventually.  Solution is to make sure the
00439              : db and the adaptor have the same species and the call
00440              : is then no longer needed.
00441 
00442 =cut
00443 
00444 sub remove_db {
00445   my ( $class, $db, $name ) = @_;
00446 
00447   my $ret =
00448     $registry_register{_SPECIES}{ lc( $db->species() ) }
00449     { lc( $db->group() ) }{'_special'}{ lc($name) };
00450 
00451   $registry_register{_SPECIES}{ lc( $db->species() ) }
00452     { lc( $db->group() ) }{'_special'}{ lc($name) } = undef;
00453 
00454   return $ret;
00455 }
00456 
00457 =head2 get_db
00458 
00459   Arg [1]    : db (DBAdaptor) to get adaptor from.
00460   Arg [2]    : name to get the adaptor for in the registry.
00461   Example    : my $db = Bio::EnsEMBL::Registry->get_db("Human", "core", "lite");
00462   Returntype : adaptor
00463   Exceptions : See get_DBAdaptor()
00464   Status     : At Risk.
00465              : This is here for backwards compatibility only and may
00466              : be removed eventually.  Solution is to make sure the
00467              : db and the adaptor have the same species then call
00468              : get_DBAdaptor instead.
00469 
00470 =cut
00471 
00472 sub get_db {
00473   my ( $class, $db, $name ) = @_;
00474 
00475   my $ret = Bio::EnsEMBL::Registry->get_DBAdaptor( lc( $db->species ),
00476     lc($name) );
00477 
00478   if ( defined($ret) ) { return $ret }
00479 
00480   return $registry_register{_SPECIES}{ lc( $db->species() ) }
00481     { lc( $db->group() ) }{'_special'}{ lc($name) };
00482 }
00483 
00484 =head2 get_all_db_adaptors
00485 
00486   Arg [1]    : db (DBAdaptor) to get all the adaptors from.
00487   Example    : my $db = Bio::EnsEMBL::Registry->get_all_db_adaptors($db);
00488   Returntype : adaptor
00489   Exceptions : none
00490   Status     : At Risk.
00491              : This is here for backwards compatibility only and
00492              : may be removed eventually.  Solution is to make
00493              : sure the dbs all have the same species then call
00494              : get_all_DBAdaptors(-species => "human");
00495 
00496 
00497 =cut
00498 
00499 sub get_all_db_adaptors {
00500   my ( $class, $db ) = @_;
00501   my %ret = ();
00502 
00503   # we now also want to add all the DBAdaptors for the same species.
00504   # as add_db_adaptor does not add if it is from the same species.
00505 
00506   foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
00507     if ( lc( $dba->species() ) eq lc( $db->species() ) ) {
00508       $ret{ $dba->group() } = $dba;
00509     }
00510   }
00511 
00512   foreach my $key (
00513     keys %{
00514       $registry_register{_SPECIES}
00515         { $class->get_alias( $db->species() ) }{ lc( $db->group() ) }
00516         {'_special'} } )
00517   {
00518     $ret{$key} =
00519       $registry_register{_SPECIES}
00520       { $class->get_alias( $db->species() ) }{ lc( $db->group() ) }
00521       {'_special'}{$key};
00522   }
00523 
00524   return \%ret;
00525 } ## end sub get_all_db_adaptors
00526 
00527 
00528 #
00529 # DBAdaptors
00530 #
00531 
00532 =head2 add_DBAdaptor
00533 
00534   Arg [1]    : name of the species to add the adaptor to in the registry.
00535   Arg [2]    : name of the group to add the adaptor to in the registry.
00536   Arg [3]    : The DBAaptor to be added to the registry.
00537   Example    : Bio::EnsEMBL::Registry->add_DBAdaptor("Human", "core", $dba);
00538   Returntype : none
00539   Exceptions : none
00540   caller     : internal
00541   Status     : Stable
00542 
00543 =cut
00544 
00545 sub add_DBAdaptor {
00546   my ( $class, $species, $group, $adap ) = @_;
00547 
00548   if ( !( $class->alias_exists($species) ) ) {
00549     $class->add_alias( $species, $species );
00550   }
00551 
00552   $species = $class->get_alias($species);
00553 
00554   $registry_register{_SPECIES}{$species}{ lc($group) }{'_DB'} = $adap;
00555 
00556   if ( !defined( $registry_register{'_DBA'} ) ) {
00557     $registry_register{'_DBA'} = [$adap];
00558   } else {
00559     push( @{ $registry_register{'_DBA'} }, $adap );
00560   }
00561   return;
00562 }
00563 
00564 
00565 
00566 =head2 get_DBAdaptor
00567 
00568   Arg [1]    : name of the species to get the adaptor for in the registry.
00569   Arg [2]    : name of the group to get the adaptor for in the registry.
00570   Arg [3]    : if set will not give warnings when looking for alias.
00571   Example    : $dba = Bio::EnsEMBL::Registry->get_DBAdaptor("Human", "core");
00572   Returntype : DBAdaptor
00573   Exceptions : If $species is not defined and if no valid internal name 
00574                could be found for $species. If thrown check your API and DB
00575                version 
00576   Status     : Stable
00577 
00578 =cut
00579 
00580 sub get_DBAdaptor {
00581   my ( $class, $species, $group, $no_alias_check ) = @_;
00582 
00583   if ( !defined($species) ) {
00584     throw('Species not defined.');
00585   }
00586 
00587   my $ispecies = $class->get_alias( $species, $no_alias_check );
00588 
00589   if ( !defined($ispecies) ) {
00590     if(! $no_alias_check) {
00591       throw("Can not find internal name for species '$species'");
00592     }
00593   }
00594   else { $species = $ispecies }
00595 
00596   return $registry_register{_SPECIES}{$species}{ lc($group) }{'_DB'};
00597 }
00598 
00599 =head2 get_all_DBAdaptors
00600 
00601   Arg [SPECIES]: (optional) string 
00602                   species name to get adaptors for
00603   Arg [GROUP]  : (optional) string 
00604                   group name to get adaptors for
00605   Example      : 
00606                 @dba =
00607                   @{ Bio::EnsEMBL::Registry->get_all_DBAdaptors() };
00608 
00609                 @human_dbas =
00610                   @{ Bio::EnsEMBL::Registry->get_all_DBAdaptors(
00611                     -species => 'human'
00612                   ) };
00613 
00614   Returntype   : list of DBAdaptors
00615   Exceptions   : none
00616   Status       : Stable
00617 
00618 =cut
00619 
00620 sub get_all_DBAdaptors {
00621   my ( $class, @args ) = @_;
00622 
00623   my ( $species, $group ) = rearrange( [qw(SPECIES GROUP)], @args );
00624 
00625   if ( defined($species) ) { $species = $class->get_alias($species) }
00626 
00627   my @ret;
00628   foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
00629     if ( ( !defined($species) || lc($species) eq lc( $dba->species() ) )
00630       && ( !defined($group) || lc($group) eq lc( $dba->group() ) ) )
00631     {
00632       push( @ret, $dba );
00633     }
00634   }
00635 
00636   return \@ret;
00637 }
00638 
00639 =head2 get_all_DBAdaptors_by_connection
00640 
00641   Arg [1]    : DBConnection used to find DBAdaptors
00642   Returntype : reference to list of DBAdaptors
00643   Exceptions : none
00644   Example    : @dba = @{ Bio::EnsEMBL::Registry
00645                   ->get_all_DBAdaptors_by_connection($dbc) };
00646   Status     : Stable
00647 
00648 =cut
00649 
00650 sub get_all_DBAdaptors_by_connection {
00651   my ( $self, $dbc_orig ) = @_;
00652 
00653   my @return;
00654 
00655   foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
00656     my $dbc = $dba->dbc();
00657 
00658     if (    defined($dbc)
00659          && $dbc->can('equals')
00660          && $dbc->equals($dbc_orig) )
00661     {
00662       push( @return, $dba );
00663     }
00664   }
00665 
00666   return \@return;
00667 }
00668 
00669 =head2 get_all_DBAdaptors_by_dbname
00670 
00671   Arg [1]    : string, name of database
00672   Returntype : reference to list of DBAdaptors
00673   Exceptions : none
00674   Example    : @dba = @{ Bio::EnsEMBL::Registry
00675                   ->get_all_DBAdaptors_by_dbname($dbname) };
00676   Status     : Stable
00677 
00678 =cut
00679 
00680 sub get_all_DBAdaptors_by_dbname {
00681   my ( $self, $dbname ) = @_;
00682 
00683   my @return;
00684 
00685   foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
00686     my $dbc = $dba->dbc();
00687 
00688     if ( defined($dbc) && $dbc->dbname() eq $dbname ) {
00689       push( @return, $dba );
00690     }
00691   }
00692 
00693   return \@return;
00694 }
00695 
00696 =head2 remove_DBAdaptor
00697 
00698   Arg [1]    : name of the species to get the adaptor for in the registry.
00699   Arg [2]    : name of the group to get the adaptor for in the registry.
00700   Example    : $dba = Bio::EnsEMBL::Registry->remove_DBAdaptor("Human", "core");
00701   Returntype : none
00702   Exceptions : none
00703   Status     : At risk
00704 
00705 =cut
00706 
00707 sub remove_DBAdaptor {
00708   my ( $class, $species, $group ) = @_;
00709 
00710   $species = $class->get_alias($species);
00711 
00712   delete $registry_register{_SPECIES}{$species}{$group};
00713   # This will remove the DBAdaptor and all the other adaptors
00714 
00715   # Now remove if from the _DBA array
00716   my $index;
00717 
00718   foreach my $i ( 0 .. $#{ $registry_register{'_DBA'} } ) {
00719     my $dba = $registry_register{'_DBA'}->[$i];
00720 
00721     if ( ( $dba->species eq $species )
00722       && $dba->group eq $group )
00723     {
00724       $index = $i;
00725       last;
00726     }
00727   }
00728 
00729   # Now remove from _DBA cache
00730   if ( defined($index) ) {
00731     splice( @{ $registry_register{'_DBA'} }, $index, 1 );
00732   }
00733 
00734   return;
00735 } ## end sub remove_DBAdaptor
00736 
00737 
00738 
00739 =head2 reset_DBAdaptor
00740 
00741   Arg [1]:     string - species e.g. homo_sapiens
00742   Arg [2]:     string - DB group e.g. core
00743   Arg [3]:     string - new dbname
00744   Args [4-7]:  string - optional DB parameters, defaults to current db params if omitted
00745   Arg [8]:     hashref - Hash ref of additional parameters e.g. eFG dnadb params for auto selecting dnadb
00746   Usage :      $reg->reset_registry_db( 'homo_sapiens', 'core',
00747                   'homo_sapiens_core_37_35j' );
00748   Description: Resets a DB within the registry.
00749   Exceptions:  Throws if mandatory params not supplied
00750                Throws if species name is not already seen by the registry
00751                Throws if no current DB for species/group available
00752   Status :     At risk
00753 
00754 =cut
00755 
00756 sub reset_DBAdaptor {
00757   my (
00758     $self, $species, $group, $dbname, $host,
00759     $port, $user,    $pass,  $params
00760   ) = @_;
00761 
00762   # Check mandatory params
00763   if ( !( defined $species && defined $group && defined $dbname ) ) {
00764     throw(
00765       'Must provide at least a species, group, and dbname parameter '
00766         . 'to redefine a DB in the registry' );
00767   }
00768 
00769   # Validate species here
00770   my $alias = $self->get_alias($species);
00771   throw("Could not find registry alias for species:\t$species")
00772     if ( !defined $alias );
00773 
00774   # Get all current defaults if not defined
00775 
00776   my $db = $self->get_DBAdaptor( $alias, $group );
00777   my $class;
00778 
00779   if ($db) {
00780     $class = ref($db);
00781     $host ||= $db->dbc->host;
00782     $port ||= $db->dbc->port;
00783     $user ||= $db->dbc->username;
00784     $pass ||= $db->dbc->password;
00785   } else {
00786     #Now we need to test mandatory params
00787     $class = $group2adaptor{ lc($group) };
00788 
00789     if ( !( $host && $user ) ) {
00790       throw("No comparable $alias $group DB present in Registry. "
00791           . "You must pass at least a dbhost and dbuser" );
00792     }
00793   }
00794 
00795   $self->remove_DBAdaptor( $alias, $group );
00796 
00797   # ConfigRegistry should automatically add this to the Registry
00798   $db = $class->new(
00799     -user    => $user,
00800     -host    => $host,
00801     -port    => $port,
00802     -pass    => $pass,
00803     -dbname  => $dbname,
00804     -species => $alias,
00805     -group   => $group,
00806     %{$params} );
00807 
00808   return $db;
00809 } ## end sub reset_DBAdaptor
00810 
00811 
00812 #
00813 # DNA Adaptors
00814 #
00815 
00816 =head2 add_DNAAdaptor
00817 
00818   Arg [1]    : name of the species to add the adaptor to in the registry.
00819   Arg [2]    : name of the group to add the adaptor to in the registry.
00820   Arg [3]    : name of the species to get the dna from
00821   Arg [4]    : name of the group to get the dna from
00822   Example    : Bio::EnsEMBL::Registry->add_DNAAdaptor("Human", "estgene", "Human", "core");
00823   Returntype : none
00824   Exceptions : none
00825   Status     : Stable
00826 
00827 =cut
00828 
00829 sub add_DNAAdaptor {
00830   my ( $class, $species, $group, $dnadb_species, $dnadb_group ) = @_;
00831 
00832   $species       = $class->get_alias($species);
00833   $dnadb_species = $class->get_alias($dnadb_species);
00834   if ( $dnadb_group->isa('Bio::EnsEMBL::DBSQL::DBAdaptor') ) {
00835     deprecated("");
00836   } else {
00837     $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA'} =
00838       $dnadb_group;
00839     $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA2'} =
00840       $dnadb_species;
00841   }
00842   return;
00843 }
00844 
00845 =head2 get_DNAAdaptor
00846 
00847   Arg [1]    : name of the species to get the adaptor for in the registry.
00848   Arg [2]    : name of the group to get the adaptor for in the registry.
00849   Example    : $dnaAdap = Bio::EnsEMBL::Registry->get_DNAAdaptor("Human", "core");
00850   Returntype : adaptor
00851   Exceptions : none
00852   Status     : Stable
00853 
00854 =cut
00855 
00856 sub get_DNAAdaptor {
00857   my ( $class, $species, $group ) = @_;
00858 
00859   $species = $class->get_alias($species);
00860   my $new_group =
00861     $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA'};
00862   my $new_species =
00863     $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA2'};
00864 
00865   if ( defined $new_group ) {
00866     return $class->get_DBAdaptor( $new_species, $new_group );
00867   }
00868 
00869   return;
00870 }
00871 
00872 #
00873 # General Adaptors
00874 #
00875 
00876 =head2 add_adaptor
00877 
00878   Arg [1]    : name of the species to add the adaptor to in the registry.
00879   Arg [2]    : name of the group to add the adaptor to in the registry.
00880   Arg [3]    : name of the type to add the adaptor to in the registry.
00881   Arg [4]    : The DBAaptor to be added to the registry.
00882   Arg [5]    : (optional) if set okay to overwrite.
00883   Example    : Bio::EnsEMBL::Registry->add_adaptor("Human", "core", "Gene", $adap);
00884   Returntype : none
00885   Exceptions : none
00886   Caller     : internal
00887   Status     : Stable
00888 
00889 =cut
00890 
00891 sub add_adaptor {
00892   my ( $class, $species, $group, $type, $adap, $reset ) = @_;
00893 
00894   $species = $class->get_alias($species);
00895 
00896   # Since the adaptors are not stored initially, only their class paths
00897   # when the adaptors are obtained, we need to store these instead.  It
00898   # is not necessarily an error if the registry is overwritten without
00899   # the reset set but it is an indication that we are overwriting a
00900   # database which should be a warning for now
00901 
00902   if ( defined($reset) )
00903   {    # JUST REST THE HASH VALUE NO MORE PROCESSING NEEDED
00904     $registry_register{_SPECIES}{$species}{ lc($group) }{ lc($type) } =
00905       $adap;
00906     return;
00907   }
00908 
00909   if (
00910     defined(
00911       $registry_register{_SPECIES}{$species}{ lc($group) }{ lc($type) }
00912     ) )
00913   {
00914   # print STDERR (
00915   #      "Overwriting Adaptor in Registry for $species $group $type\n");
00916     $registry_register{_SPECIES}{$species}{ lc($group) }{ lc($type) } =
00917       $adap;
00918     return;
00919   }
00920   $registry_register{_SPECIES}{$species}{ lc($group) }{ lc($type) } =
00921     $adap;
00922 
00923   if ( !defined( $registry_register{_SPECIES}{$species}{'list'} ) ) {
00924     $registry_register{_SPECIES}{$species}{'list'} = [$type];
00925   } else {
00926     push( @{ $registry_register{_SPECIES}{$species}{'list'} }, $type );
00927   }
00928 
00929   if ( !defined( $registry_register{_TYPE}{ lc($type) }{$species} ) ) {
00930     $registry_register{_TYPE}{ lc($type) }{$species} = [$type];
00931   } else {
00932     push( @{ $registry_register{_TYPE}{ lc($type) }{$species} },
00933       $adap );
00934   }
00935   return;
00936 } ## end sub add_adaptor
00937 
00938 
00939 =head2 get_adaptor
00940 
00941   Arg [1]    : name of the species to add the adaptor to in the registry.
00942   Arg [2]    : name of the group to add the adaptor to in the registry.
00943   Arg [3]    : name of the type to add the adaptor to in the registry.
00944   Example    : $adap = Bio::EnsEMBL::Registry->get_adaptor("Human", "core", "Gene");
00945   Returntype : adaptor
00946   Exceptions : Thrown if a valid internal name cannot be found for the given 
00947                name. If thrown check your API and DB version.
00948   Status     : Stable
00949 
00950 =cut
00951 
00952 sub get_adaptor {
00953   my ( $class, $species, $group, $type ) = @_;
00954 
00955   my $ispecies = $class->get_alias($species);
00956 
00957   if ( !defined($ispecies) ) {
00958     throw("Can not find internal name for species '$species'");
00959   }
00960   else { $species = $ispecies }
00961 
00962   my %dnadb_adaptors = (
00963     'sequence'                 => 1,
00964     'assemblymapper'           => 1,
00965     'karyotypeband'            => 1,
00966     'repeatfeature'            => 1,
00967     'coordsystem'              => 1,
00968     'assemblyexceptionfeature' => 1
00969   );
00970 
00971   # warn "$species, $group, $type";
00972 
00973   $type = lc($type);
00974 
00975   # For historical reasons, allow use of group 'regulation' to refer to
00976   # group 'funcgen'.
00977   if ( lc($group) eq 'regulation' ) { $group = 'funcgen' }
00978 
00979   my $dnadb_group =
00980     $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA'};
00981 
00982   if ( defined($dnadb_group)
00983     && defined( $dnadb_adaptors{ lc($type) } ) )
00984   {
00985     $species =
00986       $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA2'};
00987     $group = $dnadb_group;
00988   }
00989 
00990   my $ret =
00991     $registry_register{_SPECIES}{$species}{ lc($group) }{ lc($type) };
00992 
00993   if ( !defined($ret) ) { return }
00994   if ( ref($ret) )      { return $ret }
00995 
00996   # Not instantiated yet
00997 
00998   my $dba = $registry_register{_SPECIES}{$species}{ lc($group) }{'_DB'};
00999   my $module = $ret;
01000 
01001   my $test_eval = eval "require $module";
01002   if ($@ or (!$test_eval)) {
01003     warning("'$module' cannot be found.\nException $@\n");
01004     return;
01005   }
01006 
01007   if (
01008     !defined(
01009       $registry_register{_SPECIES}{$species}{ lc($group) }{'CHECKED'} )
01010     )
01011   {
01012     $registry_register{_SPECIES}{$species}{ lc($group) }{'CHECKED'} = 1;
01013     $class->version_check($dba);
01014   }
01015 
01016   my $adap = "$module"->new($dba);
01017   Bio::EnsEMBL::Registry->add_adaptor( $species, $group, $type, $adap,
01018                                        'reset' );
01019   $ret = $adap;
01020 
01021   return $ret;
01022 } ## end sub get_adaptor
01023 
01024 =head2 get_all_adaptors
01025 
01026   Arg [SPECIES] : (optional) string 
01027                   species name to get adaptors for
01028   Arg [GROUP] : (optional) string 
01029                   group name to get adaptors for
01030   Arg [TYPE] : (optional) string 
01031                   type to get adaptors for
01032   Example    : @adaps = @{Bio::EnsEMBL::Registry->get_all_adaptors()};
01033   Returntype : ref to list of adaptors
01034   Exceptions : none
01035   Status     : Stable
01036 
01037 =cut
01038 
01039 sub get_all_adaptors{
01040   my ($class,@args)= @_;
01041   my ($species, $group, $type);
01042   my @ret=();
01043   my (%species_hash, %group_hash, %type_hash);
01044 
01045 
01046   if(@args == 1){ # Old species only one parameter
01047     warn("-SPECIES argument should now be used to get species adaptors");
01048     $species = $args[0];
01049   }
01050   else{
01051     # new style -SPECIES, -GROUP, -TYPE
01052     ($species, $group, $type) =
01053       rearrange([qw(SPECIES GROUP TYPE)], @args);
01054   }
01055 
01056   if(defined($species)){
01057     $species_hash{$species} = 1;
01058   }
01059   else{
01060     # get list of species
01061     foreach my $dba (@{$registry_register{'_DBA'}}){
01062       $species_hash{lc($dba->species())} = 1;
01063     }
01064   }
01065   if(defined($group)){
01066     $group_hash{$group} = 1;
01067   }
01068   else{
01069     foreach my $dba (@{$registry_register{'_DBA'}}){
01070       $group_hash{lc($dba->group())} = 1;
01071     }
01072   }
01073 
01074   if ( defined($type) ) {
01075     $type_hash{$type} = 1;
01076   } else {
01077     foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
01078       foreach my $ty (
01079         @{ $registry_register{_SPECIES}{ lc( $dba->species ) }{'list'} }
01080         )
01081       {
01082         $type_hash{ lc($ty) } = 1;
01083       }
01084     }
01085   }
01086 
01087   ### NOW NEED TO INSTANTIATE BY CALLING get_adaptor
01088   foreach my $sp ( keys %species_hash ) {
01089     foreach my $gr ( keys %group_hash ) {
01090       foreach my $ty ( keys %type_hash ) {
01091         my $temp = $class->get_adaptor( $sp, $gr, $ty );
01092         if ( defined($temp) ) {
01093           push @ret, $temp;
01094         }
01095       }
01096     }
01097   }
01098 
01099   return (\@ret);
01100 }
01101 
01102 
01103 =head2 add_alias
01104 
01105   Arg [1]    : name of the species to add alias for
01106   Arg [2]    : name of the alias
01107   Example    : Bio::EnsEMBL::Registry->add_alias("Homo Sapiens","Human");
01108   Description: add alternative name for the species.
01109   Returntype : none
01110   Exceptions : none
01111   Status     : Stable
01112 
01113 =cut
01114 
01115 sub add_alias{
01116   my ($class, $species,$key) = @_;
01117 
01118   $registry_register{'_ALIAS'}{lc($key)} = lc($species);
01119   return;
01120 }
01121 
01122 =head2 remove_alias
01123 
01124   Arg [1]    : name of the species to remove alias for
01125   Arg [2]    : name of the alias
01126   Example    : Bio::EnsEMBL::Registry->remove_alias("Homo Sapiens","Human");
01127   Description: remove alternative name for the species.
01128   Returntype : none
01129   Exceptions : none
01130   Status     : Stable
01131 
01132 =cut
01133 
01134 sub remove_alias{
01135   my ($class, $species,$key) = @_;
01136 
01137   delete $registry_register{'_ALIAS'}{lc($key)};
01138   return;
01139 }
01140 
01141 
01142 
01143 =head2 get_alias
01144 
01145   Arg [1]    : name of the possible alias to get species for
01146   Example    : Bio::EnsEMBL::Registry->get_alias("Human");
01147   Description: get proper species name.
01148   Returntype : species name
01149   Exceptions : none
01150   Status     : Stable
01151 
01152 =cut
01153 
01154 sub get_alias {
01155   my ( $class, $key, $no_warn ) = @_;
01156 
01157   if ( !defined( $registry_register{'_ALIAS'}{ lc($key) } ) ) {
01158     if ( ( !defined( $registry_register{_SPECIES}{ lc($key) } ) ) and
01159          ( !defined( $registry_register{_ALIAS}{ lc($key) } ) ) )
01160     {
01161       if ( ( !defined($no_warn) ) or ( !$no_warn ) ) {
01162         warning( "$key is not a valid species name " .
01163                  "(check DB and API version)" );
01164       }
01165       return;
01166     }
01167     else { return $key }
01168   }
01169 
01170   return $registry_register{'_ALIAS'}{ lc($key) };
01171 }
01172 
01173 =head2 get_all_aliases
01174 
01175   Arg [1]    : Species name to retrieve aliases for
01176                (may be an alias as well).
01177   Example    : Bio::EnsEMBL::Registry->get_all_aliases('Homo sapiens');
01178   Description: Returns all known aliases for a given species (but not the
01179                species name/alias that was given).
01180   Returntype : ArrayRef of all known aliases
01181   Exceptions : none
01182   Status     : Development
01183 
01184 =cut
01185 
01186 sub get_all_aliases {
01187   my ( $class, $key ) = @_;
01188 
01189   my $species = $registry_register{_ALIAS}{ lc($key) };
01190 
01191   my @aliases;
01192   if ( defined($species) ) {
01193     foreach my $alias ( keys( %{ $registry_register{_ALIAS} } ) ) {
01194       if ( $species ne $alias
01195         && $species eq $registry_register{_ALIAS}{ lc($alias) } )
01196       {
01197         push( @aliases, $alias );
01198       }
01199     }
01200   }
01201 
01202   return \@aliases;
01203 }
01204 
01205 =head2 alias_exists
01206 
01207   Arg [1]    : name of the possible alias to get species for
01208   Example    : Bio::EnsEMBL::Registry->alias_exists("Human");
01209   Description: does the species name exist.
01210   Returntype : 1 if exists else 0
01211   Exceptions : none
01212   Status     : Stable
01213 
01214 =cut
01215 
01216 sub alias_exists {
01217   my ( $class, $key ) = @_;
01218 
01219   return defined( $registry_register{'_ALIAS'}{ lc($key) } );
01220 }
01221 
01222 =head2 set_disconnect_when_inactive
01223 
01224   Example    : Bio::EnsEMBL::Registry->set_disconnect_when_inactive();
01225   Description: Set the flag to make sure that the database connection is dropped if
01226                not being used on each database.
01227   Returntype : none
01228   Exceptions : none
01229   Status     : Stable
01230 
01231 =cut
01232 
01233 sub set_disconnect_when_inactive{
01234   foreach my $dba ( @{get_all_DBAdaptors()}){
01235     my $dbc = $dba->dbc;
01236     # Disconnect if connected
01237     $dbc->disconnect_if_idle() if $dbc->connected();
01238     $dbc->disconnect_when_inactive(1);
01239   }
01240   return;
01241 }
01242 
01243 =head2 set_reconnect_when_lost
01244 
01245   Example    : Bio::EnsEMBL::Registry->set_reconnect_when_lost();
01246   Description: Set the flag to make sure that the database connection is not lost before it's used.
01247                This is useful for long running jobs (over 8hrs).
01248   Returntype : none
01249   Exceptions : none
01250   Status     : Stable
01251 
01252 =cut
01253 
01254 sub set_reconnect_when_lost{
01255   foreach my $dba ( @{get_all_DBAdaptors()}){
01256     my $dbc = $dba->dbc;
01257     $dbc->reconnect_when_lost(1);
01258   }
01259   return;
01260 }
01261 
01262 =head2 disconnect_all
01263 
01264   Example    : Bio::EnsEMBL::Registry->disconnect_all();
01265   Description: disconnect from all the databases.
01266   Returntype : none
01267   Exceptions : none
01268   Status     : Stable
01269 
01270 =cut
01271 
01272 sub disconnect_all {
01273   foreach my $dba ( @{get_all_DBAdaptors()||[]} ){
01274     my $dbc = $dba->dbc;
01275     next unless $dbc;
01276     # Disconnect if connected
01277     $dbc->disconnect_if_idle() if $dbc->connected();
01278   }
01279   return;
01280 }
01281 
01282 =head get_DBAdaptor_count
01283 
01284   Example     : Bio::EnsEMBL::Registry->get_DBAdaptor_count();
01285   Description : Returns the count of database adaptors currently held by 
01286                 the registry
01287   Returntype  : Int count of database adaptors currently known
01288   Exceptions  : None
01289  
01290 =cut
01291 
01292 sub get_DBAdaptor_count {
01293   return scalar(@{$registry_register{'_DBA'}}) if(defined $registry_register{'_DBA'});
01294   return 0;
01295 }
01296 
01297 =head2 change_access
01298 
01299   Will change the username and password for a set of databases.
01300   if host,user or database names are missing then these are not checked.
01301   So for example if you do not specify a database then ALL databases on
01302   the specified  host and port will be changed.
01303 
01304   Arg [1]    : name of the host to change access on
01305   Arg [2]    : port number to change access on
01306   Arg [3]    : name of the user to change access on
01307   Arg [4]    : name of the database to change access on
01308   Arg [5]    : name of the new user
01309   Arg [6]    : new password
01310 
01311   Example    : Bio::EnsEMBL::Registry->get_alias("Human");
01312   Description: change username and password on one or more databases
01313   Returntype : none
01314   Exceptions : none
01315   Status     : Stable
01316 
01317 =cut
01318 
01319 sub change_access{
01320   my ($self, $host,$port,$user,$dbname,$new_user,$new_pass) = @_;
01321   foreach my $dba ( @{$registry_register{'_DBA'}}){
01322     my $dbc = $dba->dbc;
01323     if((((!defined($host)) or ($host eq $dbc->host))) and
01324        (((!defined($port)) or ($port eq $dbc->port))) and
01325        (((!defined($user)) or ($user eq $dbc->username))) and
01326        ((!defined($dbname)) or ($dbname eq $dbc->dbname))){
01327       if($dbc->connected()){
01328         $dbc->db_handle->disconnect();
01329         $dbc->connected(undef);
01330       }
01331       # over write the username and password
01332       $dbc->username($new_user);
01333       $dbc->password($new_pass);
01334     }
01335   }
01336   return;
01337 }
01338 
01339 
01340 
01341 =head2 load_registry_from_url
01342 
01343   Arg [1] : string $url
01344   Arg [2] : (optional) integer
01345             If not 0, will print out all information.
01346   Arg [3] : (optional) integer
01347           This option will turn off caching for slice features, so,
01348           every time a set of features is retrieved, they will come
01349           from the database instead of the cache. This option is only
01350           recommended for advanced users, specially if you need to
01351           store and retrieve features. It might reduce performance when
01352           querying the database if not used properly. If in doubt, do
01353           not use it or ask in the developer mailing list.
01354 
01355   Example : load_registry_from_url(
01356             'mysql://anonymous@ensembldb.ensembl.org:3306');
01357             
01358             load_registry_from_url(
01359             'mysql://anonymous@ensembldb.ensembl.org:3306/homo_sapiens_core_65_37?group=core&species=homo_sapiens'
01360             );
01361             
01362             load_registry_from_url(
01363             'mysql://anonymous@ensembldb.ensembl.org:3306/homo_sapiens_core_65_37?group=core'
01364             );
01365             
01366 
01367   Description: Will load the correct versions of the ensembl
01368                databases for the software release it can find on
01369                a database instance into the registry. Also adds
01370                a set of standard aliases. The url format is:
01371                mysql://[[username][:password]@]hostname[:port].  You
01372                can also request a specific version for the databases
01373                by adding a slash and the version number but your
01374                script may crash as the API version won't match the
01375                DB version.
01376                
01377                You can also specify a database name which will cause the 
01378                loading of a single DBAdaptor instance. Parameters are
01379                mapped from a normal URL parameter set to their DBAdaptor
01380                equivalent. Group must be defined.
01381                
01382   Returntype : Int count of the DBAdaptor instances which can be found in the 
01383                registry
01384 
01385   Exceptions : Thrown if the given URL does not parse according to the above 
01386                scheme and if the specified database cannot be connected to 
01387                (see L<load_registry_from_db> for more information)
01388   Status     : Stable
01389  
01390 =cut
01391 
01392 sub load_registry_from_url {
01393   my ( $self, $url, $verbose, $no_cache ) = @_;
01394   
01395   if ( $url =~ /^mysql\:\/\/([^\@]+\@)?([^\:\/]+)(\:\d+)?(\/\d+)?\/?$/x ) {
01396     my $user_pass = $1;
01397     my $host      = $2;
01398     my $port      = $3;
01399     my $version   = $4;
01400 
01401     $user_pass =~ s/\@$//;
01402     my ( $user, $pass ) = $user_pass =~ m/([^\:]+)(\:.+)?/x;
01403     $pass    =~ s/^\://x if ($pass);
01404     $port    =~ s/^\://x if ($port);
01405     $version =~ s/^\///x if ($version);
01406 
01407     return $self->load_registry_from_db(
01408       -host       => $host,
01409       -user       => $user,
01410       -pass       => $pass,
01411       -port       => $port,
01412       -db_version => $version,
01413       -verbose    => $verbose,
01414       -no_cache   => $no_cache
01415     );
01416   }
01417   my $uri = parse_uri($url);
01418   if($uri) {
01419     if($uri->scheme() eq 'mysql') {
01420       my %params = $uri->generate_dbsql_params();
01421       if($params{-DBNAME}) {
01422         $params{-SPECIES} = $params{-DBNAME} unless $params{-SPECIES};
01423         $params{-NO_CACHE} = 1 if $no_cache;
01424         my $group = $params{-GROUP};
01425         my $class = $self->_group_to_adaptor_class($group);
01426         if($verbose) {
01427           printf("Loading database '%s' from group '%s' with DBAdaptor class '%s' from url %s\n", $params{-DBNAME}, $group, $class, $url);
01428         }
01429         $class->new(%params);
01430         return 1;
01431       }
01432     }
01433   }
01434   throw("Only MySQL URLs are accepted. Given URL was '${url}'");
01435 } ## end sub load_registry_from_url
01436 
01437 
01438 =head2 load_registry_from_db
01439 
01440   Arg [HOST] : string
01441                 The domain name of the database host to connect to.
01442 
01443   Arg [USER] : string
01444                 The name of the database user to connect with.
01445 
01446   Arg [PASS] : (optional) string
01447                 The password to be used to connect to the database.
01448 
01449   Arg [PORT] : (optional) integer
01450                 The port to use when connecting to the database.
01451 
01452   Arg [VERBOSE]: (optional) boolean
01453                 Whether to print database messages.
01454 
01455   Arg [SPECIES]: (optional) string
01456                 By default, all databases that are found on the
01457                 server and that corresponds to the correct release
01458                 are probed for aliases etc.  For some people,
01459                 depending on where they are in the world, this might
01460                 be a slow operation.  With the '-species' argument,
01461                 one may reduce the startup time by restricting the
01462                 set of databases that are probed to those of a
01463                 particular species.
01464 
01465                 Note that the latin name of the species is required,
01466                 e.g., 'homo sapiens', 'gallus gallus', 'callithrix
01467                 jacchus' etc.  It may be the whole species name,
01468                 or only the first part of the name, e.g. 'homo',
01469                 'gallus', or 'callithrix'.  This will be used in
01470                 matching against the name of the databases.
01471 
01472   Arg [DB_VERSION]: (optional) integer
01473                 By default, only databases corresponding to the
01474                 current API version are loaded.  This argument
01475                 allows the script to use databases from another
01476                 version although it might not work properly.  This
01477                 argument should only be used for production or
01478                 testing purposes and if you really know what you are
01479                 doing.
01480 
01481   Arg [WAIT_TIMEOUT]: (optional) integer
01482                 Time in seconds for the wait timeout to happen.
01483                 Time after which the connection is deleted if not
01484                 used.  By default this is 28800 (8 hours), so set
01485                 this to greater than this if your connection are
01486                 getting deleted.  Only set this if you are having
01487                 problems and know what you are doing.
01488 
01489    Arg [-NO_CACHE]: (optional) boolean
01490                 This option will turn off caching for slice features,
01491                 so, every time a set of features is retrieved, they
01492                 will come from the database instead of the cache.  This
01493                 option is only recommended for advanced users, specially
01494                 if you need to store and retrieve features.  It might
01495                 reduce performance when querying the database if not
01496                 used properly.  If in doubt, do not use it or ask in the
01497                 developer mailing list.
01498 
01499    Arg [SPECIES_SUFFIX]: (optional) string
01500                 This option will append the string to the species name
01501                 in the registry for all databases found on this server.
01502 
01503   Example :
01504 
01505     $registry->load_registry_from_db(
01506       -host    => 'ensembldb.ensembl.org',
01507       -user    => 'anonymous',
01508       -verbose => '1'
01509     );
01510 
01511   Description: Will load the correct versions of the Ensembl
01512                databases for the software release it can find on a
01513                database instance into the registry.  Also adds a set
01514                of standard aliases.
01515 
01516   Returntype : Int count of the DBAdaptor instances which can be found in the 
01517                registry
01518 
01519   Exceptions : Thrown if the given MySQL database cannot be connected to
01520                or there is any error whilst querying the database.
01521   Status     : Stable
01522 
01523 =cut
01524 
01525 sub load_registry_from_db {
01526   my ( $self, @args ) = @_;
01527 
01528   my ( $host,         $port,     $user,
01529        $pass,         $verbose,  $db_version,
01530        $wait_timeout, $no_cache, $species, $species_suffix )
01531     = rearrange( [ 'HOST',         'PORT',
01532                    'USER',         'PASS',
01533                    'VERBOSE',      'DB_VERSION',
01534                    'WAIT_TIMEOUT', 'NO_CACHE',
01535                    'SPECIES', 'SPECIES_SUFFIX' ],
01536                  @args );
01537 
01538   if ( defined($species) ) {
01539     $species = lc($species);
01540     $species =~ tr/ -/__/;
01541   }
01542   if (!defined($species_suffix)) {
01543     $species_suffix = "";
01544   }
01545 
01546   my $ontology_db;
01547   my $ontology_version;
01548 
01549   $user ||= "ensro";
01550   if ( !defined($port) ) {
01551     $port = 3306;
01552     if ( $host eq "ensembldb.ensembl.org" ) {
01553       if ( (!defined($db_version)) or ($db_version >= 48) ) {
01554         $port = 5306;
01555       }
01556     }
01557   }
01558 
01559   $wait_timeout ||= 0;
01560   
01561   my $original_count = $self->get_DBAdaptor_count();
01562 
01563   my $err_pattern = 'Cannot %s to the Ensembl MySQL server at %s:%d; check your settings & DBI error message: %s';
01564 
01565   my $dbh = DBI->connect( "DBI:mysql:host=$host;port=$port", $user, $pass ) or
01566             throw(sprintf($err_pattern, 'connect', $host, $port, $DBI::errstr));
01567   $dbh->ping() or 
01568             throw(sprintf($err_pattern, 'ping', $host, $port, $DBI::errstr));
01569   
01570   my $res = $dbh->selectall_arrayref('SHOW DATABASES');
01571   my @dbnames = map { $_->[0] } @$res;
01572 
01573   my %temp;
01574   my $software_version = software_version();
01575 
01576   if ( defined($db_version) ) {
01577     $software_version = $db_version;
01578   }
01579 
01580   if ($verbose) {
01581     printf( "Will only load v%d databases\n", $software_version );
01582   }
01583 
01584   # From the list of all the databses create a tempory hash of those we
01585   # are interested in
01586 
01587   for my $db (@dbnames) {
01588     if ( $db =~ /^(\w+_collection_\w+(?:_\d+)?)_((\d+)_\w+)/ )
01589     {    # NEEDS TO BE FIRST TO PICK UP COLLECTION DBS
01590       if ( $3 eq $software_version ) {
01591         $temp{$1} = $2;
01592       }
01593     } elsif ( $db =~ /^(.+)_(userdata)$/x ) {
01594       $temp{$1} = $2;
01595     } elsif (
01596       $db =~ /^(ensembl_compara # compara database
01597                         (?:_\w+)*?)     # optional ensembl genomes bit
01598                         _
01599                         (\d+)$/x )
01600     {    # db version
01601       if ( $2 eq $software_version ) {
01602         $temp{$1} = $2;
01603       }
01604     } elsif ( $db =~ /^(ensembl_ancestral(?:_\w+?)*?)_(\d+)$/x ) {
01605       if ( $2 eq $software_version ) {
01606         $temp{$1} = $2;
01607       }
01608     } elsif ( $db =~ /^ensembl(?:genomes)?_ontology_(?:\d+_)?(\d+)/x ) {
01609       if ( $1 eq $software_version ) {
01610         $ontology_db      = $db;
01611         $ontology_version = $1;
01612       }
01613     } elsif (
01614       $db =~ /^([a-z]+_[a-z0-9]+(?:_[a-z0-9]+)? # species name e.g. homo_sapiens or canis_lupus_familiaris
01615            _
01616            [a-z]+            # db type
01617            (?:_\d+)?)        # optional end bit for ensembl genomes databases
01618            _
01619            (\d+)             # database release
01620            _
01621            (\w+)$             # assembly number can have letters too e.g 37c
01622            /x
01623       )
01624     {
01625 
01626       # Species specific databases (core, cdna, vega etc.)
01627 
01628       my ( $sp_name, $db_rel, $assem ) = ( $1, $2, $3 );
01629 
01630       if ( !defined($species) || $sp_name =~ /^$species/ ) {
01631         if ( $db_rel eq $software_version ) {
01632           $temp{$sp_name} = $db_rel . "_" . $assem;
01633         }
01634       }
01635 
01636     } else {
01637       # warn( sprintf( "Skipping database '%s'\n", $db ) );
01638     }
01639   } ## end for my $db (@dbnames)
01640 
01641   @dbnames = ();
01642 
01643   foreach my $key ( keys %temp ) {
01644     push @dbnames, $key . "_" . $temp{$key};
01645   }
01646 
01647   # Register Core like databases
01648   foreach my $type (qw(core cdna vega vega_update otherfeatures rnaseq)) {
01649 
01650     my @dbs = grep { /^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?  # species name
01651                        _
01652                        $type            # the database type
01653                        _
01654                        (?:\d+_)?         # optional end bit for ensembl genomes
01655                        \d+               # database release
01656                        _
01657                        /x } @dbnames;
01658 
01659     foreach my $database (@dbs) {
01660       if ( index( $database, 'collection' ) != -1 ) {
01661         # Skip multi-species databases.
01662         next;
01663       }
01664     
01665 
01666       my ( $species, $num ) =
01667         ( $database =~ /(^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?)  # species name
01668                      _
01669                      $type                   # type
01670                      _
01671                      (?:\d+_)?               # optional endbit for ensembl genomes
01672                      (\d+)                   # databases release
01673                      _
01674                       /x );
01675 
01676       if(!defined($species)){
01677         warn "for $database cannot get species??\n";
01678       }
01679 
01680       my $dba =
01681         Bio::EnsEMBL::DBSQL::DBAdaptor->new(
01682                                          -group        => $type,
01683                                          -species      => $species.$species_suffix,
01684                                          -host         => $host,
01685                                          -user         => $user,
01686                                          -pass         => $pass,
01687                                          -port         => $port,
01688                                          -dbname       => $database,
01689                                          -wait_timeout => $wait_timeout,
01690                                          -no_cache     => $no_cache );
01691 
01692       if ($verbose) {
01693         printf( "Species '%s' loaded from database '%s'\n",
01694                 $species, $database );
01695       }
01696     }
01697   }
01698 
01699   # Register multi-species databases
01700 
01701   my @multi_dbs = grep { /^\w+_collection_core_\w+$/ } @dbnames;
01702 
01703   foreach my $multidb (@multi_dbs) {
01704     my $sth = $dbh->prepare(
01705       sprintf(
01706         "SELECT species_id, meta_value FROM %s.meta "
01707           . "WHERE meta_key = 'species.db_name'",
01708         $dbh->quote_identifier($multidb) ) );
01709 
01710     $sth->execute();
01711 
01712     my ( $species_id, $species );
01713     $sth->bind_columns( \( $species_id, $species ) );
01714 
01715     while ( $sth->fetch() ) {
01716       my $dba = Bio::EnsEMBL::DBSQL::DBAdaptor->new(
01717         -group           => "core",
01718         -species         => $species.$species_suffix,
01719         -species_id      => $species_id,
01720         -multispecies_db => 1,
01721         -host            => $host,
01722         -user            => $user,
01723         -pass            => $pass,
01724         -port            => $port,
01725         -dbname          => $multidb,
01726         -wait_timeout    => $wait_timeout,
01727         -no_cache        => $no_cache
01728       );
01729 
01730       if ($verbose) {
01731         printf( "Species '%s' (id:%d) loaded from database '%s'\n",
01732           $species, $species_id, $multidb );
01733       }
01734     }
01735   } ## end foreach my $multidb (@multi_dbs)
01736 
01737 
01738   # User upload DBs
01739 
01740   my @userupload_dbs = grep { /_userdata$/ } @dbnames;
01741   for my $userupload_db (@userupload_dbs) {
01742     if ( index( $userupload_db, 'collection' ) != -1 ) {
01743       # Skip multi-species databases.
01744       next;
01745     }
01746 
01747     my ($species) = ( $userupload_db =~ /(^.+)_userdata$/ );
01748     my $dba =
01749       Bio::EnsEMBL::DBSQL::DBAdaptor->new(
01750                                          -group        => "userupload",
01751                                          -species      => $species.$species_suffix,
01752                                          -host         => $host,
01753                                          -user         => $user,
01754                                          -pass         => $pass,
01755                                          -port         => $port,
01756                                          -wait_timeout => $wait_timeout,
01757                                          -dbname   => $userupload_db,
01758                                          -no_cache => $no_cache );
01759 
01760     if ($verbose) {
01761       printf( "%s loaded\n", $userupload_db );
01762     }
01763   }
01764 
01765   # Register multi-species userupload databases.
01766   my @userdata_multidbs = grep { /^.+_collection_userdata$/ } @dbnames;
01767 
01768   foreach my $multidb (@userdata_multidbs) {
01769     my $sth = $dbh->prepare(
01770       sprintf(
01771         "SELECT species_id, meta_value FROM %s.meta "
01772           . "WHERE meta_key = 'species.db_name'",
01773         $dbh->quote_identifier($multidb) ) );
01774 
01775     $sth->execute();
01776 
01777     my ( $species_id, $species );
01778     $sth->bind_columns( \( $species_id, $species ) );
01779 
01780     while ( $sth->fetch() ) {
01781       my $dba = Bio::EnsEMBL::DBSQL::DBAdaptor->new(
01782         -group           => "userupload",
01783         -species         => $species.$species_suffix,
01784         -species_id      => $species_id,
01785         -multispecies_db => 1,
01786         -host            => $host,
01787         -user            => $user,
01788         -pass            => $pass,
01789         -port            => $port,
01790         -dbname          => $multidb,
01791         -wait_timeout    => $wait_timeout,
01792         -no_cache        => $no_cache
01793       );
01794 
01795       if ($verbose) {
01796         printf( "Species '%s' (id:%d) loaded from database '%s'\n",
01797           $species, $species_id, $multidb );
01798       }
01799     }
01800   } ## end foreach my $multidb (@userdata_multidbs)
01801 
01802   # Variation
01803 
01804   my $test_eval = eval "require Bio::EnsEMBL::Variation::DBSQL::DBAdaptor";
01805   if ($@or (!$test_eval)) {
01806     # Ignore variations as code required not there for this
01807     if ($verbose) {
01808       print(
01809            "Bio::EnsEMBL::Variation::DBSQL::DBAdaptor module not found "
01810              . "so variation databases will be ignored if found\n" );
01811     }
01812   } 
01813   else {
01814     my @variation_dbs =
01815       grep { /^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?_variation_(?:\d+_)?\d+_/ } @dbnames;
01816 
01817     for my $variation_db (@variation_dbs) {
01818     
01819       if ( index( $variation_db, 'collection' ) != -1 ) {
01820       # Skip multi-species databases.
01821       next;
01822       }
01823 
01824       my ( $species, $num ) =
01825         ( $variation_db =~ /(^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?)_variation_(?:\d+_)?(\d+)_/ );
01826       my $dba =
01827         Bio::EnsEMBL::Variation::DBSQL::DBAdaptor->new(
01828                                          -group        => "variation",
01829                                          -species      => $species.$species_suffix,
01830                                          -host         => $host,
01831                                          -user         => $user,
01832                                          -pass         => $pass,
01833                                          -port         => $port,
01834                                          -wait_timeout => $wait_timeout,
01835                                          -dbname       => $variation_db,
01836                                          -no_cache     => $no_cache );
01837 
01838       if ($verbose) {
01839       printf( "%s loaded\n", $variation_db );
01840       }
01841     }
01842 
01843     # Register variation multispecies databases
01844     my @variation_multidbs =
01845       grep { /^\w+_collection_variation_\w+$/ } @dbnames;
01846 
01847     foreach my $multidb (@variation_multidbs) {
01848       my $sth = $dbh->prepare(
01849         sprintf( 'SELECT species_id, meta_value FROM %s.meta ',
01850           $dbh->quote_identifier($multidb) )
01851            . "WHERE meta_key = 'species.db_name'"
01852       );
01853 
01854       $sth->execute();
01855 
01856       my ( $species_id, $species );
01857       $sth->bind_columns( \( $species_id, $species ) );
01858 
01859       while ( $sth->fetch() ) {
01860         my $dba = Bio::EnsEMBL::Variation::DBSQL::DBAdaptor->new(
01861           -group           => 'variation',
01862           -species         => $species.$species_suffix,
01863           -species_id      => $species_id,
01864           -multispecies_db => 1,
01865           -host            => $host,
01866           -user            => $user,
01867           -pass            => $pass,
01868           -port            => $port,
01869           -dbname          => $multidb,
01870           -wait_timeout    => $wait_timeout,
01871           -no_cache        => $no_cache
01872         );
01873 
01874         if ($verbose) {
01875           printf( "Species '%s' (id:%d) loaded from database '%s'\n",
01876             $species, $species_id, $multidb );
01877         }
01878       }
01879     } ## end foreach my $multidb (@variation_multidbs)
01880   }
01881 
01882   my $func_eval = eval "require Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor";
01883   if ($@ or (!$func_eval)) {
01884     if ($verbose) {
01885       # Ignore funcgen DBs as code required not there for this
01886       print("Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor module not found "
01887           . "so functional genomics databases will be ignored if found\n"
01888       );
01889     }
01890   } else {
01891     my @funcgen_dbs =
01892       grep { /^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?_funcgen_(?:\d+_)?\d+_/ } @dbnames;
01893 
01894     for my $funcgen_db (@funcgen_dbs) {
01895       if ( index( $funcgen_db, 'collection' ) != -1 ) {
01896         # Skip multi-species databases.
01897         next;
01898       }
01899 
01900       my ( $species, $num ) =
01901         ( $funcgen_db =~ /(^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?)_funcgen_(?:\d+_)?(\d+)_/ );
01902       my $dba = Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor->new(
01903         -group        => "funcgen",
01904         -species      => $species.$species_suffix,
01905         -host         => $host,
01906         -user         => $user,
01907         -pass         => $pass,
01908         -port         => $port,
01909         -wait_timeout => $wait_timeout,
01910         -dbname       => $funcgen_db,
01911         -no_cache     => $no_cache
01912       );
01913 
01914       if ($verbose) {
01915         printf( "%s loaded\n", $funcgen_db );
01916       }
01917     }
01918 
01919     # Register functional genomics multispecies databases
01920     my @funcgen_multidbs =
01921       grep { /^\w+_collection_funcgen_\w+$/ } @dbnames;
01922 
01923     foreach my $multidb (@funcgen_multidbs) {
01924       my $sth = $dbh->prepare(
01925         sprintf( 'SELECT species_id, meta_value FROM %s.meta ',
01926           $dbh->quote_identifier($multidb) )
01927           . "WHERE meta_key = 'species.db_name'"
01928       );
01929 
01930       $sth->execute();
01931 
01932       my ( $species_id, $species );
01933       $sth->bind_columns( \( $species_id, $species ) );
01934 
01935       while ( $sth->fetch() ) {
01936         my $dba = Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor->new(
01937           -group           => 'funcgen',
01938           -species         => $species.$species_suffix,
01939           -species_id      => $species_id,
01940           -multispecies_db => 1,
01941           -host            => $host,
01942           -user            => $user,
01943           -pass            => $pass,
01944           -port            => $port,
01945           -dbname          => $multidb,
01946           -wait_timeout    => $wait_timeout,
01947           -no_cache        => $no_cache
01948         );
01949 
01950         if ($verbose) {
01951           printf( "Species '%s' (id:%d) loaded from database '%s'\n",
01952             $species, $species_id, $multidb );
01953         }
01954       }
01955     } ## end foreach my $multidb (@funcgen_multidbs)
01956   } ## end else [ if ($@) ]
01957 
01958   # Compara
01959 
01960   my @compara_dbs = grep { /^ensembl_compara/ } @dbnames;
01961 
01962   if (@compara_dbs) {
01963     my $comp_eval = eval "require Bio::EnsEMBL::Compara::DBSQL::DBAdaptor";
01964     if ($@ or (!$comp_eval)) {
01965       # Ignore Compara as code required not there for this
01966       if ($verbose) {
01967         printf(
01968           "Bio::EnsEMBL::Compara::DBSQL::DBAdaptor "
01969             . "not found so the following compara "
01970             . "databases will be ignored: %s\n",
01971           join( ', ', @compara_dbs ) );
01972       }
01973     } else {
01974       foreach my $compara_db (@compara_dbs) {
01975         # Looking for EnsEMBL Genomes Comparas.
01976         # ensembl_compara_bacteria_2_53 is registered as
01977         # 'bacteria', ensembl_compara_pan_homology_2_53 is
01978         # registered as 'pan_homology', ensembl_compara_53 is
01979         # registered as 'multi', and the alias 'compara' still
01980         # operates.
01981 
01982         my ($species) =
01983           $compara_db =~ /^ensembl_compara_(\w+)(?:_\d+){2}$/xm;
01984 
01985         $species ||= 'multi';
01986 
01987         my $dba = Bio::EnsEMBL::Compara::DBSQL::DBAdaptor->new(
01988           -group        => 'compara',
01989           -species      => $species.$species_suffix,
01990           -host         => $host,
01991           -user         => $user,
01992           -pass         => $pass,
01993           -port         => $port,
01994           -wait_timeout => $wait_timeout,
01995           -dbname       => $compara_db,
01996           -no_cache     => $no_cache
01997         );
01998 
01999         if ($verbose) {
02000           printf( "%s loaded\n", $compara_db );
02001         }
02002       } ## end foreach my $compara_db (@compara_dbs)
02003     } ## end else [ if ($@)
02004   } elsif ($verbose) {
02005     print("No Compara databases found\n");
02006   }
02007 
02008   # Ancestral sequences
02009 
02010   my @ancestral_dbs =
02011     sort grep { /^ensembl_ancestral/ } @dbnames;
02012 
02013   if (@ancestral_dbs) {
02014     my $ancestral_db = shift @ancestral_dbs;
02015 
02016     my $dba = Bio::EnsEMBL::DBSQL::DBAdaptor->new(
02017       -group        => 'core',
02018       -species      => 'Ancestral sequences'.$species_suffix,
02019       -host         => $host,
02020       -user         => $user,
02021       -pass         => $pass,
02022       -port         => $port,
02023       -wait_timeout => $wait_timeout,
02024       -dbname       => $ancestral_db,
02025       -no_cache     => $no_cache
02026     );
02027 
02028     if ($verbose) {
02029       printf( "%s loaded\n", $ancestral_db );
02030 
02031       if (@ancestral_dbs) {
02032         # If we still had some more then report the problem.
02033         printf(
02034           "Multiple ancestral databases found.\n"
02035             . "Ignoring the following: %s\n",
02036           join( ', ', @ancestral_dbs ) );
02037       }
02038     }
02039   } elsif ($verbose) {
02040     print("No ancestral database found\n");
02041   }
02042 
02043   # Ontology
02044 
02045   if ( defined($ontology_version) && $ontology_version != 0 ) {
02046     require Bio::EnsEMBL::DBSQL::OntologyDBAdaptor;
02047 
02048     my $dba =
02049       Bio::EnsEMBL::DBSQL::OntologyDBAdaptor->new(
02050                                 '-species' => 'multi' . $species_suffix,
02051                                 '-group'   => 'ontology',
02052                                 '-host'    => $host,
02053                                 '-port'    => $port,
02054                                 '-user'    => $user,
02055                                 '-pass'    => $pass,
02056                                 '-dbname'  => $ontology_db, );
02057 
02058     if ($verbose) {
02059       printf( "%s loaded\n", $ontology_db );
02060     }
02061   }
02062   elsif ($verbose) {
02063     print("No ontology database found\n");
02064   }
02065 
02066   Bio::EnsEMBL::Utils::ConfigRegistry->add_alias(
02067     -species => 'multi'.$species_suffix,
02068     -alias   => ['compara'.$species_suffix] );
02069 
02070   Bio::EnsEMBL::Utils::ConfigRegistry->add_alias(
02071     -species => 'multi'.$species_suffix,
02072     -alias   => ['ontology'.$species_suffix] );
02073 
02074   Bio::EnsEMBL::Utils::ConfigRegistry->add_alias(
02075     -species => 'Ancestral sequences'.$species_suffix,
02076     -alias   => ['ancestral_sequences'.$species_suffix] );
02077 
02078   # Register aliases as found in adaptor meta tables.
02079 
02080   $self->find_and_add_aliases( '-handle'         => $dbh,
02081                                '-species_suffix' => $species_suffix );
02082 
02083   $dbh->disconnect();
02084   
02085   return $self->get_DBAdaptor_count() - $original_count;
02086 
02087 } ## end sub load_registry_from_db
02088 
02089 =head2 _group_to_adaptor_class
02090 
02091   Arg [1]       : The group you wish to decode to an adaptor class
02092   Example       : Bio::EnsEMBL::Registry->_group_to_adaptor_class('core');
02093   Description   : Has an internal lookup of groups to their adaptor classes
02094   Returntype    : String
02095   Exceptions    : Thrown if the group is unknown
02096   Status        : Stable
02097 
02098 =cut
02099 
02100 sub _group_to_adaptor_class {
02101   my ($self, $group) = @_;
02102   my $class = {
02103     core => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
02104     cdna => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
02105     otherfeatures => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
02106     rnaseq => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
02107     vega => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
02108     variation => 'Bio::EnsEMBL::Variation::DBSQL::DBAdaptor',
02109     funcgen => 'Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor',
02110     compara => 'Bio::EnsEMBL::Compara::DBSQL::DBAdaptor',
02111   }->{$group};
02112   throw "Group '${group}' is unknown" if ! $class;
02113   return $class;
02114 }
02115 
02116 
02117 =head2 find_and_add_aliases
02118 
02119   Arg [ADAPTOR] : (optional) Bio::EnsEMBL::DBSQL::DBAdaptor
02120                   The adaptor to use to retrieve aliases from.
02121 
02122   Arg [GROUP]   : (optional) string
02123                   The group you want to find aliases for. If not
02124                   given assumes all types.
02125 
02126   Arg [HANDLE]  : (optional) DBI database handle
02127                   A connected database handle to use instead of
02128                   the database handles stored in the DBAdaptors.
02129                   Bypasses the use of MetaContainer.
02130 
02131   Arg [SPECIES_SUFFIX]: (optional) string
02132                   This option will append the string to the species
02133                   name in the registry for all databases.
02134 
02135   Example       : Bio::EnsEMBL::Registry->find_and_add_aliases(
02136                     -ADAPTOR => $dba,
02137                     -GROUP   => 'core'
02138                   );
02139 
02140   Description   : Looks in the meta container for each database for
02141                   an entry called "species.alias".  If any are found
02142                   then the species adaptor is registered to that
02143                   set of aliases.  This can work across any adaptor
02144                   which has a MetaContainer.  If no MetaContainer
02145                   can be returned from a given adaptor then no alias
02146                   searching is performed.
02147 
02148   Return type   : none
02149   Exceptions    : Throws if an alias is found in more than one species.
02150   Status        : Stable
02151 
02152 =cut
02153 
02154 sub find_and_add_aliases {
02155   my $class = shift ;
02156 
02157   my ($adaptor, $group, $dbh, $species_suffix ) =
02158     rearrange( [ 'ADAPTOR', 'GROUP', 'HANDLE', 'SPECIES_SUFFIX' ], @_ );
02159   
02160   #Can be undef; needs to be something to avoid warnings
02161   $species_suffix ||=  q{};
02162 
02163   my @dbas;
02164   if ( defined($adaptor) ) {
02165     @dbas = ($adaptor);
02166   } elsif ( defined($dbh) ) {
02167 
02168     if ( length($species_suffix) > 0 ) {
02169       my @full = @{ $class->get_all_DBAdaptors( '-GROUP' => $group ) };
02170 
02171       foreach my $db (@full) {
02172         if ( $db->species =~ /$species_suffix/ ) {
02173           push( @dbas, $db );
02174         }
02175       }
02176 
02177     } else {
02178       @dbas = @{ $class->get_all_DBAdaptors( '-GROUP' => $group ) };
02179     }
02180 
02181   } else {
02182     @dbas = @{ $class->get_all_DBAdaptors( '-GROUP' => $group ) };
02183   }
02184 
02185   foreach my $dba (@dbas) {
02186     my @aliases;
02187     my $species = $dba->species();
02188 
02189     if ( defined($dbh) ) {
02190       my $dbname = $dba->dbc()->dbname();
02191       my $sth = $dbh->prepare( sprintf(
02192                                  "SELECT meta_value FROM %s.meta "
02193                                    . "WHERE meta_key = 'species.alias' "
02194                                    . "AND species_id = ?",
02195                                  $dbh->quote_identifier($dbname) ) );
02196 
02197       # Execute, and don't care about errors (there will be errors for
02198       # databases without a 'meta' table.
02199       $sth->{'PrintError'} = 0;
02200       $sth->{'RaiseError'} = 0;
02201       if ( !$sth->execute( $dba->species_id() ) ) { next }
02202       $sth->{'PrintError'} = $dbh->{'PrintError'};
02203       $sth->{'RaiseError'} = $dbh->{'RaiseError'};
02204 
02205       my $alias;
02206       $sth->bind_columns( \$alias );
02207       while ( $sth->fetch() ) {
02208         push( @aliases, $alias );
02209       }
02210     } else {
02211       my $meta_container = eval { $dba->get_MetaContainer() };
02212 
02213       if ( defined($meta_container) ) {
02214         push( @aliases,
02215               @{ $meta_container->list_value_by_key('species.alias') }
02216         );
02217       }
02218 
02219       # Need to disconnect so we do not spam the MySQL servers trying to
02220       # get aliases.  Can only call disonnect if dbc was defined.
02221       if ( defined( $dba->dbc() ) ) {
02222         $dba->dbc()->disconnect_if_idle();
02223       }
02224     }
02225 
02226     foreach my $alias (@aliases) {
02227       my $alias_suffix = $alias.$species_suffix;
02228       #Lowercase because stored aliases are lowercased
02229       my $lc_species = lc($species);
02230       my $lc_alias_suffix = lc($alias_suffix);
02231       if (   !$class->alias_exists( $alias_suffix )
02232            && $lc_species ne $lc_alias_suffix )
02233       {
02234         $class->add_alias( $species, $alias_suffix );
02235       } elsif (
02236              $lc_species ne $class->get_alias( $alias_suffix ) )
02237       {
02238         $class->remove_alias( $species, $alias_suffix );
02239       }
02240     }
02241 
02242   } ## end foreach my $dba (@dbas)
02243   return;
02244 } ## end sub find_and_add_aliases
02245 
02246 
02247 =head2 load_registry_from_multiple_dbs
02248 
02249   Arg [1]   : Array of hashes, each hash being a set of arguments to
02250               load_registry_from_db() (see above).
02251 
02252   Example   :
02253 
02254     $registry->load_registry_from_multiple_dbs( {
02255         '-host'    => 'ensembldb.ensembl.org',
02256         '-user'    => 'anonymous',
02257         '-verbose' => '1'
02258       },
02259       {
02260         '-host'     => 'server.example.com',
02261         '-user'     => 'anonymouse',
02262         '-password' => 'cheese',
02263         '-verbose'  => '1'
02264       } );
02265 
02266   Description:  Will call load_registry_from_db() (see above)
02267                 multiple times and merge the resulting registries
02268                 into one, effectively allowing a user to connect to
02269                 databases on multiple database servers from within
02270                 one program.
02271 
02272                 If a database is found on more than one server, the
02273                 first found instance of that database will be used.
02274 
02275   Returntype : Int count of the DBAdaptor instances which can be found in the 
02276                registry
02277 
02278 =cut
02279 
02280 sub load_registry_from_multiple_dbs {
02281   my ( $self, @args ) = @_;
02282 
02283   my $original_count = $self->get_DBAdaptor_count();
02284 
02285   my %merged_register = %registry_register;
02286 
02287   foreach my $arg (@args) {
02288     local %registry_register = ();
02289 
02290     my $verbose;
02291 
02292     ($verbose) = rearrange( ['VERBOSE'], %{$arg} );
02293 
02294     $self->load_registry_from_db( %{$arg} );
02295 
02296     #
02297     # Merge the localized %registry_register into %merged_register.
02298     #
02299 
02300     # Merge the _SPECIES and _ALIAS sections of %registry_register.
02301     foreach my $section ( 'Species', 'Alias' ) {
02302       my $section_key = '_' . uc($section);
02303 
02304       while ( my ( $key, $value ) =
02305         each( %{ $registry_register{$section_key} } ) )
02306       {
02307         if ( !exists( $merged_register{$section_key}{$key} ) ) {
02308           $merged_register{$section_key}{$key} = $value;
02309         } elsif ($verbose) {
02310           printf( "%s '%s' found on multiple servers, "
02311               . "using first found\n",
02312             $section, $key );
02313         }
02314       }
02315     }
02316   } ## end foreach my $arg (@args)
02317 
02318   # Add the DBAs from the _SPECIES section into the _DBA section.
02319   foreach my $species_hash ( values( %{ $merged_register{_SPECIES} } ) )
02320   {
02321     foreach my $group_hash ( values( %{$species_hash} ) ) {
02322       if ( ref($group_hash) eq 'HASH' && exists( $group_hash->{_DB} ) )
02323       {
02324         push( @{ $merged_register{_DBA} }, $group_hash->{_DB} );
02325       }
02326     }
02327   }
02328 
02329   %registry_register = %merged_register;
02330   
02331   return $self->get_DBAdaptor_count() - $original_count;
02332 } ## end sub load_registry_from_multiple_dbs
02333 
02334 #
02335 # Web specific routines
02336 #
02337 
02338 =head2 DEPRECATED load_registry_with_web_adaptors
02339 
02340   DEPRECATED: Use load_registry_from_db instead.
02341 
02342 =cut
02343 
02344 sub load_registry_with_web_adaptors{
02345   my $class = shift;
02346 
02347   deprecate('Use the load_registry_from_db instead'); 
02348   my $site_eval = eval{ require SiteDefs };
02349   if ($@ or (!defined($site_eval))){ die "Can't use SiteDefs.pm - $@\n"; }
02350     SiteDefs->import(qw(:ALL));
02351 
02352   my $species_eval = eval{ require SpeciesDefs };
02353   if ($@ or (!defined($species_eval))){ die "Can't use SpeciesDefs.pm - $@\n"; }
02354   my $conf = new SpeciesDefs();
02355   
02356   my %species_alias = %{$SiteDefs::ENSEMBL_SPECIES_ALIASES};
02357 
02358   foreach my $spec (keys %species_alias){
02359     Bio::EnsEMBL::Registry->add_alias($species_alias{$spec},$spec);
02360   }
02361   return;
02362 }
02363 
02364 =head2 set_default_track
02365 
02366   Sets a flag to say that that this species/group are a default track and do not
02367   need to be added as another web track.
02368 
02369   Arg [1]    : name of the species to get the adaptors for in the registry.
02370   Arg [2]    : name of the type to get the adaptors for in the registry.
02371   Example    : $merged = Bio::EnsEMBL::Registry->set_default_track("Human","core");
02372   Returntype : none
02373   Exceptions : none
02374   Status     : At Risk.
02375 
02376 =cut
02377 
02378 sub set_default_track {
02379   my ( $class, $species, $group ) = @_;
02380 
02381   $species = get_alias($species);
02382   $registry_register{'def_track'}{$species}{ lc($group) } = 1;
02383   return;
02384 }
02385 
02386 =head2 default_track
02387 
02388   Check flag to see if this is a default track
02389 
02390   Arg [1]    : name of the species to get the adaptors for in the registry.
02391   Arg [2]    : name of the type to get the adaptors for in the registry.
02392   Example    : $merged = Bio::EnsEMBL::Registry->set_default_track("Human","core");
02393   Returntype : int 
02394   Exceptions : none
02395   Status     : At Risk.
02396 
02397 =cut
02398 
02399 sub default_track {
02400   my ( $class, $species, $group ) = @_;
02401 
02402   $species = get_alias($species);
02403   if (
02404     defined( $registry_register{'def_track'}{$species}{ lc($group) } ) )
02405   {
02406     return 1;
02407   }
02408 
02409   return 0;
02410 }
02411 
02412 
02413 =head2 add_new_tracks
02414 
02415   Will add new gene tracks to the configuration of the WEB server if they are
02416   not of the type default and the configuration already has genes in the display.
02417 
02418   Arg [1]    : hash of the default configuration of the web page
02419   Returntype : none
02420   Exceptions : none
02421   Called by  : UserConfig.pm
02422   Status     : At Risk.
02423   
02424 =cut
02425 
02426 sub add_new_tracks{
02427   my($class, $conf, $pos) = @_;
02428 
02429   my $start = 0;
02430   my $reg = $class;
02431   my $species_reg = $reg->get_alias($conf->{'species'},"nothrow");
02432   my %pars;
02433 #  print STDERR "Species $species_reg check for default tracks\n";
02434   if(defined($species_reg)){
02435     foreach my $dba (@{$reg->get_all_DBAdaptors()}){
02436       if(!$reg->default_track($dba->species,$dba->group)){
02437         $pars{'available'} = "species ".$reg->get_alias($dba->species());
02438         $pars{'db_alias'} = $dba->group();
02439 #       print STDERR "Adding new track for ".$dba->species."\t".$dba->group."\n";
02440         $conf->add_new_track_generictranscript('',$dba->group(), "black",$pos,%pars);
02441         $pos++;
02442       }
02443     }
02444   }
02445   return $pos;
02446 
02447 }
02448 
02449 =head2 no_version_check
02450   
02451   getter/setter for whether to run the version checking
02452   
02453   Arg[0]     : (optional) int
02454   Returntype : int or undef if not set
02455   Exceptions : none
02456   Status     : At Risk.
02457 
02458 =cut
02459   
02460 sub no_version_check {
02461   my ( $self, $arg ) = @_;
02462   ( defined $arg )
02463     && ( $registry_register{'_no_version_check'} = $arg );
02464 
02465   return $registry_register{'_no_version_check'};
02466 }
02467 
02468   
02469 =head2 version_check
02470   
02471   run the database/API code version check for a DBAdaptor
02472   
02473   Arg[0]     : DBAdaptor to check
02474   Returntype : int 1 if okay, 0 if not the same 
02475   Exceptions : none
02476   Status     : At Risk.
02477 
02478 =cut
02479   
02480   
02481 sub version_check {
02482   my ( $self, $dba ) = @_;
02483 
02484   # Check the datbase and versions match
02485   # give warning if they do not.
02486   my $check = no_version_check();
02487 
02488   if ( (
02489       defined( $ENV{HOME} )
02490       and ( -e $ENV{HOME} . "/.ensemblapi_no_version_check" ) )
02491     or ( defined($check) and ( $check != 0 ) ) )
02492   {
02493     return 1;
02494   }
02495 
02496   my $mca =
02497     $self->get_adaptor( $dba->species(), $dba->group(),
02498     "MetaContainer" );
02499 
02500   my $database_version = 0;
02501   if ( defined($mca) ) {
02502     $database_version = $mca->get_schema_version();
02503   }
02504 
02505   if ( $database_version == 0 ) {
02506     # Try to work out the version
02507     if ( $dba->dbc()->dbname() =~ /^_test_db_/x ) {
02508       return 1;
02509     }
02510     if ( $dba->dbc()->dbname() =~ /(\d+)_\S+$/x ) {
02511       $database_version = $1;
02512     } elsif ( $dba->dbc()->dbname() =~ /ensembl_compara_(\d+)/x ) {
02513       $database_version = $1;
02514     } elsif ( $dba->dbc()->dbname() =~ /ensembl_help_(\d+)/x ) {
02515       $database_version = $1;
02516     } elsif ( $dba->dbc()->dbname() =~ /ensembl_ontology_(\d+)/x ) {
02517       $database_version = $1;
02518     } else {
02519       warn(
02520         sprintf(
02521           "No database version for database %s "
02522             . ". You must be using a post version 34 database "
02523             . "with version 34 or later code.\n"
02524             . "You need to update your database "
02525             . "or use the appropriate Ensembl software release "
02526             . "to ensure your script does not crash\n",
02527           $dba->dbc()->dbname() ) );
02528     }
02529   } ## end if ( $database_version...
02530 
02531   if ( $database_version != software_version() ) {
02532     warn(
02533       sprintf(
02534         "For %s there is a difference in the software release (%s) "
02535           . "and the database release (%s). "
02536           . "You should update one of these to ensure that your script "
02537           . "does not crash.\n",
02538         $dba->dbc()->dbname(),
02539         software_version(), $database_version
02540       ) );
02541     return 0;
02542   }
02543 
02544   return 1;    # Ok
02545 } ## end sub version_check
02546 
02547 
02548 =head2 get_species_and_object_type
02549 
02550   Description:  Get the species name, object type (gene, transcript,
02551                 translation, or exon etc.), and database type for a
02552                 stable ID.
02553 
02554                 NOTE: No validation is done to see if the stable ID
02555                       actually exists.
02556 
02557   Arg [1]    :  String stable_id
02558                 The stable ID to find species and object type for.
02559 
02560   Arg [2]    :  String known_type (optional)
02561                 The type of the stable ID, if it is known.
02562 
02563   Example    :  my $stable_id = 'ENST00000326632';
02564 
02565                 my ( $species, $object_type, $db_type ) =
02566                   $registry->get_species_and_object_type($stable_id);
02567 
02568                 my $adaptor =
02569                   $registry->get_adaptor( $species, $db_type,
02570                                           $object_type );
02571 
02572                 my $object = $adaptor->fetch_by_stable_id($stable_id);
02573 
02574   Return type:  Array consisting of the species name, object type,
02575                 and database type.  The array may be empty if no
02576                 match is found.
02577 
02578   Exceptions :  none
02579   Status     :  At Risk.
02580 
02581 =cut
02582 
02583 my %stable_id_stmts = (
02584                     "gene" => 'SELECT m.meta_value '
02585                       . 'FROM %1$s.gene '
02586                       . 'JOIN %1$s.seq_region USING (seq_region_id) '
02587                       . 'JOIN %1$s.coord_system USING (coord_system_id) '
02588                       . 'JOIN %1$s.meta m USING (species_id) '
02589                       . 'WHERE stable_id = ? '
02590                       . 'AND m.meta_key = "species.production_name"',
02591                     "transcript" => 'SELECT m.meta_value '
02592                       . 'FROM %1$s.transcript '
02593                       . 'JOIN %1$s.seq_region USING (seq_region_id) '
02594                       . 'JOIN %1$s.coord_system USING (coord_system_id) '
02595                       . 'JOIN %1$s.meta m USING (species_id) '
02596                       . 'WHERE stable_id = ? '
02597                       . 'AND m.meta_key = "species.production_name"',
02598                     "exon" => 'SELECT m.meta_value '
02599                       . 'FROM %1$s.exon '
02600                       . 'JOIN %1$s.seq_region USING (seq_region_id) '
02601                       . 'JOIN %1$s.coord_system USING (coord_system_id) '
02602                       . 'JOIN %1$s.meta m USING (species_id) '
02603                       . 'WHERE stable_id = ? '
02604                       . 'AND m.meta_key = "species.production_name"',
02605                     "translation" => 'SELECT m.meta_value '
02606                       . 'FROM %1$s.translation tl '
02607                       . 'JOIN %1$s.transcript USING (transcript_id) '
02608                       . 'JOIN %1$s.seq_region USING (seq_region_id) '
02609                       . 'JOIN %1$s.coord_system USING (coord_system_id) '
02610                       . 'JOIN %1$s.meta m USING (species_id) '
02611                       . 'WHERE tl.stable_id = ? '
02612                       . 'AND m.meta_key = "species.production_name"',
02613                     "operon" => 'SELECT m.meta_value '
02614                       . 'FROM %1$s.operon '
02615                       . 'JOIN %1$s.seq_region USING (seq_region_id) '
02616                       . 'JOIN %1$s.coord_system USING (coord_system_id) '
02617                       . 'JOIN %1$s.meta m USING (species_id) '
02618                       . 'WHERE stable_id = ? '
02619                       . 'AND m.meta_key = "species.production_name"',
02620                     "operontranscript" => 'SELECT m.meta_value '
02621                       . 'FROM %1$s.operon_transcript '
02622                       . 'JOIN %1$s.seq_region USING (seq_region_id) '
02623                       . 'JOIN %1$s.coord_system USING (coord_system_id) '
02624                       . 'JOIN %1$s.meta m USING (species_id) '
02625                       . 'WHERE stable_id = ? '
02626                       . 'AND m.meta_key = "species.production_name"',
02627 );
02628 
02629 sub get_species_and_object_type {
02630   my ($self, $stable_id, $known_type) = @_;
02631 
02632   if (defined $known_type && !exists $stable_id_stmts{lc $known_type}) {
02633     warn "Got invalid known_type '$known_type'";
02634     return;
02635   }
02636 
02637   my @types = defined $known_type ? ($known_type) : ('Gene', 'Transcript', 'Translation', 'Exon', 'Operon', 'OperonTranscript');
02638   my $dbc;
02639   my $dbh;
02640 
02641   foreach my $dba (
02642     sort { $a->dbc->host cmp $b->dbc->host || $a->dbc->port <=> $b->dbc->port } 
02643     @{$self->get_all_DBAdaptors( '-group' => 'Core' )}
02644   ) {
02645     unless (defined $dbc && $dbc->host eq $dba->dbc->host && $dbc->port eq $dba->dbc->port) {
02646       $dbc = $dba->dbc;
02647       $dbh = $dbc->db_handle;
02648     }
02649 
02650     foreach my $type (@types) {
02651       my $statement = sprintf $stable_id_stmts{lc $type}, $dba->dbc->dbname;
02652 
02653       my $sth = $dbh->prepare($statement);
02654 
02655       $sth->bind_param(1, $stable_id, SQL_VARCHAR);
02656       $sth->execute;
02657 
02658       my $species = $sth->fetchall_arrayref->[0][0];
02659 
02660       $sth->finish;
02661 
02662       return ($species, $type, 'Core') if defined $species;
02663     }
02664 
02665   } ## end foreach my $dba ( sort { $a...})
02666 
02667   return;
02668 } ## end sub get_species_and_object_type
02669 
02670 1;