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