Archive Ensembl HomeArchive Ensembl Home
ArchiveStableIdAdaptor.pm
Go to the documentation of this file.
00001 =head1 LICENSE
00002 
00003   Copyright (c) 1999-2012 The European Bioinformatics Institute and
00004   Genome Research Limited.  All rights reserved.
00005 
00006   This software is distributed under a modified Apache license.
00007   For license details, please see
00008 
00009     http://www.ensembl.org/info/about/code_licence.html
00010 
00011 =head1 CONTACT
00012 
00013   Please email comments or questions to the public Ensembl
00014   developers list at <dev@ensembl.org>.
00015 
00016   Questions may also be sent to the Ensembl help desk at
00017   <helpdesk@ensembl.org>.
00018 
00019 =cut
00020 
00021 =head1 NAME
00022 
00023 Bio::EnsEMBL::ArchiveStableIdAdaptor
00024 
00025 =head1 SYNOPSIS
00026 
00027   my $registry = "Bio::EnsEMBL::Registry";
00028 
00029   my $archiveStableIdAdaptor =
00030     $registry->get_adaptor( 'Human', 'Core', 'ArchiveStableId' );
00031 
00032   my $stable_id = 'ENSG00000068990';
00033 
00034   my $arch_id = $archiveStableIdAdaptor->fetch_by_stable_id($stable_id);
00035 
00036   print("Latest incarnation of this stable ID:\n");
00037   printf( "  Stable ID: %s.%d\n",
00038     $arch_id->stable_id(), $arch_id->version() );
00039   print("  Release: "
00040       . $arch_id->release() . " ("
00041       . $arch_id->assembly() . ", "
00042       . $arch_id->db_name()
00043       . ")\n" );
00044 
00045   print "\nStable ID history:\n\n";
00046 
00047   my $history =
00048     $archiveStableIdAdaptor->fetch_history_tree_by_stable_id(
00049     $stable_id);
00050 
00051   foreach my $a ( @{ $history->get_all_ArchiveStableIds } ) {
00052     printf( "  Stable ID: %s.%d\n", $a->stable_id(), $a->version() );
00053     print("  Release: "
00054         . $a->release() . " ("
00055         . $a->assembly() . ", "
00056         . $a->db_name()
00057         . ")\n\n" );
00058   }
00059 
00060 =head1 DESCRIPTION
00061 
00062 ArchiveStableIdAdaptor does all SQL to create ArchiveStableIds and works
00063 of
00064 
00065   stable_id_event
00066   mapping_session
00067   peptite_archive
00068   gene_archive
00069 
00070 tables inside the core database.
00071 
00072 This whole module has a status of At Risk as it is under development.
00073 
00074 =head1 METHODS
00075 
00076   fetch_by_stable_id
00077   fetch_by_stable_id_version
00078   fetch_by_stable_id_dbname
00079   fetch_all_by_archive_id
00080   fetch_predecessors_by_archive_id
00081   fetch_successors_by_archive_id
00082   fetch_history_tree_by_stable_id
00083   add_all_current_to_history
00084   list_dbnames
00085   previous_dbname
00086   next_dbname
00087   get_peptide
00088   get_current_release
00089   get_current_assembly
00090 
00091 =head1 RELATED MODULES
00092 
00093   Bio::EnsEMBL::ArchiveStableId
00094   Bio::EnsEMBL::StableIdEvent
00095   Bio::EnsEMBL::StableIdHistoryTree
00096 
00097 =head1 METHODS
00098 
00099 =cut
00100 
00101 package Bio::EnsEMBL::DBSQL::ArchiveStableIdAdaptor;
00102 
00103 use strict;
00104 use warnings;
00105 no warnings qw(uninitialized);
00106 
00107 use Bio::EnsEMBL::DBSQL::BaseAdaptor;
00108 our @ISA = qw(Bio::EnsEMBL::DBSQL::BaseAdaptor);
00109 
00110 use Bio::EnsEMBL::ArchiveStableId;
00111 use Bio::EnsEMBL::StableIdEvent;
00112 use Bio::EnsEMBL::StableIdHistoryTree;
00113 use Bio::EnsEMBL::Utils::Exception qw(deprecate warning throw);
00114 
00115 use constant MAX_ROWS => 30;
00116 use constant NUM_HIGH_SCORERS => 20;
00117 
00118 
00119 =head2 fetch_by_stable_id
00120 
00121   Arg [1]     : string $stable_id
00122   Arg [2]     : (optional) string $type
00123   Example     : none
00124   Description : Retrives an ArchiveStableId that is the latest incarnation of
00125                 given stable_id.
00126   Returntype  : Bio::EnsEMBL::ArchiveStableId or undef if not in database
00127   Exceptions  : none
00128   Caller      : general
00129   Status      : At Risk
00130               : under development
00131 
00132 =cut
00133 
00134 sub fetch_by_stable_id {
00135   my $self = shift;
00136   my $stable_id = shift;
00137   
00138   my $arch_id = Bio::EnsEMBL::ArchiveStableId->new( 
00139      -stable_id => $stable_id,
00140      -adaptor => $self
00141   );
00142 
00143   @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id);
00144 
00145   if ($self->lookup_current($arch_id)) {
00146 
00147     # stable ID is in current release
00148     $arch_id->version($arch_id->current_version);
00149     $arch_id->db_name($self->dbc->dbname);
00150     $arch_id->release($self->get_current_release);
00151     $arch_id->assembly($self->get_current_assembly);
00152   
00153   } else {
00154 
00155     # look for latest version of this stable id
00156     my $extra_sql = defined($arch_id->{'type'}) ?
00157       " AND sie.type = '@{[lc($arch_id->{'type'})]}'" : '';
00158 
00159     my $r = $self->_fetch_archive_id($stable_id, $extra_sql, $extra_sql);
00160 
00161     if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id) {
00162       # latest event is a self event, use new_* data
00163       $arch_id->version($r->{'new_version'});
00164       $arch_id->release($r->{'new_release'});
00165       $arch_id->assembly($r->{'new_assembly'});
00166       $arch_id->db_name($r->{'new_db_name'});
00167     } else {
00168       # latest event is a deletion event (or mapping to other ID; this clause
00169       # is only used to cope with buggy data where deletion events are
00170       # missing), use old_* data
00171       $arch_id->version($r->{'old_version'});
00172       $arch_id->release($r->{'old_release'});
00173       $arch_id->assembly($r->{'old_assembly'});
00174       $arch_id->db_name($r->{'old_db_name'});
00175     }
00176 
00177     $arch_id->type(ucfirst(lc($r->{'type'})));
00178   }
00179   
00180   if (! defined $arch_id->db_name) {
00181     # couldn't find stable ID in archive or current db
00182     return undef;
00183   }
00184 
00185   $arch_id->is_latest(1);
00186 
00187   return $arch_id;
00188 }
00189 
00190 
00191 =head2 fetch_by_stable_id_version
00192 
00193   Arg [1]     : string $stable_id
00194   Arg [2]     : int $version
00195   Example     : none
00196   Description : Retrieve an ArchiveStableId with given version and stable ID.
00197   Returntype  : Bio::EnsEMBL::ArchiveStableId 
00198   Exceptions  : none
00199   Caller      : general
00200   Status      : At Risk
00201               : under development
00202 
00203 =cut
00204 
00205 sub fetch_by_stable_id_version {
00206   my $self = shift;
00207   my $stable_id = shift;
00208   my $version = shift;
00209 
00210   my $arch_id = Bio::EnsEMBL::ArchiveStableId->new( 
00211      -stable_id => $stable_id,
00212      -version => $version,
00213      -adaptor => $self
00214   );
00215   
00216   @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id);
00217 
00218   if ($self->lookup_current($arch_id) && $arch_id->is_current) {
00219 
00220     # this version is the current one
00221     $arch_id->db_name($self->dbc->dbname);
00222     $arch_id->release($self->get_current_release);
00223     $arch_id->assembly($self->get_current_assembly);
00224   
00225   } else {
00226 
00227     # find latest release this stable ID version is found in archive
00228     my $extra_sql1 = qq(AND sie.old_version = "$version");
00229     my $extra_sql2 = qq(AND sie.new_version = "$version");
00230     my $r = $self->_fetch_archive_id($stable_id, $extra_sql1, $extra_sql2);
00231 
00232     if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id
00233         and $r->{'new_version'} == $version) {
00234       # latest event is a self event, use new_* data
00235       $arch_id->release($r->{'new_release'});
00236       $arch_id->assembly($r->{'new_assembly'});
00237       $arch_id->db_name($r->{'new_db_name'});
00238     } else {
00239       # latest event is a deletion event (or mapping to other ID; this clause
00240       # is only used to cope with buggy data where deletion events are
00241       # missing), use old_* data
00242       $arch_id->release($r->{'old_release'});
00243       $arch_id->assembly($r->{'old_assembly'});
00244       $arch_id->db_name($r->{'old_db_name'});
00245     }
00246 
00247     $arch_id->type(ucfirst(lc($r->{'type'})));
00248   }
00249   
00250   if (! defined $arch_id->db_name) {
00251     # couldn't find stable ID version in archive or current release
00252     return undef;
00253   }
00254 
00255   return $arch_id;
00256 }
00257 
00258 
00259 =head2 fetch_by_stable_id_dbname
00260 
00261   Arg [1]     : string $stable_id
00262   Arg [2]     : string $db_name
00263   Example     : none
00264   Description : Create an ArchiveStableId from given arguments.
00265   Returntype  : Bio::EnsEMBL::ArchiveStableId or undef if not in database
00266   Exceptions  : none
00267   Caller      : general
00268   Status      : At Risk
00269               : under development
00270 
00271 =cut
00272 
00273 sub fetch_by_stable_id_dbname {
00274   my $self = shift;
00275   my $stable_id = shift;
00276   my $db_name = shift;
00277   
00278   my $arch_id = Bio::EnsEMBL::ArchiveStableId->new( 
00279      -stable_id => $stable_id,
00280      -db_name => $db_name,
00281      -adaptor => $self
00282   );
00283   
00284   @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id);
00285 
00286   if ($self->lookup_current($arch_id) and $db_name eq $self->dbc->dbname) {
00287 
00288     # this version is the current one
00289     $arch_id->version($arch_id->current_version);
00290     $arch_id->release($self->get_current_release);
00291     $arch_id->assembly($self->get_current_assembly);
00292   
00293   } else {
00294 
00295     # find version for this dbname in the stable ID archive
00296     my $extra_sql = defined($arch_id->{'type'}) ?
00297       " AND sie.type = '@{[lc($arch_id->{'type'})]}'" : '';
00298     my $extra_sql1 = $extra_sql . qq( AND ms.old_db_name = "$db_name");
00299     my $extra_sql2 = $extra_sql . qq( AND ms.new_db_name = "$db_name");
00300     my $r = $self->_fetch_archive_id($stable_id, $extra_sql1, $extra_sql2);
00301 
00302     if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id
00303         and $r->{'new_db_name'} eq $db_name) {
00304 
00305       # latest event is a self event, use new_* data
00306       $arch_id->release($r->{'new_release'});
00307       $arch_id->assembly($r->{'new_assembly'});
00308       $arch_id->version($r->{'new_version'});
00309     } else {
00310       # latest event is a deletion event (or mapping to other ID; this clause
00311       # is only used to cope with buggy data where deletion events are
00312       # missing), use old_* data
00313       $arch_id->release($r->{'old_release'});
00314       $arch_id->assembly($r->{'old_assembly'});
00315       $arch_id->version($r->{'old_version'});
00316     }
00317 
00318     $arch_id->type(ucfirst(lc($r->{'type'})));
00319   }
00320   
00321   if (! defined $arch_id->version ) {
00322     # couldn't find stable ID version in archive or current release
00323     return undef;
00324   }
00325 
00326   return $arch_id;
00327 }
00328 
00329 #
00330 # Helper method to do fetch ArchiveStableId from db.
00331 # Used by fetch_by_stable_id(), fetch_by_stable_id_version() and
00332 # fetch_by_stable_id_dbname().
00333 # Returns hashref as returned by DBI::sth::fetchrow_hashref
00334 #
00335 sub _fetch_archive_id {
00336   my $self = shift;
00337   my $stable_id = shift;
00338   my $extra_sql1 = shift;
00339   my $extra_sql2 = shift;
00340 
00341   # using a UNION is much faster in this query than somthing like
00342   # "... AND (sie.old_stable_id = ? OR sie.new_stable_id = ?)"
00343   my $sql = qq(
00344     (SELECT * FROM stable_id_event sie, mapping_session ms
00345     WHERE sie.mapping_session_id = ms.mapping_session_id
00346     AND sie.old_stable_id = ?
00347     $extra_sql1)
00348     UNION
00349     (SELECT * FROM stable_id_event sie, mapping_session ms
00350     WHERE sie.mapping_session_id = ms.mapping_session_id
00351     AND sie.new_stable_id = ?
00352     $extra_sql2)
00353     ORDER BY created DESC
00354     LIMIT 1
00355   );
00356 
00357   my $sth = $self->prepare($sql);
00358   $sth->execute($stable_id,$stable_id);
00359   my $r = $sth->fetchrow_hashref;
00360   $sth->finish;
00361 
00362   return $r;
00363 }  
00364 
00365 
00366 =head2 fetch_all_by_archive_id
00367 
00368   Arg [1]     : Bio::EnsEMBL::ArchiveStableId $archive_id
00369   Arg [2]     : String $return_type - type of ArchiveStableId to fetch
00370   Example     : my $arch_id = $arch_adaptor->fetch_by_stable_id('ENSG0001');
00371                 my @archived_transcripts =
00372                  $arch_adaptor->fetch_all_by_archive_id($arch_id, 'Transcript');
00373   Description : Given a ArchiveStableId it retrieves associated ArchiveStableIds
00374                 of specified type (e.g. retrieve transcripts for genes or vice
00375                 versa).
00376 
00377                 See also fetch_associated_archived() for a different approach to
00378                 retrieve this data.
00379   Returntype  : listref Bio::EnsEMBL::ArchiveStableId
00380   Exceptions  : none
00381   Caller      : Bio::EnsEMBL::ArchiveStableId->get_all_gene_archive_ids,
00382                 get_all_transcript_archive_ids, get_all_translation_archive_ids
00383   Status      : At Risk
00384               : under development
00385 
00386 =cut
00387 
00388 sub fetch_all_by_archive_id {
00389   my $self = shift;
00390   my $archive_id = shift;
00391   my $return_type = shift;
00392 
00393   my @result = ();
00394   my $lc_self_type = lc($archive_id->type);
00395   my $lc_return_type = lc($return_type);
00396 
00397   my $sql = qq(
00398     SELECT
00399           ga.${lc_return_type}_stable_id,
00400           ga.${lc_return_type}_version,
00401           m.old_db_name,
00402           m.old_release,
00403           m.old_assembly
00404     FROM  gene_archive ga, mapping_session m
00405     WHERE ga.${lc_self_type}_stable_id = ?
00406     AND   ga.${lc_self_type}_version = ?
00407     AND   ga.mapping_session_id = m.mapping_session_id
00408   );
00409   
00410   my $sth = $self->prepare($sql);
00411   $sth->bind_param(1, $archive_id->stable_id, SQL_VARCHAR);
00412   $sth->bind_param(2, $archive_id->version, SQL_SMALLINT);
00413   $sth->execute;
00414   
00415   my ($stable_id, $version, $db_name, $release, $assembly);
00416   $sth->bind_columns(\$stable_id, \$version, \$db_name, \$release, \$assembly);
00417 
00418   while ($sth->fetch) {
00419     my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new(
00420        -stable_id => $stable_id,
00421        -version => $version,
00422        -db_name => $db_name,
00423        -release => $release,
00424        -assembly => $assembly,
00425        -type => $return_type,
00426        -adaptor => $self
00427     );
00428 
00429     push( @result, $new_arch_id );
00430   }
00431 
00432   $sth->finish();
00433   return \@result;
00434 }
00435 
00436 
00437 =head2 fetch_associated_archived 
00438 
00439   Arg[1]      : Bio::EnsEMBL::ArchiveStableId $arch_id -
00440                 the ArchiveStableId to fetch associated archived IDs for
00441   Example     : my ($arch_gene, $arch_tr, $arch_tl, $pep_seq) =
00442                   @{ $archive_adaptor->fetch_associated_archived($arch_id) };
00443   Description : Fetches associated archived stable IDs from the db for a given
00444                 ArchiveStableId (version is taken into account).
00445   Return type : Listref of
00446                   ArchiveStableId archived gene
00447                   ArchiveStableId archived transcript
00448                   (optional) ArchiveStableId archived translation
00449                   (optional) peptide sequence
00450   Exceptions  : thrown on missing or wrong argument
00451                 thrown if ArchiveStableID has no type
00452   Caller      : Bio::EnsEMBL::ArchiveStableId->get_all_associated_archived()
00453   Status      : At Risk
00454               : under development
00455 
00456 =cut
00457 
00458 sub fetch_associated_archived {
00459   my $self = shift;
00460   my $arch_id = shift;
00461 
00462   throw("Need a Bio::EnsEMBL::ArchiveStableId") unless ($arch_id
00463     and ref($arch_id) and $arch_id->isa('Bio::EnsEMBL::ArchiveStableId'));
00464 
00465   my $type = $arch_id->type();
00466 
00467   if ( !defined($type) ) {
00468     throw("Can't deduce ArchiveStableId type.");
00469   }
00470 
00471   $type = lc($type);
00472 
00473   my $sql = qq(
00474     SELECT  ga.gene_stable_id,
00475             ga.gene_version,
00476             ga.transcript_stable_id,
00477             ga.transcript_version,
00478             ga.translation_stable_id,
00479             ga.translation_version,
00480             pa.peptide_seq,
00481             ms.old_release,
00482             ms.old_assembly,
00483             ms.old_db_name
00484     FROM (mapping_session ms, gene_archive ga)
00485     LEFT JOIN peptide_archive pa
00486       ON ga.peptide_archive_id = pa.peptide_archive_id
00487     WHERE ga.mapping_session_id = ms.mapping_session_id
00488     AND ga.${type}_stable_id = ?
00489     AND ga.${type}_version = ?
00490   );
00491 
00492   my $sth = $self->prepare($sql);
00493   $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR);
00494   $sth->bind_param(2, $arch_id->version, SQL_SMALLINT);
00495   $sth->execute;
00496 
00497   my @result = ();
00498 
00499   while (my $r = $sth->fetchrow_hashref) {
00500 
00501     my @row = ();
00502 
00503     # create ArchiveStableIds genes, transcripts and translations
00504     push @row, Bio::EnsEMBL::ArchiveStableId->new(
00505        -stable_id => $r->{'gene_stable_id'},
00506        -version => $r->{'gene_version'},
00507        -db_name => $r->{'old_db_name'},
00508        -release => $r->{'old_release'},
00509        -assembly => $r->{'old_assembly'},
00510        -type => 'Gene',
00511        -adaptor => $self
00512     );
00513     
00514     push @row, Bio::EnsEMBL::ArchiveStableId->new(
00515        -stable_id => $r->{'transcript_stable_id'},
00516        -version => $r->{'transcript_version'},
00517        -db_name => $r->{'old_db_name'},
00518        -release => $r->{'old_release'},
00519        -assembly => $r->{'old_assembly'},
00520        -type => 'Transcript',
00521        -adaptor => $self
00522     );
00523 
00524     if ($r->{'translation_stable_id'}) {
00525       push @row, Bio::EnsEMBL::ArchiveStableId->new(
00526          -stable_id => $r->{'translation_stable_id'},
00527          -version => $r->{'translation_version'},
00528          -db_name => $r->{'old_db_name'},
00529          -release => $r->{'old_release'},
00530          -assembly => $r->{'old_assembly'},
00531          -type => 'Translation',
00532          -adaptor => $self
00533       );
00534 
00535       # push peptide sequence onto result list
00536       push @row, $r->{'peptide_seq'};
00537     }
00538     
00539     push @result, \@row;
00540   }
00541 
00542   return \@result;
00543 }
00544 
00545 
00546 =head2 fetch_predecessors_by_archive_id
00547 
00548   Arg [1]     : Bio::EnsEMBL::ArchiveStableId
00549   Example     : none
00550   Description : Retrieve a list of ArchiveStableIds that were mapped to the 
00551                 given one. This method goes back only one level, to retrieve
00552                 a full predecessor history use fetch_predecessor_history, or 
00553                 ideally fetch_history_tree_by_stable_id for the complete
00554                 history network.
00555   Returntype  : listref Bio::EnsEMBL::ArchiveStableId
00556   Exceptions  : none
00557   Caller      : Bio::EnsEMBL::ArchiveStableId->get_all_predecessors
00558   Status      : At Risk
00559               : under development
00560 
00561 =cut
00562 
00563 sub fetch_predecessors_by_archive_id {
00564   my $self = shift;
00565   my $arch_id = shift;
00566   
00567   my @result;
00568   
00569   if( ! ( defined $arch_id->stable_id() &&
00570       defined $arch_id->db_name() )) {
00571     throw( "Need db_name for predecessor retrieval" );
00572   }
00573 
00574   my $sql = qq(
00575     SELECT
00576           sie.old_stable_id,
00577           sie.old_version,
00578           sie.type,
00579           m.old_db_name,
00580           m.old_release,
00581           m.old_assembly
00582     FROM  mapping_session m, stable_id_event sie
00583     WHERE sie.mapping_session_id = m.mapping_session_id
00584     AND   sie.new_stable_id = ?
00585     AND   m.new_db_name = ? 
00586   );
00587 
00588   my $sth = $self->prepare($sql);
00589   $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR);
00590   $sth->bind_param(2, $arch_id->db_name, SQL_VARCHAR);
00591   $sth->execute();
00592   
00593   my ($old_stable_id, $old_version, $type, $old_db_name, $old_release, $old_assembly);
00594   $sth->bind_columns(\$old_stable_id, \$old_version, \$type, \$old_db_name, \$old_release, \$old_assembly);
00595   
00596   while ($sth->fetch) {
00597     if (defined $old_stable_id) {
00598       my $old_arch_id = Bio::EnsEMBL::ArchiveStableId->new( 
00599      -stable_id => $old_stable_id,
00600      -version => $old_version,
00601      -db_name => $old_db_name,
00602          -release => $old_release,
00603          -assembly => $old_assembly,
00604          -type => $type,
00605      -adaptor => $self
00606       );
00607       push( @result, $old_arch_id );
00608     }
00609   }
00610   $sth->finish();
00611 
00612   # if you didn't find any predecessors, there might be a gap in the
00613   # mapping_session history (i.e. databases in mapping_session don't chain). To
00614   # bridge the gap, look in the previous mapping_session for identical
00615   # stable_id.version
00616   unless (@result) {
00617 
00618     $sql = qq(
00619       SELECT
00620             sie.new_stable_id,
00621             sie.new_version,
00622             sie.type,
00623             m.new_db_name,
00624             m.new_release,
00625             m.new_assembly
00626       FROM  mapping_session m, stable_id_event sie
00627       WHERE sie.mapping_session_id = m.mapping_session_id
00628       AND   sie.new_stable_id = ?
00629       AND   m.new_db_name = ?   
00630     );
00631 
00632     $sth = $self->prepare($sql);
00633 
00634     my $curr_dbname = $arch_id->db_name;
00635     
00636     PREV:
00637     while (my $prev_dbname = $self->previous_dbname($curr_dbname)) {
00638     
00639       $sth->bind_param(1,$arch_id->stable_id, SQL_VARCHAR);
00640       $sth->bind_param(2,$prev_dbname, SQL_VARCHAR);
00641       $sth->execute();
00642       
00643       $sth->bind_columns(\$old_stable_id, \$old_version, \$type, \$old_db_name, \$old_release, \$old_assembly);
00644       
00645       while( $sth->fetch() ) {
00646         if (defined $old_stable_id) {
00647           my $old_arch_id = Bio::EnsEMBL::ArchiveStableId->new( 
00648              -stable_id => $old_stable_id,
00649              -version => $old_version,
00650              -db_name => $old_db_name,
00651              -release => $old_release,
00652              -assembly => $old_assembly,
00653              -type => $type,
00654              -adaptor => $self
00655           );
00656           push( @result, $old_arch_id );
00657 
00658           last PREV;
00659         }
00660       }
00661 
00662       $curr_dbname = $prev_dbname;
00663 
00664     }
00665       
00666     $sth->finish();
00667   }
00668 
00669   return \@result;
00670 }
00671 
00672 
00673 =head2 fetch_successors_by_archive_id
00674 
00675   Arg [1]     : Bio::EnsEMBL::ArchiveStableId
00676   Example     : none
00677   Description : Retrieve a list of ArchiveStableIds that the given one was 
00678                 mapped to. This method goes forward only one level, to retrieve
00679                 a full successor history use fetch_successor_history, or 
00680                 ideally fetch_history_tree_by_stable_id for the complete
00681                 history network.
00682   Returntype  : listref Bio::EnsEMBL::ArchiveStableId
00683   Exceptions  : none
00684   Caller      : Bio::EnsEMBL::ArchiveStableId->get_all_successors
00685   Status      : At Risk
00686               : under development
00687 
00688 =cut
00689 
00690 sub fetch_successors_by_archive_id {
00691   my $self = shift;
00692   my $arch_id = shift;
00693   my @result;
00694 
00695   
00696   if( ! ( defined $arch_id->stable_id() &&
00697       defined $arch_id->db_name() )) {
00698     throw( "Need db_name for successor retrieval" );
00699   }
00700 
00701   my $sql = qq(
00702     SELECT
00703           sie.new_stable_id,
00704           sie.new_version,
00705           sie.type,
00706           m.new_db_name,
00707           m.new_release,
00708           m.new_assembly
00709     FROM  mapping_session m, stable_id_event sie
00710     WHERE sie.mapping_session_id = m.mapping_session_id
00711     AND   sie.old_stable_id = ?
00712     AND   m.old_db_name = ? 
00713   );
00714 
00715   my $sth = $self->prepare( $sql );
00716   $sth->bind_param(1,$arch_id->stable_id,SQL_VARCHAR);
00717   $sth->bind_param(2,$arch_id->db_name,SQL_VARCHAR);
00718   $sth->execute();
00719   
00720   my ($new_stable_id, $new_version, $type, $new_db_name, $new_release, $new_assembly);
00721   $sth->bind_columns(\$new_stable_id, \$new_version, \$type, \$new_db_name, \$new_release, \$new_assembly);
00722   
00723   while( $sth->fetch() ) {
00724     if( defined $new_stable_id ) {
00725       my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new( 
00726      -stable_id => $new_stable_id,
00727      -version => $new_version,
00728      -db_name => $new_db_name,
00729          -release => $new_release,
00730          -assembly => $new_assembly,
00731          -type => $type,
00732      -adaptor => $self
00733       );
00734         
00735       push( @result, $new_arch_id );
00736     }
00737   }
00738   $sth->finish();
00739   
00740   # if you didn't find any successors, there might be a gap in the
00741   # mapping_session history (i.e. databases in mapping_session don't chain). To
00742   # bridge the gap, look in the next mapping_session for identical
00743   # stable_id.version
00744   unless (@result) {
00745 
00746     $sql = qq(
00747       SELECT
00748             sie.old_stable_id,
00749             sie.old_version,
00750             sie.type,
00751             m.old_db_name,
00752             m.old_release,
00753             m.old_assembly
00754       FROM  mapping_session m, stable_id_event sie
00755       WHERE sie.mapping_session_id = m.mapping_session_id
00756       AND   sie.old_stable_id = ?
00757       AND   m.old_db_name = ?   
00758     );
00759 
00760     $sth = $self->prepare($sql);
00761 
00762     my $curr_dbname = $arch_id->db_name;
00763     
00764     NEXTDB:
00765     while (my $next_dbname = $self->next_dbname($curr_dbname)) {
00766 
00767       $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR);
00768       $sth->bind_param(2, $next_dbname, SQL_VARCHAR);
00769       $sth->execute();
00770       
00771       $sth->bind_columns(\$new_stable_id, \$new_version, \$type, \$new_db_name, \$new_release, \$new_assembly);
00772       
00773       while( $sth->fetch() ) {
00774         if (defined $new_stable_id) {
00775           my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new( 
00776              -stable_id => $new_stable_id,
00777              -version => $new_version,
00778              -db_name => $new_db_name,
00779              -release => $new_release,
00780              -assembly => $new_assembly,
00781              -type => $type,
00782              -adaptor => $self
00783           );
00784             
00785           push( @result, $new_arch_id );
00786 
00787           last NEXTDB;
00788         }
00789       }
00790       
00791       $curr_dbname = $next_dbname;
00792 
00793     }
00794 
00795     $sth->finish();
00796   }
00797 
00798   return \@result;
00799 }
00800 
00801 
00802 
00803 =head2 fetch_history_tree_by_stable_id
00804 
00805   Arg[1]      : String $stable_id - the stable ID to fetch the history tree for
00806   Arg[2]      : (optional) Int $num_high_scorers
00807                 number of mappings per stable ID allowed when filtering
00808   Arg[3]      : (optional) Int $max_rows
00809                 maximum number of stable IDs in history tree (used for
00810                 filtering)
00811   Example     : my $history = $archive_adaptor->fetch_history_tree_by_stable_id(
00812                   'ENSG00023747897');
00813   Description : Returns the history tree for a given stable ID. This will
00814                 include a network of all stable IDs it is related to. The
00815                 method will try to return a minimal (sparse) set of nodes
00816                 (ArchiveStableIds) and links (StableIdEvents) by removing any
00817                 redundant entries and consolidating mapping events so that only
00818                 changes are recorded.
00819   Return type : Bio::EnsEMBL::StableIdHistoryTree
00820   Exceptions  : thrown on missing argument
00821   Caller      : Bio::EnsEMBL::ArchiveStableId::get_history_tree, general
00822   Status      : At Risk
00823               : under development
00824 
00825 =cut
00826 
00827 sub fetch_history_tree_by_stable_id {
00828   my ($self, $stable_id, $num_high_scorers, $max_rows) = @_;
00829 
00830   throw("Expecting a stable ID argument.") unless $stable_id;
00831 
00832   $num_high_scorers ||= NUM_HIGH_SCORERS;
00833   $max_rows ||= MAX_ROWS;
00834 
00835   # using a UNION is much faster in this query than somthing like
00836   # "... AND (sie.old_stable_id = ?) OR (sie.new_stable_id = ?)"
00837   my $sql = qq(
00838     SELECT sie.old_stable_id, sie.old_version,
00839            ms.old_db_name, ms.old_release, ms.old_assembly,
00840            sie.new_stable_id, sie.new_version,
00841            ms.new_db_name, ms.new_release, ms.new_assembly,
00842            sie.type, sie.score
00843     FROM stable_id_event sie, mapping_session ms
00844     WHERE sie.mapping_session_id = ms.mapping_session_id
00845     AND sie.old_stable_id = ?
00846     UNION
00847     SELECT sie.old_stable_id, sie.old_version,
00848            ms.old_db_name, ms.old_release, ms.old_assembly,
00849            sie.new_stable_id, sie.new_version,
00850            ms.new_db_name, ms.new_release, ms.new_assembly,
00851            sie.type, sie.score
00852     FROM stable_id_event sie, mapping_session ms
00853     WHERE sie.mapping_session_id = ms.mapping_session_id
00854     AND sie.new_stable_id = ?
00855   );
00856   
00857   my $sth = $self->prepare($sql);
00858 
00859   my $history = Bio::EnsEMBL::StableIdHistoryTree->new(
00860       -CURRENT_DBNAME => $self->dbc->dbname,
00861       -CURRENT_RELEASE => $self->get_current_release,
00862       -CURRENT_ASSEMBLY => $self->get_current_assembly,
00863   );
00864 
00865   # remember stable IDs you need to do and those that are done. Initialise the
00866   # former hash with the focus stable ID
00867   my %do = ($stable_id => 1);
00868   my %done;
00869 
00870   # while we got someting to do
00871   while (my ($id) = keys(%do)) {
00872 
00873     # if we already have more than MAX_ROWS stable IDs in this tree, we can't
00874     # build the full tree. Return undef.
00875     if (scalar(keys(%done)) > $max_rows) {
00876       # warning("Too many related stable IDs (".scalar(keys(%done)).") to draw a history tree.");
00877       $history->is_incomplete(1);
00878       $sth->finish;
00879       last;
00880     }
00881 
00882     # mark this stable ID as done
00883     delete $do{$id};
00884     $done{$id} = 1;
00885 
00886     # fetch all stable IDs related to this one from the database
00887     $sth->bind_param(1, $id, SQL_VARCHAR);
00888     $sth->bind_param(2, $id, SQL_VARCHAR);
00889     $sth->execute;
00890 
00891     my @events;
00892 
00893     while (my $r = $sth->fetchrow_hashref) {
00894       
00895       #
00896       # create old and new ArchiveStableIds and a StableIdEvent to link them
00897       # add all of these to the history tree
00898       #
00899       my ($old_id, $new_id);
00900 
00901       if ($r->{'old_stable_id'}) {
00902         $old_id = Bio::EnsEMBL::ArchiveStableId->new(
00903           -stable_id => $r->{'old_stable_id'},
00904           -version => $r->{'old_version'},
00905           -db_name => $r->{'old_db_name'},
00906           -release => $r->{'old_release'},
00907           -assembly => $r->{'old_assembly'},
00908           -type => $r->{'type'},
00909           -adaptor => $self
00910         );
00911       }
00912        
00913       if ($r->{'new_stable_id'}) {
00914         $new_id = Bio::EnsEMBL::ArchiveStableId->new(
00915           -stable_id => $r->{'new_stable_id'},
00916           -version => $r->{'new_version'},
00917           -db_name => $r->{'new_db_name'},
00918           -release => $r->{'new_release'},
00919           -assembly => $r->{'new_assembly'},
00920           -type => $r->{'type'},
00921           -adaptor => $self
00922         );
00923       }
00924 
00925       my $event = Bio::EnsEMBL::StableIdEvent->new(
00926         -old_id => $old_id,
00927         -new_id => $new_id,
00928         -score => $r->{'score'}
00929       );
00930 
00931       push @events, $event;
00932 
00933     }
00934 
00935     # filter out low-scoring events; the number of highest scoring events
00936     # returned is defined by NUM_HIGH_SCORERS
00937     my @others;
00938 
00939     foreach my $event (@events) {
00940       
00941       my $old_id = $event->old_ArchiveStableId;
00942       my $new_id = $event->new_ArchiveStableId;
00943       
00944       # creation, deletion and mapping-to-self events are added to the history
00945       # tree directly
00946       if (!$old_id || !$new_id || ($old_id->stable_id eq $new_id->stable_id)) {
00947         $history->add_StableIdEvents($event);
00948       } else {
00949         push @others, $event;
00950       }
00951       
00952     }
00953 
00954     #if (scalar(@others) > $num_high_scorers) {
00955     #  warn "Filtering ".(scalar(@others) - $num_high_scorers).
00956     #    " low-scoring events.\n";
00957     #}
00958 
00959     my $k = 0;
00960     foreach my $event (sort { $b->score <=> $a->score } @others) {
00961       $history->add_StableIdEvents($event);
00962       
00963       # mark stable IDs as todo if appropriate
00964       $do{$event->old_ArchiveStableId->stable_id} = 1
00965         unless $done{$event->old_ArchiveStableId->stable_id};
00966       $do{$event->new_ArchiveStableId->stable_id} = 1
00967         unless $done{$event->new_ArchiveStableId->stable_id};
00968       
00969       last if (++$k == $num_high_scorers);
00970     }
00971     
00972   }
00973 
00974   $sth->finish;
00975   
00976   # try to consolidate the tree (remove redundant nodes, bridge gaps)
00977   $history->consolidate_tree;
00978 
00979   # now add ArchiveStableIds for current Ids not found in the archive
00980   $self->add_all_current_to_history($history);
00981   
00982   # calculate grid coordinates for the sorted tree; this will also try to
00983   # untangle the tree
00984   $history->calculate_coords;
00985   
00986   return $history;
00987 }
00988 
00989 
00990 =head2 add_all_current_to_history 
00991 
00992   Arg[1]      : Bio::EnsEMBL::StableIdHistoryTree $history -
00993                 the StableIdHistoryTree object to add the current IDs to
00994   Description : This method adds the current versions of all stable IDs found
00995                 in a StableIdHistoryTree object to the tree, by creating
00996                 appropriate Events for the stable IDs found in the *_stable_id
00997                 tables. This is a helper method for
00998                 fetch_history_tree_by_stable_id(), see there for more
00999                 documentation.
01000   Return type : none (passed-in object is manipulated)
01001   Exceptions  : thrown on missing or wrong argument
01002   Caller      : internal
01003   Status      : At Risk
01004               : under development
01005 
01006 =cut
01007 
01008 sub add_all_current_to_history {
01009   my $self = shift;
01010   my $history = shift;
01011 
01012   unless ($history and $history->isa('Bio::EnsEMBL::StableIdHistoryTree')) {
01013     throw("Need a Bio::EnsEMBL::StableIdHistoryTree.");
01014   }
01015 
01016   my @ids = @{ $history->get_unique_stable_ids };
01017   my $id_string = join("', '", @ids);
01018   
01019   my $tmp_id = Bio::EnsEMBL::ArchiveStableId->new(-stable_id => $ids[0]);
01020   my $type = lc($self->_resolve_type($tmp_id));
01021   return unless ($type);
01022 
01023   # get current stable IDs from db
01024   my $sql = qq(
01025     SELECT stable_id, version FROM ${type}
01026     WHERE stable_id IN ('$id_string')
01027   );
01028   my $sth = $self->prepare($sql);
01029   $sth->execute;
01030 
01031   while (my ($stable_id, $version) = $sth->fetchrow_array) {
01032 
01033     my $new_id = Bio::EnsEMBL::ArchiveStableId->new(
01034       -stable_id => $stable_id,
01035       -version => $version,
01036       -current_version => $version,
01037       -db_name => $self->dbc->dbname,
01038       -release => $self->get_current_release,
01039       -assembly => $self->get_current_assembly,
01040       -type => $type,
01041       -adaptor => $self
01042     );
01043 
01044     my $event = $history->get_latest_StableIdEvent($new_id);
01045     next unless ($event);
01046 
01047     if ($event->old_ArchiveStableId and
01048         $event->old_ArchiveStableId->stable_id eq $stable_id) {
01049       
01050       # latest event was a self event
01051       # update it with current stable ID and add to tree
01052       $event->new_ArchiveStableId($new_id);
01053 
01054     } else {
01055 
01056       # latest event was a non-self event
01057       # create a new event where the old_id is the new_id from latest
01058       my $new_event = Bio::EnsEMBL::StableIdEvent->new(
01059         -old_id => $event->new_ArchiveStableId,
01060         -new_id => $new_id,
01061         -score => $event->score,
01062       );
01063       $history->add_StableIdEvents($new_event);
01064     }
01065     
01066   }
01067 
01068   # refresh node cache
01069   $history->flush_ArchiveStableIds;
01070   $history->add_ArchiveStableIds_for_events;
01071 }
01072 
01073 
01074 =head2 fetch_successor_history
01075 
01076   Arg [1]     : Bio::EnsEMBL::ArchiveStableId $arch_id
01077   Example     : none
01078   Description : Gives back a list of archive stable ids which are successors in
01079                 the stable_id_event tree of the given stable_id. Might well be
01080                 empty.
01081                 
01082                 This method isn't deprecated, but in most cases you will rather
01083                 want to use fetch_history_tree_by_stable_id().
01084   Returntype  : listref Bio::EnsEMBL::ArchiveStableId
01085                 Since every ArchiveStableId knows about it's successors, this is
01086                 a linked tree.
01087   Exceptions  : none
01088   Caller      : webcode for archive
01089   Status      : At Risk
01090               : under development
01091 
01092 =cut
01093 
01094 sub fetch_successor_history {
01095   my $self = shift;
01096   my $arch_id = shift;
01097 
01098   my $current_db_name = $self->list_dbnames->[0];
01099   my $dbname = $arch_id->db_name;
01100 
01101   if ($dbname eq $current_db_name) {
01102     return [$arch_id];
01103   }
01104 
01105   my $old = [];
01106   my @result = ();
01107   
01108   push @$old, $arch_id;
01109 
01110   while ($dbname ne $current_db_name) {
01111     my $new = [];
01112     while (my $asi = (shift @$old)) {
01113       push @$new, @{ $asi->get_all_successors };
01114     }
01115 
01116     if (@$new) {
01117       $dbname = $new->[0]->db_name;
01118     } else {
01119       last;
01120     }
01121 
01122     # filter duplicates
01123     my %unique = map { join(":", $_->stable_id, $_->version, $_->release) =>
01124       $_ } @$new;
01125     @$new = values %unique;
01126     
01127     @$old = @$new;
01128     push @result, @$new;
01129   }
01130 
01131   return \@result;
01132 }
01133 
01134 
01135 =head2 fetch_predecessor_history
01136 
01137   Arg [1]     : Bio::EnsEMBL::ArchiveStableId $arch_id
01138   Example     : none
01139   Description : Gives back a list of archive stable ids which are predecessors
01140                 in the stable_id_event tree of the given stable_id. Might well
01141                 be empty.
01142                 
01143                 This method isn't deprecated, but in most cases you will rather
01144                 want to use fetch_history_tree_by_stable_id().
01145   Returntype  : listref Bio::EnsEMBL::ArchiveStableId
01146                 Since every ArchiveStableId knows about it's successors, this is
01147                 a linked tree.
01148   Exceptions  : none
01149   Caller      : webcode for archive
01150   Status      : At Risk
01151               : under development
01152 
01153 =cut
01154 
01155 sub fetch_predecessor_history {
01156   my $self = shift;
01157   my $arch_id = shift;
01158 
01159   my $oldest_db_name = $self->list_dbnames->[-1];
01160   my $dbname = $arch_id->db_name;
01161 
01162   if ($dbname eq $oldest_db_name) {
01163     return [$arch_id];
01164   }
01165 
01166   my $old = [];
01167   my @result = ();
01168 
01169   push @$old, $arch_id;
01170 
01171   while ($dbname ne $oldest_db_name) {
01172     my $new = [];
01173     while (my $asi = (shift @$old)) {
01174       push @$new, @{ $asi->get_all_predecessors };
01175     }
01176 
01177     if( @$new ) {
01178       $dbname = $new->[0]->db_name;
01179     } else {
01180       last;
01181     }
01182     
01183     # filter duplicates
01184     my %unique = map { join(":", $_->stable_id, $_->version, $_->release) =>
01185       $_ } @$new;
01186     @$new = values %unique;
01187     
01188     @$old = @$new;
01189     push @result, @$new;
01190   }
01191 
01192   return \@result;
01193 }
01194 
01195 
01196 =head2 list_dbnames
01197 
01198   Args        : none
01199   Example     : none
01200   Description : A list of available database names from the latest (current) to
01201                 the oldest (ordered).
01202   Returntype  : listref of strings
01203   Exceptions  : none
01204   Caller      : general
01205   Status      : At Risk
01206               : under development
01207 
01208 =cut
01209 
01210 sub list_dbnames {
01211   my $self = shift;
01212   
01213   if( ! defined $self->{'dbnames'} ) {
01214 
01215     my $sql = qq(
01216       SELECT old_db_name, new_db_name
01217       FROM mapping_session
01218       ORDER BY created DESC
01219     );
01220     my $sth = $self->prepare( $sql );
01221     $sth->execute();
01222     my ( $old_db_name, $new_db_name );
01223     
01224     my @dbnames = ();
01225     my %seen;
01226 
01227     $sth->bind_columns( \$old_db_name, \$new_db_name );
01228 
01229     while( $sth->fetch() ) {
01230       # this code now can deal with non-chaining mapping sessions
01231       push(@{ $self->{'dbnames'} }, $new_db_name) unless ($seen{$new_db_name});
01232       $seen{$new_db_name} = 1;
01233 
01234       push(@{ $self->{'dbnames'} }, $old_db_name) unless ($seen{$old_db_name});
01235       $seen{$old_db_name} = 1;
01236     }
01237 
01238     $sth->finish();
01239     
01240   }
01241 
01242   return $self->{'dbnames'};
01243 }
01244 
01245 
01246 =head2 previous_dbname
01247 
01248   Arg[1]      : String $dbname - focus db name
01249   Example     : my $prev_db = $self->previous_dbname($curr_db);
01250   Description : Returns the name of the next oldest database which has mapping
01251                 session information.
01252   Return type : String (or undef if not available)
01253   Exceptions  : none
01254   Caller      : general
01255   Status      : At Risk
01256 
01257 =cut
01258 
01259 sub previous_dbname {
01260   my $self = shift;
01261   my $dbname = shift;
01262 
01263   my $curr_idx = $self->_dbname_index($dbname);
01264   my @dbnames = @{ $self->list_dbnames };
01265 
01266   if ($curr_idx == @dbnames) {
01267     # this is the oldest dbname, so no previous one available
01268     return undef;
01269   } else {
01270     return $dbnames[$curr_idx+1];
01271   }
01272 }
01273 
01274 
01275 =head2 next_dbname
01276 
01277   Arg[1]      : String $dbname - focus db name
01278   Example     : my $prev_db = $self->next_dbname($curr_db);
01279   Description : Returns the name of the next newest database which has mapping
01280                 session information.
01281   Return type : String (or undef if not available)
01282   Exceptions  : none
01283   Caller      : general
01284   Status      : At Risk
01285 
01286 =cut
01287 
01288 sub next_dbname {
01289   my $self = shift;
01290   my $dbname = shift;
01291 
01292   my $curr_idx = $self->_dbname_index($dbname);
01293   my @dbnames = @{ $self->list_dbnames };
01294 
01295   if ($curr_idx == 0) {
01296     # this is the latest dbname, so no next one available
01297     return undef;
01298   } else {
01299     return $dbnames[$curr_idx-1];
01300   }
01301 }
01302 
01303 
01304 #
01305 # helper method to return the array index of a database in the ordered list of
01306 # available databases (as returned by list_dbnames()
01307 #
01308 sub _dbname_index {
01309   my $self = shift;
01310   my $dbname = shift;
01311 
01312   my @dbnames = @{ $self->list_dbnames };
01313 
01314   for (my $i = 0; $i < @dbnames; $i++) {
01315     if ($dbnames[$i] eq $dbname) {
01316       return $i;
01317     }
01318   }
01319 }
01320 
01321 
01322 =head2 get_peptide
01323 
01324   Arg [1]     : Bio::EnsEMBL::ArchiveStableId $arch_id
01325   Example     : none
01326   Description : Retrieves the peptide string for given ArchiveStableId. If its
01327                 not a peptide or not in the database returns undef.
01328   Returntype  : string or undef
01329   Exceptions  : none
01330   Caller      : Bio::EnsEMBL::ArchiveStableId->get_peptide, general
01331   Status      : At Risk
01332               : under development
01333 
01334 =cut
01335 
01336 sub get_peptide {
01337   my $self    = shift;
01338   my $arch_id = shift;
01339 
01340   if ( lc( $arch_id->type() ) ne 'translation' ) {
01341     return undef;
01342   }
01343 
01344   my $sql = qq(
01345     SELECT pa.peptide_seq
01346       FROM peptide_archive pa, gene_archive ga
01347      WHERE ga.translation_stable_id = ?
01348        AND ga.translation_version = ?
01349        AND ga.peptide_archive_id = pa.peptide_archive_id
01350   );
01351 
01352   my $sth = $self->prepare($sql);
01353   $sth->bind_param( 1, $arch_id->stable_id, SQL_VARCHAR );
01354   $sth->bind_param( 2, $arch_id->version,   SQL_SMALLINT );
01355   $sth->execute();
01356 
01357   my ($peptide_seq) = $sth->fetchrow_array();
01358   $sth->finish();
01359 
01360   return $peptide_seq;
01361 } ## end sub get_peptide
01362 
01363 
01364 =head2 get_current_release 
01365 
01366   Example     : my $current_release = $archive_adaptor->get_current_release;
01367   Description : Returns the current release number (as found in the meta table).
01368   Return type : Int
01369   Exceptions  : none
01370   Caller      : general
01371   Status      : At Risk
01372               : under development
01373 
01374 =cut
01375 
01376 sub get_current_release {
01377   my $self = shift;
01378 
01379   unless ($self->{'current_release'}) {
01380     my $mca = $self->db->get_MetaContainer;
01381     my ($release) = @{ $mca->list_value_by_key('schema_version') };
01382     $self->{'current_release'} = $release;
01383   }
01384 
01385   return $self->{'current_release'};
01386 }
01387 
01388 
01389 =head2 get_current_assembly
01390 
01391   Example     : my $current_assembly = $archive_adaptor->get_current_assembly;
01392   Description : Returns the current assembly version (as found in the meta
01393                 table).
01394   Return type : String
01395   Exceptions  : none
01396   Caller      : general
01397   Status      : At Risk
01398               : under development
01399 
01400 =cut
01401 
01402 sub get_current_assembly {
01403   my $self = shift;
01404 
01405   unless ($self->{'current_assembly'}) {
01406     my $mca = $self->db->get_MetaContainer;
01407     my ($assembly) = @{ $mca->list_value_by_key('assembly.default') };
01408     $self->{'current_assembly'} = $assembly;
01409   }
01410 
01411   return $self->{'current_assembly'};
01412 }
01413 
01414 
01415 =head2 lookup_current
01416 
01417   Arg[1]      : Bio::EnsEMBL::ArchiveStableId $arch_id -
01418                 the stalbe ID to find the current version for
01419   Example     : if ($self->lookup_version($arch_id) {
01420                   $arch_id->version($arch_id->current_version);
01421                   $arch_id->db_name($self->dbc->dbname);
01422   Description : Look in [gene|transcript|translation]_stable_id if you can find
01423                 a current version for this stable ID. Set
01424                 ArchiveStableId->current_version if found.
01425   Return type : Boolean (TRUE if current version found, else FALSE)
01426   Exceptions  : none
01427   Caller      : general
01428   Status      : At Risk
01429               : under development
01430 
01431 =cut
01432 
01433 sub lookup_current {
01434   my $self    = shift;
01435   my $arch_id = shift;
01436 
01437   my $type = lc( $arch_id->type );
01438 
01439   unless ($type) {
01440     warning("Can't lookup current version without a type.");
01441     return 0;
01442   }
01443 
01444   my $sql = qq(
01445     SELECT version FROM ${type}
01446     WHERE stable_id = ?
01447   );
01448   my $sth = $self->prepare($sql);
01449   $sth->execute( $arch_id->stable_id );
01450   my ($version) = $sth->fetchrow_array;
01451   $sth->finish;
01452 
01453   if ($version) {
01454     $arch_id->current_version($version);
01455     return 1;
01456   }
01457 
01458   # didn't find a current version
01459   return 0;
01460 } ## end sub lookup_current
01461 
01462 
01463 # infer type from stable ID format
01464 sub _resolve_type {
01465   my $self = shift;
01466   my $arch_id = shift;
01467   
01468   my $stable_id = $arch_id->stable_id();
01469   my $id_type;
01470 
01471   # first, try to infer type from stable ID format
01472   #
01473   # Anopheles IDs
01474   if ($stable_id =~ /^AGAP.*/) {
01475     if ($stable_id =~ /.*-RA/) {
01476       $id_type = "Transcript";
01477     } elsif ($stable_id =~ /.*-PA/) {
01478       $id_type = "Translation";
01479     } else {
01480       $id_type = "Gene";
01481     }
01482 
01483   # standard Ensembl IDs
01484   } elsif ($stable_id =~ /.*G\d+$/) {
01485     $id_type = "Gene";
01486   } elsif ($stable_id =~ /.*T\d+$/) { 
01487     $id_type = "Transcript";
01488   } elsif ($stable_id =~ /.*P\d+$/) { 
01489     $id_type = "Translation";
01490   } elsif ($stable_id =~ /.*E\d+$/) { 
01491     $id_type = "Exon";
01492 
01493   # if guessing fails, look in db
01494   } else {
01495     my $sql = qq(
01496       SELECT type from stable_id_event
01497       WHERE old_stable_id = ?
01498       OR new_stable_id = ?
01499     );
01500     my $sth = $self->prepare($sql);
01501     $sth->execute($stable_id, $stable_id);
01502     ($id_type) = $sth->fetchrow_array;
01503     $sth->finish;
01504   }
01505 
01506   warning("Couldn't resolve stable ID type.") unless ($id_type);
01507   
01508   $arch_id->type($id_type);
01509 }
01510 
01511 
01512 1;
01513