3 See the NOTICE file distributed with
this work
for additional information
4 regarding copyright ownership.
6 Licensed under the Apache License, Version 2.0 (the
"License");
7 you may not use
this file except in compliance with the License.
8 You may obtain a copy of the License at
12 Unless required by applicable law or agreed to in writing, software
13 distributed under the License is distributed on an
"AS IS" BASIS,
14 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 See the License
for the specific language governing permissions and
16 limitations under the License.
28 my $registry =
'Bio::EnsEMBL::Registry';
30 $registry->
load_all(
"configuration_file");
32 $gene_adaptor = $registry->get_adaptor(
'Human',
'Core',
'Gene' );
36 All Adaptors are stored/registered
using this module. This module should
37 then be used to get the adaptors needed.
39 The registry can be loaded from a configuration file
using the load_all
42 If a filename is passed to load_all then
this is used. Else
if the
43 environment variable ENSEMBL_REGISTRY is set to the name on an existing
44 configuration file, then
this is used. Else
if the file .ensembl_init
45 in your home directory exist, it is used.
47 For the Web server ENSEMBL_REGISTRY should be set in SiteDefs.pm. This
48 will then be passed on to load_all.
51 The registry can also be loaded via the method load_registry_from_db
52 which given a database host will load the latest versions of the Ensembl
55 The four types of registries are
for db adaptors, dba adaptors, dna
56 adaptors and the standard type.
60 These are registries
for backwards compatibility and enable the
61 subroutines to add other adaptors to connections.
63 e.g. get_all_db_adaptors, get_db_adaptor, add_db_adaptor,
64 remove_db_adaptor are the old DBAdaptor subroutines which are now
65 redirected to the Registry.
69 my $sfa = $self->adaptor()->db()->get_db_adaptor(
'blast');
71 We now want to change
this to
79 These are the stores
for the DBAdaptors
81 The Registry will create all the DBConnections needed now
if you set up
82 the configuration correctly. So instead of the old commands like
85 my $exon_adaptor = $db->get_ExonAdaptor;
87 we should now have just
95 This is an
internal Registry and allows the configuration of a dnadb.
96 An example here is to set the est database to get its dna data from the
99 ## set the est db to use the core
for getting dna data.
101 #
"core",
"Homo Sapiens",
"est" );
106 This is the registry
for all the general types of adaptors like
107 GeneAdaptor, ExonAdaptor, Slice Adaptor etc.
109 These are accessed by the
get_adaptor subroutine i.e.
120 package Bio::EnsEMBL::Registry;
135 use DBI qw(:sql_types);
137 use Scalar::Util qw/blessed/;
139 use vars qw(%registry_register);
141 # This is a map from group names to Ensembl DB adaptors. Used by
142 # load_all() and reset_DBAdaptor().
143 my %group2adaptor = (
144 'compara' =>
'Bio::EnsEMBL::Compara::DBSQL::DBAdaptor',
145 'core' =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
146 'estgene' =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
147 'funcgen' =>
'Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor',
148 'gene2phenotype' =>
'Bio::EnsEMBL::G2P::DBSQL::DBAdaptor',
149 'regulation' =>
'Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor',
150 'hive' =>
'Bio::EnsEMBL::Hive::DBSQL::DBAdaptor',
151 'metadata' =>
'Bio::EnsEMBL::MetaData::DBSQL::MetaDataDBAdaptor',
152 'ontology' =>
'Bio::EnsEMBL::DBSQL::OntologyDBAdaptor',
153 'otherfeatures' =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
154 'pipeline' =>
'Bio::EnsEMBL::Pipeline::DBSQL::DBAdaptor',
155 'production' =>
'Bio::EnsEMBL::Production::DBSQL::DBAdaptor',
156 'stable_ids' =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
157 'taxonomy' =>
'Bio::EnsEMBL::Taxonomy::DBSQL::TaxonomyDBAdaptor',
158 'variation' =>
'Bio::EnsEMBL::Variation::DBSQL::DBAdaptor',
159 'vega' =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
160 'vega_update' =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
166 Will load the registry with the configuration file which is
167 obtained from the first in the following and in that order.
169 1) If an argument is passed to
this method,
this is used as the
170 name of the configuration file to read.
172 2) If the environment variable ENSEMBL_REGISTRY is set,
this is
173 used as the name of the configuration file to read.
175 3) If the file .ensembl_init exist in the home directory, it is
176 used as the configuration file.
178 Arg [1] : (optional)
string
179 Name of file to load the registry from.
181 Arg [2] : (optional) integer
182 If not 0, will print out all information.
184 Arg [3] : (optional) integer
185 If not 0, the database connection will not be
186 cleared,
if 0 or
if not set the database connections
187 will be cleared (
this is the
default).
189 Arg [4]: (optional)
boolean
190 This option will turn off caching
for slice features,
191 so, every time a set of features is retrieved,
192 they will come from the database instead of the
193 cache. This option is only recommended
for advanced
194 users, specially
if you need to store and retrieve
195 features. It might reduce performance when querying
196 the database
if not used properly. If in doubt,
do
197 not use it or ask in the developer mailing list.
199 Arg [5]: (optional)
boolean
200 This option will make load_all()
throw if the configuration file
201 is missing and cannot be guessed from the environment
204 Returntype : Int count of the DBAdaptor instances which can be found in the
205 registry due to
this method being called. Will never be negative
206 Exceptions : Throws
if $throw_if_missing is set and ($config_file is missing
207 and cannot be guessed from the environment
213 my ($class, $config_file, $verbose, $no_clear, $no_cache, $throw_if_missing ) = @_;
215 if ( !defined($config_file) ) {
216 if ( defined( $ENV{ENSEMBL_REGISTRY} ) ) {
217 if (-e $ENV{ENSEMBL_REGISTRY}) {
218 $config_file = $ENV{ENSEMBL_REGISTRY};
220 warning(
"\$ENV{ENSEMBL_REGISTRY} points to a file ('$ENV{ENSEMBL_REGISTRY}') that does not exist.\n");
222 } elsif ( defined( $ENV{HOME} ) ) {
223 if (-e ($ENV{HOME} .
"/.ensembl_init")) {
224 $config_file = $ENV{HOME} .
"/.ensembl_init";
227 if ($throw_if_missing and !defined($config_file) ) {
228 throw(
"No registry configuration to load, and no default could be guessed.\n");
230 } elsif ($throw_if_missing and !(-e $config_file)) {
231 throw(sprintf(
"Configuration file '%s' does not exist. Registry configuration not loaded.\n", $config_file ));
238 my $original_count = $class->get_DBAdaptor_count();
240 if ( !defined($config_file) ) {
243 "No default registry configuration to load.\n" );
245 } elsif ( !-e $config_file ) {
247 printf( STDERR
"Configuration file '%s' does not exist. "
248 .
"Registry configuration not loaded.\n",
252 if ( defined( $registry_register{
'seen'} ) ) {
255 print( STDERR
"Clearing previously loaded "
256 .
"registry configuration\n" );
261 $registry_register{
'seen'} = 1;
265 "Loading registry configuration from '%s'.\n",
271 my $test_eval = eval { require Config::IniFiles };
273 if ($@ or (!$test_eval)) {
274 # The user does not have the 'Config::IniFiles' module.
276 print( STDERR
"No Config::IniFiles module found, "
277 .
"assuming this is not an ini-file\n" );
279 # If the configuration file *is* an ini-file, we can expect a
280 # load of compilation errors from the next eval...
282 # The user has the 'Config::IniFiles' module installed. See
283 # if this is an ini-file or not...
284 $cfg = Config::IniFiles->new( -file => $config_file );
287 if ( defined $cfg ) {
288 my %default_adaptor_args = ();
290 if ( $cfg->SectionExists(
'default') ) {
291 # The 'default' section is special. It contain default
292 # values that should be implicit to all other section in
293 # this configuration file. Aliases are added if there
294 # is also a 'species' setting.
296 my $alias = $cfg->val(
'default',
'alias' );
297 $cfg->delval(
'default',
'alias' );
299 my $species = $cfg->val(
'default',
'species' );
301 if ( defined($alias) && defined($species) ) {
303 -species => $species,
304 -alias => [ split( /\n/, $alias ) ]
308 %default_adaptor_args =
309 map {
'-' . $_ => $cfg->val(
'default', $_ ) }
310 $cfg->Parameters(
'default');
313 foreach my $section ( $cfg->Sections() ) {
314 if ( $section eq
'default' )
315 { # We have already done the
'default' section.
319 my $group = $cfg->val( $section,
'group' )
320 || $cfg->val(
'default',
'group' );
322 if ( !defined($group) ) {
323 printf( STDERR
"Key 'group' is undefined "
324 .
"for configuration section '%s', "
325 .
"skipping this section.\n",
330 my $adaptor = $group2adaptor{ lc($group) };
331 if ( !defined($adaptor) ) {
332 printf( STDERR
"Unknown group '%s' "
333 .
"for configuration section '%s', "
334 .
"skipping this section.\n",
339 # Handle aliases. A section must have both an 'alias'
340 # setting and a 'species' setting for aliases to be
341 # added. The 'species' setting might be inherited from
342 # the 'default' section.
344 my $alias = $cfg->val( $section,
'alias' );
345 $cfg->delval( $section,
'alias' );
347 my $species = $cfg->val( $section,
'species' )
348 || $cfg->val(
'default',
'species' );
350 if ( defined($alias) && defined($species) ) {
352 -species => $species,
353 -alias => [ split( /\n/, $alias ) ]
357 # Fill in the adaptor initialization arguments.
358 # We trust the user to provide sensible key-value pairs.
359 my %adaptor_args = %default_adaptor_args;
360 foreach my $parameter ( $cfg->Parameters($section) ) {
361 $adaptor_args{
'-' . $parameter } =
362 $cfg->val( $section, $parameter );
364 # when set, do not use the feature cache in the
367 $adaptor_args{
'-no_cache'} = 1;
371 printf(
"Configuring adaptor '%s' "
372 .
"for configuration section '%s'...\n",
373 $adaptor, $section );
376 my $test_eval = eval
"require $adaptor"; ## no critic
377 if ($@ or (!$test_eval)) { die($@) }
379 $adaptor->new(%adaptor_args);
381 } ## end
foreach my $section ( $cfg->Sections...
383 # This is probably no ini-file but an old style piece
384 # of configuration written in Perl. We need to try to
391 $test_eval = eval $contents; ## no critic
394 $test_eval = eval { require($config_file) };
395 # To make the web code avoid doing this again we delete first
396 delete $INC{$config_file};
399 #Now raise the exception just in case something above is
401 if ($@ or (!$test_eval)) { die($@) }
404 } ## end
else [
if ( !defined($config_file...
406 my $count = $class->get_DBAdaptor_count() - $original_count;
407 return $count >= 0 ? $count : 0;
408 } ## end sub load_all
412 Will clear the registry and disconnect from all databases.
424 foreach my $dba (@{$registry_register{
'_DBA'}}){
425 if($dba->dbc->connected){
426 $dba->dbc->db_handle->disconnect();
429 %registry_register = ();
434 # db adaptors. (for backwards compatibility)
439 Arg [1] : db (DBAdaptor) to add adaptor to.
440 Arg [2] : name of the name to add the adaptor to in the registry.
441 Arg [3] : The adaptor to be added to the registry.
446 : This is here
for backwards compatibility only and may
447 : be removed eventually. Solution is to make sure the
448 : db and the adaptor have the same species and the call
449 : is then no longer needed.
454 my ( $class, $db, $name, $adap ) = @_;
455 #No warnings brought in due to some overzelous webcode triggering a lot of warnings.
456 no warnings
'uninitialized';
457 if ( lc( $db->species() ) ne lc( $adap->species ) ) {
458 $registry_register{_SPECIES}{ lc( $db->species() ) }
459 { lc( $db->group() ) }{
'_special'}{ lc($name) } = $adap;
466 Arg [1] : db (DBAdaptor) to remove adaptor from.
467 Arg [2] : name to remove the adaptor from in the registry.
472 : This is here
for backwards compatibility only and may
473 : be removed eventually. Solution is to make sure the
474 : db and the adaptor have the same species and the call
475 : is then no longer needed.
480 my ( $class, $db, $name ) = @_;
483 $registry_register{_SPECIES}{ lc( $db->species() ) }
484 { lc( $db->group() ) }{
'_special'}{ lc($name) };
486 $registry_register{_SPECIES}{ lc( $db->species() ) }
487 { lc( $db->group() ) }{
'_special'}{ lc($name) } = undef;
494 Arg [1] : db (DBAdaptor) to get adaptor from.
495 Arg [2] : name to get the adaptor
for in the registry.
498 Exceptions : See get_DBAdaptor()
500 : This is here
for backwards compatibility only and may
501 : be removed eventually. Solution is to make sure the
502 : db and the adaptor have the same species then call
503 : get_DBAdaptor instead.
508 my ( $class, $db, $name ) = @_;
513 if ( defined($ret) ) {
return $ret }
515 return $registry_register{_SPECIES}{ lc( $db->species() ) }
516 { lc( $db->group() ) }{
'_special'}{ lc($name) };
519 =head2 get_all_db_adaptors
521 Arg [1] : db (DBAdaptor) to get all the adaptors from.
526 : This is here
for backwards compatibility only and
527 : may be removed eventually. Solution is to make
528 : sure the dbs all have the same species then call
529 : get_all_DBAdaptors(-species =>
"human");
534 sub get_all_db_adaptors {
535 my ( $class, $db ) = @_;
538 # we now also want to add all the DBAdaptors for the same species.
539 # as add_db_adaptor does not add if it is from the same species.
541 foreach my $dba ( @{ $registry_register{
'_DBA'} } ) {
542 if ( lc( $dba->species() ) eq lc( $db->species() ) ) {
543 $ret{ $dba->group() } = $dba;
549 $registry_register{_SPECIES}
550 { $class->get_alias( $db->species() ) }{ lc( $db->group() ) }
554 $registry_register{_SPECIES}
555 { $class->get_alias( $db->species() ) }{ lc( $db->group() ) }
560 } ## end sub get_all_db_adaptors
569 Arg [1] : name of the species to add the adaptor to in the registry.
570 Arg [2] : name of the group to add the adaptor to in the registry.
571 Arg [3] : DBAdaptor to be added to the registry.
581 my ( $class, $species, $group, $adap ) = @_;
583 if ( !defined($species) ) {
584 throw(
'Species not defined.');
587 if ( !( $class->alias_exists($species) ) ) {
588 $class->add_alias( $species, $species );
591 $species = $class->get_alias($species);
593 $registry_register{_SPECIES}{$species}{ lc($group) }{
'_DB'} = $adap;
595 if ( !defined( $registry_register{
'_DBA'} ) ) {
596 $registry_register{
'_DBA'} = [$adap];
598 push( @{ $registry_register{
'_DBA'} }, $adap );
607 Arg [1] : name of the species to get the adaptor
for in the registry.
608 Arg [2] : name of the group to get the adaptor
for in the registry.
609 Arg [3] :
if set will not give warnings when looking
for alias.
611 Returntype : DBAdaptor
612 Exceptions : If $species is not defined and
if no valid
internal name
613 could be found
for $species. If thrown check your API and DB
620 my ( $class, $species, $group, $no_alias_check ) = @_;
622 if ( !defined($species) ) {
623 throw(
'Species not defined.');
626 my $ispecies = $class->get_alias( $species, $no_alias_check );
628 if ($group eq
'regulation') { $group =
'funcgen'; }
630 if ( !defined($ispecies) ) {
631 if(! $no_alias_check) {
632 throw(
"Can not find internal name for species '$species'");
635 else { $species = $ispecies }
637 return $registry_register{_SPECIES}{$species}{ lc($group) }{
'_DB'};
640 =head2 get_all_DBAdaptors
642 Arg [SPECIES]: (optional)
string
643 species name to get adaptors
for
644 Arg [GROUP] : (optional)
string
645 group name to get adaptors
for
655 Returntype : list of DBAdaptors
661 sub get_all_DBAdaptors {
662 my ( $class, @args ) = @_;
664 my ( $species, $group ) = rearrange( [qw(SPECIES GROUP)], @args );
666 if ( !defined($species) && !defined($group) ) {
667 return $registry_register{
'_DBA'} || [];
670 if ( defined($species) ) {
671 $species = $class->get_alias($species);
672 return [] unless $species;
676 foreach my $dba ( @{ $registry_register{
'_DBA'} } ) {
677 if ( ( !defined($species) || lc($species) eq lc( $dba->species() ) )
678 && ( !defined($group) || lc($group) eq lc( $dba->group() ) ) )
687 =head2 get_all_DBAdaptors_by_connection
689 Arg [1] : DBConnection used to find DBAdaptors
690 Returntype : reference to list of DBAdaptors
698 sub get_all_DBAdaptors_by_connection {
699 my ( $self, $dbc_orig ) = @_;
703 foreach my $dba ( @{ $registry_register{
'_DBA'} } ) {
704 my $dbc = $dba->dbc();
707 && $dbc->can(
'equals')
708 && $dbc->equals($dbc_orig) )
710 push( @
return, $dba );
717 =head2 get_all_DBAdaptors_by_dbname
719 Arg [1] : string, name of database
720 Returntype : reference to list of DBAdaptors
728 sub get_all_DBAdaptors_by_dbname {
729 my ( $self, $dbname ) = @_;
733 foreach my $dba ( @{ $registry_register{
'_DBA'} } ) {
734 my $dbc = $dba->dbc();
736 if ( defined($dbc) && $dbc->dbname() eq $dbname ) {
737 push( @
return, $dba );
744 =head2 remove_DBAdaptor
746 Arg [1] : name of the species to get the adaptor
for in the registry.
747 Arg [2] : name of the group to get the adaptor
for in the registry.
755 sub remove_DBAdaptor {
756 my ( $class, $species, $group ) = @_;
758 $species = $class->get_alias($species);
760 delete $registry_register{_SPECIES}{$species}{$group};
761 # This will remove the DBAdaptor and all the other adaptors
763 # Now remove if from the _DBA array
766 foreach my $i ( 0 .. $#{ $registry_register{
'_DBA'} } ) {
767 my $dba = $registry_register{
'_DBA'}->[$i];
769 if ( ( $dba->species eq $species )
770 && $dba->group eq $group )
777 # Now remove from _DBA cache
778 if ( defined($index) ) {
779 splice( @{ $registry_register{
'_DBA'} }, $index, 1 );
783 } ## end sub remove_DBAdaptor
787 =head2 reset_DBAdaptor
789 Arg [1]:
string - species e.g. homo_sapiens
790 Arg [2]:
string - DB group e.g. core
791 Arg [3]:
string -
new dbname
792 Args [4-7]:
string - optional DB parameters, defaults to current db params
if omitted
793 Arg [8]: hashref - Hash ref of additional parameters e.g. eFG dnadb params
for auto selecting dnadb
794 Usage : $reg->reset_registry_db(
'homo_sapiens',
'core',
795 'homo_sapiens_core_37_35j' );
796 Description: Resets a DB within the registry.
797 Exceptions: Throws
if mandatory params not supplied
798 Throws
if species name is not already seen by the registry
799 Throws
if no current DB
for species/group available
804 sub reset_DBAdaptor {
806 $self, $species, $group, $dbname, $host,
807 $port, $user, $pass, $params
810 # Check mandatory params
811 if ( !( defined $species && defined $group && defined $dbname ) ) {
813 'Must provide at least a species, group, and dbname parameter '
814 .
'to redefine a DB in the registry' );
817 # Validate species here
818 my $alias = $self->get_alias($species);
819 throw(
"Could not find registry alias for species:\t$species")
820 if ( !defined $alias );
822 # Get all current defaults if not defined
824 my $db = $self->get_DBAdaptor( $alias, $group );
829 $host ||= $db->dbc->host;
830 $port ||= $db->dbc->port;
831 $user ||= $db->dbc->username;
832 $pass ||= $db->dbc->password;
834 #Now we need to test mandatory params
835 $class = $group2adaptor{ lc($group) };
837 if ( !( $host && $user ) ) {
838 throw(
"No comparable $alias $group DB present in Registry. "
839 .
"You must pass at least a dbhost and dbuser" );
843 $self->remove_DBAdaptor( $alias, $group );
845 # ConfigRegistry should automatically add this to the Registry
857 } ## end sub reset_DBAdaptor
864 =head2 add_DNAAdaptor
866 Arg [1] : name of the species to add the adaptor to in the registry.
867 Arg [2] : name of the group to add the adaptor to in the registry.
868 Arg [3] : name of the species to get the dna from
869 Arg [4] : name of the group to get the dna from
878 my ( $class, $species, $group, $dnadb_species, $dnadb_group ) = @_;
880 $species = $class->get_alias($species);
881 $dnadb_species = $class->get_alias($dnadb_species);
882 if ( $dnadb_group->isa(
'Bio::EnsEMBL::DBSQL::DBAdaptor') ) {
885 $registry_register{_SPECIES}{$species}{ lc($group) }{
'_DNA'} =
887 $registry_register{_SPECIES}{$species}{ lc($group) }{
'_DNA2'} =
893 =head2 get_DNAAdaptor
895 Arg [1] : name of the species to get the adaptor
for in the registry.
896 Arg [2] : name of the group to get the adaptor
for in the registry.
905 my ( $class, $species, $group ) = @_;
907 $species = $class->get_alias($species);
909 $registry_register{_SPECIES}{$species}{ lc($group) }{
'_DNA'};
911 $registry_register{_SPECIES}{$species}{ lc($group) }{
'_DNA2'};
913 if ( defined $new_group ) {
914 return $class->get_DBAdaptor( $new_species, $new_group );
926 Arg [1] : name of the species to add the adaptor to in the registry.
927 Arg [2] : name of the group to add the adaptor to in the registry.
928 Arg [3] : name of the type to add the adaptor to in the registry.
929 Arg [4] : The DBAdaptor to be added to the registry.
930 Arg [5] : (optional) Set to allow overwrites of existing adaptors.
940 my ( $class, $species, $group, $type, $adap, $reset ) = @_;
942 $species = $class->get_alias($species);
943 my $lc_group = lc($group);
944 my $lc_type = lc($type);
946 # Since the adaptors are not stored initially, only their class paths
947 # when the adaptors are obtained, we need to store these instead. It
948 # is not necessarily an error if the registry is overwritten without
949 # the reset set but it is an indication that we are overwriting a
950 # database which should be a warning for now
952 if ( defined($reset) )
953 { # JUST RESET THE HASH VALUE NO MORE PROCESSING NEEDED
954 $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type } = $adap;
960 $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type }
964 # "Overwriting Adaptor in Registry for $species $group $type\n");
965 $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type } = $adap;
968 $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type } = $adap;
970 if ( !defined( $registry_register{_SPECIES}{$species}{
'list'} ) ) {
971 $registry_register{_SPECIES}{$species}{
'list'} = [$type];
974 push( @{ $registry_register{_SPECIES}{$species}{
'list'} }, $type );
978 } ## end sub add_adaptor
981 =head2 add_switchable_adaptor
983 Arg [1] : String name of the species to add its switchable adaptor into the registry
984 Arg [2] : String name of the group to add its switchable adaptor into the registry
985 Arg [3] : String name of the type to add its switchable adaptor into the registry
986 Arg [4] : Reference switchable adaptor to insert
987 Arg [5] : Boolean
override any existing switchable adaptor
990 Exceptions : Thrown
if a valid
internal name cannot be found
for the given
991 name. If thrown check your API and DB version. Also thrown
if
992 no type, group or switchable adaptor instance was given
996 sub add_switchable_adaptor {
997 my ($class, $species, $group, $adaptor_type, $instance, $override) = @_;
999 my $ispecies = $class->get_alias($species);
1000 throw "Cannot decode given species ${species} to an internal registry name" if ! $species;
1001 throw "No group given" if ! $group;
1002 throw "No adaptor type given" if ! $adaptor_type;
1003 throw "No switchable adaptor given" if ! $instance;
1004 throw "Switchable adaptor was not a blessed reference" if ! blessed($instance);
1006 $group = lc($group);
1007 $adaptor_type = lc($adaptor_type);
1009 $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type} = $instance;
1013 if(exists $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type}) {
1014 my $existing_ref = ref($registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type});
1015 throw "Cannot switch adaptors for ${species}, ${group} and ${adaptor_type} because one is already set ($existing_ref). Use the override flag or revert_switchable_adaptor";
1018 $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type} = $instance;
1022 =head2 has_switchable_adaptor
1024 Arg [1] : String name of the species to add its switchable adaptor into the registry
1025 Arg [2] : String name of the group to add its switchable adaptor into the registry
1026 Arg [3] : String name of the type to add its switchable adaptor into the registry
1028 Returntype : Boolean indicating
if a switchable adaptor is available
for your submitted combination
1029 Exceptions : Thrown
if a valid
internal name cannot be found
for the given
1030 name. If thrown check your API and DB version. Also thrown
if
1031 no type, group or switchable adaptor instance was given
1035 sub has_switchable_adaptor {
1036 my ($class, $species, $group, $adaptor_type) = @_;
1038 my $ispecies = $class->get_alias($species);
1039 throw "Cannot decode given species ${species} to an internal registry name" if ! $species;
1040 throw "No group given" if ! $group;
1041 throw "No adaptor type given" if ! $adaptor_type;
1043 $group = lc($group);
1044 $adaptor_type = lc($adaptor_type);
1045 return (defined $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type}) ? 1 : 0;
1048 =head2 remove_switchable_adaptor
1050 Arg [1] : name of the species to remove its switchable adaptor from the registry
1051 Arg [2] : name of the group to remove its switchable adaptor from the registry
1052 Arg [3] : name of the type to remove its switchable adaptor from the registry
1054 Returntype : The removed adaptor
if one was removed. Otherwise undef
1055 Exceptions : Thrown
if a valid
internal name cannot be found
for the given
1056 name. If thrown check your API and DB version. Also thrown
if
1057 no type or group was given
1061 sub remove_switchable_adaptor {
1062 my ($class, $species, $group, $adaptor_type) = @_;
1063 my $ispecies = $class->get_alias($species);
1064 throw "Cannot decode given species ${species} to an internal registry name" if ! $species;
1065 throw "No group given" if ! $group;
1066 throw "No adaptor type given" if ! $adaptor_type;
1068 $group = lc($group);
1069 $adaptor_type = lc($adaptor_type);
1070 if(defined $registry_register{_SWITCHABLE}{$ispecies}{$group}{$adaptor_type}) {
1071 my $adaptor = $registry_register{_SWITCHABLE}{$ispecies}{$group}{$adaptor_type};
1072 delete $registry_register{_SWITCHABLE}{$ispecies}{$group}{$adaptor_type};
1080 Arg [1] : name of the species to add the adaptor to in the registry.
1081 Arg [2] : name of the group to add the adaptor to in the registry.
1082 Arg [3] : name of the type to add the adaptor to in the registry.
1084 Description : Finds and returns the specified adaptor. This method will also check
1085 if the species, group and adaptor combination satisfy a DNADB condition
1086 (and will
return that DNADB
's implementation). Also we check for
1087 any available switchable adaptors and will return that if available.
1088 Returntype : adaptor
1089 Exceptions : Thrown if a valid internal name cannot be found for the given
1090 name. If thrown check your API and DB version. Also thrown if
1091 no type or group was given
1097 my ( $class, $species, $group, $type ) = @_;
1099 my $ispecies = $class->get_alias($species);
1101 if ( !defined($ispecies) ) {
1102 throw("Can not find internal name for species '$species
'");
1104 else { $species = $ispecies }
1106 throw 'No adaptor group given
' if ! defined $group;
1107 throw 'No adaptor type given
' if ! defined $type;
1109 $group = lc($group);
1110 my $lc_type = lc($type);
1113 if($type =~ /Adaptor$/i) {
1114 warning("Detected additional Adaptor string in given the type '$type
'. Removing it to avoid possible issues. Alter your type to stop this message");
1115 $type =~ s/Adaptor$//i;
1118 # For historical reasons, allow use of group 'regulation
' to refer to
1120 if ( $group eq 'regulation
' ) { $group = 'funcgen
' }
1122 my %dnadb_adaptors = (
1124 'assemblymapper
' => 1,
1125 'karyotypeband
' => 1,
1126 'repeatfeature
' => 1,
1128 'assemblyexceptionfeature
' => 1
1131 #Before looking for DNA adaptors we need to see if we have a switchable adaptor since they take preference
1132 if(defined $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type}) {
1133 return $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type};
1136 # Look for a possible DNADB group alongside the species hash
1137 my $dnadb_group = $registry_register{_SPECIES}{$species}{ $group }{'_DNA
'};
1139 # If we found one & this is an adaptor we should be replaced by a DNADB then
1140 # look up the species to use and replace the current group with the DNADB group
1141 # (groups are held in _DNA, species are in _DNA2)
1142 if ( defined($dnadb_group) && defined( $dnadb_adaptors{ $lc_type } ) ) {
1143 $species = $registry_register{_SPECIES}{$species}{ $group }{'_DNA2
'};
1144 $group = $dnadb_group;
1146 # Once we have switched to the possibility of a DNADB call now check again for
1147 # a switchable adaptor
1148 if(defined $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type}) {
1149 return $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type};
1153 # No switchable adaptor? Ok then continue with the normal logic
1154 my $ret = $registry_register{_SPECIES}{$species}{ $group }{ $lc_type };
1156 if ( !defined($ret) ) { return }
1157 if ( ref($ret) ) { return $ret }
1159 # Not instantiated yet
1161 my $dba = $registry_register{_SPECIES}{$species}{ $group }{'_DB
'};
1164 my $test_eval = eval "require $module"; ## no critic
1165 if ($@ or (!$test_eval)) {
1166 warning("'$module
' cannot be found.\nException $@\n");
1172 $registry_register{_SPECIES}{$species}{ $group }{'CHECKED
'} )
1175 $registry_register{_SPECIES}{$species}{ $group }{'CHECKED
'} = 1;
1176 $class->version_check($dba);
1179 my $adap = "$module"->new($dba);
1180 Bio::EnsEMBL::Registry->add_adaptor( $species, $group, $type, $adap,
1185 } ## end sub get_adaptor
1187 =head2 get_all_adaptors
1189 Arg [SPECIES] : (optional) string
1190 species name to get adaptors for
1191 Arg [GROUP] : (optional) string
1192 group name to get adaptors for
1193 Arg [TYPE] : (optional) string
1194 type to get adaptors for
1195 Example : @adaps = @{Bio::EnsEMBL::Registry->get_all_adaptors()};
1196 Returntype : ref to list of adaptors
1202 sub get_all_adaptors{
1203 my ($class,@args)= @_;
1204 my ($species, $group, $type);
1206 my (%species_hash, %group_hash, %type_hash);
1209 if(@args == 1){ # Old species only one parameter
1210 warn("-SPECIES argument should now be used to get species adaptors");
1211 $species = $args[0];
1214 # new style -SPECIES, -GROUP, -TYPE
1215 ($species, $group, $type) =
1216 rearrange([qw(SPECIES GROUP TYPE)], @args);
1219 if(defined($species)){
1220 $species_hash{$species} = 1;
1223 # get list of species
1224 foreach my $dba (@{$registry_register{'_DBA
'}}){
1225 $species_hash{lc($dba->species())} = 1;
1228 if(defined($group)){
1229 $group_hash{$group} = 1;
1232 foreach my $dba (@{$registry_register{'_DBA
'}}){
1233 $group_hash{lc($dba->group())} = 1;
1237 if ( defined($type) ) {
1238 $type_hash{$type} = 1;
1240 foreach my $dba ( @{ $registry_register{'_DBA
'} } ) {
1242 @{ $registry_register{_SPECIES}{ lc( $dba->species ) }{'list
'} }
1245 $type_hash{ lc($ty) } = 1;
1250 ### NOW NEED TO INSTANTIATE BY CALLING get_adaptor
1251 foreach my $sp ( keys %species_hash ) {
1252 foreach my $gr ( keys %group_hash ) {
1253 foreach my $ty ( keys %type_hash ) {
1254 my $temp = $class->get_adaptor( $sp, $gr, $ty );
1255 if ( defined($temp) ) {
1268 Arg [1] : name of the species to add alias for
1269 Arg [2] : name of the alias
1270 Example : Bio::EnsEMBL::Registry->add_alias("Homo Sapiens","Human");
1271 Description: add alternative name for the species.
1279 my ($class, $species,$key) = @_;
1281 $registry_register{'_ALIAS
'}{lc($key)} = lc($species);
1287 Arg [1] : name of the species to remove alias for
1288 Arg [2] : name of the alias
1289 Example : Bio::EnsEMBL::Registry->remove_alias("Homo Sapiens","Human");
1290 Description: remove alternative name for the species.
1298 my ($class, $species,$key) = @_;
1300 delete $registry_register{'_ALIAS
'}{lc($key)};
1308 Arg [1] : name of the possible alias to get species for
1309 Example : Bio::EnsEMBL::Registry->get_alias("Human");
1310 Description: get proper species name.
1311 Returntype : species name
1318 my ( $class, $key, $no_warn ) = @_;
1320 if ( !defined( $registry_register{'_ALIAS
'}{ lc($key) } ) ) {
1321 if ( ( !defined( $registry_register{_SPECIES}{ lc($key) } ) ) and
1322 ( !defined( $registry_register{_ALIAS}{ lc($key) } ) ) )
1324 if ( ( !defined($no_warn) ) or ( !$no_warn ) ) {
1325 warning( "$key is not a valid species name " .
1326 "(check DB and API version)" );
1330 else { return $key }
1333 return $registry_register{'_ALIAS
'}{ lc($key) };
1336 =head2 get_all_aliases
1338 Arg [1] : Species name to retrieve aliases for
1339 (may be an alias as well).
1340 Example : Bio::EnsEMBL::Registry->get_all_aliases('Homo sapiens
');
1341 Description: Returns all known aliases for a given species (but not the
1342 species name/alias that was given).
1343 Returntype : ArrayRef of all known aliases
1345 Status : Development
1349 sub get_all_aliases {
1350 my ( $class, $key ) = @_;
1352 my $species = $registry_register{_ALIAS}{ lc($key) };
1355 if ( defined($species) ) {
1356 foreach my $alias ( keys( %{ $registry_register{_ALIAS} } ) ) {
1357 if ( $species ne $alias
1358 && $species eq $registry_register{_ALIAS}{ lc($alias) } )
1360 push( @aliases, $alias );
1370 Arg [1] : name of the possible alias to get species for
1371 Example : Bio::EnsEMBL::Registry->alias_exists("Human");
1372 Description: does the species name exist.
1373 Returntype : 1 if exists else 0
1380 my ( $class, $key ) = @_;
1382 return defined( $registry_register{'_ALIAS
'}{ lc($key) } );
1385 =head2 set_disconnect_when_inactive
1387 Example : Bio::EnsEMBL::Registry->set_disconnect_when_inactive();
1388 Description: Set the flag to make sure that the database connection is dropped if
1389 not being used on each database.
1396 sub set_disconnect_when_inactive{
1397 foreach my $dba ( @{get_all_DBAdaptors()}){
1398 my $dbc = $dba->dbc;
1399 # Disconnect if connected
1400 $dbc->disconnect_if_idle() if $dbc->connected();
1401 $dbc->disconnect_when_inactive(1);
1406 =head2 set_reconnect_when_lost
1408 Example : Bio::EnsEMBL::Registry->set_reconnect_when_lost();
1409 Description: Set the flag to make sure that the database connection is not lost before it's used.
1410 This is useful
for long running jobs (over 8hrs).
1417 sub set_reconnect_when_lost{
1418 foreach my $dba ( @{get_all_DBAdaptors()}){
1419 my $dbc = $dba->dbc;
1420 $dbc->reconnect_when_lost(1);
1425 =head2 disconnect_all
1428 Description: disconnect from all the databases.
1435 sub disconnect_all {
1436 foreach my $dba ( @{get_all_DBAdaptors()||[]} ){
1437 my $dbc = $dba->dbc;
1439 # Disconnect if connected
1440 $dbc->disconnect_if_idle()
if $dbc->connected();
1445 =head2 get_DBAdaptor_count
1448 Description : Returns the count of database adaptors currently held by
1450 Returntype : Int count of database adaptors currently known
1455 sub get_DBAdaptor_count {
1456 return scalar(@{$registry_register{
'_DBA'}})
if(defined $registry_register{
'_DBA'});
1460 =head2 change_access
1462 Will change the username and password
for a set of databases.
1463 if host,user or database names are missing then these are not checked.
1464 So
for example
if you
do not specify a database then ALL databases on
1465 the specified host and port will be changed.
1467 Arg [1] : name of the host to change access on
1468 Arg [2] : port number to change access on
1469 Arg [3] : name of the user to change access on
1470 Arg [4] : name of the database to change access on
1471 Arg [5] : name of the
new user
1472 Arg [6] :
new password
1475 Description: change username and password on one or more databases
1483 my ($self, $host,$port,$user,$dbname,$new_user,$new_pass) = @_;
1484 foreach my $dba ( @{$registry_register{
'_DBA'}}){
1485 my $dbc = $dba->dbc;
1486 if((((!defined($host)) or ($host eq $dbc->host))) and
1487 (((!defined($port)) or ($port eq $dbc->port))) and
1488 (((!defined($user)) or ($user eq $dbc->username))) and
1489 ((!defined($dbname)) or ($dbname eq $dbc->dbname))){
1490 if($dbc->connected()){
1491 $dbc->db_handle->disconnect();
1492 $dbc->connected(undef);
1494 # over write the username and password
1495 $dbc->username($new_user);
1496 $dbc->password($new_pass);
1504 =head2 load_registry_from_url
1506 Arg [1] :
string $url
1507 Arg [2] : (optional) integer
1508 If not 0, will print out all information.
1509 Arg [3] : (optional) integer
1510 This option will turn off caching
for slice features, so,
1511 every time a set of features is retrieved, they will come
1512 from the database instead of the cache. This option is only
1513 recommended
for advanced users, specially
if you need to
1514 store and retrieve features. It might reduce performance when
1515 querying the database
if not used properly. If in doubt,
do
1516 not use it or ask in the developer mailing list.
1518 Example : load_registry_from_url(
1519 'mysql://anonymous@ensembldb.ensembl.org:3306');
1521 load_registry_from_url(
1522 'mysql://anonymous@ensembldb.ensembl.org:3306/homo_sapiens_core_65_37?group=core&species=homo_sapiens'
1525 load_registry_from_url(
1526 'mysql://anonymous@ensembldb.ensembl.org:3306/homo_sapiens_core_65_37?group=core'
1530 Description: Will load the correct versions of the ensembl
1531 databases
for the software release it can find on
1532 a database instance into the registry. Also adds
1533 a set of standard aliases. The url format is:
1535 can also request a specific version
for the databases
1536 by adding a slash and the version number but your
1537 script may crash as the API version won
't match the
1540 You can also specify a database name which will cause the
1541 loading of a single DBAdaptor instance. Parameters are
1542 mapped from a normal URL parameter set to their DBAdaptor
1543 equivalent. Group must be defined.
1545 Returntype : Int count of the DBAdaptor instances which can be found in the
1548 Exceptions : Thrown if the given URL does not parse according to the above
1549 scheme and if the specified database cannot be connected to
1550 (see L<load_registry_from_db> for more information)
1555 sub load_registry_from_url {
1556 my ( $self, $url, $verbose, $no_cache ) = @_;
1558 if ( $url =~ /^mysql\:\/\/([^\@]+\@)?([^\:\/]+)(\:\d+)?(\/\d+)?\/?$/x ) {
1564 $user_pass =~ s/\@$//;
1565 my ( $user, $pass ) = $user_pass =~ m/([^\:]+)(\:.+)?/x;
1566 $pass =~ s/^\://x if ($pass);
1567 $port =~ s/^\://x if ($port);
1568 $version =~ s/^\///x if ($version);
1570 return $self->load_registry_from_db(
1575 -db_version => $version,
1576 -verbose => $verbose,
1577 -no_cache => $no_cache
1580 my $uri = parse_uri($url);
1582 if($uri->scheme() eq 'mysql
') {
1583 my %params = $uri->generate_dbsql_params();
1584 if($params{-DBNAME}) {
1585 $params{-SPECIES} = $params{-DBNAME} unless $params{-SPECIES};
1586 $params{-NO_CACHE} = 1 if $no_cache;
1587 my $group = $params{-GROUP};
1588 my $class = $self->_group_to_adaptor_class($group);
1590 printf("Loading database '%s
' from group '%s
' with DBAdaptor class '%s
' from url %s\n", $params{-DBNAME}, $group, $class, $url);
1592 $class->new(%params);
1597 throw("Only MySQL URLs are accepted. Given URL was '${url}
'");
1598 } ## end sub load_registry_from_url
1601 =head2 load_registry_from_db
1604 The domain name of the database host to connect to.
1607 The name of the database user to connect with.
1609 Arg [PASS] : (optional) string
1610 The password to be used to connect to the database.
1612 Arg [PORT] : (optional) integer
1613 The port to use when connecting to the database.
1615 Arg [VERBOSE]: (optional) boolean
1616 Whether to print database messages. This includes a listing
1617 of all available species & databases.
1619 Arg [SPECIES]: (optional) string
1620 By default, all databases that are found on the
1621 server and that corresponds to the correct release
1622 are probed for aliases etc. For some people,
1623 depending on where they are in the world, this might
1624 be a slow operation. With the '-species
' argument,
1625 one may reduce the startup time by restricting the
1626 set of databases that are probed to those of a
1629 Note that the latin name of the species is required,
1630 e.g., 'homo sapiens
', 'gallus gallus
', 'callithrix
1631 jacchus
' etc. It may be the whole species name,
1632 or only the first part of the name, e.g. 'homo
',
1633 'gallus
', or 'callithrix
'. This will be used in
1634 matching against the name of the databases.
1636 Arg [DB_VERSION]: (optional) integer
1637 By default, only databases corresponding to the
1638 current API version are loaded. This argument
1639 allows the script to use databases from another
1640 version although it might not work properly. This
1641 argument should only be used for production or
1642 testing purposes and if you really know what you are
1645 Arg [WAIT_TIMEOUT]: (optional) integer
1646 Time in seconds for the wait timeout to happen.
1647 Time after which the connection is deleted if not
1648 used. By default this is 28800 (8 hours), so set
1649 this to greater than this if your connection are
1650 getting deleted. Only set this if you are having
1651 problems and know what you are doing.
1653 Arg [-NO_CACHE]: (optional) boolean
1654 This option will turn off caching for slice features,
1655 so, every time a set of features is retrieved, they
1656 will come from the database instead of the cache. This
1657 option is only recommended for advanced users, specially
1658 if you need to store and retrieve features. It might
1659 reduce performance when querying the database if not
1660 used properly. If in doubt, do not use it or ask in the
1661 developer mailing list.
1663 Arg [SPECIES_SUFFIX]: (optional) string
1664 This option will append the string to the species name
1665 in the registry for all databases found on this server.
1669 $registry->load_registry_from_db(
1670 -host => 'ensembldb.ensembl.org
',
1671 -user => 'anonymous
',
1675 Description: Will load the correct versions of the Ensembl
1676 databases for the software release it can find on a
1677 database instance into the registry. Also adds a set
1678 of standard aliases.
1680 Returntype : Int count of the DBAdaptor instances which can be found in the
1681 registry due to this method call.
1683 Exceptions : Thrown if the given MySQL database cannot be connected to
1684 or there is any error whilst querying the database.
1689 sub load_registry_from_db {
1690 my ( $self, @args ) = @_;
1692 my ( $host, $port, $user,
1693 $pass, $verbose, $db_version,
1694 $wait_timeout, $no_cache, $species, $species_suffix, $db_prefix )
1695 = rearrange( [ 'HOST
', 'PORT
',
1697 'VERBOSE
', 'DB_VERSION
',
1698 'WAIT_TIMEOUT
', 'NO_CACHE
',
1699 'SPECIES
', 'SPECIES_SUFFIX
', 'DB_PREFIX
' ],
1702 my $ignore_multi = 0;
1704 if ( defined($species) ) {
1705 $species = lc($species);
1706 $species =~ tr/ -/__/;
1709 if (!defined($species_suffix)) {
1710 $species_suffix = "";
1712 if (defined($db_prefix)) {
1713 $db_prefix = $db_prefix . '_
';
1718 if(! defined $db_version) {
1719 # Do checking for the -DB_VERSION flag which can be mis-spelt. Regex assembled using:
1720 # perl -MRegexp::Assemble -e '$r=Regexp::Assemble->new(); $r->add($_)
for (
"-dbversion",
"-version",
"-verion",
"-verison"); print $r->re,
"\n";
'
1721 my %hashed_args = @args;
1722 my ($possible_key) = grep { $_ =~ /(?-xism:-(?:ver(?:is?|si)|dbversi)on)/xism } keys %hashed_args;
1724 my $msg = sprintf(q{Detected no -DB_VERSION flag but found '%s
'; assuming a mis-spelling. Please fix}, $possible_key);
1726 $db_version = $hashed_args{$possible_key};
1732 my $ontology_version;
1735 my $taxonomy_db_versioned;
1736 my $ensembl_metadata_db;
1737 my $ensembl_metadata_db_versioned;
1739 my $production_dba_ok =
1740 eval { require Bio::EnsEMBL::Production::DBSQL::DBAdaptor; 1 };
1742 my $production_version;
1745 my $stable_ids_version;
1747 $user ||= "anonymous";
1748 if ( !defined($port) ) {
1750 if ( $host eq "ensembldb.ensembl.org" && defined($db_version) && $db_version < 48 ) {
1755 $wait_timeout ||= 0;
1757 my $original_count = $self->get_DBAdaptor_count();
1759 my $err_pattern = 'Cannot %s to the Ensembl MySQL server at %s:%d; check your settings & DBI error message: %s
';
1761 my $dbh = DBI->connect( "DBI:mysql:host=$host;port=$port", $user, $pass ) or
1762 throw(sprintf($err_pattern, 'connect
', $host, $port, $DBI::errstr));
1764 throw(sprintf($err_pattern, 'ping
', $host, $port, $DBI::errstr));
1766 my $res = $dbh->selectall_arrayref('SHOW DATABASES
');
1767 my @dbnames = map { $_->[0] } @$res;
1770 my $software_version = software_version();
1772 if ( defined($db_version) ) {
1773 $software_version = $db_version;
1777 printf( "Will only load v%d databases\n", $software_version );
1780 # From the list of all the databses create a tempory hash of those we
1783 for my $db (@dbnames) {
1784 if ( $db =~ /^(\w+_collection_\w+(?:_\d+)?)_((\d+)_\w+)/ )
1785 { # NEEDS TO BE FIRST TO PICK UP COLLECTION DBS
1786 if ( $3 eq $software_version ) {
1789 } elsif ( $db =~ /^(.+)_(userdata)$/x ) {
1792 $db =~ /^(ensembl_compara # compara database
1793 (?:_\w+)*?) # optional ensembl genomes bit
1797 if ( $2 eq $software_version ) {
1800 } elsif ( $db =~ /^(ensembl_ancestral(?:_\w+?)*?)_(\d+)$/x ) {
1801 if ( $2 eq $software_version ) {
1804 } elsif ( $db =~ /^ensembl(?:genomes)?_ontology_(?:\d+_)?(\d+)/x ) {
1805 if ( $1 eq $software_version ) {
1807 $ontology_version = $1;
1809 } elsif ( $db =~ /^ncbi_taxonomy$/ ) {
1812 elsif ( $db =~ m{ \A ncbi_taxonomy_(\d+) \z }msx ) {
1813 if ( $1 eq $software_version ) {
1814 $taxonomy_db_versioned = $db;
1816 } elsif ( $db =~ /^ensembl_metadata$/ ) {
1817 $ensembl_metadata_db = $db;
1819 elsif ( $db =~ m{ \A ensembl_metadata_(\d+) \z }msx ) {
1820 if ( $1 eq $software_version ) {
1821 $ensembl_metadata_db_versioned = $db;
1823 } elsif ( $production_dba_ok and $db =~ /^ensembl(?:genomes)?_production(_\d+)?/x ) {
1824 # production db can come with no version (i.e. that on ens-staging1),
1825 # but it's backed up with a release number
1829 if ($software_version and $version eq $software_version) {
1830 $production_db = $db;
1831 $production_version = $version;
1833 }
else { #
this is the
default choice
1834 $production_db = $db
if $db =~ /^ensembl(?:genomes)?_production$/;
1836 } elsif ( $db =~ /^ensembl(?:genomes)?_stable_ids_(?:\d+_)?(\d+)/x ) {
1837 if ( $1 eq $software_version ) {
1838 $stable_ids_db = $db;
1839 $stable_ids_version = $1;
1843 $db =~ /^(?:$db_prefix)([a-z]+_[a-z0-9]+(?:_[a-z0-9]+)? # species name e.g. homo_sapiens or canis_lupus_familiaris
1846 (?:_\d+)?) # optional end bit
for ensembl genomes databases
1848 (\d+) # database release
1850 (\w+)$ # assembly number can have letters too e.g 37c
1855 # Species specific databases (core, cdna, vega etc.)
1857 my ( $sp_name, $db_rel, $assem ) = ( $1, $2, $3 );
1858 if ($db_prefix) { $sp_name = $db_prefix . $sp_name; }
1860 if ( !defined($species) || $sp_name =~ /^$species/ ) {
1861 if ( $db_rel eq $software_version ) {
1862 $temp{$sp_name} = $db_rel .
"_" . $assem;
1867 # warn( sprintf( "Skipping database '%s'\n", $db ) );
1869 } ## end
for my $db (@dbnames)
1873 foreach my $key ( keys %temp ) {
1874 push @dbnames, $key .
"_" . $temp{$key};
1877 # Register Core like databases
1878 my $core_like_dbs_found = 0;
1879 foreach my $type (qw(core cdna vega vega_update otherfeatures rnaseq ccds)) {
1881 my @dbs = grep { /^(?:$db_prefix)[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)? # species name
1883 $type # the database type
1885 (?:\d+_)? # optional end bit
for ensembl genomes
1886 \d+ # database release
1891 $core_like_dbs_found = 1;
1894 foreach my $database (@dbs) {
1895 if ( index( $database,
'collection' ) != -1 ) {
1896 # Skip multi-species databases.
1901 my ( $prefix, $species, $num ) =
1902 ( $database =~ /(^$db_prefix)([a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?) # species name
1906 (?:\d+_)? # optional endbit
for ensembl genomes
1907 (\d+)
# databases release
1911 if(!defined($species)){
1912 warn
"Cannot extract species name from database '$database'";
1918 -species => $species.$species_suffix,
1923 -dbname => $database,
1924 -wait_timeout => $wait_timeout,
1925 -no_cache => $no_cache );
1928 printf(
"Species '%s' loaded from database '%s'\n",
1929 $species, $database );
1934 # Register multi-species databases
1936 my @multi_dbs = grep { /^\w+_collection_core_\w+$/ } @dbnames;
1938 if (!$ignore_multi) {
1939 foreach my $multidb (@multi_dbs) {
1940 my $sth = $dbh->prepare(
1942 "SELECT species_id, meta_value FROM %s.meta "
1943 .
"WHERE meta_key = 'species.db_name'",
1944 $dbh->quote_identifier($multidb) ) );
1948 my ( $species_id, $species );
1949 $sth->bind_columns( \( $species_id, $species ) );
1951 while ( $sth->fetch() ) {
1954 -species => $species.$species_suffix,
1955 -species_id => $species_id,
1956 -multispecies_db => 1,
1961 -dbname => $multidb,
1962 -wait_timeout => $wait_timeout,
1963 -no_cache => $no_cache
1967 printf(
"Species '%s' (id:%d) loaded from database '%s'\n",
1968 $species, $species_id, $multidb );
1971 } ## end
foreach my $multidb (@multi_dbs)
1974 if(!$core_like_dbs_found && $verbose) {
1975 print(
"No core-like databases found. Check your DB_VERSION (used '$software_version')\n");
1980 my @userupload_dbs = grep { /_userdata$/ } @dbnames;
1981 if (!$ignore_multi) {
1982 for my $userupload_db (@userupload_dbs) {
1983 if ( index( $userupload_db,
'collection' ) != -1 ) {
1984 # Skip multi-species databases.
1988 my ($species) = ( $userupload_db =~ /(^.+)_userdata$/ );
1991 -group =>
"userupload",
1992 -species => $species.$species_suffix,
1997 -wait_timeout => $wait_timeout,
1998 -dbname => $userupload_db,
1999 -no_cache => $no_cache );
2002 printf(
"%s loaded\n", $userupload_db );
2007 # Register multi-species userupload databases.
2008 my @userdata_multidbs = grep { /^.+_collection_userdata$/ } @dbnames;
2010 if (!$ignore_multi) {
2011 foreach my $multidb (@userdata_multidbs) {
2012 my $sth = $dbh->prepare(
2014 "SELECT species_id, meta_value FROM %s.meta "
2015 .
"WHERE meta_key = 'species.db_name'",
2016 $dbh->quote_identifier($multidb) ) );
2020 my ( $species_id, $species );
2021 $sth->bind_columns( \( $species_id, $species ) );
2023 while ( $sth->fetch() ) {
2025 -group =>
"userupload",
2026 -species => $species.$species_suffix,
2027 -species_id => $species_id,
2028 -multispecies_db => 1,
2033 -dbname => $multidb,
2034 -wait_timeout => $wait_timeout,
2035 -no_cache => $no_cache
2039 printf(
"Species '%s' (id:%d) loaded from database '%s'\n",
2040 $species, $species_id, $multidb );
2043 } ## end
foreach my $multidb (@userdata_multidbs)
2048 my $test_eval = eval
"require Bio::EnsEMBL::Variation::DBSQL::DBAdaptor"; ## no critic
2049 if ($@or (!$test_eval)) {
2050 # Ignore variations as code required not there for this
2053 "Bio::EnsEMBL::Variation::DBSQL::DBAdaptor module not found "
2054 .
"so variation databases will be ignored if found\n" );
2059 grep { /^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?_variation_(?:\d+_)?\d+_/ } @dbnames;
2061 if(! @variation_dbs && $verbose) {
2062 print(
"No variation databases found\n");
2065 for my $variation_db (@variation_dbs) {
2067 if ( index( $variation_db,
'collection' ) != -1 ) {
2068 # Skip multi-species databases.
2072 my ( $species, $num ) =
2073 ( $variation_db =~ /(^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?)_variation_(?:\d+_)?(\d+)_/ );
2075 Bio::EnsEMBL::Variation::DBSQL::DBAdaptor->new(
2076 -group =>
"variation",
2077 -species => $species.$species_suffix,
2082 -wait_timeout => $wait_timeout,
2083 -dbname => $variation_db,
2084 -no_cache => $no_cache );
2087 printf(
"%s loaded\n", $variation_db );
2091 # Register variation multispecies databases
2092 my @variation_multidbs =
2093 grep { /^\w+_collection_variation_\w+$/ } @dbnames;
2095 if (!$ignore_multi) {
2096 foreach my $multidb (@variation_multidbs) {
2097 my $sth = $dbh->prepare(
2098 sprintf(
'SELECT species_id, meta_value FROM %s.meta ',
2099 $dbh->quote_identifier($multidb) )
2100 .
"WHERE meta_key = 'species.db_name'"
2105 my ( $species_id, $species );
2106 $sth->bind_columns( \( $species_id, $species ) );
2108 while ( $sth->fetch() ) {
2109 my $dba = Bio::EnsEMBL::Variation::DBSQL::DBAdaptor->new(
2110 -group =>
'variation',
2111 -species => $species.$species_suffix,
2112 -species_id => $species_id,
2113 -multispecies_db => 1,
2118 -dbname => $multidb,
2119 -wait_timeout => $wait_timeout,
2120 -no_cache => $no_cache
2124 printf(
"Species '%s' (id:%d) loaded from database '%s'\n",
2125 $species, $species_id, $multidb );
2128 } ## end
foreach my $multidb (@variation_multidbs)
2132 my $func_eval = eval
"require Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor"; ## no critic
2133 if ($@ or (!$func_eval)) {
2135 # Ignore funcgen DBs as code required not there for this
2136 print(
"Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor module not found "
2137 .
"so functional genomics databases will be ignored if found\n"
2142 grep { /^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?_funcgen_(?:\d+_)?\d+_/ } @dbnames;
2144 if(! @funcgen_dbs && $verbose) {
2145 print(
"No funcgen databases found\n");
2148 for my $funcgen_db (@funcgen_dbs) {
2149 if ( index( $funcgen_db,
'collection' ) != -1 ) {
2150 # Skip multi-species databases.
2154 my ( $species, $num ) =
2155 ( $funcgen_db =~ /(^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?)_funcgen_(?:\d+_)?(\d+)_/ );
2156 my $dba = Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor->new(
2157 -group =>
"funcgen",
2158 -species => $species.$species_suffix,
2163 -wait_timeout => $wait_timeout,
2164 -dbname => $funcgen_db,
2165 -no_cache => $no_cache
2169 printf(
"%s loaded\n", $funcgen_db );
2173 # Register functional genomics multispecies databases
2174 my @funcgen_multidbs =
2175 grep { /^\w+_collection_funcgen_\w+$/ } @dbnames;
2177 if (!$ignore_multi) {
2178 foreach my $multidb (@funcgen_multidbs) {
2179 my $sth = $dbh->prepare(
2180 sprintf(
'SELECT species_id, meta_value FROM %s.meta ',
2181 $dbh->quote_identifier($multidb) )
2182 .
"WHERE meta_key = 'species.db_name'"
2187 my ( $species_id, $species );
2188 $sth->bind_columns( \( $species_id, $species ) );
2190 while ( $sth->fetch() ) {
2191 my $dba = Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor->new(
2192 -group =>
'funcgen',
2193 -species => $species.$species_suffix,
2194 -species_id => $species_id,
2195 -multispecies_db => 1,
2200 -dbname => $multidb,
2201 -wait_timeout => $wait_timeout,
2202 -no_cache => $no_cache
2206 printf(
"Species '%s' (id:%d) loaded from database '%s'\n",
2207 $species, $species_id, $multidb );
2210 } ## end
foreach my $multidb (@funcgen_multidbs)
2212 } ## end
else [
if ($@) ]
2216 my @compara_dbs = grep { /^ensembl_compara/ } @dbnames;
2218 if (!$ignore_multi) {
2220 my $comp_eval = eval
"require Bio::EnsEMBL::Compara::DBSQL::DBAdaptor"; ## no critic
2221 if ($@ or (!$comp_eval)) {
2222 # Ignore Compara as code required not there for this
2225 "Bio::EnsEMBL::Compara::DBSQL::DBAdaptor "
2226 .
"not found so the following compara "
2227 .
"databases will be ignored: %s\n",
2228 join(
', ', @compara_dbs ) );
2231 foreach my $compara_db (@compara_dbs) {
2232 # Looking for EnsEMBL Genomes Comparas.
2233 # ensembl_compara_bacteria_2_53 is registered as
2234 # 'bacteria', ensembl_compara_pan_homology_2_53 is
2235 # registered as 'pan_homology', ensembl_compara_53 is
2236 # registered as 'multi', and the alias 'compara' still
2240 $compara_db =~ /^ensembl_compara_(\w+)(?:_\d+){2}$/xm;
2242 $species ||=
'multi';
2244 my $dba = Bio::EnsEMBL::Compara::DBSQL::DBAdaptor->new(
2245 -group =>
'compara',
2246 -species => $species.$species_suffix,
2251 -wait_timeout => $wait_timeout,
2252 -dbname => $compara_db,
2253 -no_cache => $no_cache
2257 printf(
"%s loaded\n", $compara_db );
2259 } ## end
foreach my $compara_db (@compara_dbs)
2260 } ## end
else [
if ($@)
2261 } elsif ($verbose) {
2262 print(
"No Compara databases found\n");
2266 # Ancestral sequences
2269 sort grep { /^ensembl_ancestral/ } @dbnames;
2271 if (@ancestral_dbs && !$ignore_multi) {
2272 foreach my $ancestral_db (@ancestral_dbs) {
2273 # Looking for Compara's "ancestral" databases.
2274 # ensembl_ancestral_plants_47_100 is registered with the 'plants'
2275 # prefix, while ensembl_ancestral_100 is not given any prefix for
2276 # backwards compatibility.
2277 # Similarly, contrary to the nomenclature, "Ancestral sequences"
2278 # is the species (production) name and "ancestral_sequences" is
2281 my ($division) = $ancestral_db =~ /^ensembl_ancestral_(\w+)(?:_\d+){2}$/xm;
2283 $species = (ucfirst $division).
' Ancestral sequences'.$species_suffix;
2284 $alias = $division.
'_ancestral_sequences'.$species_suffix;
2286 $species =
'Ancestral sequences'.$species_suffix;
2287 $alias =
'ancestral_sequences'.$species_suffix;
2292 -species => $species,
2297 -wait_timeout => $wait_timeout,
2298 -dbname => $ancestral_db,
2299 -no_cache => $no_cache
2303 -species => $species,
2308 printf(
"%s loaded\n", $ancestral_db );
2311 } elsif ($verbose) {
2312 print(
"No ancestral database found\n");
2317 if ( defined($ontology_version) && $ontology_version != 0 && !$ignore_multi) {
2322 '-species' =>
'multi' . $species_suffix,
2323 '-group' =>
'ontology',
2328 '-dbname' => $ontology_db, );
2331 printf(
"%s loaded\n", $ontology_db );
2335 print(
"No ontology database found\n");
2340 if ( ( defined $taxonomy_db ) || ( defined $taxonomy_db_versioned ) ) {
2342 my $has_taxonomy = eval {require Bio::EnsEMBL::Taxonomy::DBSQL::TaxonomyDBAdaptor};
2343 if($@ or (!defined $has_taxonomy)) {
2345 print
"ensembl_taxonomy API not found - ignoring $taxonomy_db\n";
2349 my $taxonomy_dbname;
2350 # Versioned database has priority over unversioned one.
2351 if ( defined $taxonomy_db_versioned ) {
2352 $taxonomy_dbname = $taxonomy_db_versioned;
2355 $taxonomy_dbname = $taxonomy_db;
2358 my $dba = Bio::EnsEMBL::Taxonomy::DBSQL::TaxonomyDBAdaptor->new(
2359 '-species' =>
'multi' . $species_suffix,
2360 '-group' =>
'taxonomy',
2365 '-dbname' => $taxonomy_dbname, );
2368 printf(
"%s loaded\n", $taxonomy_dbname );
2373 print(
"No taxonomy database found\n");
2378 if ( ( defined $ensembl_metadata_db ) || ( defined $ensembl_metadata_db_versioned ) ) {
2380 my $has_metadata = eval {require Bio::EnsEMBL::MetaData::DBSQL::MetaDataDBAdaptor};
2381 if($@ or (!defined $has_metadata)) {
2383 print
"ensembl_metadata API not found - ignoring $ensembl_metadata_db\n";
2387 my $metadata_dbname;
2388 # Versioned database has priority over unversioned one.
2389 if ( defined $ensembl_metadata_db_versioned ) {
2390 $metadata_dbname = $ensembl_metadata_db_versioned;
2393 $metadata_dbname = $ensembl_metadata_db;
2396 my $dba = Bio::EnsEMBL::MetaData::DBSQL::MetaDataDBAdaptor->new(
2397 '-species' =>
'multi' . $species_suffix,
2398 '-group' =>
'metadata',
2403 '-dbname' => $metadata_dbname, );
2406 printf(
"%s loaded\n", $metadata_dbname );
2411 print(
"No ensembl_metadata database found\n");
2416 if ( $production_dba_ok and defined($production_db) && !$ignore_multi) {
2417 # require Bio::EnsEMBL::Production::DBSQL::DBAdaptor;
2420 Bio::EnsEMBL::Production::DBSQL::DBAdaptor->new(
2421 '-species' =>
'multi' . $species_suffix,
2422 '-group' =>
'production',
2427 '-dbname' => $production_db, );
2430 printf(
"%s loaded\n", $production_db );
2434 print(
"No production database or adaptor found\n");
2439 if ( defined($stable_ids_db) && $stable_ids_version != 0 && !$ignore_multi) {
2443 '-species' =>
'multi' . $species_suffix,
2444 '-group' =>
'stable_ids',
2449 '-dbname' => $stable_ids_db, );
2452 printf(
"%s loaded\n", $stable_ids_db );
2459 -species =>
'multi'.$species_suffix,
2460 -alias => [
'compara'.$species_suffix] );
2463 -species =>
'multi'.$species_suffix,
2464 -alias => [
'ontology'.$species_suffix] );
2466 $production_dba_ok and
2468 -species =>
'multi'.$species_suffix,
2469 -alias => [
'production'.$species_suffix] );
2472 -species =>
'multi'.$species_suffix,
2473 -alias => [
'stable_ids'.$species_suffix] );
2475 # Register aliases as found in adaptor meta tables.
2477 $self->find_and_add_aliases(
'-handle' => $dbh,
2478 '-species_suffix' => $species_suffix );
2482 my $count = $self->get_DBAdaptor_count() - $original_count;
2483 return $count >= 0 ? $count : 0;
2485 } ## end sub load_registry_from_db
2487 =head2 _group_to_adaptor_class
2489 Arg [1] : The group you wish to decode to an adaptor
class
2491 Description : Has an
internal lookup of groups to their adaptor classes
2493 Exceptions : Thrown
if the group is unknown
2498 sub _group_to_adaptor_class {
2499 my ($self, $group) = @_;
2500 my $class = $group2adaptor{$group};
2501 if (!defined $class) {
2503 cdna =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
2504 rnaseq =>
'Bio::EnsEMBL::DBSQL::DBAdaptor',
2507 throw "Group '${group}' is unknown" if ! $class;
2512 =head2 find_and_add_aliases
2515 The adaptor to use to retrieve aliases from.
2517 Arg [GROUP] : (optional)
string
2518 The group you want to find aliases
for. If not
2519 given assumes all types.
2521 Arg [HANDLE] : (optional) DBI database handle
2522 A connected database handle to use instead of
2523 the database handles stored in the DBAdaptors.
2524 Bypasses the use of MetaContainer.
2526 Arg [SPECIES_SUFFIX]: (optional)
string
2527 This option will append the
string to the species
2528 name in the registry
for all databases.
2535 Description : Looks in the meta container
for each database
for
2536 an entry called
"species.alias". If any are found
2537 then the species adaptor is registered to that
2538 set of aliases. This can work across any adaptor
2539 which has a MetaContainer. If no MetaContainer
2540 can be returned from a given adaptor then no alias
2541 searching is performed.
2544 Exceptions : Throws
if an alias is found in more than one species.
2549 sub find_and_add_aliases {
2552 my ($adaptor, $group, $dbh, $species_suffix ) =
2553 rearrange( [
'ADAPTOR',
'GROUP',
'HANDLE',
'SPECIES_SUFFIX' ], @_ );
2555 #Can be undef; needs to be something to avoid warnings
2556 $species_suffix ||= q{};
2559 if ( defined($adaptor) ) {
2561 } elsif ( defined($dbh) ) {
2563 if ( length($species_suffix) > 0 ) {
2564 my @full = @{ $class->get_all_DBAdaptors(
'-GROUP' => $group ) };
2566 foreach my $db (@full) {
2567 if ( $db->species =~ /$species_suffix/ ) {
2573 @dbas = @{ $class->get_all_DBAdaptors(
'-GROUP' => $group ) };
2577 @dbas = @{ $class->get_all_DBAdaptors(
'-GROUP' => $group ) };
2580 my $aliases_for_dbc = {};
2582 foreach my $dba (@dbas) {
2584 my $species = $dba->species();
2586 if ( defined($dbh) ) {
2588 my $dbname = $dba->dbc()->dbname();
2590 if (!defined $aliases_for_dbc->{$dbname}) {
2592 my $sth = $dbh->prepare(sprintf(
"SELECT species_id,meta_value FROM %s.meta "
2593 .
"WHERE meta_key = 'species.alias' ", $dbh->quote_identifier($dbname))
2596 # Execute, and don't care about errors (there will be errors for
2597 # databases without a 'meta' table.
2598 $sth->{
'PrintError'} = 0;
2599 $sth->{
'RaiseError'} = 0;
2600 if (!$sth->execute()) { next }
2601 $sth->{
'PrintError'} = $dbh->{
'PrintError'};
2602 $sth->{
'RaiseError'} = $dbh->{
'RaiseError'};
2606 $sth->bind_columns(\$species_id, \$alias);
2607 while ($sth->fetch()) {
2608 push(@{$aliases_for_dbc->{$dbname}{$species_id}}, $alias);
2612 @aliases = @{$aliases_for_dbc->{$dbname}{$dba->species_id()}||[]}
2615 my $meta_container = eval { $dba->get_MetaContainer() };
2617 if ( defined($meta_container) ) {
2619 @{ $meta_container->list_value_by_key(
'species.alias') }
2623 # Need to disconnect so we do not spam the MySQL servers trying to
2624 # get aliases. Can only call disonnect if dbc was defined.
2625 if ( defined( $dba->dbc() ) ) {
2626 $dba->dbc()->disconnect_if_idle();
2630 foreach my $alias (@aliases) {
2631 my $alias_suffix = $alias.$species_suffix;
2632 #Lowercase because stored aliases are lowercased
2633 my $lc_species = lc($species);
2634 my $lc_alias_suffix = lc($alias_suffix);
2635 if ( !$class->alias_exists( $alias_suffix )
2636 && $lc_species ne $lc_alias_suffix )
2638 $class->add_alias( $species, $alias_suffix );
2640 $lc_species ne $class->get_alias( $alias_suffix ) )
2642 $class->remove_alias( $species, $alias_suffix );
2646 } ## end
foreach my $dba (@dbas)
2648 } ## end sub find_and_add_aliases
2651 =head2 load_registry_from_multiple_dbs
2653 Arg [1] : Array of hashes, each hash being a set of arguments to
2654 load_registry_from_db() (see above).
2658 $registry->load_registry_from_multiple_dbs( {
2659 '-host' =>
'ensembldb.ensembl.org',
2660 '-user' =>
'anonymous',
2664 '-host' =>
'server.example.com',
2665 '-user' =>
'anonymouse',
2666 '-password' =>
'cheese',
2670 Description: Will call load_registry_from_db() (see above)
2671 multiple times and merge the resulting registries
2672 into one, effectively allowing a user to connect to
2673 databases on multiple database servers from within
2676 If a database is found on more than one server, the
2677 first found instance of that database will be used.
2679 Returntype : Int count of the DBAdaptor instances which can be found in the
2684 sub load_registry_from_multiple_dbs {
2685 my ( $self, @args ) = @_;
2687 my $original_count = $self->get_DBAdaptor_count();
2689 my %merged_register = %registry_register;
2691 foreach my $arg (@args) {
2692 local %registry_register = ();
2696 ($verbose) = rearrange( [
'VERBOSE'], %{$arg} );
2698 $self->load_registry_from_db( %{$arg} );
2701 # Merge the localized %registry_register into %merged_register.
2704 # Merge the _SPECIES and _ALIAS sections of %registry_register.
2705 foreach my $section (
'Species',
'Alias' ) {
2706 my $section_key =
'_' . uc($section);
2708 while ( my ( $key, $value ) =
2709 each( %{ $registry_register{$section_key} } ) )
2711 if ( !exists( $merged_register{$section_key}{$key} ) ) {
2712 $merged_register{$section_key}{$key} = $value;
2713 } elsif ($verbose) {
2714 printf(
"%s '%s' found on multiple servers, "
2715 .
"using first found\n",
2720 } ## end
foreach my $arg (@args)
2722 # Add the DBAs from the _SPECIES section into the _DBA section.
2723 foreach my $species_hash ( values( %{ $merged_register{_SPECIES} } ) )
2725 foreach my $group_hash ( values( %{$species_hash} ) ) {
2726 if ( ref($group_hash) eq
'HASH' && exists( $group_hash->{_DB} ) )
2728 push( @{ $merged_register{_DBA} }, $group_hash->{_DB} );
2733 %registry_register = %merged_register;
2735 my $count = $self->get_DBAdaptor_count() - $original_count;
2736 return $count >= 0 ? $count : 0;
2737 } ## end sub load_registry_from_multiple_dbs
2740 # Web specific routines
2743 =head2 set_default_track
2745 Sets a flag to say that that
this species/group are a
default track and
do not
2746 need to be added as another web track.
2748 Arg [1] : name of the species to get the adaptors
for in the registry.
2749 Arg [2] : name of the type to get the adaptors
for in the registry.
2757 sub set_default_track {
2758 my ( $class, $species, $group ) = @_;
2760 $species = get_alias($species);
2761 $registry_register{
'def_track'}{$species}{ lc($group) } = 1;
2765 =head2 default_track
2767 Check flag to see
if this is a
default track
2769 Arg [1] : name of the species to get the adaptors
for in the registry.
2770 Arg [2] : name of the type to get the adaptors
for in the registry.
2779 my ( $class, $species, $group ) = @_;
2781 $species = get_alias($species);
2783 defined( $registry_register{
'def_track'}{$species}{ lc($group) } ) )
2792 =head2 add_new_tracks
2794 Will add
new gene tracks to the configuration of the WEB server
if they are
2795 not of the type
default and the configuration already has genes in the display.
2797 Arg [1] : hash of the
default configuration of the web page
2800 Called by : UserConfig.pm
2806 my($class, $conf, $pos) = @_;
2810 my $species_reg = $reg->get_alias($conf->{
'species'},
"nothrow");
2812 # print STDERR "Species $species_reg check for default tracks\n";
2813 if(defined($species_reg)){
2814 foreach my $dba (@{$reg->get_all_DBAdaptors()}){
2815 if(!$reg->default_track($dba->species,$dba->group)){
2816 $pars{
'available'} =
"species ".$reg->get_alias($dba->species());
2817 $pars{
'db_alias'} = $dba->group();
2818 # print STDERR "Adding new track for ".$dba->species."\t".$dba->group."\n";
2819 $conf->add_new_track_generictranscript(
'',$dba->group(),
"black",$pos,%pars);
2828 =head2 no_version_check
2830 getter/setter
for whether to
run the version checking
2832 Arg[0] : (optional)
int
2833 Returntype :
int or undef
if not set
2839 sub no_version_check {
2840 my ( $self, $arg ) = @_;
2842 && ( $registry_register{
'_no_version_check'} = $arg );
2844 return $registry_register{
'_no_version_check'};
2847 =head2 no_cache_warnings
2849 Arg[0] :
boolean for turning the flag on and off
2850 Description : Turns off any warnings
about not
using caching in all available
2852 Returntype :
boolean Current status
2857 sub no_cache_warnings {
2858 my ($self, $arg) = @_;
2860 $Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor::SILENCE_CACHE_WARNINGS = $arg;
2862 return $Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor::SILENCE_CACHE_WARNINGS;
2866 =head2 version_check
2868 run the database/API code version check
for a DBAdaptor
2870 Arg[0] : DBAdaptor to check
2871 Returntype :
int 1
if okay, 0
if not the same
2879 my ( $self, $dba ) = @_;
2881 # Check the datbase and versions match
2882 # give warning if they do not.
2883 my $check = no_version_check();
2886 defined( $ENV{HOME} )
2887 and ( -e $ENV{HOME} .
"/.ensemblapi_no_version_check" ) )
2888 or ( defined($check) and ( $check != 0 ) ) )
2894 $self->get_adaptor( $dba->species(), $dba->group(),
2897 my $database_version = 0;
2898 if ( defined($mca) ) {
2899 $database_version = $mca->get_schema_version();
2902 if ( $database_version == 0 ) {
2903 # Try to work out the version
2904 if ( $dba->dbc()->dbname() =~ /^_test_db_/x ) {
2908 # ensembl_metadata was unversioned prior to release 96
2909 # we now have multiple pattern for metadata db name (qrp and grch37) - valid until we merge those.
2910 if ( $dba->dbc()->dbname() =~ /ensembl_metadata(\_?(qrp|grch37)?)/s ) {
2913 # ncbi_taxonomy was unversioned prior to release 100
2914 if ( $dba->dbc()->dbname() eq
'ncbi_taxonomy' ) {
2918 if ( $dba->dbc()->dbname() =~ /(\d+)_\S+$/x ) {
2919 $database_version = $1;
2920 } elsif ( $dba->dbc()->dbname() =~ /ensembl_compara_(\d+)/x ) {
2921 $database_version = $1;
2922 } elsif ( $dba->dbc()->dbname() =~ /ensembl_help_(\d+)/x ) {
2923 $database_version = $1;
2924 } elsif ( $dba->dbc()->dbname() =~ / ensembl_metadata_(\d+) /msx ) {
2925 # Prior to release 96 metadata is supposed to be versionned on meta-1. Not the case since
2926 $database_version = $1;
2927 } elsif ( $dba->dbc()->dbname() =~ /ensembl_ontology_(\d+)/x ) {
2928 $database_version = $1;
2929 } elsif ( $dba->dbc()->dbname() =~ /ensembl_stable_ids_(\d+)/x ) {
2930 $database_version = $1;
2931 } elsif ( $dba->dbc()->dbname() =~ / ncbi_taxonomy_(\d+) /msx ) {
2932 $database_version = $1;
2936 "No database version for database %s "
2937 .
". You must be using a post version 34 database "
2938 .
"with version 34 or later code.\n"
2939 .
"You need to update your database "
2940 .
"or use the appropriate Ensembl software release "
2941 .
"to ensure your script does not crash\n",
2942 $dba->dbc()->dbname() ) );
2944 } ## end
if ( $database_version...
2946 if ( $database_version != software_version() ) {
2949 "For %s there is a difference in the software release (%s) "
2950 .
"and the database release (%s). "
2951 .
"You should update one of these to ensure that your script "
2952 .
"does not crash.\n",
2953 $dba->dbc()->dbname().
"@".$dba->dbc()->host,
2954 software_version(), $database_version
2960 } ## end sub version_check
2962 =head2 get_all_species
2964 Arg [1] : String group type, such as core, or otherfeatures
2965 Description: Method
for getting all valid species names found in available
2966 databases. This excludes the ancestral sequence databases, and
2967 any species from a non-core database. Specifying a group allows
2968 the list to apply to non-core database types.
2969 Example : my @species_names = @{ $reg->get_all_species() };
2970 Returntype : Listref of species names
2974 sub get_all_species {
2975 my ($self,$group) = @_;
2978 foreach my $name (keys %{$registry_register{_SPECIES}}) {
2979 push @species, $name
if (
2980 # limit species names to given db group and no ancestral dbs
2981 $registry_register{_SPECIES}->{$name}->{$group}
2982 && $name !~ /^ancestral/i
2989 =head2 get_species_and_object_type
2991 Description: Get the species name,
object type (gene,
transcript,
2992 translation, or
exon etc.), and database type
for a
2995 Arg [1] : String stable_id
2996 The stable ID to find species and
object type
for.
2998 Arg [2] : String known_type (optional)
2999 The type of the stable ID,
if it is known.
3001 Arg [3] : String known_species (optional)
3002 The species,
if known
3004 Arg [4] : String known_db_type (optional)
3005 The database type,
if known
3007 Example : my $stable_id =
'ENST00000326632';
3009 my ( $species, $object_type, $db_type ) =
3010 $registry->get_species_and_object_type($stable_id);
3013 $registry->get_adaptor( $species, $db_type,
3016 my $object = $adaptor->fetch_by_stable_id($stable_id);
3018 Return type: Array consisting of the species name,
object type,
3019 and database type. The array may be empty
if no
3027 my %stable_id_stmts = (
3028 gene =>
'SELECT m.meta_value '
3030 .
'JOIN %1$s.seq_region USING (seq_region_id) '
3031 .
'JOIN %1$s.coord_system USING (coord_system_id) '
3032 .
'JOIN %1$s.meta m USING (species_id) '
3033 .
'WHERE stable_id = ? '
3034 .
'AND m.meta_key = "species.production_name"',
3036 .
'FROM %1$s.transcript '
3037 .
'JOIN %1$s.seq_region USING (seq_region_id) '
3038 .
'JOIN %1$s.coord_system USING (coord_system_id) '
3039 .
'JOIN %1$s.meta m USING (species_id) '
3040 .
'WHERE stable_id = ? '
3041 .
'AND m.meta_key = "species.production_name"',
3042 exon =>
'SELECT m.meta_value '
3044 .
'JOIN %1$s.seq_region USING (seq_region_id) '
3045 .
'JOIN %1$s.coord_system USING (coord_system_id) '
3046 .
'JOIN %1$s.meta m USING (species_id) '
3047 .
'WHERE stable_id = ? '
3048 .
'AND m.meta_key = "species.production_name"',
3049 translation =>
'SELECT m.meta_value '
3050 .
'FROM %1$s.translation tl '
3051 .
'JOIN %1$s.transcript USING (transcript_id) '
3052 .
'JOIN %1$s.seq_region USING (seq_region_id) '
3053 .
'JOIN %1$s.coord_system USING (coord_system_id) '
3054 .
'JOIN %1$s.meta m USING (species_id) '
3055 .
'WHERE tl.stable_id = ? '
3056 .
'AND m.meta_key = "species.production_name"',
3057 operon =>
'SELECT m.meta_value '
3058 .
'FROM %1$s.operon '
3059 .
'JOIN %1$s.seq_region USING (seq_region_id) '
3060 .
'JOIN %1$s.coord_system USING (coord_system_id) '
3061 .
'JOIN %1$s.meta m USING (species_id) '
3062 .
'WHERE stable_id = ? '
3063 .
'AND m.meta_key = "species.production_name"',
3064 operontranscript =>
'SELECT m.meta_value '
3065 .
'FROM %1$s.operon_transcript '
3066 .
'JOIN %1$s.seq_region USING (seq_region_id) '
3067 .
'JOIN %1$s.coord_system USING (coord_system_id) '
3068 .
'JOIN %1$s.meta m USING (species_id) '
3069 .
'WHERE stable_id = ? '
3070 .
'AND m.meta_key = "species.production_name"',
3074 my %compara_stable_id_stmts = (
3075 genetree =>
'SELECT 1 FROM %1$s.gene_tree_root WHERE stable_id =?',
3076 family =>
'SELECT 1 from %1$s.family where stable_id = ?',
3080 sub get_species_and_object_type {
3081 my ($self, $stable_id, $known_type, $known_species, $known_db_type, $force_long_lookup, $use_archive) = @_;
3083 #get the stable_id lookup database adaptor
3085 my $stable_ids_dba = $self->get_DBAdaptor(
"multi",
"stable_ids", 1);
3087 if ($stable_ids_dba && ! $force_long_lookup) {
3088 return $self->_lookup_db_get_species_and_object_type($stable_id, $known_type, $known_species, $known_db_type, $use_archive);
3091 if(defined $known_type) {
3092 my $lc_known_type = lc $known_type;
3093 if(!exists $stable_id_stmts{$lc_known_type} && ! exists $compara_stable_id_stmts{$lc_known_type}) {
3098 $known_db_type =
'core' if ! $known_db_type;
3100 my %get_adaptors_args = (
'-GROUP' => $known_db_type);
3101 $get_adaptors_args{
'-species'} = $known_species
if $known_species;
3104 sort { $a->dbc->host cmp $b->dbc->host || $a->dbc->port <=> $b->dbc->port }
3105 grep { $_->dbc->dbname !~ m{ \A ensembl_metadata | ncbi_taxonomy }msx }
3106 @{$self->get_all_DBAdaptors(%get_adaptors_args)};
3108 foreach my $dba (@dbas) {
3110 my $dba_adaptor_type = $group2adaptor{$dba->group()};
3111 if($dba_adaptor_type eq
'Bio::EnsEMBL::DBSQL::DBAdaptor') {
3112 @results = $self->_core_get_species_and_object_type($stable_id, $known_type, $dba);
3114 elsif($dba_adaptor_type eq
'Bio::EnsEMBL::Compara::DBSQL::DBAdaptor') {
3115 @results = $self->_compara_get_species_and_object_type($stable_id, $known_type, $dba);
3117 return @results
if scalar(@results) > 0;
3118 } ## end
foreach my $dba ( sort { $a...})
3122 } ## end sub get_species_and_object_type
3124 sub _lookup_db_get_species_and_object_type {
3125 my ($self, $stable_id, $known_type, $known_species, $known_db_type, $use_archive) = @_;
3128 my $stable_ids_dba = $self->get_DBAdaptor(
"multi",
"stable_ids", 1);
3130 my ($species, $type, $db_type) = $self->stable_id_lookup($stable_id, $known_type, $known_species, $known_db_type);
3132 if (!$species && $use_archive) {
3133 ($species, $type, $db_type) = $self->archive_id_lookup($stable_id, $known_type, $known_species, $known_db_type);
3134 $retired = 1
if $species;
3137 return ($species ,$type, $db_type, $retired);
3138 } ## end sub _lookup_db_get_species_and_object_type
3141 sub stable_id_lookup {
3142 my ($self, $stable_id, $known_type, $known_species, $known_db_type) = @_;
3144 my $stable_ids_dba = $self->get_DBAdaptor(
"multi",
"stable_ids", 1);
3146 my $statement =
'SELECT name, object_type, db_type FROM stable_id_lookup join species using(species_id) WHERE stable_id = ?';
3147 if ($known_species) {
3148 $statement .=
' AND name = ?';
3150 if ($known_db_type) {
3151 $statement .=
' AND db_type = ?';
3154 $statement .=
' AND object_type = ?';
3157 my $sth = $stable_ids_dba->dbc()->prepare($statement);
3158 $sth->bind_param(1, $stable_id, SQL_VARCHAR);
3159 my $param_count = 1;
3160 if ($known_species) {
3161 $known_species = $self->get_alias($known_species);
3163 $sth->bind_param($param_count, $known_species, SQL_VARCHAR);
3165 if ($known_db_type) {
3167 $sth->bind_param($param_count, $known_db_type, SQL_VARCHAR);
3171 $sth->bind_param($param_count, $known_type, SQL_VARCHAR);
3174 my ($species, $type, $db_type) = $sth->fetchrow_array();
3177 return ($species ,$type, $db_type);
3180 sub archive_id_lookup {
3181 my ($self, $stable_id, $known_type, $known_species, $known_db_type) = @_;
3183 my $stable_ids_dba = $self->get_DBAdaptor(
"multi",
"stable_ids", 1);
3185 my $archive_statement =
'SELECT name, object_type, db_type FROM archive_id_lookup join species using(species_id) WHERE archive_id = ?';
3186 if ($known_species) {
3187 $archive_statement .=
' AND name = ?';
3189 if ($known_db_type) {
3190 $archive_statement .=
' AND db_type = ?';
3193 $archive_statement .=
' AND object_type = ?';
3196 my $archive_sth = $stable_ids_dba->dbc()->prepare($archive_statement);
3197 $archive_sth->bind_param(1, $stable_id, SQL_VARCHAR);
3198 my $param_count = 1;
3199 if ($known_species) {
3200 $known_species = $self->get_alias($known_species);
3202 $archive_sth->bind_param($param_count, $known_species, SQL_VARCHAR);
3204 if ($known_db_type) {
3206 $archive_sth->bind_param($param_count, $known_db_type, SQL_VARCHAR);
3210 $archive_sth->bind_param($param_count, $known_type, SQL_VARCHAR);
3213 $archive_sth->execute();
3214 my ($species, $type, $db_type) = $archive_sth->fetchrow_array();
3215 $archive_sth->finish();
3217 return ($species ,$type, $db_type);
3221 # A level of abstraction because we need to test the stable_id as-is and then
3222 # try to chop off a version id if nothing is return, and try again
3224 sub _core_get_species_and_object_type {
3225 my ($self, $stable_id, $known_type, $dba) = @_;
3227 # Try looking up the species with the stable_is, as-is
3228 my @results = $self->_core_get_species_and_object_type_worker($stable_id, $known_type, $dba);
3232 } elsif(my $vindex = rindex($stable_id,
'.')) {
3233 return $self->_core_get_species_and_object_type_worker(substr($stable_id,0,$vindex), $known_type, $dba)
3234 if(substr($stable_id,$vindex+1) =~ /^\d+$/);
3241 # Loop over a known set of object types for a core DB until we find a hit
3242 sub _core_get_species_and_object_type_worker {
3243 my ($self, $stable_id, $known_type, $dba) = @_;
3244 my @types = defined $known_type ? ($known_type) : (
'Gene',
'Transcript',
'Translation',
'Exon',
'Operon',
'OperonTranscript');
3245 my ($species, $final_type, $final_db_type);
3246 foreach my $type (@types) {
3247 my $statement = sprintf $stable_id_stmts{lc $type}, $dba->dbc->dbname;
3248 my $sth = $dba->dbc()->prepare($statement);
3249 $sth->bind_param(1, $stable_id, SQL_VARCHAR);
3251 $species = $sth->fetchall_arrayref->[0][0];
3253 if(defined $species) {
3254 $final_type = $type;
3255 $final_db_type = $dba->group();
3259 $dba->dbc->disconnect_if_idle(); # always disconnect after lookup
3260 return ($species, $final_type, $final_db_type)
if defined $species;
3264 # A level of abstraction because we need to test the stable_id as-is and then
3265 # try to chop off a version id if nothing is return, and try again
3267 sub _compara_get_species_and_object_type {
3268 my ($self, $stable_id, $known_type, $dba) = @_;
3270 # Try looking up the species with the stable_is, as-is
3271 my @results = $self->_compara_get_species_and_object_type_worker($stable_id, $known_type, $dba);
3275 } elsif(my $vindex = rindex($stable_id,
'.')) {
3276 return $self->_compara_get_species_and_object_type_worker(substr($stable_id,0,$vindex), $known_type, $dba)
3277 if(substr($stable_id,$vindex+1) =~ /^\d+$/);
3284 # Loop over a known set of object types for a compara DB until we find a hit
3285 sub _compara_get_species_and_object_type_worker {
3286 my ($self, $stable_id, $known_type, $dba) = @_;
3287 my @types = defined $known_type ? ($known_type) : (
'GeneTree');
3288 my ($species, $final_type, $final_db_type);
3289 foreach my $type (@types) {
3290 my $statement = sprintf $compara_stable_id_stmts{lc $type}, $dba->dbc->dbname;
3291 my $sth = $dba->dbc()->prepare($statement);
3292 $sth->bind_param(1, $stable_id, SQL_VARCHAR);
3294 my $found = $sth->fetchall_arrayref->[0][0];
3296 if(defined $found) {
3297 $species = $dba->species();
3298 $final_type = $type;
3299 $final_db_type = $dba->group();
3303 $dba->dbc->disconnect_if_idle(); # always disconnect after lookup
3304 return ($species, $final_type, $final_db_type)
if defined $species;