ensembl-hive  2.6
Registry.pm
Go to the documentation of this file.
1 =head1 LICENSE
2 
3 Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
4 Copyright [2016-2024] EMBL-European Bioinformatics Institute
5 
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
9 
10  http://www.apache.org/licenses/LICENSE-2.0
11 
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.
17 
18 =cut
19 
20 
21 =head1 CONTACT
22 
23  Please email comments or questions to the public Ensembl
24  developers list at <http://lists.ensembl.org/mailman/listinfo/dev>.
25 
26  Questions may also be sent to the Ensembl help desk at
27  <http://www.ensembl.org/Help/Contact>.
28 
29 =cut
30 
31 =head1 NAME
32 
34 
35 =head1 SYNOPSIS
36 
38 
39  my $registry = 'Bio::EnsEMBL::Registry';
40 
41  $registry->load_all("configuration_file");
42 
43  $gene_adaptor = $registry->get_adaptor( 'Human', 'Core', 'Gene' );
44 
45 =head1 DESCRIPTION
46 
47 All Adaptors are stored/registered using this module. This module should
48 then be used to get the adaptors needed.
49 
50 The registry can be loaded from a configuration file using the load_all
51 method.
52 
53 If a filename is passed to load_all then this is used. Else if the
54 environment variable ENSEMBL_REGISTRY is set to the name on an existing
55 configuration file, then this is used. Else if the file .ensembl_init
56 in your home directory exist, it is used.
57 
58 For the Web server ENSEMBL_REGISTRY should be set in SiteDefs.pm. This
59 will then be passed on to load_all.
60 
61 
62 The registry can also be loaded via the method load_registry_from_db
63 which given a database host will load the latest versions of the Ensembl
64 databases from it.
65 
66 The four types of registries are for db adaptors, dba adaptors, dna
67 adaptors and the standard type.
68 
69 =head2 db
70 
71 These are registries for backwards compatibility and enable the
72 subroutines to add other adaptors to connections.
73 
74 e.g. get_all_db_adaptors, get_db_adaptor, add_db_adaptor,
75 remove_db_adaptor are the old DBAdaptor subroutines which are now
76 redirected to the Registry.
77 
78 So if before we had
79 
80  my $sfa = $self->adaptor()->db()->get_db_adaptor('blast');
81 
82 We now want to change this to
83 
84  my $sfa =
85  Bio::EnsEMBL::Registry->get_adaptor( "human", "core", "blast" );
86 
87 
88 =head2 DBA
89 
90 These are the stores for the DBAdaptors
91 
92 The Registry will create all the DBConnections needed now if you set up
93 the configuration correctly. So instead of the old commands like
94 
95  my $db = Bio::EnsEMBL::DBSQL::DBAdaptor->new(...);
96  my $exon_adaptor = $db->get_ExonAdaptor;
97 
98 we should now have just
99 
100  my $exon_adaptor =
101  Bio::EnsEMBL::Registry->get_adaptor( "human", "core", "exon" );
102 
103 
104 =head2 DNA
105 
106 This is an internal Registry and allows the configuration of a dnadb.
107 An example here is to set the est database to get its dna data from the
108 core database.
109 
110  ## set the est db to use the core for getting dna data.
111  # Bio::EnsEMBL::Utils::ConfigRegistry->dnadb_add( "Homo Sapiens",
112  # "core", "Homo Sapiens", "est" );
113 
114 
115 =head2 adaptors
116 
117 This is the registry for all the general types of adaptors like
118 GeneAdaptor, ExonAdaptor, Slice Adaptor etc.
119 
120 These are accessed by the get_adaptor subroutine i.e.
121 
122  my $exon_adaptor =
123  Bio::EnsEMBL::Registry->get_adaptor( "human", "core", "exon" );
124 
125 =head1 METHODS
126 
127 =cut
128 
129 
130 
131 package Bio::EnsEMBL::Registry;
132 use strict;
133 use warnings;
134 
135 our $NEW_EVAL = 0;
136 
139 use Bio::EnsEMBL::Utils::Exception qw( deprecate throw warning );
140 use Bio::EnsEMBL::Utils::Argument qw(rearrange);
143 use Bio::EnsEMBL::Utils::URI qw/parse_uri/;
144 
145 use DBI qw(:sql_types);
146 
147 use Scalar::Util qw/blessed/;
148 
149 use vars qw(%registry_register);
150 
151 # This is a map from group names to Ensembl DB adaptors. Used by
152 # load_all() and reset_DBAdaptor().
153 my %group2adaptor = (
154  'compara' => 'Bio::EnsEMBL::Compara::DBSQL::DBAdaptor',
155  'core' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
156  'estgene' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
157  'funcgen' => 'Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor',
158  'gene2phenotype' => 'Bio::EnsEMBL::G2P::DBSQL::DBAdaptor',
159  'regulation' => 'Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor',
160  'hive' => 'Bio::EnsEMBL::Hive::DBSQL::DBAdaptor',
161  'metadata' => 'Bio::EnsEMBL::MetaData::DBSQL::MetaDataDBAdaptor',
162  'ontology' => 'Bio::EnsEMBL::DBSQL::OntologyDBAdaptor',
163  'otherfeatures' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
164  'pipeline' => 'Bio::EnsEMBL::Pipeline::DBSQL::DBAdaptor',
165  'production' => 'Bio::EnsEMBL::Production::DBSQL::DBAdaptor',
166  'stable_ids' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
167  'taxonomy' => 'Bio::EnsEMBL::Taxonomy::DBSQL::TaxonomyDBAdaptor',
168  'variation' => 'Bio::EnsEMBL::Variation::DBSQL::DBAdaptor',
169  'vega' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
170  'vega_update' => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
171 );
172 
173 
174 =head2 load_all
175 
176  Will load the registry with the configuration file which is
177  obtained from the first in the following and in that order.
178 
179  1) If an argument is passed to this method, this is used as the
180  name of the configuration file to read.
181 
182  2) If the environment variable ENSEMBL_REGISTRY is set, this is
183  used as the name of the configuration file to read.
184 
185  3) If the file .ensembl_init exist in the home directory, it is
186  used as the configuration file.
187 
188  Arg [1] : (optional) string
189  Name of file to load the registry from.
190 
191  Arg [2] : (optional) integer
192  If not 0, will print out all information.
193 
194  Arg [3] : (optional) integer
195  If not 0, the database connection will not be
196  cleared, if 0 or if not set the database connections
197  will be cleared (this is the default).
198 
199  Arg [4]: (optional) boolean
200  This option will turn off caching for slice features,
201  so, every time a set of features is retrieved,
202  they will come from the database instead of the
203  cache. This option is only recommended for advanced
204  users, specially if you need to store and retrieve
205  features. It might reduce performance when querying
206  the database if not used properly. If in doubt, do
207  not use it or ask in the developer mailing list.
208 
209  Arg [5]: (optional) boolean
210  This option will make load_all() throw if the configuration file
211  is missing and cannot be guessed from the environment
212 
213  Example : Bio::EnsEMBL::Registry->load_all();
214  Returntype : Int count of the DBAdaptor instances which can be found in the
215  registry due to this method being called. Will never be negative
216  Exceptions : Throws if $throw_if_missing is set and ($config_file is missing
217  and cannot be guessed from the environment
218  Status : Stable
219 
220 =cut
221 
222 sub load_all {
223  my ($class, $config_file, $verbose, $no_clear, $no_cache, $throw_if_missing ) = @_;
224 
225  if ( !defined($config_file) ) {
226  if ( defined( $ENV{ENSEMBL_REGISTRY} ) ) {
227  if (-e $ENV{ENSEMBL_REGISTRY}) {
228  $config_file = $ENV{ENSEMBL_REGISTRY};
229  } else {
230  warning("\$ENV{ENSEMBL_REGISTRY} points to a file ('$ENV{ENSEMBL_REGISTRY}') that does not exist.\n");
231  }
232  } elsif ( defined( $ENV{HOME} ) ) {
233  if (-e ($ENV{HOME} . "/.ensembl_init")) {
234  $config_file = $ENV{HOME} . "/.ensembl_init";
235  }
236  }
237  if ($throw_if_missing and !defined($config_file) ) {
238  throw("No registry configuration to load, and no default could be guessed.\n");
239  }
240  } elsif ($throw_if_missing and !(-e $config_file)) {
241  throw(sprintf("Configuration file '%s' does not exist. Registry configuration not loaded.\n", $config_file ));
242  }
243 
244  $verbose ||= 0;
245  $no_clear ||= 0;
246  $no_cache ||= 0;
247 
248  my $original_count = $class->get_DBAdaptor_count();
249 
250  if ( !defined($config_file) ) {
251  if ($verbose) {
252  print( STDERR
253  "No default registry configuration to load.\n" );
254  }
255  } elsif ( !-e $config_file ) {
256  if ($verbose) {
257  printf( STDERR "Configuration file '%s' does not exist. "
258  . "Registry configuration not loaded.\n",
259  $config_file );
260  }
261  } else {
262  if ( defined( $registry_register{'seen'} ) ) {
263  if ( !$no_clear ) {
264  if ($verbose) {
265  print( STDERR "Clearing previously loaded "
266  . "registry configuration\n" );
267  }
268  $class->clear();
269  }
270  }
271  $registry_register{'seen'} = 1;
272 
273  if ($verbose) {
274  printf( STDERR
275  "Loading registry configuration from '%s'.\n",
276  $config_file );
277  }
278 
279  my $cfg;
280 
281  my $test_eval = eval { require Config::IniFiles };
282 
283  if ($@ or (!$test_eval)) {
284  # The user does not have the 'Config::IniFiles' module.
285  if ($verbose) {
286  print( STDERR "No Config::IniFiles module found, "
287  . "assuming this is not an ini-file\n" );
288  }
289  # If the configuration file *is* an ini-file, we can expect a
290  # load of compilation errors from the next eval...
291  } else {
292  # The user has the 'Config::IniFiles' module installed. See
293  # if this is an ini-file or not...
294  $cfg = Config::IniFiles->new( -file => $config_file );
295  }
296 
297  if ( defined $cfg ) {
298  my %default_adaptor_args = ();
299 
300  if ( $cfg->SectionExists('default') ) {
301  # The 'default' section is special. It contain default
302  # values that should be implicit to all other section in
303  # this configuration file. Aliases are added if there
304  # is also a 'species' setting.
305 
306  my $alias = $cfg->val( 'default', 'alias' );
307  $cfg->delval( 'default', 'alias' );
308 
309  my $species = $cfg->val( 'default', 'species' );
310 
311  if ( defined($alias) && defined($species) ) {
313  -species => $species,
314  -alias => [ split( /\n/, $alias ) ]
315  );
316  }
317 
318  %default_adaptor_args =
319  map { '-' . $_ => $cfg->val( 'default', $_ ) }
320  $cfg->Parameters('default');
321  }
322 
323  foreach my $section ( $cfg->Sections() ) {
324  if ( $section eq 'default' )
325  { # We have already done the 'default' section.
326  next;
327  }
328 
329  my $group = $cfg->val( $section, 'group' )
330  || $cfg->val( 'default', 'group' );
331 
332  if ( !defined($group) ) {
333  printf( STDERR "Key 'group' is undefined "
334  . "for configuration section '%s', "
335  . "skipping this section.\n",
336  $section );
337  next;
338  }
339 
340  my $adaptor = $group2adaptor{ lc($group) };
341  if ( !defined($adaptor) ) {
342  printf( STDERR "Unknown group '%s' "
343  . "for configuration section '%s', "
344  . "skipping this section.\n",
345  $group, $section );
346  next;
347  }
348 
349  # Handle aliases. A section must have both an 'alias'
350  # setting and a 'species' setting for aliases to be
351  # added. The 'species' setting might be inherited from
352  # the 'default' section.
353 
354  my $alias = $cfg->val( $section, 'alias' );
355  $cfg->delval( $section, 'alias' );
356 
357  my $species = $cfg->val( $section, 'species' )
358  || $cfg->val( 'default', 'species' );
359 
360  if ( defined($alias) && defined($species) ) {
362  -species => $species,
363  -alias => [ split( /\n/, $alias ) ]
364  );
365  }
366 
367  # Fill in the adaptor initialization arguments.
368  # We trust the user to provide sensible key-value pairs.
369  my %adaptor_args = %default_adaptor_args;
370  foreach my $parameter ( $cfg->Parameters($section) ) {
371  $adaptor_args{ '-' . $parameter } =
372  $cfg->val( $section, $parameter );
373 
374  # when set, do not use the feature cache in the
375  # different adaptors
376  if ($no_cache) {
377  $adaptor_args{'-no_cache'} = 1;
378  }
379  }
380  if ($verbose) {
381  printf( "Configuring adaptor '%s' "
382  . "for configuration section '%s'...\n",
383  $adaptor, $section );
384  }
385 
386  my $test_eval = eval "require $adaptor"; ## no critic
387  if ($@ or (!$test_eval)) { die($@) }
388 
389  $adaptor->new(%adaptor_args);
390 
391  } ## end foreach my $section ( $cfg->Sections...
392  } else {
393  # This is probably no ini-file but an old style piece
394  # of configuration written in Perl. We need to try to
395  # require() it.
396 
397  my $test_eval;
398  if($NEW_EVAL) {
399  require Bio::EnsEMBL::Utils::IO;
400  my $contents = Bio::EnsEMBL::Utils::IO::slurp($config_file);
401  $test_eval = eval $contents; ## no critic
402  }
403  else {
404  $test_eval = eval { require($config_file) };
405  # To make the web code avoid doing this again we delete first
406  delete $INC{$config_file};
407  }
408 
409  #Now raise the exception just in case something above is
410  #catching this
411  if ($@ or (!$test_eval)) { die($@) }
412 
413  }
414  } ## end else [ if ( !defined($config_file...
415 
416  my $count = $class->get_DBAdaptor_count() - $original_count;
417  return $count >= 0 ? $count : 0;
418 } ## end sub load_all
419 
420 =head2 clear
421 
422  Will clear the registry and disconnect from all databases.
423 
424  Example : Bio::EnsEMBL::Registry->clear();
425  Returntype : none
426  Exceptions : none
427  Status : Stable
428 
429 =cut
430 
431 sub clear{
432  my ($self);
433 
434  foreach my $dba (@{$registry_register{'_DBA'}}){
435  if($dba->dbc->connected){
436  $dba->dbc->db_handle->disconnect();
437  }
438  }
439  %registry_register = ();
440  return;
441 }
442 
443 #
444 # db adaptors. (for backwards compatibility)
445 #
446 
447 =head2 add_db
448 
449  Arg [1] : db (DBAdaptor) to add adaptor to.
450  Arg [2] : name of the name to add the adaptor to in the registry.
451  Arg [3] : The adaptor to be added to the registry.
452  Example : Bio::EnsEMBL::Registry->add_db($db, "lite", $dba);
453  Returntype : none
454  Exceptions : none
455  Status : At Risk.
456  : This is here for backwards compatibility only and may
457  : be removed eventually. Solution is to make sure the
458  : db and the adaptor have the same species and the call
459  : is then no longer needed.
460 
461 =cut
462 
463 sub add_db {
464  my ( $class, $db, $name, $adap ) = @_;
465  #No warnings brought in due to some overzelous webcode triggering a lot of warnings.
466  no warnings 'uninitialized';
467  if ( lc( $db->species() ) ne lc( $adap->species ) ) {
468  $registry_register{_SPECIES}{ lc( $db->species() ) }
469  { lc( $db->group() ) }{'_special'}{ lc($name) } = $adap;
470  }
471  return;
472 }
473 
474 =head2 remove_db
475 
476  Arg [1] : db (DBAdaptor) to remove adaptor from.
477  Arg [2] : name to remove the adaptor from in the registry.
478  Example : my $db = Bio::EnsEMBL::Registry->remove_db($db, "lite");
479  Returntype : adaptor
480  Exceptions : none
481  Status : At Risk.
482  : This is here for backwards compatibility only and may
483  : be removed eventually. Solution is to make sure the
484  : db and the adaptor have the same species and the call
485  : is then no longer needed.
486 
487 =cut
488 
489 sub remove_db {
490  my ( $class, $db, $name ) = @_;
491 
492  my $ret =
493  $registry_register{_SPECIES}{ lc( $db->species() ) }
494  { lc( $db->group() ) }{'_special'}{ lc($name) };
495 
496  $registry_register{_SPECIES}{ lc( $db->species() ) }
497  { lc( $db->group() ) }{'_special'}{ lc($name) } = undef;
498 
499  return $ret;
500 }
501 
502 =head2 get_db
503 
504  Arg [1] : db (DBAdaptor) to get adaptor from.
505  Arg [2] : name to get the adaptor for in the registry.
506  Example : my $db = Bio::EnsEMBL::Registry->get_db("Human", "core", "lite");
507  Returntype : adaptor
508  Exceptions : See get_DBAdaptor()
509  Status : At Risk.
510  : This is here for backwards compatibility only and may
511  : be removed eventually. Solution is to make sure the
512  : db and the adaptor have the same species then call
513  : get_DBAdaptor instead.
514 
515 =cut
516 
517 sub get_db {
518  my ( $class, $db, $name ) = @_;
519 
520  my $ret = Bio::EnsEMBL::Registry->get_DBAdaptor( lc( $db->species ),
521  lc($name) );
522 
523  if ( defined($ret) ) { return $ret }
524 
525  return $registry_register{_SPECIES}{ lc( $db->species() ) }
526  { lc( $db->group() ) }{'_special'}{ lc($name) };
527 }
528 
529 =head2 get_all_db_adaptors
530 
531  Arg [1] : db (DBAdaptor) to get all the adaptors from.
532  Example : my $db = Bio::EnsEMBL::Registry->get_all_db_adaptors($db);
533  Returntype : adaptor
534  Exceptions : none
535  Status : At Risk.
536  : This is here for backwards compatibility only and
537  : may be removed eventually. Solution is to make
538  : sure the dbs all have the same species then call
539  : get_all_DBAdaptors(-species => "human");
540 
541 
542 =cut
543 
544 sub get_all_db_adaptors {
545  my ( $class, $db ) = @_;
546  my %ret = ();
547 
548  # we now also want to add all the DBAdaptors for the same species.
549  # as add_db_adaptor does not add if it is from the same species.
550 
551  foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
552  if ( lc( $dba->species() ) eq lc( $db->species() ) ) {
553  $ret{ $dba->group() } = $dba;
554  }
555  }
556 
557  foreach my $key (
558  keys %{
559  $registry_register{_SPECIES}
560  { $class->get_alias( $db->species() ) }{ lc( $db->group() ) }
561  {'_special'} } )
562  {
563  $ret{$key} =
564  $registry_register{_SPECIES}
565  { $class->get_alias( $db->species() ) }{ lc( $db->group() ) }
566  {'_special'}{$key};
567  }
568 
569  return \%ret;
570 } ## end sub get_all_db_adaptors
571 
572 
573 #
574 # DBAdaptors
575 #
576 
577 =head2 add_DBAdaptor
578 
579  Arg [1] : name of the species to add the adaptor to in the registry.
580  Arg [2] : name of the group to add the adaptor to in the registry.
581  Arg [3] : DBAdaptor to be added to the registry.
582  Example : Bio::EnsEMBL::Registry->add_DBAdaptor("Human", "core", $dba);
583  Returntype : none
584  Exceptions : none
585  caller : internal
586  Status : Stable
587 
588 =cut
589 
590 sub add_DBAdaptor {
591  my ( $class, $species, $group, $adap ) = @_;
592 
593  if ( !defined($species) ) {
594  throw('Species not defined.');
595  }
596 
597  if ( !( $class->alias_exists($species) ) ) {
598  $class->add_alias( $species, $species );
599  }
600 
601  $species = $class->get_alias($species);
602 
603  $registry_register{_SPECIES}{$species}{ lc($group) }{'_DB'} = $adap;
604 
605  if ( !defined( $registry_register{'_DBA'} ) ) {
606  $registry_register{'_DBA'} = [$adap];
607  } else {
608  push( @{ $registry_register{'_DBA'} }, $adap );
609  }
610  return;
611 }
612 
613 
614 
615 =head2 get_DBAdaptor
616 
617  Arg [1] : name of the species to get the adaptor for in the registry.
618  Arg [2] : name of the group to get the adaptor for in the registry.
619  Arg [3] : if set will not give warnings when looking for alias.
620  Example : $dba = Bio::EnsEMBL::Registry->get_DBAdaptor("Human", "core");
621  Returntype : DBAdaptor
622  Exceptions : If $species is not defined and if no valid internal name
623  could be found for $species. If thrown check your API and DB
624  version
625  Status : Stable
626 
627 =cut
628 
629 sub get_DBAdaptor {
630  my ( $class, $species, $group, $no_alias_check ) = @_;
631 
632  if ( !defined($species) ) {
633  throw('Species not defined.');
634  }
635 
636  my $ispecies = $class->get_alias( $species, $no_alias_check );
637 
638  if ($group eq 'regulation') { $group = 'funcgen'; }
639 
640  if ( !defined($ispecies) ) {
641  if(! $no_alias_check) {
642  throw("Can not find internal name for species '$species'");
643  }
644  }
645  else { $species = $ispecies }
646 
647  return $registry_register{_SPECIES}{$species}{ lc($group) }{'_DB'};
648 }
649 
650 =head2 get_all_DBAdaptors
651 
652  Arg [SPECIES]: (optional) string
653  species name to get adaptors for
654  Arg [GROUP] : (optional) string
655  group name to get adaptors for
656  Example :
657  @dba =
659 
660  @human_dbas =
662  -species => 'human'
663  ) };
664 
665  Returntype : list of DBAdaptors
666  Exceptions : none
667  Status : Stable
668 
669 =cut
670 
671 sub get_all_DBAdaptors {
672  my ( $class, @args ) = @_;
673 
674  my ( $species, $group ) = rearrange( [qw(SPECIES GROUP)], @args );
675 
676  if ( !defined($species) && !defined($group) ) {
677  return $registry_register{'_DBA'} || [];
678  }
679 
680  if ( defined($species) ) {
681  $species = $class->get_alias($species);
682  return [] unless $species;
683  }
684 
685  my @ret;
686  foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
687  if ( ( !defined($species) || lc($species) eq lc( $dba->species() ) )
688  && ( !defined($group) || lc($group) eq lc( $dba->group() ) ) )
689  {
690  push( @ret, $dba );
691  }
692  }
693 
694  return \@ret;
695 }
696 
697 =head2 get_all_DBAdaptors_by_connection
698 
699  Arg [1] : DBConnection used to find DBAdaptors
700  Returntype : reference to list of DBAdaptors
701  Exceptions : none
702  Example : @dba = @{ Bio::EnsEMBL::Registry
704  Status : Stable
705 
706 =cut
707 
708 sub get_all_DBAdaptors_by_connection {
709  my ( $self, $dbc_orig ) = @_;
710 
711  my @return;
712 
713  foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
714  my $dbc = $dba->dbc();
715 
716  if ( defined($dbc)
717  && $dbc->can('equals')
718  && $dbc->equals($dbc_orig) )
719  {
720  push( @return, $dba );
721  }
722  }
723 
724  return \@return;
725 }
726 
727 =head2 get_all_DBAdaptors_by_dbname
728 
729  Arg [1] : string, name of database
730  Returntype : reference to list of DBAdaptors
731  Exceptions : none
732  Example : @dba = @{ Bio::EnsEMBL::Registry
733  ->get_all_DBAdaptors_by_dbname($dbname) };
734  Status : Stable
735 
736 =cut
737 
738 sub get_all_DBAdaptors_by_dbname {
739  my ( $self, $dbname ) = @_;
740 
741  my @return;
742 
743  foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
744  my $dbc = $dba->dbc();
745 
746  if ( defined($dbc) && $dbc->dbname() eq $dbname ) {
747  push( @return, $dba );
748  }
749  }
750 
751  return \@return;
752 }
753 
754 =head2 remove_DBAdaptor
755 
756  Arg [1] : name of the species to get the adaptor for in the registry.
757  Arg [2] : name of the group to get the adaptor for in the registry.
758  Example : $dba = Bio::EnsEMBL::Registry->remove_DBAdaptor("Human", "core");
759  Returntype : none
760  Exceptions : none
761  Status : At risk
762 
763 =cut
764 
765 sub remove_DBAdaptor {
766  my ( $class, $species, $group ) = @_;
767 
768  $species = $class->get_alias($species);
769 
770  delete $registry_register{_SPECIES}{$species}{$group};
771  # This will remove the DBAdaptor and all the other adaptors
772 
773  # Now remove if from the _DBA array
774  my $index;
775 
776  foreach my $i ( 0 .. $#{ $registry_register{'_DBA'} } ) {
777  my $dba = $registry_register{'_DBA'}->[$i];
778 
779  if ( ( $dba->species eq $species )
780  && $dba->group eq $group )
781  {
782  $index = $i;
783  last;
784  }
785  }
786 
787  # Now remove from _DBA cache
788  if ( defined($index) ) {
789  splice( @{ $registry_register{'_DBA'} }, $index, 1 );
790  }
791 
792  return;
793 } ## end sub remove_DBAdaptor
794 
795 
796 
797 =head2 reset_DBAdaptor
798 
799  Arg [1]: string - species e.g. homo_sapiens
800  Arg [2]: string - DB group e.g. core
801  Arg [3]: string - new dbname
802  Args [4-7]: string - optional DB parameters, defaults to current db params if omitted
803  Arg [8]: hashref - Hash ref of additional parameters e.g. eFG dnadb params for auto selecting dnadb
804  Usage : $reg->reset_registry_db( 'homo_sapiens', 'core',
805  'homo_sapiens_core_37_35j' );
806  Description: Resets a DB within the registry.
807  Exceptions: Throws if mandatory params not supplied
808  Throws if species name is not already seen by the registry
809  Throws if no current DB for species/group available
810  Status : At risk
811 
812 =cut
813 
814 sub reset_DBAdaptor {
815  my (
816  $self, $species, $group, $dbname, $host,
817  $port, $user, $pass, $params
818  ) = @_;
819 
820  # Check mandatory params
821  if ( !( defined $species && defined $group && defined $dbname ) ) {
822  throw(
823  'Must provide at least a species, group, and dbname parameter '
824  . 'to redefine a DB in the registry' );
825  }
826 
827  # Validate species here
828  my $alias = $self->get_alias($species);
829  throw("Could not find registry alias for species:\t$species")
830  if ( !defined $alias );
831 
832  # Get all current defaults if not defined
833 
834  my $db = $self->get_DBAdaptor( $alias, $group );
835  my $class;
836 
837  if ($db) {
838  $class = ref($db);
839  $host ||= $db->dbc->host;
840  $port ||= $db->dbc->port;
841  $user ||= $db->dbc->username;
842  $pass ||= $db->dbc->password;
843  } else {
844  #Now we need to test mandatory params
845  $class = $group2adaptor{ lc($group) };
846 
847  if ( !( $host && $user ) ) {
848  throw("No comparable $alias $group DB present in Registry. "
849  . "You must pass at least a dbhost and dbuser" );
850  }
851  }
852 
853  $self->remove_DBAdaptor( $alias, $group );
854 
855  # ConfigRegistry should automatically add this to the Registry
856  $db = $class->new(
857  -user => $user,
858  -host => $host,
859  -port => $port,
860  -pass => $pass,
861  -dbname => $dbname,
862  -species => $alias,
863  -group => $group,
864  %{$params} );
865 
866  return $db;
867 } ## end sub reset_DBAdaptor
868 
869 
870 #
871 # DNA Adaptors
872 #
873 
874 =head2 add_DNAAdaptor
875 
876  Arg [1] : name of the species to add the adaptor to in the registry.
877  Arg [2] : name of the group to add the adaptor to in the registry.
878  Arg [3] : name of the species to get the dna from
879  Arg [4] : name of the group to get the dna from
880  Example : Bio::EnsEMBL::Registry->add_DNAAdaptor("Human", "estgene", "Human", "core");
881  Returntype : none
882  Exceptions : none
883  Status : Stable
884 
885 =cut
886 
887 sub add_DNAAdaptor {
888  my ( $class, $species, $group, $dnadb_species, $dnadb_group ) = @_;
889 
890  $species = $class->get_alias($species);
891  $dnadb_species = $class->get_alias($dnadb_species);
892  if ( $dnadb_group->isa('Bio::EnsEMBL::DBSQL::DBAdaptor') ) {
893  deprecated("");
894  } else {
895  $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA'} =
896  $dnadb_group;
897  $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA2'} =
898  $dnadb_species;
899  }
900  return;
901 }
902 
903 =head2 get_DNAAdaptor
904 
905  Arg [1] : name of the species to get the adaptor for in the registry.
906  Arg [2] : name of the group to get the adaptor for in the registry.
907  Example : $dnaAdap = Bio::EnsEMBL::Registry->get_DNAAdaptor("Human", "core");
908  Returntype : adaptor
909  Exceptions : none
910  Status : Stable
911 
912 =cut
913 
914 sub get_DNAAdaptor {
915  my ( $class, $species, $group ) = @_;
916 
917  $species = $class->get_alias($species);
918  my $new_group =
919  $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA'};
920  my $new_species =
921  $registry_register{_SPECIES}{$species}{ lc($group) }{'_DNA2'};
922 
923  if ( defined $new_group ) {
924  return $class->get_DBAdaptor( $new_species, $new_group );
925  }
926 
927  return;
928 }
929 
930 #
931 # General Adaptors
932 #
933 
934 =head2 add_adaptor
935 
936  Arg [1] : name of the species to add the adaptor to in the registry.
937  Arg [2] : name of the group to add the adaptor to in the registry.
938  Arg [3] : name of the type to add the adaptor to in the registry.
939  Arg [4] : The DBAdaptor to be added to the registry.
940  Arg [5] : (optional) Set to allow overwrites of existing adaptors.
941  Example : Bio::EnsEMBL::Registry->add_adaptor("Human", "core", "Gene", $adap);
942  Returntype : none
943  Exceptions : none
944  Caller : internal
945  Status : Stable
946 
947 =cut
948 
949 sub add_adaptor {
950  my ( $class, $species, $group, $type, $adap, $reset ) = @_;
951 
952  $species = $class->get_alias($species);
953  my $lc_group = lc($group);
954  my $lc_type = lc($type);
955 
956  # Since the adaptors are not stored initially, only their class paths
957  # when the adaptors are obtained, we need to store these instead. It
958  # is not necessarily an error if the registry is overwritten without
959  # the reset set but it is an indication that we are overwriting a
960  # database which should be a warning for now
961 
962  if ( defined($reset) )
963  { # JUST RESET THE HASH VALUE NO MORE PROCESSING NEEDED
964  $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type } = $adap;
965  return;
966  }
967 
968  if (
969  defined(
970  $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type }
971  ) )
972  {
973  # print STDERR (
974  # "Overwriting Adaptor in Registry for $species $group $type\n");
975  $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type } = $adap;
976  return;
977  }
978  $registry_register{_SPECIES}{$species}{ $lc_group }{ $lc_type } = $adap;
979 
980  if ( !defined( $registry_register{_SPECIES}{$species}{'list'} ) ) {
981  $registry_register{_SPECIES}{$species}{'list'} = [$type];
982  }
983  else {
984  push( @{ $registry_register{_SPECIES}{$species}{'list'} }, $type );
985  }
986 
987  return;
988 } ## end sub add_adaptor
989 
990 
991 =head2 add_switchable_adaptor
992 
993  Arg [1] : String name of the species to add its switchable adaptor into the registry
994  Arg [2] : String name of the group to add its switchable adaptor into the registry
995  Arg [3] : String name of the type to add its switchable adaptor into the registry
996  Arg [4] : Reference switchable adaptor to insert
997  Arg [5] : Boolean override any existing switchable adaptor
998  Example : Bio::EnsEMBL::Registry->add_switchable_adaptor("Human", "core", "Gene", $my_other_source);
999  Returntype : None
1000  Exceptions : Thrown if a valid internal name cannot be found for the given
1001  name. If thrown check your API and DB version. Also thrown if
1002  no type, group or switchable adaptor instance was given
1003 
1004 =cut
1005 
1006 sub add_switchable_adaptor {
1007  my ($class, $species, $group, $adaptor_type, $instance, $override) = @_;
1008 
1009  my $ispecies = $class->get_alias($species);
1010  throw "Cannot decode given species ${species} to an internal registry name" if ! $species;
1011  throw "No group given" if ! $group;
1012  throw "No adaptor type given" if ! $adaptor_type;
1013  throw "No switchable adaptor given" if ! $instance;
1014  throw "Switchable adaptor was not a blessed reference" if ! blessed($instance);
1015 
1016  $group = lc($group);
1017  $adaptor_type = lc($adaptor_type);
1018  if($override) {
1019  $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type} = $instance;
1020  return;
1021  }
1022 
1023  if(exists $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type}) {
1024  my $existing_ref = ref($registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type});
1025  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";
1026  }
1027 
1028  $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type} = $instance;
1029  return;
1030 }
1031 
1032 =head2 has_switchable_adaptor
1033 
1034  Arg [1] : String name of the species to add its switchable adaptor into the registry
1035  Arg [2] : String name of the group to add its switchable adaptor into the registry
1036  Arg [3] : String name of the type to add its switchable adaptor into the registry
1037  Example : Bio::EnsEMBL::Registry->has_switchable_adaptor("Human", "core", "Gene");
1038  Returntype : Boolean indicating if a switchable adaptor is available for your submitted combination
1039  Exceptions : Thrown if a valid internal name cannot be found for the given
1040  name. If thrown check your API and DB version. Also thrown if
1041  no type, group or switchable adaptor instance was given
1042 
1043 =cut
1044 
1045 sub has_switchable_adaptor {
1046  my ($class, $species, $group, $adaptor_type) = @_;
1047 
1048  my $ispecies = $class->get_alias($species);
1049  throw "Cannot decode given species ${species} to an internal registry name" if ! $species;
1050  throw "No group given" if ! $group;
1051  throw "No adaptor type given" if ! $adaptor_type;
1052 
1053  $group = lc($group);
1054  $adaptor_type = lc($adaptor_type);
1055  return (defined $registry_register{_SWITCHABLE}{$species}{$group}{$adaptor_type}) ? 1 : 0;
1056 }
1057 
1058 =head2 remove_switchable_adaptor
1059 
1060  Arg [1] : name of the species to remove its switchable adaptor from the registry
1061  Arg [2] : name of the group to remove its switchable adaptor from the registry
1062  Arg [3] : name of the type to remove its switchable adaptor from the registry
1063  Example : $adap = Bio::EnsEMBL::Registry->remove_switchable_adaptor("Human", "core", "Gene");
1064  Returntype : The removed adaptor if one was removed. Otherwise undef
1065  Exceptions : Thrown if a valid internal name cannot be found for the given
1066  name. If thrown check your API and DB version. Also thrown if
1067  no type or group was given
1068 
1069 =cut
1070 
1071 sub remove_switchable_adaptor {
1072  my ($class, $species, $group, $adaptor_type) = @_;
1073  my $ispecies = $class->get_alias($species);
1074  throw "Cannot decode given species ${species} to an internal registry name" if ! $species;
1075  throw "No group given" if ! $group;
1076  throw "No adaptor type given" if ! $adaptor_type;
1077 
1078  $group = lc($group);
1079  $adaptor_type = lc($adaptor_type);
1080  if(defined $registry_register{_SWITCHABLE}{$ispecies}{$group}{$adaptor_type}) {
1081  my $adaptor = $registry_register{_SWITCHABLE}{$ispecies}{$group}{$adaptor_type};
1082  delete $registry_register{_SWITCHABLE}{$ispecies}{$group}{$adaptor_type};
1083  return $adaptor;
1084  }
1085  return;
1086 }
1087 
1088 =head2 get_adaptor
1089 
1090  Arg [1] : name of the species to add the adaptor to in the registry.
1091  Arg [2] : name of the group to add the adaptor to in the registry.
1092  Arg [3] : name of the type to add the adaptor to in the registry.
1093  Example : $adap = Bio::EnsEMBL::Registry->get_adaptor("Human", "core", "Gene");
1094  Description : Finds and returns the specified adaptor. This method will also check
1095  if the species, group and adaptor combination satisfy a DNADB condition
1096  (and will return that DNADB's implementation). Also we check for
1097  any available switchable adaptors and will return that if available.
1098  Returntype : adaptor
1099  Exceptions : Thrown if a valid internal name cannot be found for the given
1100  name. If thrown check your API and DB version. Also thrown if
1101  no type or group was given
1102  Status : Stable
1103 
1104 =cut
1105 
1106 sub get_adaptor {
1107  my ( $class, $species, $group, $type ) = @_;
1108 
1109  my $ispecies = $class->get_alias($species);
1110 
1111  if ( !defined($ispecies) ) {
1112  throw("Can not find internal name for species '$species'");
1113  }
1114  else { $species = $ispecies }
1115 
1116  throw 'No adaptor group given' if ! defined $group;
1117  throw 'No adaptor type given' if ! defined $type;
1118 
1119  $group = lc($group);
1120  my $lc_type = lc($type);
1121 
1122 
1123  if($type =~ /Adaptor$/i) {
1124  warning("Detected additional Adaptor string in given the type '$type'. Removing it to avoid possible issues. Alter your type to stop this message");
1125  $type =~ s/Adaptor$//i;
1126  }
1127 
1128  # For historical reasons, allow use of group 'regulation' to refer to
1129  # group 'funcgen'.
1130  if ( $group eq 'regulation' ) { $group = 'funcgen' }
1131 
1132  my %dnadb_adaptors = (
1133  'sequence' => 1,
1134  'assemblymapper' => 1,
1135  'karyotypeband' => 1,
1136  'repeatfeature' => 1,
1137  'coordsystem' => 1,
1138  'assemblyexceptionfeature' => 1
1139  );
1140 
1141  #Before looking for DNA adaptors we need to see if we have a switchable adaptor since they take preference
1142  if(defined $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type}) {
1143  return $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type};
1144  }
1145 
1146  # Look for a possible DNADB group alongside the species hash
1147  my $dnadb_group = $registry_register{_SPECIES}{$species}{ $group }{'_DNA'};
1148 
1149  # If we found one & this is an adaptor we should be replaced by a DNADB then
1150  # look up the species to use and replace the current group with the DNADB group
1151  # (groups are held in _DNA, species are in _DNA2)
1152  if ( defined($dnadb_group) && defined( $dnadb_adaptors{ $lc_type } ) ) {
1153  $species = $registry_register{_SPECIES}{$species}{ $group }{'_DNA2'};
1154  $group = $dnadb_group;
1155 
1156  # Once we have switched to the possibility of a DNADB call now check again for
1157  # a switchable adaptor
1158  if(defined $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type}) {
1159  return $registry_register{_SWITCHABLE}{$species}{$group}{$lc_type};
1160  }
1161  }
1162 
1163  # No switchable adaptor? Ok then continue with the normal logic
1164  my $ret = $registry_register{_SPECIES}{$species}{ $group }{ $lc_type };
1165 
1166  if ( !defined($ret) ) { return }
1167  if ( ref($ret) ) { return $ret }
1168 
1169  # Not instantiated yet
1170 
1171  my $dba = $registry_register{_SPECIES}{$species}{ $group }{'_DB'};
1172  my $module = $ret;
1173 
1174  my $test_eval = eval "require $module"; ## no critic
1175  if ($@ or (!$test_eval)) {
1176  warning("'$module' cannot be found.\nException $@\n");
1177  return;
1178  }
1179 
1180  if (
1181  !defined(
1182  $registry_register{_SPECIES}{$species}{ $group }{'CHECKED'} )
1183  )
1184  {
1185  $registry_register{_SPECIES}{$species}{ $group }{'CHECKED'} = 1;
1186  $class->version_check($dba);
1187  }
1188 
1189  my $adap = "$module"->new($dba);
1190  Bio::EnsEMBL::Registry->add_adaptor( $species, $group, $type, $adap,
1191  'reset' );
1192  $ret = $adap;
1193 
1194  return $ret;
1195 } ## end sub get_adaptor
1196 
1197 =head2 get_all_adaptors
1198 
1199  Arg [SPECIES] : (optional) string
1200  species name to get adaptors for
1201  Arg [GROUP] : (optional) string
1202  group name to get adaptors for
1203  Arg [TYPE] : (optional) string
1204  type to get adaptors for
1205  Example : @adaps = @{Bio::EnsEMBL::Registry->get_all_adaptors()};
1206  Returntype : ref to list of adaptors
1207  Exceptions : none
1208  Status : Stable
1209 
1210 =cut
1211 
1212 sub get_all_adaptors{
1213  my ($class,@args)= @_;
1214  my ($species, $group, $type);
1215  my @ret=();
1216  my (%species_hash, %group_hash, %type_hash);
1217 
1218 
1219  if(@args == 1){ # Old species only one parameter
1220  warn("-SPECIES argument should now be used to get species adaptors");
1221  $species = $args[0];
1222  }
1223  else{
1224  # new style -SPECIES, -GROUP, -TYPE
1225  ($species, $group, $type) =
1226  rearrange([qw(SPECIES GROUP TYPE)], @args);
1227  }
1228 
1229  if(defined($species)){
1230  $species_hash{$species} = 1;
1231  }
1232  else{
1233  # get list of species
1234  foreach my $dba (@{$registry_register{'_DBA'}}){
1235  $species_hash{lc($dba->species())} = 1;
1236  }
1237  }
1238  if(defined($group)){
1239  $group_hash{$group} = 1;
1240  }
1241  else{
1242  foreach my $dba (@{$registry_register{'_DBA'}}){
1243  $group_hash{lc($dba->group())} = 1;
1244  }
1245  }
1246 
1247  if ( defined($type) ) {
1248  $type_hash{$type} = 1;
1249  } else {
1250  foreach my $dba ( @{ $registry_register{'_DBA'} } ) {
1251  foreach my $ty (
1252  @{ $registry_register{_SPECIES}{ lc( $dba->species ) }{'list'} }
1253  )
1254  {
1255  $type_hash{ lc($ty) } = 1;
1256  }
1257  }
1258  }
1259 
1260  ### NOW NEED TO INSTANTIATE BY CALLING get_adaptor
1261  foreach my $sp ( keys %species_hash ) {
1262  foreach my $gr ( keys %group_hash ) {
1263  foreach my $ty ( keys %type_hash ) {
1264  my $temp = $class->get_adaptor( $sp, $gr, $ty );
1265  if ( defined($temp) ) {
1266  push @ret, $temp;
1267  }
1268  }
1269  }
1270  }
1271 
1272  return (\@ret);
1273 }
1274 
1275 
1276 =head2 add_alias
1277 
1278  Arg [1] : name of the species to add alias for
1279  Arg [2] : name of the alias
1280  Example : Bio::EnsEMBL::Registry->add_alias("Homo Sapiens","Human");
1281  Description: add alternative name for the species.
1282  Returntype : none
1283  Exceptions : none
1284  Status : Stable
1285 
1286 =cut
1287 
1288 sub add_alias{
1289  my ($class, $species,$key) = @_;
1290 
1291  $registry_register{'_ALIAS'}{lc($key)} = lc($species);
1292  return;
1293 }
1294 
1295 =head2 remove_alias
1296 
1297  Arg [1] : name of the species to remove alias for
1298  Arg [2] : name of the alias
1299  Example : Bio::EnsEMBL::Registry->remove_alias("Homo Sapiens","Human");
1300  Description: remove alternative name for the species.
1301  Returntype : none
1302  Exceptions : none
1303  Status : Stable
1304 
1305 =cut
1306 
1307 sub remove_alias{
1308  my ($class, $species,$key) = @_;
1309 
1310  delete $registry_register{'_ALIAS'}{lc($key)};
1311  return;
1312 }
1313 
1314 
1315 
1316 =head2 get_alias
1317 
1318  Arg [1] : name of the possible alias to get species for
1319  Example : Bio::EnsEMBL::Registry->get_alias("Human");
1320  Description: get proper species name.
1321  Returntype : species name
1322  Exceptions : none
1323  Status : Stable
1324 
1325 =cut
1326 
1327 sub get_alias {
1328  my ( $class, $key, $no_warn ) = @_;
1329 
1330  if ( !defined( $registry_register{'_ALIAS'}{ lc($key) } ) ) {
1331  if ( ( !defined( $registry_register{_SPECIES}{ lc($key) } ) ) and
1332  ( !defined( $registry_register{_ALIAS}{ lc($key) } ) ) )
1333  {
1334  if ( ( !defined($no_warn) ) or ( !$no_warn ) ) {
1335  warning( "$key is not a valid species name " .
1336  "(check DB and API version)" );
1337  }
1338  return;
1339  }
1340  else { return $key }
1341  }
1342 
1343  return $registry_register{'_ALIAS'}{ lc($key) };
1344 }
1345 
1346 =head2 get_all_aliases
1347 
1348  Arg [1] : Species name to retrieve aliases for
1349  (may be an alias as well).
1350  Example : Bio::EnsEMBL::Registry->get_all_aliases('Homo sapiens');
1351  Description: Returns all known aliases for a given species (but not the
1352  species name/alias that was given).
1353  Returntype : ArrayRef of all known aliases
1354  Exceptions : none
1355  Status : Development
1356 
1357 =cut
1358 
1359 sub get_all_aliases {
1360  my ( $class, $key ) = @_;
1361 
1362  my $species = $registry_register{_ALIAS}{ lc($key) };
1363 
1364  my @aliases;
1365  if ( defined($species) ) {
1366  foreach my $alias ( keys( %{ $registry_register{_ALIAS} } ) ) {
1367  if ( $species ne $alias
1368  && $species eq $registry_register{_ALIAS}{ lc($alias) } )
1369  {
1370  push( @aliases, $alias );
1371  }
1372  }
1373  }
1374 
1375  return \@aliases;
1376 }
1377 
1378 =head2 alias_exists
1379 
1380  Arg [1] : name of the possible alias to get species for
1381  Example : Bio::EnsEMBL::Registry->alias_exists("Human");
1382  Description: does the species name exist.
1383  Returntype : 1 if exists else 0
1384  Exceptions : none
1385  Status : Stable
1386 
1387 =cut
1388 
1389 sub alias_exists {
1390  my ( $class, $key ) = @_;
1391 
1392  return defined( $registry_register{'_ALIAS'}{ lc($key) } );
1393 }
1394 
1395 =head2 set_disconnect_when_inactive
1396 
1397  Example : Bio::EnsEMBL::Registry->set_disconnect_when_inactive();
1398  Description: Set the flag to make sure that the database connection is dropped if
1399  not being used on each database.
1400  Returntype : none
1401  Exceptions : none
1402  Status : Stable
1403 
1404 =cut
1405 
1406 sub set_disconnect_when_inactive{
1407  foreach my $dba ( @{get_all_DBAdaptors()}){
1408  my $dbc = $dba->dbc;
1409  # Disconnect if connected
1410  $dbc->disconnect_if_idle() if $dbc->connected();
1411  $dbc->disconnect_when_inactive(1);
1412  }
1413  return;
1414 }
1415 
1416 =head2 set_reconnect_when_lost
1417 
1418  Example : Bio::EnsEMBL::Registry->set_reconnect_when_lost();
1419  Description: Set the flag to make sure that the database connection is not lost before it's used.
1420  This is useful for long running jobs (over 8hrs).
1421  Returntype : none
1422  Exceptions : none
1423  Status : Stable
1424 
1425 =cut
1426 
1427 sub set_reconnect_when_lost{
1428  foreach my $dba ( @{get_all_DBAdaptors()}){
1429  my $dbc = $dba->dbc;
1430  $dbc->reconnect_when_lost(1);
1431  }
1432  return;
1433 }
1434 
1435 =head2 disconnect_all
1436 
1438  Description: disconnect from all the databases.
1439  Returntype : none
1440  Exceptions : none
1441  Status : Stable
1442 
1443 =cut
1444 
1445 sub disconnect_all {
1446  foreach my $dba ( @{get_all_DBAdaptors()||[]} ){
1447  my $dbc = $dba->dbc;
1448  next unless $dbc;
1449  # Disconnect if connected
1450  $dbc->disconnect_if_idle() if $dbc->connected();
1451  }
1452  return;
1453 }
1454 
1455 =head get_DBAdaptor_count
1456 
1458  Description : Returns the count of database adaptors currently held by
1459  the registry
1460  Returntype : Int count of database adaptors currently known
1461  Exceptions : None
1462 
1463 =cut
1464 
1465 sub get_DBAdaptor_count {
1466  return scalar(@{$registry_register{'_DBA'}}) if(defined $registry_register{'_DBA'});
1467  return 0;
1468 }
1469 
1470 =head2 change_access
1471 
1472  Will change the username and password for a set of databases.
1473  if host,user or database names are missing then these are not checked.
1474  So for example if you do not specify a database then ALL databases on
1475  the specified host and port will be changed.
1476 
1477  Arg [1] : name of the host to change access on
1478  Arg [2] : port number to change access on
1479  Arg [3] : name of the user to change access on
1480  Arg [4] : name of the database to change access on
1481  Arg [5] : name of the new user
1482  Arg [6] : new password
1483 
1484  Example : Bio::EnsEMBL::Registry->get_alias("Human");
1485  Description: change username and password on one or more databases
1486  Returntype : none
1487  Exceptions : none
1488  Status : Stable
1489 
1490 =cut
1491 
1492 sub change_access{
1493  my ($self, $host,$port,$user,$dbname,$new_user,$new_pass) = @_;
1494  foreach my $dba ( @{$registry_register{'_DBA'}}){
1495  my $dbc = $dba->dbc;
1496  if((((!defined($host)) or ($host eq $dbc->host))) and
1497  (((!defined($port)) or ($port eq $dbc->port))) and
1498  (((!defined($user)) or ($user eq $dbc->username))) and
1499  ((!defined($dbname)) or ($dbname eq $dbc->dbname))){
1500  if($dbc->connected()){
1501  $dbc->db_handle->disconnect();
1502  $dbc->connected(undef);
1503  }
1504  # over write the username and password
1505  $dbc->username($new_user);
1506  $dbc->password($new_pass);
1507  }
1508  }
1509  return;
1510 }
1511 
1512 
1513 
1514 =head2 load_registry_from_url
1515 
1516  Arg [1] : string $url
1517  Arg [2] : (optional) integer
1518  If not 0, will print out all information.
1519  Arg [3] : (optional) integer
1520  This option will turn off caching for slice features, so,
1521  every time a set of features is retrieved, they will come
1522  from the database instead of the cache. This option is only
1523  recommended for advanced users, specially if you need to
1524  store and retrieve features. It might reduce performance when
1525  querying the database if not used properly. If in doubt, do
1526  not use it or ask in the developer mailing list.
1527 
1528  Example : load_registry_from_url(
1529  'mysql://anonymous@ensembldb.ensembl.org:3306');
1530 
1531  load_registry_from_url(
1532  'mysql://anonymous@ensembldb.ensembl.org:3306/homo_sapiens_core_65_37?group=core&species=homo_sapiens'
1533  );
1534 
1535  load_registry_from_url(
1536  'mysql://anonymous@ensembldb.ensembl.org:3306/homo_sapiens_core_65_37?group=core'
1537  );
1538 
1539 
1540  Description: Will load the correct versions of the ensembl
1541  databases for the software release it can find on
1542  a database instance into the registry. Also adds
1543  a set of standard aliases. The url format is:
1544  mysql://[[username][:password]@]hostname[:port]. You
1545  can also request a specific version for the databases
1546  by adding a slash and the version number but your
1547  script may crash as the API version won't match the
1548  DB version.
1549 
1550  You can also specify a database name which will cause the
1551  loading of a single DBAdaptor instance. Parameters are
1552  mapped from a normal URL parameter set to their DBAdaptor
1553  equivalent. Group must be defined.
1554 
1555  Returntype : Int count of the DBAdaptor instances which can be found in the
1556  registry
1557 
1558  Exceptions : Thrown if the given URL does not parse according to the above
1559  scheme and if the specified database cannot be connected to
1560  (see L<load_registry_from_db> for more information)
1561  Status : Stable
1562 
1563 =cut
1564 
1565 sub load_registry_from_url {
1566  my ( $self, $url, $verbose, $no_cache ) = @_;
1567 
1568  if ( $url =~ /^mysql\:\/\/([^\@]+\@)?([^\:\/]+)(\:\d+)?(\/\d+)?\/?$/x ) {
1569  my $user_pass = $1;
1570  my $host = $2;
1571  my $port = $3;
1572  my $version = $4;
1573 
1574  $user_pass =~ s/\@$//;
1575  my ( $user, $pass ) = $user_pass =~ m/([^\:]+)(\:.+)?/x;
1576  $pass =~ s/^\://x if ($pass);
1577  $port =~ s/^\://x if ($port);
1578  $version =~ s/^\///x if ($version);
1579 
1580  return $self->load_registry_from_db(
1581  -host => $host,
1582  -user => $user,
1583  -pass => $pass,
1584  -port => $port,
1585  -db_version => $version,
1586  -verbose => $verbose,
1587  -no_cache => $no_cache
1588  );
1589  }
1590  my $uri = parse_uri($url);
1591  if($uri) {
1592  if($uri->scheme() eq 'mysql') {
1593  my %params = $uri->generate_dbsql_params();
1594  if($params{-DBNAME}) {
1595  $params{-SPECIES} = $params{-DBNAME} unless $params{-SPECIES};
1596  $params{-NO_CACHE} = 1 if $no_cache;
1597  my $group = $params{-GROUP};
1598  my $class = $self->_group_to_adaptor_class($group);
1599  if($verbose) {
1600  printf("Loading database '%s' from group '%s' with DBAdaptor class '%s' from url %s\n", $params{-DBNAME}, $group, $class, $url);
1601  }
1602  $class->new(%params);
1603  return 1;
1604  }
1605  }
1606  }
1607  throw("Only MySQL URLs are accepted. Given URL was '${url}'");
1608 } ## end sub load_registry_from_url
1609 
1610 
1611 =head2 load_registry_from_db
1612 
1613  Arg [HOST] : string
1614  The domain name of the database host to connect to.
1615 
1616  Arg [USER] : string
1617  The name of the database user to connect with.
1618 
1619  Arg [PASS] : (optional) string
1620  The password to be used to connect to the database.
1621 
1622  Arg [PORT] : (optional) integer
1623  The port to use when connecting to the database.
1624 
1625  Arg [VERBOSE]: (optional) boolean
1626  Whether to print database messages. This includes a listing
1627  of all available species & databases.
1628 
1629  Arg [SPECIES]: (optional) string
1630  By default, all databases that are found on the
1631  server and that corresponds to the correct release
1632  are probed for aliases etc. For some people,
1633  depending on where they are in the world, this might
1634  be a slow operation. With the '-species' argument,
1635  one may reduce the startup time by restricting the
1636  set of databases that are probed to those of a
1637  particular species.
1638 
1639  Note that the latin name of the species is required,
1640  e.g., 'homo sapiens', 'gallus gallus', 'callithrix
1641  jacchus' etc. It may be the whole species name,
1642  or only the first part of the name, e.g. 'homo',
1643  'gallus', or 'callithrix'. This will be used in
1644  matching against the name of the databases.
1645 
1646  Arg [DB_VERSION]: (optional) integer
1647  By default, only databases corresponding to the
1648  current API version are loaded. This argument
1649  allows the script to use databases from another
1650  version although it might not work properly. This
1651  argument should only be used for production or
1652  testing purposes and if you really know what you are
1653  doing.
1654 
1655  Arg [WAIT_TIMEOUT]: (optional) integer
1656  Time in seconds for the wait timeout to happen.
1657  Time after which the connection is deleted if not
1658  used. By default this is 28800 (8 hours), so set
1659  this to greater than this if your connection are
1660  getting deleted. Only set this if you are having
1661  problems and know what you are doing.
1662 
1663  Arg [-NO_CACHE]: (optional) boolean
1664  This option will turn off caching for slice features,
1665  so, every time a set of features is retrieved, they
1666  will come from the database instead of the cache. This
1667  option is only recommended for advanced users, specially
1668  if you need to store and retrieve features. It might
1669  reduce performance when querying the database if not
1670  used properly. If in doubt, do not use it or ask in the
1671  developer mailing list.
1672 
1673  Arg [SPECIES_SUFFIX]: (optional) string
1674  This option will append the string to the species name
1675  in the registry for all databases found on this server.
1676 
1677  Example :
1678 
1679  $registry->load_registry_from_db(
1680  -host => 'ensembldb.ensembl.org',
1681  -user => 'anonymous',
1682  -verbose => '1'
1683  );
1684 
1685  Description: Will load the correct versions of the Ensembl
1686  databases for the software release it can find on a
1687  database instance into the registry. Also adds a set
1688  of standard aliases.
1689 
1690  Returntype : Int count of the DBAdaptor instances which can be found in the
1691  registry due to this method call.
1692 
1693  Exceptions : Thrown if the given MySQL database cannot be connected to
1694  or there is any error whilst querying the database.
1695  Status : Stable
1696 
1697 =cut
1698 
1699 sub load_registry_from_db {
1700  my ( $self, @args ) = @_;
1701 
1702  my ( $host, $port, $user,
1703  $pass, $verbose, $db_version,
1704  $wait_timeout, $no_cache, $species, $species_suffix, $db_prefix )
1705  = rearrange( [ 'HOST', 'PORT',
1706  'USER', 'PASS',
1707  'VERBOSE', 'DB_VERSION',
1708  'WAIT_TIMEOUT', 'NO_CACHE',
1709  'SPECIES', 'SPECIES_SUFFIX', 'DB_PREFIX' ],
1710  @args );
1711 
1712  my $ignore_multi = 0;
1713 
1714  if ( defined($species) ) {
1715  $species = lc($species);
1716  $species =~ tr/ -/__/;
1717  $ignore_multi = 1;
1718  }
1719  if (!defined($species_suffix)) {
1720  $species_suffix = "";
1721  }
1722  if (defined($db_prefix)) {
1723  $db_prefix = $db_prefix . '_';
1724  } else {
1725  $db_prefix = '';
1726  }
1727 
1728  if(! defined $db_version) {
1729  # Do checking for the -DB_VERSION flag which can be mis-spelt. Regex assembled using:
1730  # perl -MRegexp::Assemble -e '$r=Regexp::Assemble->new(); $r->add($_) for ("-dbversion","-version","-verion","-verison"); print $r->re, "\n";'
1731  my %hashed_args = @args;
1732  my ($possible_key) = grep { $_ =~ /(?-xism:-(?:ver(?:is?|si)|dbversi)on)/xism } keys %hashed_args;
1733  if($possible_key) {
1734  my $msg = sprintf(q{Detected no -DB_VERSION flag but found '%s'; assuming a mis-spelling. Please fix}, $possible_key);
1735  warning($msg);
1736  $db_version = $hashed_args{$possible_key};
1737  }
1738  }
1739 
1740 
1741  my $ontology_db;
1742  my $ontology_version;
1743 
1744  my $taxonomy_db;
1745  my $taxonomy_db_versioned;
1746  my $ensembl_metadata_db;
1747  my $ensembl_metadata_db_versioned;
1748 
1749  my $production_dba_ok =
1750  eval { require Bio::EnsEMBL::Production::DBSQL::DBAdaptor; 1 };
1751  my $production_db;
1752  my $production_version;
1753 
1754  my $stable_ids_db;
1755  my $stable_ids_version;
1756 
1757  $user ||= "anonymous";
1758  if ( !defined($port) ) {
1759  $port = 3306;
1760  if ( $host eq "ensembldb.ensembl.org" && defined($db_version) && $db_version < 48 ) {
1761  $port = 4306;
1762  }
1763  }
1764 
1765  $wait_timeout ||= 0;
1766 
1767  my $original_count = $self->get_DBAdaptor_count();
1768 
1769  my $err_pattern = 'Cannot %s to the Ensembl MySQL server at %s:%d; check your settings & DBI error message: %s';
1770 
1771  my $dbh = DBI->connect( "DBI:mysql:host=$host;port=$port", $user, $pass ) or
1772  throw(sprintf($err_pattern, 'connect', $host, $port, $DBI::errstr));
1773  $dbh->ping() or
1774  throw(sprintf($err_pattern, 'ping', $host, $port, $DBI::errstr));
1775 
1776  my $res = $dbh->selectall_arrayref('SHOW DATABASES');
1777  my @dbnames = map { $_->[0] } @$res;
1778 
1779  my %temp;
1780  my $software_version = software_version();
1781 
1782  if ( defined($db_version) ) {
1783  $software_version = $db_version;
1784  }
1785 
1786  if ($verbose) {
1787  printf( "Will only load v%d databases\n", $software_version );
1788  }
1789 
1790  # From the list of all the databses create a tempory hash of those we
1791  # are interested in
1792 
1793  for my $db (@dbnames) {
1794  if ( $db =~ /^(\w+_collection_\w+(?:_\d+)?)_((\d+)_\w+)/ )
1795  { # NEEDS TO BE FIRST TO PICK UP COLLECTION DBS
1796  if ( $3 eq $software_version ) {
1797  $temp{$1} = $2;
1798  }
1799  } elsif ( $db =~ /^(.+)_(userdata)$/x ) {
1800  $temp{$1} = $2;
1801  } elsif (
1802  $db =~ /^(ensembl_compara # compara database
1803  (?:_\w+)*?) # optional ensembl genomes bit
1804  _
1805  (\d+)$/x )
1806  { # db version
1807  if ( $2 eq $software_version ) {
1808  $temp{$1} = $2;
1809  }
1810  } elsif ( $db =~ /^(ensembl_ancestral(?:_\w+?)*?)_(\d+)$/x ) {
1811  if ( $2 eq $software_version ) {
1812  $temp{$1} = $2;
1813  }
1814  } elsif ( $db =~ /^ensembl(?:genomes)?_ontology_(?:\d+_)?(\d+)/x ) {
1815  if ( $1 eq $software_version ) {
1816  $ontology_db = $db;
1817  $ontology_version = $1;
1818  }
1819  } elsif ( $db =~ /^ncbi_taxonomy$/ ) {
1820  $taxonomy_db = $db;
1821  }
1822  elsif ( $db =~ m{ \A ncbi_taxonomy_(\d+) \z }msx ) {
1823  if ( $1 eq $software_version ) {
1824  $taxonomy_db_versioned = $db;
1825  }
1826  } elsif ( $db =~ /^ensembl_metadata$/ ) {
1827  $ensembl_metadata_db = $db;
1828  }
1829  elsif ( $db =~ m{ \A ensembl_metadata_(\d+) \z }msx ) {
1830  if ( $1 eq $software_version ) {
1831  $ensembl_metadata_db_versioned = $db;
1832  }
1833  } elsif ( $production_dba_ok and $db =~ /^ensembl(?:genomes)?_production(_\d+)?/x ) {
1834  # production db can come with no version (i.e. that on ens-staging1),
1835  # but it's backed up with a release number
1836  my $version = $1;
1837  if ($version) {
1838  $version =~ s/_//;
1839  if ($software_version and $version eq $software_version) {
1840  $production_db = $db;
1841  $production_version = $version;
1842  }
1843  } else { # this is the default choice
1844  $production_db = $db if $db =~ /^ensembl(?:genomes)?_production$/;
1845  }
1846  } elsif ( $db =~ /^ensembl(?:genomes)?_stable_ids_(?:\d+_)?(\d+)/x ) {
1847  if ( $1 eq $software_version ) {
1848  $stable_ids_db = $db;
1849  $stable_ids_version = $1;
1850  }
1851 
1852  } elsif (
1853  $db =~ /^(?:$db_prefix)([a-z]+_[a-z0-9]+(?:_[a-z0-9]+)? # species name e.g. homo_sapiens or canis_lupus_familiaris
1854  _
1855  [a-z]+ # db type
1856  (?:_\d+)?) # optional end bit for ensembl genomes databases
1857  _
1858  (\d+) # database release
1859  _
1860  (\w+)$ # assembly number can have letters too e.g 37c
1861  /x
1862  )
1863  {
1864 
1865  # Species specific databases (core, cdna, vega etc.)
1866 
1867  my ( $sp_name, $db_rel, $assem ) = ( $1, $2, $3 );
1868  if ($db_prefix) { $sp_name = $db_prefix . $sp_name; }
1869 
1870  if ( !defined($species) || $sp_name =~ /^$species/ ) {
1871  if ( $db_rel eq $software_version ) {
1872  $temp{$sp_name} = $db_rel . "_" . $assem;
1873  }
1874  }
1875 
1876  } else {
1877  # warn( sprintf( "Skipping database '%s'\n", $db ) );
1878  }
1879  } ## end for my $db (@dbnames)
1880 
1881  @dbnames = ();
1882 
1883  foreach my $key ( keys %temp ) {
1884  push @dbnames, $key . "_" . $temp{$key};
1885  }
1886 
1887  # Register Core like databases
1888  my $core_like_dbs_found = 0;
1889  foreach my $type (qw(core cdna vega vega_update otherfeatures rnaseq ccds)) {
1890 
1891  my @dbs = grep { /^(?:$db_prefix)[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)? # species name
1892  _
1893  $type # the database type
1894  _
1895  (?:\d+_)? # optional end bit for ensembl genomes
1896  \d+ # database release
1897  _
1898  /x } @dbnames;
1899 
1900  if(@dbs) {
1901  $core_like_dbs_found = 1;
1902  }
1903 
1904  foreach my $database (@dbs) {
1905  if ( index( $database, 'collection' ) != -1 ) {
1906  # Skip multi-species databases.
1907  next;
1908  }
1909 
1910 
1911  my ( $prefix, $species, $num ) =
1912  ( $database =~ /(^$db_prefix)([a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?) # species name
1913  _
1914  $type # type
1915  _
1916  (?:\d+_)? # optional endbit for ensembl genomes
1917  (\d+) # databases release
1918  _
1919  /x );
1920 
1921  if(!defined($species)){
1922  warn "Cannot extract species name from database '$database'";
1923  }
1924 
1925  my $dba =
1927  -group => $type,
1928  -species => $species.$species_suffix,
1929  -host => $host,
1930  -user => $user,
1931  -pass => $pass,
1932  -port => $port,
1933  -dbname => $database,
1934  -wait_timeout => $wait_timeout,
1935  -no_cache => $no_cache );
1936 
1937  if ($verbose) {
1938  printf( "Species '%s' loaded from database '%s'\n",
1939  $species, $database );
1940  }
1941  }
1942  }
1943 
1944  # Register multi-species databases
1945 
1946  my @multi_dbs = grep { /^\w+_collection_core_\w+$/ } @dbnames;
1947 
1948  if (!$ignore_multi) {
1949  foreach my $multidb (@multi_dbs) {
1950  my $sth = $dbh->prepare(
1951  sprintf(
1952  "SELECT species_id, meta_value FROM %s.meta "
1953  . "WHERE meta_key = 'species.db_name'",
1954  $dbh->quote_identifier($multidb) ) );
1955 
1956  $sth->execute();
1957 
1958  my ( $species_id, $species );
1959  $sth->bind_columns( \( $species_id, $species ) );
1960 
1961  while ( $sth->fetch() ) {
1963  -group => "core",
1964  -species => $species.$species_suffix,
1965  -species_id => $species_id,
1966  -multispecies_db => 1,
1967  -host => $host,
1968  -user => $user,
1969  -pass => $pass,
1970  -port => $port,
1971  -dbname => $multidb,
1972  -wait_timeout => $wait_timeout,
1973  -no_cache => $no_cache
1974  );
1975 
1976  if ($verbose) {
1977  printf( "Species '%s' (id:%d) loaded from database '%s'\n",
1978  $species, $species_id, $multidb );
1979  }
1980  }
1981  } ## end foreach my $multidb (@multi_dbs)
1982  }
1983 
1984  if(!$core_like_dbs_found && $verbose) {
1985  print("No core-like databases found. Check your DB_VERSION (used '$software_version')\n");
1986  }
1987 
1988  # User upload DBs
1989 
1990  my @userupload_dbs = grep { /_userdata$/ } @dbnames;
1991  if (!$ignore_multi) {
1992  for my $userupload_db (@userupload_dbs) {
1993  if ( index( $userupload_db, 'collection' ) != -1 ) {
1994  # Skip multi-species databases.
1995  next;
1996  }
1997 
1998  my ($species) = ( $userupload_db =~ /(^.+)_userdata$/ );
1999  my $dba =
2001  -group => "userupload",
2002  -species => $species.$species_suffix,
2003  -host => $host,
2004  -user => $user,
2005  -pass => $pass,
2006  -port => $port,
2007  -wait_timeout => $wait_timeout,
2008  -dbname => $userupload_db,
2009  -no_cache => $no_cache );
2010 
2011  if ($verbose) {
2012  printf( "%s loaded\n", $userupload_db );
2013  }
2014  }
2015  }
2016 
2017  # Register multi-species userupload databases.
2018  my @userdata_multidbs = grep { /^.+_collection_userdata$/ } @dbnames;
2019 
2020  if (!$ignore_multi) {
2021  foreach my $multidb (@userdata_multidbs) {
2022  my $sth = $dbh->prepare(
2023  sprintf(
2024  "SELECT species_id, meta_value FROM %s.meta "
2025  . "WHERE meta_key = 'species.db_name'",
2026  $dbh->quote_identifier($multidb) ) );
2027 
2028  $sth->execute();
2029 
2030  my ( $species_id, $species );
2031  $sth->bind_columns( \( $species_id, $species ) );
2032 
2033  while ( $sth->fetch() ) {
2035  -group => "userupload",
2036  -species => $species.$species_suffix,
2037  -species_id => $species_id,
2038  -multispecies_db => 1,
2039  -host => $host,
2040  -user => $user,
2041  -pass => $pass,
2042  -port => $port,
2043  -dbname => $multidb,
2044  -wait_timeout => $wait_timeout,
2045  -no_cache => $no_cache
2046  );
2047 
2048  if ($verbose) {
2049  printf( "Species '%s' (id:%d) loaded from database '%s'\n",
2050  $species, $species_id, $multidb );
2051  }
2052  }
2053  } ## end foreach my $multidb (@userdata_multidbs)
2054  }
2055 
2056  # Variation
2057 
2058  my $test_eval = eval "require Bio::EnsEMBL::Variation::DBSQL::DBAdaptor"; ## no critic
2059  if ($@or (!$test_eval)) {
2060  # Ignore variations as code required not there for this
2061  if ($verbose) {
2062  print(
2063  "Bio::EnsEMBL::Variation::DBSQL::DBAdaptor module not found "
2064  . "so variation databases will be ignored if found\n" );
2065  }
2066  }
2067  else {
2068  my @variation_dbs =
2069  grep { /^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?_variation_(?:\d+_)?\d+_/ } @dbnames;
2070 
2071  if(! @variation_dbs && $verbose) {
2072  print("No variation databases found\n");
2073  }
2074 
2075  for my $variation_db (@variation_dbs) {
2076 
2077  if ( index( $variation_db, 'collection' ) != -1 ) {
2078  # Skip multi-species databases.
2079  next;
2080  }
2081 
2082  my ( $species, $num ) =
2083  ( $variation_db =~ /(^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?)_variation_(?:\d+_)?(\d+)_/ );
2084  my $dba =
2085  Bio::EnsEMBL::Variation::DBSQL::DBAdaptor->new(
2086  -group => "variation",
2087  -species => $species.$species_suffix,
2088  -host => $host,
2089  -user => $user,
2090  -pass => $pass,
2091  -port => $port,
2092  -wait_timeout => $wait_timeout,
2093  -dbname => $variation_db,
2094  -no_cache => $no_cache );
2095 
2096  if ($verbose) {
2097  printf( "%s loaded\n", $variation_db );
2098  }
2099  }
2100 
2101  # Register variation multispecies databases
2102  my @variation_multidbs =
2103  grep { /^\w+_collection_variation_\w+$/ } @dbnames;
2104 
2105  if (!$ignore_multi) {
2106  foreach my $multidb (@variation_multidbs) {
2107  my $sth = $dbh->prepare(
2108  sprintf( 'SELECT species_id, meta_value FROM %s.meta ',
2109  $dbh->quote_identifier($multidb) )
2110  . "WHERE meta_key = 'species.db_name'"
2111  );
2112 
2113  $sth->execute();
2114 
2115  my ( $species_id, $species );
2116  $sth->bind_columns( \( $species_id, $species ) );
2117 
2118  while ( $sth->fetch() ) {
2119  my $dba = Bio::EnsEMBL::Variation::DBSQL::DBAdaptor->new(
2120  -group => 'variation',
2121  -species => $species.$species_suffix,
2122  -species_id => $species_id,
2123  -multispecies_db => 1,
2124  -host => $host,
2125  -user => $user,
2126  -pass => $pass,
2127  -port => $port,
2128  -dbname => $multidb,
2129  -wait_timeout => $wait_timeout,
2130  -no_cache => $no_cache
2131  );
2132 
2133  if ($verbose) {
2134  printf( "Species '%s' (id:%d) loaded from database '%s'\n",
2135  $species, $species_id, $multidb );
2136  }
2137  }
2138  } ## end foreach my $multidb (@variation_multidbs)
2139  }
2140  }
2141 
2142  my $func_eval = eval "require Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor"; ## no critic
2143  if ($@ or (!$func_eval)) {
2144  if ($verbose) {
2145  # Ignore funcgen DBs as code required not there for this
2146  print("Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor module not found "
2147  . "so functional genomics databases will be ignored if found\n"
2148  );
2149  }
2150  } else {
2151  my @funcgen_dbs =
2152  grep { /^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?_funcgen_(?:\d+_)?\d+_/ } @dbnames;
2153 
2154  if(! @funcgen_dbs && $verbose) {
2155  print("No funcgen databases found\n");
2156  }
2157 
2158  for my $funcgen_db (@funcgen_dbs) {
2159  if ( index( $funcgen_db, 'collection' ) != -1 ) {
2160  # Skip multi-species databases.
2161  next;
2162  }
2163 
2164  my ( $species, $num ) =
2165  ( $funcgen_db =~ /(^[a-z]+_[a-z0-9]+(?:_[a-z0-9]+)?)_funcgen_(?:\d+_)?(\d+)_/ );
2166  my $dba = Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor->new(
2167  -group => "funcgen",
2168  -species => $species.$species_suffix,
2169  -host => $host,
2170  -user => $user,
2171  -pass => $pass,
2172  -port => $port,
2173  -wait_timeout => $wait_timeout,
2174  -dbname => $funcgen_db,
2175  -no_cache => $no_cache
2176  );
2177 
2178  if ($verbose) {
2179  printf( "%s loaded\n", $funcgen_db );
2180  }
2181  }
2182 
2183  # Register functional genomics multispecies databases
2184  my @funcgen_multidbs =
2185  grep { /^\w+_collection_funcgen_\w+$/ } @dbnames;
2186 
2187  if (!$ignore_multi) {
2188  foreach my $multidb (@funcgen_multidbs) {
2189  my $sth = $dbh->prepare(
2190  sprintf( 'SELECT species_id, meta_value FROM %s.meta ',
2191  $dbh->quote_identifier($multidb) )
2192  . "WHERE meta_key = 'species.db_name'"
2193  );
2194 
2195  $sth->execute();
2196 
2197  my ( $species_id, $species );
2198  $sth->bind_columns( \( $species_id, $species ) );
2199 
2200  while ( $sth->fetch() ) {
2201  my $dba = Bio::EnsEMBL::Funcgen::DBSQL::DBAdaptor->new(
2202  -group => 'funcgen',
2203  -species => $species.$species_suffix,
2204  -species_id => $species_id,
2205  -multispecies_db => 1,
2206  -host => $host,
2207  -user => $user,
2208  -pass => $pass,
2209  -port => $port,
2210  -dbname => $multidb,
2211  -wait_timeout => $wait_timeout,
2212  -no_cache => $no_cache
2213  );
2214 
2215  if ($verbose) {
2216  printf( "Species '%s' (id:%d) loaded from database '%s'\n",
2217  $species, $species_id, $multidb );
2218  }
2219  }
2220  } ## end foreach my $multidb (@funcgen_multidbs)
2221  }
2222  } ## end else [ if ($@) ]
2223 
2224  # Compara
2225 
2226  my @compara_dbs = grep { /^ensembl_compara/ } @dbnames;
2227 
2228  if (!$ignore_multi) {
2229  if (@compara_dbs) {
2230  my $comp_eval = eval "require Bio::EnsEMBL::Compara::DBSQL::DBAdaptor"; ## no critic
2231  if ($@ or (!$comp_eval)) {
2232  # Ignore Compara as code required not there for this
2233  if ($verbose) {
2234  printf(
2235  "Bio::EnsEMBL::Compara::DBSQL::DBAdaptor "
2236  . "not found so the following compara "
2237  . "databases will be ignored: %s\n",
2238  join( ', ', @compara_dbs ) );
2239  }
2240  } else {
2241  foreach my $compara_db (@compara_dbs) {
2242  # Looking for EnsEMBL Genomes Comparas.
2243  # ensembl_compara_bacteria_2_53 is registered as
2244  # 'bacteria', ensembl_compara_pan_homology_2_53 is
2245  # registered as 'pan_homology', ensembl_compara_53 is
2246  # registered as 'multi', and the alias 'compara' still
2247  # operates.
2248 
2249  my ($species) =
2250  $compara_db =~ /^ensembl_compara_(\w+)(?:_\d+){2}$/xm;
2251 
2252  $species ||= 'multi';
2253 
2254  my $dba = Bio::EnsEMBL::Compara::DBSQL::DBAdaptor->new(
2255  -group => 'compara',
2256  -species => $species.$species_suffix,
2257  -host => $host,
2258  -user => $user,
2259  -pass => $pass,
2260  -port => $port,
2261  -wait_timeout => $wait_timeout,
2262  -dbname => $compara_db,
2263  -no_cache => $no_cache
2264  );
2265 
2266  if ($verbose) {
2267  printf( "%s loaded\n", $compara_db );
2268  }
2269  } ## end foreach my $compara_db (@compara_dbs)
2270  } ## end else [ if ($@)
2271  } elsif ($verbose) {
2272  print("No Compara databases found\n");
2273  }
2274  }
2275 
2276  # Ancestral sequences
2277 
2278  my @ancestral_dbs =
2279  sort grep { /^ensembl_ancestral/ } @dbnames;
2280 
2281  if (@ancestral_dbs && !$ignore_multi) {
2282  foreach my $ancestral_db (@ancestral_dbs) {
2283  # Looking for Compara's "ancestral" databases.
2284  # ensembl_ancestral_plants_47_100 is registered with the 'plants'
2285  # prefix, while ensembl_ancestral_100 is not given any prefix for
2286  # backwards compatibility.
2287  # Similarly, contrary to the nomenclature, "Ancestral sequences"
2288  # is the species (production) name and "ancestral_sequences" is
2289  # an alias.
2290  my $alias;
2291  my ($division) = $ancestral_db =~ /^ensembl_ancestral_(\w+)(?:_\d+){2}$/xm;
2292  if ($division) {
2293  $species = (ucfirst $division).' Ancestral sequences'.$species_suffix;
2294  $alias = $division.'_ancestral_sequences'.$species_suffix;
2295  } else {
2296  $species = 'Ancestral sequences'.$species_suffix;
2297  $alias = 'ancestral_sequences'.$species_suffix;
2298  }
2299 
2301  -group => 'core',
2302  -species => $species,
2303  -host => $host,
2304  -user => $user,
2305  -pass => $pass,
2306  -port => $port,
2307  -wait_timeout => $wait_timeout,
2308  -dbname => $ancestral_db,
2309  -no_cache => $no_cache
2310  );
2311 
2313  -species => $species,
2314  -alias => [$alias],
2315  );
2316 
2317  if ($verbose) {
2318  printf( "%s loaded\n", $ancestral_db );
2319  }
2320  }
2321  } elsif ($verbose) {
2322  print("No ancestral database found\n");
2323  }
2324 
2325  # Ontology
2326 
2327  if ( defined($ontology_version) && $ontology_version != 0 && !$ignore_multi) {
2329 
2330  my $dba =
2332  '-species' => 'multi' . $species_suffix,
2333  '-group' => 'ontology',
2334  '-host' => $host,
2335  '-port' => $port,
2336  '-user' => $user,
2337  '-pass' => $pass,
2338  '-dbname' => $ontology_db, );
2339 
2340  if ($verbose) {
2341  printf( "%s loaded\n", $ontology_db );
2342  }
2343  }
2344  elsif ($verbose) {
2345  print("No ontology database found\n");
2346  }
2347 
2348  # Taxonomy
2349 
2350  if ( ( defined $taxonomy_db ) || ( defined $taxonomy_db_versioned ) ) {
2351 
2352  my $has_taxonomy = eval {require Bio::EnsEMBL::Taxonomy::DBSQL::TaxonomyDBAdaptor};
2353  if($@ or (!defined $has_taxonomy)) {
2354  if($verbose) {
2355  print "ensembl_taxonomy API not found - ignoring $taxonomy_db\n";
2356  }
2357  } else {
2358 
2359  my $taxonomy_dbname;
2360  # Versioned database has priority over unversioned one.
2361  if ( defined $taxonomy_db_versioned ) {
2362  $taxonomy_dbname = $taxonomy_db_versioned;
2363  }
2364  else {
2365  $taxonomy_dbname = $taxonomy_db;
2366  }
2367 
2368  my $dba = Bio::EnsEMBL::Taxonomy::DBSQL::TaxonomyDBAdaptor->new(
2369  '-species' => 'multi' . $species_suffix,
2370  '-group' => 'taxonomy',
2371  '-host' => $host,
2372  '-port' => $port,
2373  '-user' => $user,
2374  '-pass' => $pass,
2375  '-dbname' => $taxonomy_dbname, );
2376 
2377  if ($verbose) {
2378  printf( "%s loaded\n", $taxonomy_dbname );
2379  }
2380  }
2381  }
2382  elsif ($verbose) {
2383  print("No taxonomy database found\n");
2384  }
2385 
2386  # ensembl_metadata
2387 
2388  if ( ( defined $ensembl_metadata_db ) || ( defined $ensembl_metadata_db_versioned ) ) {
2389 
2390  my $has_metadata = eval {require Bio::EnsEMBL::MetaData::DBSQL::MetaDataDBAdaptor};
2391  if($@ or (!defined $has_metadata)) {
2392  if($verbose) {
2393  print "ensembl_metadata API not found - ignoring $ensembl_metadata_db\n";
2394  }
2395  } else {
2396 
2397  my $metadata_dbname;
2398  # Versioned database has priority over unversioned one.
2399  if ( defined $ensembl_metadata_db_versioned ) {
2400  $metadata_dbname = $ensembl_metadata_db_versioned;
2401  }
2402  else {
2403  $metadata_dbname = $ensembl_metadata_db;
2404  }
2405 
2406  my $dba = Bio::EnsEMBL::MetaData::DBSQL::MetaDataDBAdaptor->new(
2407  '-species' => 'multi' . $species_suffix,
2408  '-group' => 'metadata',
2409  '-host' => $host,
2410  '-port' => $port,
2411  '-user' => $user,
2412  '-pass' => $pass,
2413  '-dbname' => $metadata_dbname, );
2414 
2415  if ($verbose) {
2416  printf( "%s loaded\n", $metadata_dbname );
2417  }
2418  }
2419  }
2420  elsif ($verbose) {
2421  print("No ensembl_metadata database found\n");
2422  }
2423 
2424  # Production
2425 
2426  if ( $production_dba_ok and defined($production_db) && !$ignore_multi) {
2427  # require Bio::EnsEMBL::Production::DBSQL::DBAdaptor;
2428 
2429  my $dba =
2430  Bio::EnsEMBL::Production::DBSQL::DBAdaptor->new(
2431  '-species' => 'multi' . $species_suffix,
2432  '-group' => 'production',
2433  '-host' => $host,
2434  '-port' => $port,
2435  '-user' => $user,
2436  '-pass' => $pass,
2437  '-dbname' => $production_db, );
2438 
2439  if ($verbose) {
2440  printf( "%s loaded\n", $production_db );
2441  }
2442  }
2443  elsif ($verbose) {
2444  print("No production database or adaptor found\n");
2445  }
2446 
2447  # Stable IDs
2448 
2449  if ( defined($stable_ids_db) && $stable_ids_version != 0 && !$ignore_multi) {
2450 
2451  my $dba =
2453  '-species' => 'multi' . $species_suffix,
2454  '-group' => 'stable_ids',
2455  '-host' => $host,
2456  '-port' => $port,
2457  '-user' => $user,
2458  '-pass' => $pass,
2459  '-dbname' => $stable_ids_db, );
2460 
2461  if ($verbose) {
2462  printf( "%s loaded\n", $stable_ids_db );
2463  }
2464 
2465  }
2466 
2467 
2469  -species => 'multi'.$species_suffix,
2470  -alias => ['compara'.$species_suffix] );
2471 
2473  -species => 'multi'.$species_suffix,
2474  -alias => ['ontology'.$species_suffix] );
2475 
2476  $production_dba_ok and
2478  -species => 'multi'.$species_suffix,
2479  -alias => ['production'.$species_suffix] );
2480 
2482  -species => 'multi'.$species_suffix,
2483  -alias => ['stable_ids'.$species_suffix] );
2484 
2485  # Register aliases as found in adaptor meta tables.
2486 
2487  $self->find_and_add_aliases( '-handle' => $dbh,
2488  '-species_suffix' => $species_suffix );
2489 
2490  $dbh->disconnect();
2491 
2492  my $count = $self->get_DBAdaptor_count() - $original_count;
2493  return $count >= 0 ? $count : 0;
2494 
2495 } ## end sub load_registry_from_db
2496 
2497 =head2 _group_to_adaptor_class
2498 
2499  Arg [1] : The group you wish to decode to an adaptor class
2501  Description : Has an internal lookup of groups to their adaptor classes
2502  Returntype : String
2503  Exceptions : Thrown if the group is unknown
2504  Status : Stable
2505 
2506 =cut
2507 
2508 sub _group_to_adaptor_class {
2509  my ($self, $group) = @_;
2510  my $class = $group2adaptor{$group};
2511  if (!defined $class) {
2512  $class = {
2513  cdna => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
2514  rnaseq => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
2515  }->{$group};
2516  }
2517  throw "Group '${group}' is unknown" if ! $class;
2518  return $class;
2519 }
2520 
2521 
2522 =head2 find_and_add_aliases
2523 
2524  Arg [ADAPTOR] : (optional) Bio::EnsEMBL::DBSQL::DBAdaptor
2525  The adaptor to use to retrieve aliases from.
2526 
2527  Arg [GROUP] : (optional) string
2528  The group you want to find aliases for. If not
2529  given assumes all types.
2530 
2531  Arg [HANDLE] : (optional) DBI database handle
2532  A connected database handle to use instead of
2533  the database handles stored in the DBAdaptors.
2534  Bypasses the use of MetaContainer.
2535 
2536  Arg [SPECIES_SUFFIX]: (optional) string
2537  This option will append the string to the species
2538  name in the registry for all databases.
2539 
2541  -ADAPTOR => $dba,
2542  -GROUP => 'core'
2543  );
2544 
2545  Description : Looks in the meta container for each database for
2546  an entry called "species.alias". If any are found
2547  then the species adaptor is registered to that
2548  set of aliases. This can work across any adaptor
2549  which has a MetaContainer. If no MetaContainer
2550  can be returned from a given adaptor then no alias
2551  searching is performed.
2552 
2553  Return type : none
2554  Exceptions : Throws if an alias is found in more than one species.
2555  Status : Stable
2556 
2557 =cut
2558 
2559 sub find_and_add_aliases {
2560  my $class = shift ;
2561 
2562  my ($adaptor, $group, $dbh, $species_suffix ) =
2563  rearrange( [ 'ADAPTOR', 'GROUP', 'HANDLE', 'SPECIES_SUFFIX' ], @_ );
2564 
2565  #Can be undef; needs to be something to avoid warnings
2566  $species_suffix ||= q{};
2567 
2568  my @dbas;
2569  if ( defined($adaptor) ) {
2570  @dbas = ($adaptor);
2571  } elsif ( defined($dbh) ) {
2572 
2573  if ( length($species_suffix) > 0 ) {
2574  my @full = @{ $class->get_all_DBAdaptors( '-GROUP' => $group ) };
2575 
2576  foreach my $db (@full) {
2577  if ( $db->species =~ /$species_suffix/ ) {
2578  push( @dbas, $db );
2579  }
2580  }
2581 
2582  } else {
2583  @dbas = @{ $class->get_all_DBAdaptors( '-GROUP' => $group ) };
2584  }
2585 
2586  } else {
2587  @dbas = @{ $class->get_all_DBAdaptors( '-GROUP' => $group ) };
2588  }
2589 
2590  my $aliases_for_dbc = {};
2591 
2592  foreach my $dba (@dbas) {
2593  my @aliases;
2594  my $species = $dba->species();
2595 
2596  if ( defined($dbh) ) {
2597 
2598  my $dbname = $dba->dbc()->dbname();
2599 
2600  if (!defined $aliases_for_dbc->{$dbname}) {
2601 
2602  my $sth = $dbh->prepare(sprintf("SELECT species_id,meta_value FROM %s.meta "
2603  . "WHERE meta_key = 'species.alias' ", $dbh->quote_identifier($dbname))
2604  );
2605 
2606  # Execute, and don't care about errors (there will be errors for
2607  # databases without a 'meta' table.
2608  $sth->{'PrintError'} = 0;
2609  $sth->{'RaiseError'} = 0;
2610  if (!$sth->execute()) { next }
2611  $sth->{'PrintError'} = $dbh->{'PrintError'};
2612  $sth->{'RaiseError'} = $dbh->{'RaiseError'};
2613 
2614  my $alias;
2615  my $species_id;
2616  $sth->bind_columns(\$species_id, \$alias);
2617  while ($sth->fetch()) {
2618  push(@{$aliases_for_dbc->{$dbname}{$species_id}}, $alias);
2619  }
2620  }
2621 
2622  @aliases = @{$aliases_for_dbc->{$dbname}{$dba->species_id()}||[]}
2623 
2624  } else {
2625  my $meta_container = eval { $dba->get_MetaContainer() };
2626 
2627  if ( defined($meta_container) ) {
2628  push( @aliases,
2629  @{ $meta_container->list_value_by_key('species.alias') }
2630  );
2631  }
2632 
2633  # Need to disconnect so we do not spam the MySQL servers trying to
2634  # get aliases. Can only call disonnect if dbc was defined.
2635  if ( defined( $dba->dbc() ) ) {
2636  $dba->dbc()->disconnect_if_idle();
2637  }
2638  }
2639 
2640  foreach my $alias (@aliases) {
2641  my $alias_suffix = $alias.$species_suffix;
2642  #Lowercase because stored aliases are lowercased
2643  my $lc_species = lc($species);
2644  my $lc_alias_suffix = lc($alias_suffix);
2645  if ( !$class->alias_exists( $alias_suffix )
2646  && $lc_species ne $lc_alias_suffix )
2647  {
2648  $class->add_alias( $species, $alias_suffix );
2649  } elsif (
2650  $lc_species ne $class->get_alias( $alias_suffix ) )
2651  {
2652  $class->remove_alias( $species, $alias_suffix );
2653  }
2654  }
2655 
2656  } ## end foreach my $dba (@dbas)
2657  return;
2658 } ## end sub find_and_add_aliases
2659 
2660 
2661 =head2 load_registry_from_multiple_dbs
2662 
2663  Arg [1] : Array of hashes, each hash being a set of arguments to
2664  load_registry_from_db() (see above).
2665 
2666  Example :
2667 
2668  $registry->load_registry_from_multiple_dbs( {
2669  '-host' => 'ensembldb.ensembl.org',
2670  '-user' => 'anonymous',
2671  '-verbose' => '1'
2672  },
2673  {
2674  '-host' => 'server.example.com',
2675  '-user' => 'anonymouse',
2676  '-password' => 'cheese',
2677  '-verbose' => '1'
2678  } );
2679 
2680  Description: Will call load_registry_from_db() (see above)
2681  multiple times and merge the resulting registries
2682  into one, effectively allowing a user to connect to
2683  databases on multiple database servers from within
2684  one program.
2685 
2686  If a database is found on more than one server, the
2687  first found instance of that database will be used.
2688 
2689  Returntype : Int count of the DBAdaptor instances which can be found in the
2690  registry
2691 
2692 =cut
2693 
2694 sub load_registry_from_multiple_dbs {
2695  my ( $self, @args ) = @_;
2696 
2697  my $original_count = $self->get_DBAdaptor_count();
2698 
2699  my %merged_register = %registry_register;
2700 
2701  foreach my $arg (@args) {
2702  local %registry_register = ();
2703 
2704  my $verbose;
2705 
2706  ($verbose) = rearrange( ['VERBOSE'], %{$arg} );
2707 
2708  $self->load_registry_from_db( %{$arg} );
2709 
2710  #
2711  # Merge the localized %registry_register into %merged_register.
2712  #
2713 
2714  # Merge the _SPECIES and _ALIAS sections of %registry_register.
2715  foreach my $section ( 'Species', 'Alias' ) {
2716  my $section_key = '_' . uc($section);
2717 
2718  while ( my ( $key, $value ) =
2719  each( %{ $registry_register{$section_key} } ) )
2720  {
2721  if ( !exists( $merged_register{$section_key}{$key} ) ) {
2722  $merged_register{$section_key}{$key} = $value;
2723  } elsif ($verbose) {
2724  printf( "%s '%s' found on multiple servers, "
2725  . "using first found\n",
2726  $section, $key );
2727  }
2728  }
2729  }
2730  } ## end foreach my $arg (@args)
2731 
2732  # Add the DBAs from the _SPECIES section into the _DBA section.
2733  foreach my $species_hash ( values( %{ $merged_register{_SPECIES} } ) )
2734  {
2735  foreach my $group_hash ( values( %{$species_hash} ) ) {
2736  if ( ref($group_hash) eq 'HASH' && exists( $group_hash->{_DB} ) )
2737  {
2738  push( @{ $merged_register{_DBA} }, $group_hash->{_DB} );
2739  }
2740  }
2741  }
2742 
2743  %registry_register = %merged_register;
2744 
2745  my $count = $self->get_DBAdaptor_count() - $original_count;
2746  return $count >= 0 ? $count : 0;
2747 } ## end sub load_registry_from_multiple_dbs
2748 
2749 #
2750 # Web specific routines
2751 #
2752 
2753 =head2 set_default_track
2754 
2755  Sets a flag to say that that this species/group are a default track and do not
2756  need to be added as another web track.
2757 
2758  Arg [1] : name of the species to get the adaptors for in the registry.
2759  Arg [2] : name of the type to get the adaptors for in the registry.
2760  Example : $merged = Bio::EnsEMBL::Registry->set_default_track("Human","core");
2761  Returntype : none
2762  Exceptions : none
2763  Status : At Risk.
2764 
2765 =cut
2766 
2767 sub set_default_track {
2768  my ( $class, $species, $group ) = @_;
2769 
2770  $species = get_alias($species);
2771  $registry_register{'def_track'}{$species}{ lc($group) } = 1;
2772  return;
2773 }
2774 
2775 =head2 default_track
2776 
2777  Check flag to see if this is a default track
2778 
2779  Arg [1] : name of the species to get the adaptors for in the registry.
2780  Arg [2] : name of the type to get the adaptors for in the registry.
2781  Example : $merged = Bio::EnsEMBL::Registry->set_default_track("Human","core");
2782  Returntype : int
2783  Exceptions : none
2784  Status : At Risk.
2785 
2786 =cut
2787 
2788 sub default_track {
2789  my ( $class, $species, $group ) = @_;
2790 
2791  $species = get_alias($species);
2792  if (
2793  defined( $registry_register{'def_track'}{$species}{ lc($group) } ) )
2794  {
2795  return 1;
2796  }
2797 
2798  return 0;
2799 }
2800 
2801 
2802 =head2 add_new_tracks
2803 
2804  Will add new gene tracks to the configuration of the WEB server if they are
2805  not of the type default and the configuration already has genes in the display.
2806 
2807  Arg [1] : hash of the default configuration of the web page
2808  Returntype : none
2809  Exceptions : none
2810  Called by : UserConfig.pm
2811  Status : At Risk.
2812 
2813 =cut
2814 
2815 sub add_new_tracks{
2816  my($class, $conf, $pos) = @_;
2817 
2818  my $start = 0;
2819  my $reg = $class;
2820  my $species_reg = $reg->get_alias($conf->{'species'},"nothrow");
2821  my %pars;
2822 # print STDERR "Species $species_reg check for default tracks\n";
2823  if(defined($species_reg)){
2824  foreach my $dba (@{$reg->get_all_DBAdaptors()}){
2825  if(!$reg->default_track($dba->species,$dba->group)){
2826  $pars{'available'} = "species ".$reg->get_alias($dba->species());
2827  $pars{'db_alias'} = $dba->group();
2828 # print STDERR "Adding new track for ".$dba->species."\t".$dba->group."\n";
2829  $conf->add_new_track_generictranscript('',$dba->group(), "black",$pos,%pars);
2830  $pos++;
2831  }
2832  }
2833  }
2834  return $pos;
2835 
2836 }
2837 
2838 =head2 no_version_check
2839 
2840  getter/setter for whether to run the version checking
2841 
2842  Arg[0] : (optional) int
2843  Returntype : int or undef if not set
2844  Exceptions : none
2845  Status : At Risk.
2846 
2847 =cut
2848 
2849 sub no_version_check {
2850  my ( $self, $arg ) = @_;
2851  ( defined $arg )
2852  && ( $registry_register{'_no_version_check'} = $arg );
2853 
2854  return $registry_register{'_no_version_check'};
2855 }
2856 
2857 =head2 no_cache_warnings
2858 
2859  Arg[0] : boolean for turning the flag on and off
2860  Description : Turns off any warnings about not using caching in all available
2861  adaptors.
2862  Returntype : boolean Current status
2863  Exceptions : None
2864 
2865 =cut
2866 
2867 sub no_cache_warnings {
2868  my ($self, $arg) = @_;
2869  if(defined $arg) {
2870  $Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor::SILENCE_CACHE_WARNINGS = $arg;
2871  }
2872  return $Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor::SILENCE_CACHE_WARNINGS;
2873 }
2874 
2875 
2876 =head2 version_check
2877 
2878  run the database/API code version check for a DBAdaptor
2879 
2880  Arg[0] : DBAdaptor to check
2881  Returntype : int 1 if okay, 0 if not the same
2882  Exceptions : none
2883  Status : At Risk.
2884 
2885 =cut
2886 
2887 
2888 sub version_check {
2889  my ( $self, $dba ) = @_;
2890 
2891  # Check the datbase and versions match
2892  # give warning if they do not.
2893  my $check = no_version_check();
2894 
2895  if ( (
2896  defined( $ENV{HOME} )
2897  and ( -e $ENV{HOME} . "/.ensemblapi_no_version_check" ) )
2898  or ( defined($check) and ( $check != 0 ) ) )
2899  {
2900  return 1;
2901  }
2902 
2903  my $mca =
2904  $self->get_adaptor( $dba->species(), $dba->group(),
2905  "MetaContainer" );
2906 
2907  my $database_version = 0;
2908  if ( defined($mca) ) {
2909  $database_version = $mca->get_schema_version();
2910  }
2911 
2912  if ( $database_version == 0 ) {
2913  # Try to work out the version
2914  if ( $dba->dbc()->dbname() =~ /^_test_db_/x ) {
2915  return 1;
2916  }
2917 
2918  # ensembl_metadata was unversioned prior to release 96
2919  # we now have multiple pattern for metadata db name (qrp and grch37) - valid until we merge those.
2920  if ( $dba->dbc()->dbname() =~ /ensembl_metadata(\_?(qrp|grch37)?)/s ) {
2921  return 1;
2922  }
2923  # ncbi_taxonomy was unversioned prior to release 100
2924  if ( $dba->dbc()->dbname() eq 'ncbi_taxonomy' ) {
2925  return 1;
2926  }
2927 
2928  if ( $dba->dbc()->dbname() =~ /(\d+)_\S+$/x ) {
2929  $database_version = $1;
2930  } elsif ( $dba->dbc()->dbname() =~ /ensembl_compara_(\d+)/x ) {
2931  $database_version = $1;
2932  } elsif ( $dba->dbc()->dbname() =~ /ensembl_help_(\d+)/x ) {
2933  $database_version = $1;
2934  } elsif ( $dba->dbc()->dbname() =~ / ensembl_metadata_(\d+) /msx ) {
2935  # Prior to release 96 metadata is supposed to be versionned on meta-1. Not the case since
2936  $database_version = $1;
2937  } elsif ( $dba->dbc()->dbname() =~ /ensembl_ontology_(\d+)/x ) {
2938  $database_version = $1;
2939  } elsif ( $dba->dbc()->dbname() =~ /ensembl_stable_ids_(\d+)/x ) {
2940  $database_version = $1;
2941  } elsif ( $dba->dbc()->dbname() =~ / ncbi_taxonomy_(\d+) /msx ) {
2942  $database_version = $1;
2943  } else {
2944  warn(
2945  sprintf(
2946  "No database version for database %s "
2947  . ". You must be using a post version 34 database "
2948  . "with version 34 or later code.\n"
2949  . "You need to update your database "
2950  . "or use the appropriate Ensembl software release "
2951  . "to ensure your script does not crash\n",
2952  $dba->dbc()->dbname() ) );
2953  }
2954  } ## end if ( $database_version...
2955 
2956  if ( $database_version != software_version() ) {
2957  warn(
2958  sprintf(
2959  "For %s there is a difference in the software release (%s) "
2960  . "and the database release (%s). "
2961  . "You should update one of these to ensure that your script "
2962  . "does not crash.\n",
2963  $dba->dbc()->dbname()."@".$dba->dbc()->host,
2964  software_version(), $database_version
2965  ) );
2966  return 0;
2967  }
2968 
2969  return 1; # Ok
2970 } ## end sub version_check
2971 
2972 =head2 get_all_species
2973 
2974  Arg [1] : String group type, such as core, or otherfeatures
2975  Description: Method for getting all valid species names found in available
2976  databases. This excludes the ancestral sequence databases, and
2977  any species from a non-core database. Specifying a group allows
2978  the list to apply to non-core database types.
2979  Example : my @species_names = @{ $reg->get_all_species() };
2980  Returntype : Listref of species names
2981 
2982 =cut
2983 
2984 sub get_all_species {
2985  my ($self,$group) = @_;
2986  $group ||= 'core';
2987  my @species;
2988  foreach my $name (keys %{$registry_register{_SPECIES}}) {
2989  push @species, $name if (
2990  # limit species names to given db group and no ancestral dbs
2991  $registry_register{_SPECIES}->{$name}->{$group}
2992  && $name !~ /^ancestral/i
2993  );
2994  }
2995  return \@species;
2996 }
2997 
2998 
2999 =head2 get_species_and_object_type
3000 
3001  Description: Get the species name, object type (gene, transcript,
3002  translation, or exon etc.), and database type for a
3003  stable ID.
3004 
3005  Arg [1] : String stable_id
3006  The stable ID to find species and object type for.
3007 
3008  Arg [2] : String known_type (optional)
3009  The type of the stable ID, if it is known.
3010 
3011  Arg [3] : String known_species (optional)
3012  The species, if known
3013 
3014  Arg [4] : String known_db_type (optional)
3015  The database type, if known
3016 
3017  Example : my $stable_id = 'ENST00000326632';
3018 
3019  my ( $species, $object_type, $db_type ) =
3020  $registry->get_species_and_object_type($stable_id);
3021 
3022  my $adaptor =
3023  $registry->get_adaptor( $species, $db_type,
3024  $object_type );
3025 
3026  my $object = $adaptor->fetch_by_stable_id($stable_id);
3027 
3028  Return type: Array consisting of the species name, object type,
3029  and database type. The array may be empty if no
3030  match is found.
3031 
3032  Exceptions : none
3033  Status : At Risk.
3034 
3035 =cut
3036 
3037 my %stable_id_stmts = (
3038  gene => 'SELECT m.meta_value '
3039  . 'FROM %1$s.gene '
3040  . 'JOIN %1$s.seq_region USING (seq_region_id) '
3041  . 'JOIN %1$s.coord_system USING (coord_system_id) '
3042  . 'JOIN %1$s.meta m USING (species_id) '
3043  . 'WHERE stable_id = ? '
3044  . 'AND m.meta_key = "species.production_name"',
3045  transcript => 'SELECT m.meta_value '
3046  . 'FROM %1$s.transcript '
3047  . 'JOIN %1$s.seq_region USING (seq_region_id) '
3048  . 'JOIN %1$s.coord_system USING (coord_system_id) '
3049  . 'JOIN %1$s.meta m USING (species_id) '
3050  . 'WHERE stable_id = ? '
3051  . 'AND m.meta_key = "species.production_name"',
3052  exon => 'SELECT m.meta_value '
3053  . 'FROM %1$s.exon '
3054  . 'JOIN %1$s.seq_region USING (seq_region_id) '
3055  . 'JOIN %1$s.coord_system USING (coord_system_id) '
3056  . 'JOIN %1$s.meta m USING (species_id) '
3057  . 'WHERE stable_id = ? '
3058  . 'AND m.meta_key = "species.production_name"',
3059  translation => 'SELECT m.meta_value '
3060  . 'FROM %1$s.translation tl '
3061  . 'JOIN %1$s.transcript USING (transcript_id) '
3062  . 'JOIN %1$s.seq_region USING (seq_region_id) '
3063  . 'JOIN %1$s.coord_system USING (coord_system_id) '
3064  . 'JOIN %1$s.meta m USING (species_id) '
3065  . 'WHERE tl.stable_id = ? '
3066  . 'AND m.meta_key = "species.production_name"',
3067  operon => 'SELECT m.meta_value '
3068  . 'FROM %1$s.operon '
3069  . 'JOIN %1$s.seq_region USING (seq_region_id) '
3070  . 'JOIN %1$s.coord_system USING (coord_system_id) '
3071  . 'JOIN %1$s.meta m USING (species_id) '
3072  . 'WHERE stable_id = ? '
3073  . 'AND m.meta_key = "species.production_name"',
3074  operontranscript => 'SELECT m.meta_value '
3075  . 'FROM %1$s.operon_transcript '
3076  . 'JOIN %1$s.seq_region USING (seq_region_id) '
3077  . 'JOIN %1$s.coord_system USING (coord_system_id) '
3078  . 'JOIN %1$s.meta m USING (species_id) '
3079  . 'WHERE stable_id = ? '
3080  . 'AND m.meta_key = "species.production_name"',
3081 
3082 );
3083 
3084 my %compara_stable_id_stmts = (
3085  genetree => 'SELECT 1 FROM %1$s.gene_tree_root WHERE stable_id =?',
3086  family => 'SELECT 1 from %1$s.family where stable_id = ?',
3087 );
3088 
3089 
3090 sub get_species_and_object_type {
3091  my ($self, $stable_id, $known_type, $known_species, $known_db_type, $force_long_lookup, $use_archive) = @_;
3092 
3093  #get the stable_id lookup database adaptor
3094 
3095  my $stable_ids_dba = $self->get_DBAdaptor("multi", "stable_ids", 1);
3096 
3097  if ($stable_ids_dba && ! $force_long_lookup) {
3098  return $self->_lookup_db_get_species_and_object_type($stable_id, $known_type, $known_species, $known_db_type, $use_archive);
3099  }
3100  else {
3101  if(defined $known_type) {
3102  my $lc_known_type = lc $known_type;
3103  if(!exists $stable_id_stmts{$lc_known_type} && ! exists $compara_stable_id_stmts{$lc_known_type}) {
3104  return;
3105  }
3106  }
3107 
3108  $known_db_type = 'core' if ! $known_db_type;
3109 
3110  my %get_adaptors_args = ('-GROUP' => $known_db_type);
3111  $get_adaptors_args{'-species'} = $known_species if $known_species;
3112 
3113  my @dbas =
3114  sort { $a->dbc->host cmp $b->dbc->host || $a->dbc->port <=> $b->dbc->port }
3115  grep { $_->dbc->dbname !~ m{ \A ensembl_metadata | ncbi_taxonomy }msx }
3116  @{$self->get_all_DBAdaptors(%get_adaptors_args)};
3117 
3118  foreach my $dba (@dbas) {
3119  my @results;
3120  my $dba_adaptor_type = $group2adaptor{$dba->group()};
3121  if($dba_adaptor_type eq 'Bio::EnsEMBL::DBSQL::DBAdaptor') {
3122  @results = $self->_core_get_species_and_object_type($stable_id, $known_type, $dba);
3123  }
3124  elsif($dba_adaptor_type eq 'Bio::EnsEMBL::Compara::DBSQL::DBAdaptor') {
3125  @results = $self->_compara_get_species_and_object_type($stable_id, $known_type, $dba);
3126  }
3127  return @results if scalar(@results) > 0;
3128  } ## end foreach my $dba ( sort { $a...})
3129  }
3130 
3131  return;
3132 } ## end sub get_species_and_object_type
3133 
3134 sub _lookup_db_get_species_and_object_type {
3135  my ($self, $stable_id, $known_type, $known_species, $known_db_type, $use_archive) = @_;
3136 
3137  my $retired;
3138  my $stable_ids_dba = $self->get_DBAdaptor("multi", "stable_ids", 1);
3139 
3140  my ($species, $type, $db_type) = $self->stable_id_lookup($stable_id, $known_type, $known_species, $known_db_type);
3141 
3142  if (!$species && $use_archive) {
3143  ($species, $type, $db_type) = $self->archive_id_lookup($stable_id, $known_type, $known_species, $known_db_type);
3144  $retired = 1 if $species;
3145  }
3146 
3147  return ($species ,$type, $db_type, $retired);
3148 } ## end sub _lookup_db_get_species_and_object_type
3149 
3150 
3151 sub stable_id_lookup {
3152  my ($self, $stable_id, $known_type, $known_species, $known_db_type) = @_;
3153  my $retired;
3154  my $stable_ids_dba = $self->get_DBAdaptor("multi", "stable_ids", 1);
3155 
3156  my $statement = 'SELECT name, object_type, db_type FROM stable_id_lookup join species using(species_id) WHERE stable_id = ?';
3157  if ($known_species) {
3158  $statement .= ' AND name = ?';
3159  }
3160  if ($known_db_type) {
3161  $statement .= ' AND db_type = ?';
3162  }
3163  if ($known_type) {
3164  $statement .= ' AND object_type = ?';
3165  }
3166 
3167  my $sth = $stable_ids_dba->dbc()->prepare($statement);
3168  $sth->bind_param(1, $stable_id, SQL_VARCHAR);
3169  my $param_count = 1;
3170  if ($known_species) {
3171  $known_species = $self->get_alias($known_species);
3172  $param_count++;
3173  $sth->bind_param($param_count, $known_species, SQL_VARCHAR);
3174  }
3175  if ($known_db_type) {
3176  $param_count++;
3177  $sth->bind_param($param_count, $known_db_type, SQL_VARCHAR);
3178  }
3179  if ($known_type) {
3180  $param_count++;
3181  $sth->bind_param($param_count, $known_type, SQL_VARCHAR);
3182  }
3183  $sth->execute();
3184  my ($species, $type, $db_type) = $sth->fetchrow_array();
3185  $sth->finish();
3186 
3187  return ($species ,$type, $db_type);
3188 }
3189 
3190 sub archive_id_lookup {
3191  my ($self, $stable_id, $known_type, $known_species, $known_db_type) = @_;
3192  my $retired;
3193  my $stable_ids_dba = $self->get_DBAdaptor("multi", "stable_ids", 1);
3194 
3195  my $archive_statement = 'SELECT name, object_type, db_type FROM archive_id_lookup join species using(species_id) WHERE archive_id = ?';
3196  if ($known_species) {
3197  $archive_statement .= ' AND name = ?';
3198  }
3199  if ($known_db_type) {
3200  $archive_statement .= ' AND db_type = ?';
3201  }
3202  if ($known_type) {
3203  $archive_statement .= ' AND object_type = ?';
3204  }
3205 
3206  my $archive_sth = $stable_ids_dba->dbc()->prepare($archive_statement);
3207  $archive_sth->bind_param(1, $stable_id, SQL_VARCHAR);
3208  my $param_count = 1;
3209  if ($known_species) {
3210  $known_species = $self->get_alias($known_species);
3211  $param_count++;
3212  $archive_sth->bind_param($param_count, $known_species, SQL_VARCHAR);
3213  }
3214  if ($known_db_type) {
3215  $param_count++;
3216  $archive_sth->bind_param($param_count, $known_db_type, SQL_VARCHAR);
3217  }
3218  if ($known_type) {
3219  $param_count++;
3220  $archive_sth->bind_param($param_count, $known_type, SQL_VARCHAR);
3221  }
3222 
3223  $archive_sth->execute();
3224  my ($species, $type, $db_type) = $archive_sth->fetchrow_array();
3225  $archive_sth->finish();
3226 
3227  return ($species ,$type, $db_type);
3228 }
3229 
3230 
3231 # A level of abstraction because we need to test the stable_id as-is and then
3232 # try to chop off a version id if nothing is return, and try again
3233 
3234 sub _core_get_species_and_object_type {
3235  my ($self, $stable_id, $known_type, $dba) = @_;
3236 
3237  # Try looking up the species with the stable_is, as-is
3238  my @results = $self->_core_get_species_and_object_type_worker($stable_id, $known_type, $dba);
3239 
3240  if(@results) {
3241  return @results;
3242  } elsif(my $vindex = rindex($stable_id, '.')) {
3243  return $self->_core_get_species_and_object_type_worker(substr($stable_id,0,$vindex), $known_type, $dba)
3244  if(substr($stable_id,$vindex+1) =~ /^\d+$/);
3245  }
3246 
3247  return;
3248 
3249 }
3250 
3251 # Loop over a known set of object types for a core DB until we find a hit
3252 sub _core_get_species_and_object_type_worker {
3253  my ($self, $stable_id, $known_type, $dba) = @_;
3254  my @types = defined $known_type ? ($known_type) : ('Gene', 'Transcript', 'Translation', 'Exon', 'Operon', 'OperonTranscript');
3255  my ($species, $final_type, $final_db_type);
3256  foreach my $type (@types) {
3257  my $statement = sprintf $stable_id_stmts{lc $type}, $dba->dbc->dbname;
3258  my $sth = $dba->dbc()->prepare($statement);
3259  $sth->bind_param(1, $stable_id, SQL_VARCHAR);
3260  $sth->execute;
3261  $species = $sth->fetchall_arrayref->[0][0];
3262  $sth->finish;
3263  if(defined $species) {
3264  $final_type = $type;
3265  $final_db_type = $dba->group();
3266  last;
3267  }
3268  }
3269  $dba->dbc->disconnect_if_idle(); # always disconnect after lookup
3270  return ($species, $final_type, $final_db_type) if defined $species;
3271  return;
3272 }
3273 
3274 # A level of abstraction because we need to test the stable_id as-is and then
3275 # try to chop off a version id if nothing is return, and try again
3276 
3277 sub _compara_get_species_and_object_type {
3278  my ($self, $stable_id, $known_type, $dba) = @_;
3279 
3280  # Try looking up the species with the stable_is, as-is
3281  my @results = $self->_compara_get_species_and_object_type_worker($stable_id, $known_type, $dba);
3282 
3283  if(@results) {
3284  return @results;
3285  } elsif(my $vindex = rindex($stable_id, '.')) {
3286  return $self->_compara_get_species_and_object_type_worker(substr($stable_id,0,$vindex), $known_type, $dba)
3287  if(substr($stable_id,$vindex+1) =~ /^\d+$/);
3288  }
3289 
3290  return;
3291 
3292 }
3293 
3294 # Loop over a known set of object types for a compara DB until we find a hit
3295 sub _compara_get_species_and_object_type_worker {
3296  my ($self, $stable_id, $known_type, $dba) = @_;
3297  my @types = defined $known_type ? ($known_type) : ('GeneTree');
3298  my ($species, $final_type, $final_db_type);
3299  foreach my $type (@types) {
3300  my $statement = sprintf $compara_stable_id_stmts{lc $type}, $dba->dbc->dbname;
3301  my $sth = $dba->dbc()->prepare($statement);
3302  $sth->bind_param(1, $stable_id, SQL_VARCHAR);
3303  $sth->execute;
3304  my $found = $sth->fetchall_arrayref->[0][0];
3305  $sth->finish;
3306  if(defined $found) {
3307  $species = $dba->species();
3308  $final_type = $type;
3309  $final_db_type = $dba->group();
3310  last;
3311  }
3312  }
3313  $dba->dbc->disconnect_if_idle(); # always disconnect after lookup
3314  return ($species, $final_type, $final_db_type) if defined $species;
3315  return;
3316 }
3317 
3318 1;
transcript
public transcript()
Bio::EnsEMBL::Registry::remove_switchable_adaptor
public The remove_switchable_adaptor()
Bio::EnsEMBL::Registry::get_adaptor
public Adaptor get_adaptor()
Bio::EnsEMBL::Registry::remove_DBAdaptor
public void remove_DBAdaptor()
Bio::EnsEMBL::Registry::get_DNAAdaptor
public Adaptor get_DNAAdaptor()
Bio::EnsEMBL::Registry::get_all_DBAdaptors_by_connection
public Reference get_all_DBAdaptors_by_connection()
Bio::EnsEMBL::Registry::find_and_add_aliases
public void find_and_add_aliases()
Bio::EnsEMBL::DBSQL::DBAdaptor
Definition: DBAdaptor.pm:40
map
public map()
Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor
Definition: BaseFeatureAdaptor.pm:24
Bio::EnsEMBL::Utils::URI
Definition: URI.pm:28
Bio::EnsEMBL::Utils::ConfigRegistry
Definition: ConfigRegistry.pm:23
Bio::EnsEMBL::Registry::get_alias
public Species get_alias()
Bio::EnsEMBL::Registry::add_adaptor
public void add_adaptor()
Bio::EnsEMBL::Registry::remove_db
public Adaptor remove_db()
Bio::EnsEMBL::Registry::get_all_db_adaptors
public Adaptor get_all_db_adaptors()
Bio::EnsEMBL::Registry::clear
public void clear()
Bio::EnsEMBL::DBSQL::OntologyDBAdaptor
Definition: OntologyDBAdaptor.pm:12
Bio::EnsEMBL::Registry::get_DBAdaptor_count
public get_DBAdaptor_count()
Bio::EnsEMBL::Slice
Definition: Slice.pm:50
Bio::EnsEMBL::Registry::disconnect_all
public void disconnect_all()
Bio::EnsEMBL::Registry
Definition: Registry.pm:113
Bio::EnsEMBL::Registry::get_DBAdaptor
public DBAdaptor get_DBAdaptor()
Bio::EnsEMBL::Utils::IO
Definition: IO.pm:80
exon
public exon()
Bio::EnsEMBL::Utils::ConfigRegistry::add_alias
public add_alias()
Bio::EnsEMBL::Registry::set_default_track
public void set_default_track()
Bio::EnsEMBL::Registry::add_switchable_adaptor
public void add_switchable_adaptor()
Bio::EnsEMBL::Registry::_group_to_adaptor_class
protected String _group_to_adaptor_class()
about
public about()
Bio::EnsEMBL::Registry::add_DNAAdaptor
public void add_DNAAdaptor()
run
public run()
Bio::EnsEMBL::DBSQL::DBAdaptor::new
public Bio::EnsEMBL::DBSQL::DBAdaptor new()
Bio::EnsEMBL::Registry::get_db
public Adaptor get_db()
Bio::EnsEMBL::Registry::add_DBAdaptor
public void add_DBAdaptor()
Bio::EnsEMBL::Registry::get_all_DBAdaptors
public List get_all_DBAdaptors()
Bio::EnsEMBL::Registry::add_db
public void add_db()
Bio::EnsEMBL::Registry::get_all_DBAdaptors_by_dbname
public Reference get_all_DBAdaptors_by_dbname()
get_adaptor
public get_adaptor()
Bio::EnsEMBL::Registry::has_switchable_adaptor
public Boolean has_switchable_adaptor()
Bio::EnsEMBL::Utils::Argument
Definition: Argument.pm:34
Bio::EnsEMBL::Utils::Exception
Definition: Exception.pm:68
Bio::EnsEMBL::Utils::IO::slurp
public Scalar slurp()
Bio::EnsEMBL::Registry::load_all
public Int load_all()
Bio::EnsEMBL::ApiVersion
Definition: ApiVersion.pm:17