Archive Ensembl HomeArchive Ensembl Home
Transcript.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::Transcript - object representing an Ensembl transcript
00024 
00025 =head1 SYNOPSIS
00026 
00027 Creation:
00028 
00029   my $tran = new Bio::EnsEMBL::Transcript();
00030   my $tran = new Bio::EnsEMBL::Transcript( -EXONS => \@exons );
00031 
00032 Manipulation:
00033 
00034   # Returns an array of Exon objects
00035   my @exons = @{ $tran->get_all_Exons() };
00036 
00037   # Returns the peptide translation of the exons as a Bio::Seq
00038   if ( $tran->translation() ) {
00039     my $pep = $tran->translate();
00040   } else {
00041     print "Transcript ", $tran->stable_id(), " is non-coding\n";
00042   }
00043 
00044 =head1 DESCRIPTION
00045 
00046 A representation of a transcript within the Ensembl system.  A transcript
00047 consists of a set of Exons and (possibly) a Translation which defines the
00048 coding and non-coding regions of the exons.
00049 
00050 =cut
00051 
00052 package Bio::EnsEMBL::Transcript;
00053 
00054 use strict;
00055 
00056 use Bio::EnsEMBL::Feature;
00057 use Bio::EnsEMBL::Intron;
00058 use Bio::EnsEMBL::TranscriptMapper;
00059 use Bio::EnsEMBL::Utils::TranscriptSNPs;
00060 use Bio::EnsEMBL::SeqEdit;
00061 
00062 use Bio::EnsEMBL::Utils::Argument qw( rearrange );
00063 use Bio::EnsEMBL::Utils::Exception qw( deprecate warning throw );
00064 use Bio::EnsEMBL::Utils::Scalar qw( assert_ref );
00065 
00066 use vars qw(@ISA);
00067 @ISA = qw(Bio::EnsEMBL::Feature);
00068 
00069 
00070 =head2 new
00071 
00072   Arg [-EXONS] :
00073         reference to list of Bio::EnsEMBL::Exon objects - exons which make up 
00074         this transcript
00075   Arg [-STABLE_ID] :
00076         string - the stable identifier of this transcript
00077   Arg [-VERSION] :
00078         int - the version of the stable identifier of this transcript
00079   Arg [-EXTERNAL_NAME] :
00080         string - the external database name associated with this transcript
00081   Arg [-EXTERNAL_DB] :
00082         string - the name of the database the external name is from
00083   Arg [-EXTERNAL_STATUS]:
00084         string - the status of the external identifier
00085   Arg [-DISPLAY_XREF]:
00086         Bio::EnsEMBL::DBEntry - The external database entry that is used
00087         to label this transcript when it is displayed.
00088   Arg [-CREATED_DATE]:
00089         string - the date the transcript was created
00090   Arg [-MODIFIED_DATE]:
00091         string - the date the transcript was last modified
00092   Arg [-DESCRIPTION]:
00093         string - the transcipts description
00094   Arg [-BIOTYPE]: 
00095         string - the biotype e.g. "protein_coding"
00096   Arg [-STATUS]:
00097         string - the transcripts status i.e. "KNOWN","NOVEL"
00098   Arg [-IS_CURRENT]:
00099         Boolean - specifies if this is the current version of the transcript
00100   Example    : $tran = new Bio::EnsEMBL::Transcript(-EXONS => \@exons);
00101   Description: Constructor. Instantiates a Transcript object.
00102   Returntype : Bio::EnsEMBL::Transcript
00103   Exceptions : throw on bad arguments
00104   Caller     : general
00105   Status     : Stable
00106 
00107 =cut
00108 
00109 sub new {
00110   my $proto = shift;
00111 
00112   my $class = ref($proto) || $proto;
00113 
00114   my $self = $class->SUPER::new(@_);
00115 
00116   my (
00117     $exons,            $stable_id,    $version,
00118     $external_name,    $external_db,  $external_status,
00119     $display_xref,     $created_date, $modified_date,
00120     $description,      $biotype,      $confidence,
00121     $external_db_name, $status,       $is_current
00122   );
00123 
00124   # Catch for old style constructor calling:
00125   if ( ( @_ > 0 ) && ref( $_[0] ) ) {
00126     $exons = [@_];
00127     deprecate( "Transcript constructor should use named arguments.\n"
00128         . "Use Bio::EnsEMBL::Transcript->new(-EXONS => \@exons);\n"
00129         . "instead of Bio::EnsEMBL::Transcript->new(\@exons);" );
00130   } else {
00131     (
00132       $exons,            $stable_id,    $version,
00133       $external_name,    $external_db,  $external_status,
00134       $display_xref,     $created_date, $modified_date,
00135       $description,      $biotype,      $confidence,
00136       $external_db_name, $status,       $is_current
00137       )
00138       = rearrange( [
00139         'EXONS',            'STABLE_ID',
00140         'VERSION',          'EXTERNAL_NAME',
00141         'EXTERNAL_DB',      'EXTERNAL_STATUS',
00142         'DISPLAY_XREF',     'CREATED_DATE',
00143         'MODIFIED_DATE',    'DESCRIPTION',
00144         'BIOTYPE',          'CONFIDENCE',
00145         'EXTERNAL_DB_NAME', 'STATUS',
00146         'IS_CURRENT'
00147       ],
00148       @_
00149       );
00150   }
00151 
00152   if ($exons) {
00153     $self->{'_trans_exon_array'} = $exons;
00154     $self->recalculate_coordinates();
00155   }
00156 
00157   $self->stable_id($stable_id);
00158   $self->version($version);
00159   $self->{'created_date'}  = $created_date;
00160   $self->{'modified_date'} = $modified_date;
00161   $self->external_name($external_name) if ( defined $external_name );
00162   $self->external_db($external_db)     if ( defined $external_db );
00163   $self->external_status($external_status)
00164     if ( defined $external_status );
00165   $self->display_xref($display_xref) if ( defined $display_xref );
00166   $self->edits_enabled(1);
00167 
00168   $self->description($description);
00169   $self->status($confidence);    # old style name
00170   $self->status($status);        # new style name
00171   $self->biotype($biotype);
00172 
00173   # default is_current
00174   $is_current = 1 unless ( defined($is_current) );
00175   $self->{'is_current'} = $is_current;
00176 
00177   return $self;
00178 } ## end sub new
00179 
00180 =head2 get_all_DBLinks
00181 
00182   Arg [1]    : String database name (optional)
00183                SQL wildcard characters (_ and %) can be used to
00184                specify patterns.
00185 
00186   Example    : my @dblinks = @{ $transcript->get_all_DBLinks() };
00187                my @dblinks = @{ $transcript->get_all_DBLinks('Uniprot%') };
00188 
00189   Description: Retrieves *all* related DBEntries for this
00190                transcript.  This includes all DBEntries that are
00191                associated with the corresponding translation.
00192 
00193                If you only want to retrieve the DBEntries associated
00194                with the transcript (and not the translation) then
00195                you should use the get_all_DBEntries() call instead.
00196 
00197                Note: Each entry may be listed more than once.  No
00198                uniqueness checks are done.  Also if you put in an
00199                incorrect external database name no checks are done
00200                to see if this exists, you will just get an empty
00201                list.
00202 
00203   Return type: Listref of Bio::EnsEMBL::DBEntry objects
00204   Exceptions : none
00205   Caller     : general
00206   Status     : Stable
00207 
00208 =cut
00209 
00210 sub get_all_DBLinks {
00211   my ( $self, $db_name_exp, $ex_db_type ) = @_;
00212 
00213   my @links =
00214     @{ $self->get_all_DBEntries( $db_name_exp, $ex_db_type ) };
00215 
00216   # Add all of the transcript and translation xrefs to the return list.
00217   my $translation = $self->translation();
00218   if ( defined($translation) ) {
00219     push( @links,
00220           @{$translation->get_all_DBEntries( $db_name_exp, $ex_db_type ) }
00221     );
00222   }
00223 
00224   @links = sort { _compare_xrefs() } @links;
00225 
00226   return \@links;
00227 }
00228 
00229 =head2 get_all_xrefs
00230 
00231   Arg [1]    : String database name (optional)
00232                SQL wildcard characters (_ and %) can be used to
00233                specify patterns.
00234 
00235   Example    : @xrefs = @{ $transcript->get_all_xrefs() };
00236                @xrefs = @{ $transcript->get_all_xrefs('Uniprot%') };
00237 
00238   Description: Retrieves *all* related xrefs for this transcript.
00239                This includes all xrefs that are associated with the
00240                corresponding translation of this transcript.
00241 
00242                If you want to retrieve the xrefs associated with
00243                only the transcript (and not the translation) then
00244                you should use the get_all_object_xrefs() method
00245                instead.
00246 
00247                Note: Each entry may be listed more than once.  No
00248                uniqueness checks are done.  Also if you put in an
00249                incorrect external database name no checks are done
00250                to see if this exists, you will just get an empty
00251                list.
00252 
00253                 NB: This method is an alias for the
00254                     get_all_DBLinks() method.
00255 
00256   Return type: Listref of Bio::EnsEMBL::DBEntry objects
00257 
00258   Status     : Stable
00259 
00260 =cut
00261 
00262 sub get_all_xrefs {
00263   my $self = shift;
00264   return $self->get_all_DBLinks(@_);
00265 }
00266 
00267 =head2 get_all_DBEntries
00268 
00269   Arg [1]    : (optional) String, external database name
00270 
00271   Arg [2]    : (optional) String, external database type
00272 
00273   Example    : my @dbentries = @{ $transcript->get_all_DBEntries() };
00274 
00275   Description: Retrieves DBEntries (xrefs) for this transcript.
00276                This does *not* include the corresponding
00277                translations DBEntries (see get_all_DBLinks()).
00278 
00279                This method will attempt to lazy-load DBEntries
00280                from a database if an adaptor is available and no
00281                DBEntries are present on the transcript (i.e. they
00282                have not already been added or loaded).
00283 
00284   Returntype : Listref of Bio::EnsEMBL::DBEntry objects
00285   Exceptions : none
00286   Caller     : get_all_DBLinks, TranscriptAdaptor::store
00287   Status     : Stable
00288 
00289 =cut
00290 
00291 sub get_all_DBEntries {
00292   my ( $self, $ex_db_exp, $ex_db_type ) = @_;
00293 
00294   my $cache_name = 'dbentries';
00295 
00296   if ( defined($ex_db_exp) ) {
00297     $cache_name .= $ex_db_exp;
00298   }
00299 
00300   if ( defined($ex_db_type) ) {
00301     $cache_name .= $ex_db_type;
00302   }
00303 
00304   # if not cached, retrieve all of the xrefs for this transcript
00305   if ( !defined( $self->{$cache_name} ) && defined( $self->adaptor() ) )
00306   {
00307     $self->{$cache_name} =
00308       $self->adaptor()->db()->get_DBEntryAdaptor()
00309       ->fetch_all_by_Transcript( $self, $ex_db_exp, $ex_db_type );
00310   }
00311 
00312   $self->{$cache_name} ||= [];
00313 
00314   return $self->{$cache_name};
00315 } ## end sub get_all_DBEntries
00316 
00317 =head2 get_all_object_xrefs
00318 
00319   Arg [1]    : (optional) String, external database name
00320 
00321   Arg [2]    : (optional) String, external_db type
00322 
00323   Example    : @oxrefs = @{ $transcript->get_all_object_xrefs() };
00324 
00325   Description: Retrieves xrefs for this transcript.  This does
00326                *not* include xrefs that are associated with the
00327                corresponding translations of this transcript (see
00328                get_all_xrefs()).
00329 
00330                This method will attempt to lazy-load xrefs from a
00331                database if an adaptor is available and no xrefs are
00332                present on the transcript (i.e. they have not already
00333                been added or loaded).
00334 
00335                 NB: This method is an alias for the
00336                     get_all_DBentries() method.
00337 
00338   Return type: Listref of Bio::EnsEMBL::DBEntry objects
00339 
00340   Status     : Stable
00341 
00342 =cut
00343 
00344 sub get_all_object_xrefs {
00345   my $self = shift;
00346   return $self->get_all_DBEntries(@_);
00347 }
00348 
00349 =head2 add_DBEntry
00350 
00351   Arg [1]    : Bio::EnsEMBL::DBEntry $dbe
00352                The dbEntry to be added
00353   Example    : my $dbe = Bio::EnsEMBL::DBEntery->new(...);
00354                $transcript->add_DBEntry($dbe);
00355   Description: Associates a DBEntry with this transcript. Note that adding
00356                DBEntries will prevent future lazy-loading of DBEntries for this
00357                gene (see get_all_DBEntries).
00358   Returntype : none
00359   Exceptions : thrown on incorrect argument type
00360   Caller     : general
00361   Status     : Stable
00362 
00363 =cut
00364 
00365 sub add_DBEntry {
00366   my $self = shift;
00367   my $dbe = shift;
00368 
00369   unless($dbe && ref($dbe) && $dbe->isa('Bio::EnsEMBL::DBEntry')) {
00370     throw('Expected DBEntry argument');
00371   }
00372 
00373   $self->{'dbentries'} ||= [];
00374   push @{$self->{'dbentries'}}, $dbe;
00375 }
00376 
00377 
00378 =head2 get_all_supporting_features
00379 
00380   Example    : my @evidence = @{ $transcript->get_all_supporting_features };
00381   Description: Retreives any supporting features added manually by 
00382                calls to add_supporting_features.
00383   Returntype : Listref of Bio::EnsEMBL::FeaturePair objects
00384   Exceptions : none
00385   Caller     : general
00386   Status     : Stable
00387 
00388 =cut
00389 
00390 sub get_all_supporting_features {
00391   my $self = shift;
00392 
00393   if( !exists  $self->{_supporting_evidence} )  {
00394     if($self->adaptor) {
00395       my $tsfa = $self->adaptor->db->get_TranscriptSupportingFeatureAdaptor();
00396       $self->{_supporting_evidence} = $tsfa->fetch_all_by_Transcript($self);
00397     }
00398   }
00399   
00400   return $self->{_supporting_evidence} || [];
00401 }
00402 
00403 
00404 =head2 add_supporting_features
00405 
00406   Arg [1-N]  : Bio::EnsEMBL::FeaturePair $feature
00407                The supporting features to add
00408   Example    : $transcript->add_supporting_features(@features);
00409   Description: Adds a list of supporting features to this Transcript.
00410                The added features can be retieved by
00411                get_all_supporting_features().
00412   Returntype : none
00413   Exceptions : throw if any of the features are not FeaturePairs
00414                throw if any of the features are not in the same coordinate
00415                system as the Transcript
00416   Caller     : general
00417   Status     : Stable
00418  
00419 =cut
00420  
00421 sub add_supporting_features {
00422   my ($self, @features) = @_;
00423 
00424   return unless @features;
00425  
00426   $self->{_supporting_evidence} ||= [];
00427   
00428   # check whether this feature object has been added already
00429   FEATURE: foreach my $feature (@features) {
00430 
00431     if (!defined($feature) || ref($feature) eq "ARRAY") {
00432       throw("Element in transcript supporting features array is undefined or is an ARRAY for " . $self->dbID);
00433     }
00434     if (!$feature || !$feature->isa("Bio::EnsEMBL::FeaturePair")) {
00435       print "feature = " . $feature . "\n";
00436       throw("Supporting feat [$feature] not a " .
00437             "Bio::EnsEMBL::FeaturePair");
00438     } 
00439     
00440     if ((defined $self->slice() && defined $feature->slice())&&
00441         ( $self->slice()->name() ne $feature->slice()->name())){
00442       throw("Supporting feat not in same coord system as exon\n" .
00443             "exon is attached to [".$self->slice()->name()."]\n" .
00444             "feat is attached to [".$feature->slice()->name()."]");
00445     }
00446 
00447     foreach my $added_feature ( @{ $self->{_supporting_evidence} } ){
00448       # compare objects
00449       if ( $feature == $added_feature ){
00450     #this feature has already been added
00451     next FEATURE;
00452       }
00453     }
00454     
00455     #no duplicate was found, add the feature
00456     push(@{$self->{_supporting_evidence}}, $feature);
00457   }
00458 }
00459 
00460 
00461 =head2 flush_supporting_features
00462 
00463   Example     : $transcript->flush_supporting_features;
00464   Description : Removes all supporting evidence from the transcript.
00465   Return type : (Empty) listref
00466   Exceptions  : none
00467   Caller      : general
00468   Status      : Stable
00469 
00470 =cut
00471 
00472 sub flush_supporting_features {
00473   my $self = shift;
00474   $self->{'_supporting_evidence'} = [];
00475 }
00476 
00477 
00478 =head2 external_db
00479 
00480   Arg [1]    : (optional) String - name of external db to set
00481   Example    : $transcript->external_db('HGNC');
00482   Description: Getter/setter for attribute external_db. The db is the one that 
00483                belongs to the external_name.  
00484   Returntype : String
00485   Exceptions : none
00486   Caller     : general
00487   Status     : Stable
00488 
00489 =cut
00490 
00491 sub external_db {
00492   my ( $self, $ext_dbname ) = @_;
00493 
00494   if(defined $ext_dbname) { 
00495     return ( $self->{'external_db'} = $ext_dbname );
00496   }
00497 
00498   if( exists $self->{'external_db'} ) {
00499     return $self->{'external_db'};
00500   }
00501 
00502   my $display_xref = $self->display_xref();
00503 
00504   if( defined $display_xref ) {
00505     return $display_xref->dbname()
00506   } else {
00507     return undef;
00508   }
00509 }
00510 
00511 
00512 =head2 external_status
00513 
00514   Arg [1]    : (optional) String - status of the external db
00515   Example    : $transcript->external_status('KNOWNXREF');
00516   Description: Getter/setter for attribute external_status. The status of
00517                the external db of the one that belongs to the external_name.
00518   Returntype : String
00519   Exceptions : none
00520   Caller     : general
00521   Status     : Stable
00522 
00523 =cut
00524 
00525 sub external_status { 
00526   my ( $self, $ext_status ) = @_;
00527 
00528   if(defined $ext_status) {
00529     return ( $self->{'external_status'} = $ext_status );
00530   }
00531 
00532   if( exists $self->{'external_status'} ) {
00533     return $self->{'external_status'};
00534   }
00535 
00536   my $display_xref = $self->display_xref();
00537 
00538   if( defined $display_xref ) {
00539     return $display_xref->status()
00540   } else {
00541     return undef;
00542   }
00543 }
00544 
00545 
00546 =head2 external_name
00547 
00548   Arg [1]    : (optional) String - the external name to set
00549   Example    : $transcript->external_name('BRCA2-001');
00550   Description: Getter/setter for attribute external_name.
00551   Returntype : String or undef
00552   Exceptions : none
00553   Caller     : general
00554   Status     : Stable
00555 
00556 =cut
00557 
00558 sub external_name {
00559   my ($self, $ext_name) = @_;
00560 
00561   if(defined $ext_name) { 
00562     return ( $self->{'external_name'} = $ext_name );
00563   }
00564 
00565   if( exists $self->{'external_name'} ) {
00566     return $self->{'external_name'};
00567   }
00568 
00569   my $display_xref = $self->display_xref();
00570 
00571   if( defined $display_xref ) {
00572     return $display_xref->display_id()
00573   } else {
00574     return undef;
00575   }
00576 }
00577 
00578 
00579 =head2 is_known
00580 
00581   Example    : print "Transcript ".$transcript->stable_id." is KNOWN\n" if
00582                   $transcript->is_known;
00583   Description: Returns TRUE if this gene has a status of 'KNOWN'
00584   Returntype : TRUE if known, FALSE otherwise
00585   Exceptions : none
00586   Caller     : general
00587   Status     : Stable
00588 
00589 =cut
00590 
00591 sub is_known {
00592   my $self = shift;
00593   return ( $self->{'status'} eq "KNOWN" || $self->{'status'} eq "KNOWN_BY_PROJECTION" );
00594 }
00595 
00596 
00597 =head2 status
00598 
00599   Arg [1]    : string $status
00600   Example    : none
00601   Description: get/set for attribute status
00602   Returntype : string
00603   Exceptions : none
00604   Caller     : general
00605   Status     : Medium Risk
00606 
00607 =cut
00608 
00609 sub status {
00610    my $self = shift;
00611   $self->{'status'} = shift if( @_ );
00612   return $self->{'status'};
00613 }
00614 
00615 =head2 biotype
00616 
00617   Arg [1]    : string $biotype
00618   Example    : none
00619   Description: get/set for attribute biotype
00620   Returntype : string
00621   Exceptions : none
00622   Caller     : general
00623   Status     : Stable
00624 
00625 =cut
00626 
00627 sub biotype {
00628    my $self = shift;
00629   $self->{'biotype'} = shift if( @_ );
00630   return ( $self->{'biotype'} || "protein_coding" );
00631 }
00632 
00633 
00634 =head2 display_xref
00635 
00636   Arg [1]    : (optional) Bio::EnsEMBL::DBEntry - the display xref to set
00637   Example    : $transcript->display_xref($db_entry);
00638   Description: Getter/setter for display_xref for this transcript.
00639   Returntype : Bio::EnsEMBL::DBEntry
00640   Exceptions : none
00641   Caller     : general
00642   Status     : Stable
00643 
00644 =cut
00645 
00646 sub display_xref {
00647   my $self = shift;
00648   $self->{'display_xref'} = shift if(@_);
00649   return $self->{'display_xref'};
00650 }
00651 
00652 =head2 is_canonical
00653 
00654   Args [1]      : (optional) Boolean is_canonical
00655 
00656   Example       : if ($transcript->is_canonical()) { ... }
00657 
00658   Description : Returns true (non-zero) if the transcript is the
00659                 canonical transcript of its gene, false (0) if not. If the code
00660                 returns an undefined it is because its state is not currently
00661                 known. Internally the code will consult the database for this
00662                 value if it is unknown and the transcript has a dbID and an
00663                 attached adaptor
00664 
00665   Return type   : Boolean
00666 
00667   Status        : Stable
00668 
00669 =cut
00670 
00671 sub is_canonical {
00672   my ( $self, $value ) = @_;
00673   
00674   #Shortcut call
00675   return $self->{is_canonical} if defined $self->{is_canonical};
00676   
00677   if ( defined($value) ) {
00678     $self->{is_canonical} = ( $value ? 1 : 0 );
00679   }
00680   else {
00681     if(! defined $self->{is_canonical} && $self->dbID() && $self->adaptor()) {
00682       $self->{is_canonical} = $self->adaptor()->is_Transcript_canonical($self);
00683     }
00684   }
00685 
00686   return $self->{is_canonical};
00687 }
00688 
00689 =head2 translation
00690 
00691   Args       : None
00692   Example    : if ( $transcript->translation() ) {
00693                  print( $transcript->translation()->stable_id(), "\n" );
00694                } else {
00695                  print("Pseudogene\n");
00696                }
00697   Description: Getter/setter for the Translation object which
00698                defines the CDS (and as a result the peptide encoded
00699                by) this transcript.  This function will return
00700                undef if this transcript is a pseudogene, i.e. a
00701                non-translating transcript such as an ncRNA.  This
00702                is the accepted method of determining whether a
00703                transcript is a pseudogene or not.
00704   Returntype : Bio::EnsEMBL::Translation
00705   Exceptions : none
00706   Caller     : general
00707   Status     : Stable
00708 
00709 =cut
00710 
00711 sub translation {
00712   my ( $self, $translation ) = @_;
00713 
00714   if ( defined($translation) ) {
00715     assert_ref( $translation, 'Bio::EnsEMBL::Translation' );
00716 
00717     $self->{'translation'} = $translation;
00718     $translation->transcript($self);
00719 
00720     $self->{'cdna_coding_start'} = undef;
00721     $self->{'cdna_coding_end'}   = undef;
00722 
00723     $self->{'coding_region_start'} = undef;
00724     $self->{'coding_region_end'}   = undef;
00725 
00726     $self->{'transcript_mapper'} = undef;
00727 
00728   } elsif ( @_ > 1 ) {
00729     if ( defined( $self->{'translation'} ) ) {
00730       # Removing existing translation
00731 
00732       $self->{'translation'}->transcript(undef);
00733       delete( $self->{'translation'} );
00734 
00735       $self->{'cdna_coding_start'} = undef;
00736       $self->{'cdna_coding_end'}   = undef;
00737 
00738       $self->{'coding_region_start'} = undef;
00739       $self->{'coding_region_end'}   = undef;
00740 
00741       $self->{'transcript_mapper'} = undef;
00742     }
00743   } elsif (   !exists( $self->{'translation'} )
00744             && defined( $self->adaptor() ) )
00745   {
00746     $self->{'translation'} =
00747       $self->adaptor()->db()->get_TranslationAdaptor()
00748       ->fetch_by_Transcript($self);
00749   }
00750 
00751   return $self->{'translation'};
00752 } ## end sub translation
00753 
00754 =head2 get_all_alternative_translations
00755 
00756   Args       : None
00757   Example    :
00758 
00759     my @alt_translations =
00760       @{ $transcript->get_all_alternative_translations() };
00761 
00762   Description:  Fetches all alternative translations defined for this
00763                 transcript.  The canonical translation is not returned.
00764 
00765   Returntype : Arrayref to Bio::EnsEMBL::Translation
00766   Exceptions : None
00767   Caller     : General
00768   Status     : Stable
00769 
00770 =cut
00771 
00772 sub get_all_alternative_translations {
00773   my ($self) = @_;
00774 
00775   if (   !exists( $self->{'alternative_translations'} )
00776        && defined( $self->adaptor() ) )
00777   {
00778     my $pa = $self->adaptor()->db()->get_TranslationAdaptor();
00779     my @translations =
00780       @{ $pa->fetch_all_alternative_by_Transcript($self) };
00781 
00782     $self->{'alternative_translations'} = \@translations;
00783   }
00784 
00785   return $self->{'alternative_translations'};
00786 }
00787 
00788 =head2 add_alternative_translation
00789 
00790   Args       : Bio::EnsEMBL::Translation $translation
00791   Example    :
00792 
00793     $transcript->add_alternative_translation($translation);
00794 
00795   Description: Adds an alternative translation to this transcript.
00796   Returntype : None
00797   Exceptions : None
00798   Caller     : General
00799   Status     : Stable
00800 
00801 =cut
00802 
00803 sub add_alternative_translation {
00804   my ( $self, $translation ) = @_;
00805 
00806   if ( !(    defined($translation)
00807           && ref($translation)
00808           && $translation->isa('Bio::EnsEMBL::Translation') ) )
00809   {
00810     throw("Bio::EnsEMBL::Translation argument expected.");
00811   }
00812 
00813   # Load the existsing alternative translations from the database if
00814   # they haven't already been loaded.
00815   $self->get_all_alternative_translations();
00816 
00817   push( @{ $self->{'alternative_translations'} }, $translation );
00818 }
00819 
00820 =head2 spliced_seq
00821 
00822   Args       : none
00823   Example    : none
00824   Description: Retrieves all Exon sequences and concats them together.
00825                No phase padding magic is done, even if phases do not align.
00826   Returntype : Text
00827   Exceptions : none
00828   Caller     : general
00829   Status     : Stable
00830 
00831 =cut
00832 
00833 sub spliced_seq {
00834   my ( $self ) = @_;
00835 
00836   my $seq_string = "";
00837   for my $ex ( @{$self->get_all_Exons()} ) {
00838     my $seq = $ex->seq();
00839 
00840     if(!$seq) {
00841       warning("Could not obtain seq for exon.  Transcript sequence may not " .
00842               "be correct.");
00843       $seq_string .= 'N' x $ex->length();
00844     } else {
00845       $seq_string .= $seq->seq();
00846     }
00847   }
00848 
00849   # apply post transcriptional edits
00850   if($self->edits_enabled()) {
00851     my @seqeds = @{$self->get_all_SeqEdits()};
00852 
00853     # sort edits in reverse order to remove complication of
00854     # adjusting downstream edits
00855     @seqeds = sort {$b->start() <=> $a->start()} @seqeds;
00856 
00857     foreach my $se (@seqeds) {
00858       $se->apply_edit(\$seq_string);
00859     }
00860   }
00861 
00862   return $seq_string;
00863 }
00864 
00865 
00866 =head2 translateable_seq
00867 
00868   Args       : none
00869   Example    : print $transcript->translateable_seq(), "\n";
00870   Description: Returns a sequence string which is the the translateable part
00871                of the transcripts sequence.  This is formed by splicing all
00872                Exon sequences together and apply all defined RNA edits.
00873                Then the coding part of the sequence is extracted and returned.
00874                The code will not support monkey exons any more. If you want to
00875                have non phase matching exons, defined appropriate _rna_edit
00876                attributes!
00877 
00878                An empty string is returned if this transcript is a pseudogene
00879                (i.e. is non-translateable).
00880   Returntype : Text
00881   Exceptions : none
00882   Caller     : general
00883   Status     : Stable
00884 
00885 =cut
00886 
00887 sub translateable_seq {
00888   my ( $self ) = @_;
00889 
00890   if ( !$self->translation() ) {
00891     return '';
00892   }
00893 
00894   my $mrna = $self->spliced_seq();
00895 
00896   my $start = $self->cdna_coding_start();
00897   my $end   = $self->cdna_coding_end();
00898 
00899   $mrna = substr( $mrna, $start - 1, $end - $start + 1 );
00900 
00901   my $start_phase = $self->translation->start_Exon->phase();
00902   if( $start_phase > 0 ) {
00903     $mrna = "N"x$start_phase . $mrna;
00904   }
00905   if( ! $start || ! $end ) {
00906     return "";
00907   }
00908 
00909   return $mrna;
00910 }
00911 
00912 
00913 =head2 cdna_coding_start
00914 
00915   Arg [1]    : (optional) $value
00916   Example    : $relative_coding_start = $transcript->cdna_coding_start;
00917   Description: Retrieves the position of the coding start of this transcript
00918                in cdna coordinates (relative to the start of the 5prime end of
00919                the transcript, excluding introns, including utrs).
00920 
00921                This will return undef if this is a pseudogene (i.e. a
00922                transcript with no translation).
00923   Returntype : int
00924   Exceptions : none
00925   Caller     : five_prime_utr, get_all_snps, general
00926   Status     : Stable
00927 
00928 =cut
00929 
00930 sub cdna_coding_start {
00931   my $self = shift;
00932 
00933   if( @_ ) {
00934     $self->{'cdna_coding_start'} = shift;
00935   }
00936 
00937   if(!defined $self->{'cdna_coding_start'} && defined $self->translation){
00938     # calc coding start relative from the start of translation (in cdna coords)
00939     my $start = 0;
00940 
00941     my @exons = @{$self->get_all_Exons};
00942     my $exon;
00943 
00944     while($exon = shift @exons) {
00945       if($exon == $self->translation->start_Exon) {
00946         #add the utr portion of the start exon
00947         $start += $self->translation->start;
00948         last;
00949       } else {
00950         #add the entire length of this non-coding exon
00951         $start += $exon->length;
00952       }
00953     }
00954 
00955     # adjust cdna coords if sequence edits are enabled
00956     if($self->edits_enabled()) {
00957       my @seqeds = @{$self->get_all_SeqEdits()};
00958       # sort in reverse order to avoid adjustment of downstream edits
00959       @seqeds = sort {$b->start() <=> $a->start()} @seqeds;
00960 
00961       foreach my $se (@seqeds) {
00962         # use less than start so that start of CDS can be extended
00963         if($se->start() < $start) {
00964           $start += $se->length_diff();
00965         }
00966       }
00967     }
00968 
00969     $self->{'cdna_coding_start'} = $start;
00970   }
00971 
00972   return $self->{'cdna_coding_start'};
00973 }
00974 
00975 
00976 =head2 cdna_coding_end
00977 
00978   Arg [1]    : (optional) $value
00979   Example    : $cdna_coding_end = $transcript->cdna_coding_end;
00980   Description: Retrieves the end of the coding region of this transcript in
00981                cdna coordinates (relative to the five prime end of the
00982                transcript, excluding introns, including utrs).
00983 
00984                This will return undef if this transcript is a pseudogene
00985                (i.e. a transcript with no translation and therefor no CDS).
00986   Returntype : int
00987   Exceptions : none
00988   Caller     : general
00989   Status     : Stable
00990 
00991 =cut
00992 
00993 sub cdna_coding_end {
00994   my $self = shift;
00995 
00996   if( @_ ) {
00997     $self->{'cdna_coding_end'} = shift;
00998   }
00999 
01000   if(!defined $self->{'cdna_coding_end'} && defined $self->translation) {
01001     my @exons = @{$self->get_all_Exons};
01002 
01003     my $end = 0;
01004     while(my $exon = shift @exons) {
01005       if($exon == $self->translation->end_Exon) {
01006         # add coding portion of the final coding exon
01007         $end += $self->translation->end;
01008         last;
01009       } else {
01010         # add entire exon
01011         $end += $exon->length;
01012       }
01013     }
01014 
01015     # adjust cdna coords if sequence edits are enabled
01016     if($self->edits_enabled()) {
01017       my @seqeds = @{$self->get_all_SeqEdits()};
01018       # sort in reverse order to avoid adjustment of downstream edits
01019       @seqeds = sort {$b->start() <=> $a->start()} @seqeds;
01020 
01021       foreach my $se (@seqeds) {
01022         # use less than or equal to end+1 so end of the CDS can be extended
01023         if($se->start() <= $end + 1) {
01024           $end += $se->length_diff();
01025         }
01026       }
01027     }
01028 
01029     $self->{'cdna_coding_end'} = $end;
01030   }
01031 
01032   return $self->{'cdna_coding_end'};
01033 }
01034 
01035 
01036 =head2 coding_region_start
01037 
01038   Arg [1]    : (optional) $value
01039   Example    : $coding_region_start = $transcript->coding_region_start
01040   Description: Retrieves the start of the coding region of this transcript
01041                in genomic coordinates (i.e. in either slice or contig coords).
01042                By convention, the coding_region_start is always lower than
01043                the value returned by the coding_end method.
01044                The value returned by this function is NOT the biological
01045                coding start since on the reverse strand the biological coding
01046                start would be the higher genomic value.
01047 
01048                This function will return undef if this is a pseudogene
01049                (a non-translated transcript).
01050   Returntype : int
01051   Exceptions : none
01052   Caller     : general
01053   Status     : Stable
01054 
01055 =cut
01056 
01057 sub coding_region_start {
01058   my ($self, $value) = @_;
01059 
01060   if( defined $value ) {
01061     $self->{'coding_region_start'} = $value;
01062   } elsif(!defined $self->{'coding_region_start'} &&
01063       defined $self->translation) {
01064     #calculate the coding start from the translation
01065     my $start;
01066     my $strand = $self->translation()->start_Exon->strand();
01067     if( $strand == 1 ) {
01068       $start = $self->translation()->start_Exon->start();
01069       $start += ( $self->translation()->start() - 1 );
01070     } else {
01071       $start = $self->translation()->end_Exon->end();
01072       $start -= ( $self->translation()->end() - 1 );
01073     }
01074     $self->{'coding_region_start'} = $start;
01075   }
01076 
01077   return $self->{'coding_region_start'};
01078 }
01079 
01080 
01081 =head2 coding_region_end
01082 
01083   Arg [1]    : (optional) $value
01084   Example    : $coding_region_end = $transcript->coding_region_end
01085   Description: Retrieves the end of the coding region of this transcript
01086                in genomic coordinates (i.e. in either slice or contig coords).
01087                By convention, the coding_region_end is always higher than the
01088                value returned by the coding_region_start method.
01089                The value returned by this function is NOT the biological
01090                coding end since on the reverse strand the biological coding
01091                end would be the lower genomic value.
01092 
01093                This function will return undef if this is a pseudogene
01094                (a non-translated transcript).
01095   Returntype : int
01096   Exceptions : none
01097   Caller     : general
01098   Status     : Stable
01099 
01100 =cut
01101 
01102 sub coding_region_end {
01103   my ($self, $value ) = @_;
01104 
01105   my $strand;
01106   my $end;
01107 
01108   if( defined $value ) {
01109     $self->{'coding_region_end'} = $value;
01110   } elsif( ! defined $self->{'coding_region_end'}
01111        && defined $self->translation() ) {
01112     $strand = $self->translation()->start_Exon->strand();
01113     if( $strand == 1 ) {
01114       $end = $self->translation()->end_Exon->start();
01115       $end += ( $self->translation()->end() - 1 );
01116     } else {
01117       $end = $self->translation()->start_Exon->end();
01118       $end -= ( $self->translation()->start() - 1 );
01119     }
01120     $self->{'coding_region_end'} = $end;
01121   }
01122 
01123   return $self->{'coding_region_end'};
01124 }
01125 
01126 
01127 =head2 edits_enabled
01128 
01129   Arg [1]    : (optional) boolean $newval
01130   Example    : $transcript->edits_enabled(1);
01131   Description: Enables/Disables the application of SeqEdits to this transcript.
01132                Edits are enabled by default, and affect the cdna/mrna
01133                sequences coordinates and the resultant translation.
01134   Returntype : boolean - the current value of the edits
01135   Exceptions : none
01136   Caller     : general, cdna_coding_start, cdna_coding_end, length
01137   Status     : Stable
01138 
01139 =cut
01140 
01141 sub edits_enabled {
01142   my ( $self, $boolean ) = @_;
01143 
01144   if ( defined($boolean) ) {
01145     $self->{'edits_enabled'} = $boolean;
01146 
01147     # flush cached values that will be different with/without edits
01148     $self->{'cdna_coding_start'} = undef;
01149     $self->{'cdna_coding_end'}   = undef;
01150     $self->{'transcript_mapper'} = undef;
01151   }
01152 
01153   return $self->{'edits_enabled'};
01154 }
01155 
01156 
01157 =head2 get_all_SeqEdits
01158 
01159   Arg [1]    : none
01160   Example    : my @seqeds = @{$transcript->get_all_SeqEdits()};
01161   Description: Retrieves all post transcriptional sequence modifications for
01162                this transcript.
01163   Returntype : Bio::EnsEMBL::SeqEdit
01164   Exceptions : none
01165   Caller     : spliced_seq()
01166   Status     : Stable
01167 
01168 =cut
01169 
01170 sub get_all_SeqEdits {
01171   my $self = shift;
01172 
01173   my @seqeds;
01174 
01175   my $attribs = $self->get_all_Attributes('_rna_edit');
01176 
01177   # convert attributes to SeqEdit objects
01178   foreach my $a (@$attribs) {
01179     push @seqeds, Bio::EnsEMBL::SeqEdit->new(-ATTRIB => $a);
01180   }
01181 
01182   return \@seqeds;
01183 }
01184 
01185 
01186 =head2 get_all_Attributes
01187 
01188   Arg [1]    : optional string $attrib_code
01189                The code of the attribute type to retrieve values for.
01190   Example    : ($rna_edits) = @{$transcript->get_all_Attributes('_rna_edit')};
01191                @transc_attributes    = @{$transcript->get_all_Attributes()};
01192   Description: Gets a list of Attributes of this transcript.
01193                Optionally just get Attrubutes for given code.
01194   Returntype : listref Bio::EnsEMBL::Attribute
01195   Exceptions : warning if transcript does not have attached adaptor and 
01196                attempts lazy load.
01197   Caller     : general
01198   Status     : Stable
01199 
01200 =cut
01201 
01202 sub get_all_Attributes {
01203   my $self = shift;
01204   my $attrib_code = shift;
01205 
01206   if( ! exists $self->{'attributes' } ) {
01207     if(!$self->adaptor() ) {
01208       return [];
01209     }
01210 
01211     my $attribute_adaptor = $self->adaptor->db->get_AttributeAdaptor();
01212     $self->{'attributes'} = $attribute_adaptor->fetch_all_by_Transcript($self);
01213   }
01214 
01215   if( defined $attrib_code) {
01216     my @results = grep { uc($_->code()) eq uc($attrib_code) }
01217       @{$self->{'attributes'}};
01218     return \@results;
01219   } else {
01220     return $self->{'attributes'};
01221   }
01222 }
01223 
01224 
01225 =head2 add_Attributes
01226 
01227   Arg [1...] : Bio::EnsEMBL::Attribute $attribute
01228                You can have more Attributes as arguments, all will be added.
01229   Example    : $transcript->add_Attributes($rna_edit_attribute);
01230   Description: Adds an Attribute to the Transcript. Usefull to do _rna_edits.
01231                If you add an attribute before you retrieve any from database, 
01232                lazy load will be disabled.
01233   Returntype : none
01234   Exceptions : throw on incorrect arguments
01235   Caller     : general
01236   Status     : Stable
01237 
01238 =cut
01239 
01240 sub add_Attributes {
01241   my ( $self, @attribs ) = @_;
01242 
01243   if ( !exists( $self->{'attributes'} ) ) {
01244     $self->{'attributes'} = [];
01245   }
01246 
01247   my $seq_change = 0;
01248   foreach my $attrib (@attribs) {
01249     assert_ref( $attrib, 'Bio::EnsEMBL::Attribute' );
01250 
01251     push( @{ $self->{'attributes'} }, $attrib );
01252 
01253     if ( $attrib->code() eq "_rna_edit" ) {
01254       $seq_change = 1;
01255     }
01256   }
01257 
01258   if ($seq_change) {
01259     my $translation = $self->translation();
01260     if ( defined($translation) ) {
01261       delete( $translation->{'seq'} );
01262     }
01263   }
01264 
01265   # flush cdna coord cache b/c we may have added a SeqEdit
01266   delete( $self->{'cdna_coding_start'} );
01267   delete( $self->{'cdna_coding_end'} );
01268   delete( $self->{'transcript_mapper'} );
01269 } ## end sub add_Attributes
01270 
01271 
01272 =head2 add_Exon
01273 
01274  Title   : add_Exon
01275  Usage   : $trans->add_Exon($exon)
01276  Returns : None
01277  Args [1]: Bio::EnsEMBL::Exon object to add
01278  Args [2]: rank
01279  Exceptions: throws if not a valid Bio::EnsEMBL::Exon
01280            : or exon clashes with another one
01281  Status  : Stable
01282 
01283 =cut
01284 
01285 sub add_Exon {
01286   my ( $self, $exon, $rank ) = @_;
01287 
01288   assert_ref( $exon, 'Bio::EnsEMBL::Exon' );
01289 
01290   $self->{'_trans_exon_array'} ||= [];
01291 
01292   if ( defined($rank) ) {
01293     $self->{'_trans_exon_array'}->[ $rank - 1 ] = $exon;
01294     return;
01295   }
01296 
01297   my $was_added = 0;
01298 
01299   my $ea = $self->{'_trans_exon_array'};
01300 
01301   if ( @{$ea} ) {
01302     if ( $exon->strand() == 1 ) {
01303 
01304       my $exon_start = $exon->start();
01305 
01306       if ( $exon_start > $ea->[-1]->end() ) {
01307         push( @{$ea}, $exon );
01308         $was_added = 1;
01309       } else {
01310         # Insert it at correct place
01311 
01312         my $i = 0;
01313         foreach my $e ( @{$ea} ) {
01314           if ( $exon_start < $e->start() ) {
01315             if ( $exon->end() >= $e->start() ) {
01316               # Overlap
01317               last;
01318             }
01319             if ( $i and $exon_start <= $ea->[$i-1]->end() ) {
01320               # Overlap
01321               last;
01322             }
01323             splice( @{$ea}, $i, 0, $exon );
01324             $was_added = 1;
01325             last;
01326           }
01327           ++$i;
01328         }
01329 
01330       }
01331 
01332     } else {
01333 
01334       my $exon_end = $exon->end();
01335 
01336       if ( $exon_end < $ea->[-1]->start() ) {
01337         push( @{$ea}, $exon );
01338         $was_added = 1;
01339       } else {
01340         # Insert it at correct place
01341 
01342         my $i = 0;
01343         foreach my $e ( @{$ea} ) {
01344           if ( $exon_end > $e->end() ) {
01345             if ( $exon->start() <= $e->end() ) {
01346               # Overlap
01347               last;
01348             }
01349             if ( $i and $exon_end >= $ea->[$i-1]->start() ) {
01350               # Overlap
01351               last;
01352             }
01353             splice( @{$ea}, $i, 0, $exon );
01354             $was_added = 1;
01355             last;
01356           }
01357           ++$i;
01358         }
01359 
01360       }
01361 
01362     } ## end else [ if ( $exon->strand() ==...)]
01363   } else {
01364     push( @{$ea}, $exon );
01365     $was_added = 1;
01366   }
01367 
01368   # sanity check:
01369   if ( !$was_added ) {
01370     # The exon was not added because it was overloapping with an
01371     # existing exon.
01372     my $all_str = '';
01373 
01374     foreach my $e ( @{$ea} ) {
01375       $all_str .= '  '
01376         . $e->start() . '-'
01377         . $e->end() . ' ('
01378         . $e->strand() . ') '
01379         . ( $e->stable_id() || '' ) . "\n";
01380     }
01381 
01382     my $cur_str = '  '
01383       . $exon->start() . '-'
01384       . $exon->end() . ' ('
01385       . $exon->strand() . ') '
01386       . ( $exon->stable_id() || '' ) . "\n";
01387 
01388     throw(   "Exon overlaps with other exon in same transcript.\n"
01389            . "Transcript Exons:\n$all_str\n"
01390            . "This Exon:\n$cur_str" );
01391   }
01392 
01393   # recalculate start, end, slice, strand
01394   $self->recalculate_coordinates();
01395 } ## end sub add_Exon
01396 
01397 
01398 =head2 get_all_Exons
01399 
01400   Arg [CONSTITUTIVE]    : Boolean
01401                           Only return constitutive exons if true (non-zero)
01402 
01403   Examples  :   my @exons = @{ $transcript->get_all_Exons() };
01404 
01405                 my @exons =
01406                   @{ $transcript->get_all_Exons( -constitutive => 1 ) };
01407 
01408   Description: Returns an listref of the exons in this transcript
01409                in order, i.e. the first exon in the listref is the
01410                5prime most exon in the transcript.  Only returns
01411                constitutive exons if the CONSTITUTIVE argument is
01412                true.
01413 
01414   Returntype : listref to Bio::EnsEMBL::Exon objects
01415   Exceptions : none
01416   Caller     : general
01417   Status     : Stable
01418 
01419 =cut
01420 
01421 sub get_all_Exons {
01422   my ( $self, @args ) = @_;
01423 
01424   my $constitutive;
01425   if (@args) {
01426     $constitutive = rearrange( ['CONSTITUTIVE'], @args );
01427   }
01428 
01429   if (!defined( $self->{'_trans_exon_array'} )
01430     && defined( $self->adaptor() ) )
01431   {
01432     $self->{'_trans_exon_array'} =
01433       $self->adaptor()->db()->get_ExonAdaptor()
01434       ->fetch_all_by_Transcript($self);
01435   }
01436 
01437   my @result;
01438   if ( defined($constitutive) && $constitutive != 0 ) {
01439     foreach my $exon ( @{ $self->{'_trans_exon_array'} } ) {
01440       if ( $exon->is_constitutive() ) {
01441         push( @result, $exon );
01442       }
01443     }
01444   } else {
01445     @result = @{ $self->{'_trans_exon_array'} };
01446   }
01447 
01448   return \@result;
01449 } ## end sub get_all_Exons
01450 
01451 =head2 get_all_constitutive_Exons
01452 
01453   Arg        :  None
01454 
01455   Examples   :  my @exons = @{ $transcript->get_all_constitutive_Exons() };
01456 
01457   Description:  Returns an listref of the constitutive exons in this
01458                 transcript in order, i.e. the first exon in the
01459                 listref is the 5prime most exon in the transcript.
01460 
01461   Returntype : listref to Bio::EnsEMBL::Exon objects
01462   Exceptions : none
01463   Caller     : general
01464   Status     : Stable
01465 
01466 =cut
01467 
01468 sub get_all_constitutive_Exons {
01469   my ($self) = @_;
01470   return $self->get_all_Exons( '-constitutive' => 1 );
01471 }
01472 
01473 =head2 get_all_Introns
01474 
01475   Arg [1]    : none
01476   Example    : my @introns = @{$transcript->get_all_Introns()};
01477   Description: Returns an listref of the introns in this transcript in order.
01478                i.e. the first intron in the listref is the 5prime most exon in 
01479                the transcript.
01480   Returntype : listref to Bio::EnsEMBL::Intron objects
01481   Exceptions : none
01482   Caller     : general
01483   Status     : Stable
01484 
01485 =cut
01486 
01487 sub get_all_Introns {
01488    my ($self) = @_;
01489    if( ! defined $self->{'_trans_exon_array'} && defined $self->adaptor() ) {
01490      $self->{'_trans_exon_array'} = $self->adaptor()->db()->
01491        get_ExonAdaptor()->fetch_all_by_Transcript( $self );
01492    }
01493 
01494    my @introns=();
01495    my @exons = @{$self->{'_trans_exon_array'}};
01496    for(my $i=0; $i < scalar(@exons)-1; $i++){
01497      my $intron = new Bio::EnsEMBL::Intron($exons[$i],$exons[$i+1]);
01498      push(@introns, $intron)
01499    }
01500    return \@introns;
01501 }
01502 
01503 
01504 =head2 length
01505 
01506   Args       : none
01507   Example    : my $t_length = $transcript->length
01508   Description: Returns the sum of the length of all the exons in the transcript.
01509   Returntype : int
01510   Exceptions : none
01511   Caller     : general
01512   Status     : Stable
01513 
01514 =cut
01515 
01516 sub length {
01517   my( $self ) = @_;
01518 
01519   my $length = 0;
01520   foreach my $ex (@{$self->get_all_Exons}) {
01521     $length += $ex->length;
01522   }
01523 
01524   # adjust the length if post transcriptional edits are enabled
01525   if($self->edits_enabled()) {
01526     foreach my $se (@{$self->get_all_SeqEdits()}) {
01527       $length += $se->length_diff();
01528     }
01529   }
01530 
01531   return $length;
01532 }
01533 
01534 
01535 =head2 flush_Exons
01536 
01537   Arg [1]    : none
01538   Example    : $transcript->flush_Exons();
01539   Description: Removes all Exons from this transcript and flushes related
01540                internal caches.
01541   Returntype : none
01542   Exceptions : none
01543   Caller     : general
01544   Status     : Stable
01545 
01546 =cut
01547 
01548 sub flush_Exons {
01549   my ($self) = @_;
01550 
01551   $self->{'transcript_mapper'}   = undef;
01552   $self->{'coding_region_start'} = undef;
01553   $self->{'coding_region_end'}   = undef;
01554   $self->{'cdna_coding_start'}   = undef;
01555   $self->{'cdna_coding_end'}     = undef;
01556   $self->{'start'}               = undef;
01557   $self->{'end'}                 = undef;
01558   $self->{'strand'}              = undef;
01559 
01560   $self->{'_trans_exon_array'} = [];
01561 }
01562 
01563 
01564 =head2 five_prime_utr
01565 
01566   Arg [1]    : none
01567   Example    : my $five_prime  = $transcrpt->five_prime_utr
01568                  or warn "No five prime UTR";
01569   Description: Obtains a Bio::Seq object of the five prime UTR of this
01570                transcript.  If this transcript is a pseudogene
01571                (i.e. non-translating) or has no five prime UTR undef is
01572                returned instead.
01573   Returntype : Bio::Seq or undef
01574   Exceptions : none
01575   Caller     : general
01576   Status     : Stable
01577 
01578 =cut
01579 
01580 sub five_prime_utr {
01581   my $self = shift;
01582 
01583   my $cdna_coding_start  = $self->cdna_coding_start();
01584 
01585   return undef if(!$cdna_coding_start);
01586 
01587   my $seq = substr($self->spliced_seq, 0, $cdna_coding_start - 1);
01588 
01589   return undef if(!$seq);
01590 
01591   return
01592     Bio::Seq->new( -id       => $self->display_id,
01593                    -moltype  => 'dna',
01594                    -alphabet => 'dna',
01595                    -seq      => $seq );
01596 }
01597 
01598 
01599 =head2 three_prime_utr
01600 
01601   Arg [1]    : none
01602   Example    : my $three_prime  = $transcrpt->three_prime_utr
01603                  or warn "No five prime UTR";
01604   Description: Obtains a Bio::Seq object of the three prime UTR of this
01605                transcript.  If this transcript is a pseudogene
01606                (i.e. non-translating) or has no three prime UTR,
01607                undef is returned instead.
01608   Returntype : Bio::Seq or undef
01609   Exceptions : none
01610   Caller     : general
01611   Status     : Stable
01612 
01613 =cut
01614 
01615 sub three_prime_utr {
01616   my $self = shift;
01617 
01618   my $cdna_coding_end = $self->cdna_coding_end();
01619 
01620   return undef if(!$cdna_coding_end);
01621 
01622   my $seq = substr($self->spliced_seq, $cdna_coding_end);
01623 
01624   return undef if(!$seq);
01625 
01626   return
01627     Bio::Seq->new( -id       => $self->display_id,
01628                    -moltype  => 'dna',
01629                    -alphabet => 'dna',
01630                    -seq      => $seq );
01631 }
01632 
01633 
01634 =head2 get_all_translateable_Exons
01635 
01636   Args       : none
01637   Example    : none
01638   Description: Returns a list of exons that translate with the
01639                start and end exons truncated to the CDS regions.
01640                This function does not take into account any SeqEdits
01641                (post transcriptional RNA modifictions) when constructing the
01642                the 'translateable' exons, and it does not update the phase
01643                information of the created 'translateable' exons.
01644 
01645                If this transcript is a pseudogene (i.e. non-translateable)
01646                a reference to an empty list is returned.
01647 
01648   Returntype : listref Bio::EnsEMBL::Exon
01649   Exceptions : throw if translation has invalid information
01650   Caller     : Genebuild
01651   Status     : Stable
01652 
01653 =cut
01654 
01655 
01656 sub get_all_translateable_Exons {
01657   my ( $self ) = @_;
01658 
01659   #return an empty list if there is no translation (i.e. pseudogene)
01660   my $translation = $self->translation or return [];
01661   my $start_exon      = $translation->start_Exon;
01662   my $end_exon        = $translation->end_Exon;
01663   my $t_start         = $translation->start;
01664   my $t_end           = $translation->end;
01665 
01666   my( @translateable );
01667 
01668   foreach my $ex (@{$self->get_all_Exons}) {
01669 
01670     if ($ex ne $start_exon and ! @translateable) {
01671       next;   # Not yet in translated region
01672     }
01673 
01674     my $length  = $ex->length;
01675 
01676     my $adjust_start = 0;
01677     my $adjust_end = 0;
01678     # Adjust to translation start if this is the start exon
01679     if ($ex == $start_exon ) {
01680       if ($t_start < 1 or $t_start > $length) {
01681         warning("WARN: Translation start '$t_start' is outside exon $ex length=$length");
01682     return [];
01683       }
01684       $adjust_start = $t_start - 1;
01685     }
01686 
01687     # Adjust to translation end if this is the end exon
01688     if ($ex == $end_exon) {
01689 #      if ($t_end < 1 or $t_end > $length) {
01690 #        throw("Translation end '$t_end' is outside exon $ex length=$length");
01691 #      }
01692       $adjust_end = $t_end - $length;
01693     }
01694 
01695     # Make a truncated exon if the translation start or
01696     # end causes the coordinates to be altered.
01697     if ($adjust_end || $adjust_start) {
01698       my $newex = $ex->adjust_start_end( $adjust_start, $adjust_end );
01699 
01700       push( @translateable, $newex );
01701     } else {
01702       push(@translateable, $ex);
01703     }
01704 
01705     # Exit the loop when we've found the last exon
01706     last if $ex eq $end_exon;
01707   }
01708   return \@translateable;
01709 }
01710 
01711 
01712 =head2 translate
01713 
01714   Args       : none
01715   Example    : none
01716   Description: Return the peptide (plus eventual stop codon) for
01717                this transcript.  Does N-padding of non-phase
01718                matching exons.  It uses translateable_seq
01719                internally.  Returns undef if this Transcript does
01720                not have a translation (i.e. pseudogene).
01721   Returntype : Bio::Seq or undef
01722   Exceptions : none
01723   Caller     : general
01724   Status     : Stable
01725 
01726 =cut
01727 
01728 sub translate {
01729   my ($self) = @_;
01730 
01731   if ( !defined( $self->translation() ) ) { return undef }
01732 
01733   my $mrna = $self->translateable_seq();
01734 
01735   # Alternative codon tables (such as the mitochondrial codon table)
01736   # can be specified for a sequence region via the seq_region_attrib
01737   # table.  A list of codon tables and their codes is at:
01738   # http://www.ncbi.nlm.nih.gov/htbin-post/Taxonomy/wprintgc?mode=c
01739 
01740   my $codon_table_id;
01741   my ( $complete5, $complete3 );
01742   if ( defined( $self->slice() ) ) {
01743     my $attrib;
01744 
01745     ($attrib) = @{ $self->slice()->get_all_Attributes('codon_table') };
01746     if ( defined($attrib) ) {
01747       $codon_table_id = $attrib->value();
01748     }
01749 
01750     ($attrib) = @{ $self->slice()->get_all_Attributes('complete5') };
01751     if ( defined($attrib) ) {
01752       $complete5 = $attrib->value();
01753     }
01754 
01755     ($attrib) = @{ $self->slice()->get_all_Attributes('complete3') };
01756     if ( defined($attrib) ) {
01757       $complete3 = $attrib->value();
01758     }
01759   }
01760   $codon_table_id ||= 1;    # default vertebrate codon table
01761 
01762   # Remove final stop codon from the mrna if it is present.  Produced
01763   # peptides will not have '*' at end.  If terminal stop codon is
01764   # desired call translatable_seq directly and produce a translation
01765   # from it.
01766 
01767   if ( CORE::length($mrna) % 3 == 0 ) {
01768     my $codon_table =
01769       Bio::Tools::CodonTable->new( -id => $codon_table_id );
01770 
01771     if ( $codon_table->is_ter_codon( substr( $mrna, -3, 3 ) ) ) {
01772       substr( $mrna, -3, 3, '' );
01773     }
01774   }
01775 
01776   if ( CORE::length($mrna) < 1 ) { return undef }
01777 
01778   my $display_id = $self->translation->display_id()
01779     || scalar( $self->translation() );
01780 
01781   my $peptide = Bio::Seq->new( -seq      => $mrna,
01782                                -moltype  => 'dna',
01783                                -alphabet => 'dna',
01784                                -id       => $display_id );
01785 
01786   my $translation =
01787     $peptide->translate( undef, undef, undef, $codon_table_id, undef,
01788                          undef, $complete5, $complete3 );
01789 
01790   if ( $self->edits_enabled() ) {
01791     $self->translation()->modify_translation($translation);
01792   }
01793 
01794   return $translation;
01795 } ## end sub translate
01796 
01797 
01798 =head2 seq
01799 
01800   Description: Returns a Bio::Seq object which consists of just
01801              : the sequence of the exons concatenated together,
01802              : without messing about with padding with N\'s from
01803              : Exon phases like B<dna_seq> does.
01804   Args       : none
01805   Example    : none
01806   Returntype : Bio::Seq
01807   Exceptions : none
01808   Caller     : general
01809   Status     : Stable
01810 
01811 =cut
01812 
01813 sub seq {
01814   my ($self) = @_;
01815 
01816   return
01817     Bio::Seq->new( -id       => $self->display_id,
01818                    -moltype  => 'dna',
01819                    -alphabet => 'dna',
01820                    -seq      => $self->spliced_seq );
01821 }
01822 
01823 
01824 =head2 pep2genomic
01825 
01826   Description: See Bio::EnsEMBL::TranscriptMapper::pep2genomic
01827 
01828 =cut
01829 
01830 sub pep2genomic {
01831   my $self = shift;
01832   return $self->get_TranscriptMapper()->pep2genomic(@_);
01833 }
01834 
01835 
01836 =head2 genomic2pep
01837 
01838   Description: See Bio::EnsEMBL::TranscriptMapper::genomic2pep
01839 
01840 =cut
01841 
01842 sub genomic2pep {
01843   my $self = shift;
01844   return $self->get_TranscriptMapper()->genomic2pep(@_);
01845 }
01846 
01847 
01848 =head2 cdna2genomic
01849 
01850   Description: See Bio::EnsEMBL::TranscriptMapper::cdna2genomic
01851 
01852 =cut
01853 
01854 sub cdna2genomic {
01855   my $self = shift;
01856   return $self->get_TranscriptMapper()->cdna2genomic(@_);
01857 }
01858 
01859 
01860 =head2 genomic2cdna
01861 
01862   Description: See Bio::EnsEMBL::TranscriptMapper::genomic2cdna
01863 
01864 =cut
01865 
01866 sub genomic2cdna {
01867   my $self = shift;
01868   return $self->get_TranscriptMapper->genomic2cdna(@_);
01869 }
01870 
01871 
01872 =head2 get_TranscriptMapper
01873 
01874   Args       : none
01875   Example    : my $trans_mapper = $transcript->get_TranscriptMapper();
01876   Description: Gets a TranscriptMapper object which can be used to perform
01877                a variety of coordinate conversions relating this transcript,
01878                genomic sequence and peptide resulting from this transcripts
01879                translation.
01880   Returntype : Bio::EnsEMBL::TranscriptMapper
01881   Exceptions : none
01882   Caller     : cdna2genomic, pep2genomic, genomic2cdna, cdna2genomic
01883   Status     : Stable
01884 
01885 =cut
01886 
01887 sub get_TranscriptMapper {
01888   my ( $self ) = @_;
01889   return $self->{'transcript_mapper'} ||=
01890     Bio::EnsEMBL::TranscriptMapper->new($self);
01891 }
01892 
01893 
01894 =head2 start_Exon
01895 
01896  Title       : start_Exon
01897  Usage       : $start_exon = $transcript->start_Exon;
01898  Returntype  : Bio::EnsEMBL::Exon
01899  Description : The first exon in the transcript.
01900  Args        : NONE
01901  Status      : Stable
01902 
01903 =cut
01904 
01905 sub start_Exon {
01906   my $self = shift;
01907   return $self->get_all_Exons()->[0];
01908 }
01909 
01910 
01911 =head2 end_Exon
01912 
01913  Title       : end_exon
01914  Usage       : $end_exon = $transcript->end_Exon;
01915  Description : The last exon in the transcript.
01916  Returntype  : Bio::EnsEMBL::Exon
01917  Args        : NONE
01918  Status      : Stable
01919 
01920 =cut
01921 
01922 sub end_Exon {
01923    my $self = shift;
01924    return $self->get_all_Exons()->[-1];
01925 }
01926 
01927 
01928 =head2 description
01929 
01930  Title   : description
01931  Usage   : $obj->description($newval)
01932  Function: 
01933  Returns : String
01934  Args    : newvalue (optional)
01935  Status  : Stable
01936 
01937 =cut
01938 
01939 sub description {
01940   my $self = shift;
01941   $self->{'description'} = shift if( @_ );
01942   return $self->{'description'};
01943 }
01944 
01945 
01946 =head2 version
01947 
01948  Title   : version
01949  Usage   : $obj->version()
01950  Function: 
01951  Returns : String
01952  Args    : 
01953  Status  : Stable
01954 
01955 =cut
01956 
01957 sub version {
01958   my $self = shift;
01959   $self->{'version'} = shift if( @_ );
01960   return $self->{'version'};
01961 }
01962 
01963 
01964 =head2 stable_id
01965 
01966  Title   : stable_id
01967  Usage   : $obj->stable_id
01968  Function: 
01969  Returns : String
01970  Args    : 
01971  Status  : Stable
01972 
01973 =cut
01974 
01975 sub stable_id {
01976   my $self = shift;
01977   $self->{'stable_id'} = shift if( @_ );
01978   return $self->{'stable_id'};
01979 }
01980 
01981 
01982 =head2 is_current
01983 
01984   Arg [1]    : Boolean $is_current
01985   Example    : $transcript->is_current(1)
01986   Description: Getter/setter for is_current state of this transcript.
01987   Returntype : Int
01988   Exceptions : none
01989   Caller     : general
01990   Status     : Stable
01991 
01992 =cut
01993 
01994 sub is_current {
01995   my $self = shift;
01996   $self->{'is_current'} = shift if (@_);
01997   return $self->{'is_current'};
01998 }
01999 
02000 
02001 =head2 created_date
02002 
02003   Arg [1]    : (optional) string to be used for the created date
02004   Example    : none
02005   Description: get/set for attribute created date
02006   Returntype : string
02007   Exceptions : none
02008   Caller     : general
02009   Status     : Stable
02010 
02011 =cut
02012 
02013 sub created_date {
02014   my $self = shift;
02015   $self->{'created_date'} = shift if ( @_ );
02016   return $self->{'created_date'};
02017 }
02018 
02019 
02020 =head2 modified_date
02021 
02022   Arg [1]    : (optional) string to be used for the modified date
02023   Example    : none
02024   Description: get/set for attribute modified date
02025   Returntype : string
02026   Exceptions : none
02027   Caller     : general
02028   Status     : Stable
02029 
02030 =cut
02031 
02032 sub modified_date {
02033   my $self = shift;
02034   $self->{'modified_date'} = shift if ( @_ );
02035   return $self->{'modified_date'};
02036 }
02037 
02038 
02039 =head2 swap_exons
02040 
02041   Arg [1]    : Bio::EnsEMBL::Exon $old_Exon
02042                An exon that should be replaced
02043   Arg [2]    : Bio::EnsEMBL::Exon $new_Exon
02044                The replacement Exon
02045   Example    : none
02046   Description: exchange an exon in the current Exon list with a given one.
02047                Usually done before storing of Gene, so the Exons can
02048                be shared between Transcripts.
02049   Returntype : none
02050   Exceptions : none
02051   Caller     : GeneAdaptor->store()
02052   Status     : Stable
02053 
02054 =cut
02055 
02056 sub swap_exons {
02057   my ( $self, $old_exon, $new_exon ) = @_;
02058   
02059   my $arref = $self->{'_trans_exon_array'};
02060   for(my $i = 0; $i < @$arref; $i++) {
02061     if($arref->[$i] == $old_exon) {
02062       $arref->[$i] = $new_exon;
02063       last;
02064     }
02065   }
02066 
02067   if( defined $self->{'translation'} ) {
02068      if( $self->translation()->start_Exon() == $old_exon ) {
02069       $self->translation()->start_Exon( $new_exon );
02070     }
02071     if( $self->translation()->end_Exon() == $old_exon ) {
02072       $self->translation()->end_Exon( $new_exon );
02073     }
02074   }
02075 }
02076 
02077 
02078 =head2 equals
02079 
02080   Arg [1]       : Bio::EnsEMBL::Transcript transcript
02081   Example       : if ($transcriptA->equals($transcriptB)) { ... }
02082   Description   : Compares two transcripts for equality.
02083                   The test for eqality goes through the following list
02084                   and terminates at the first true match:
02085 
02086                   1. If Bio::EnsEMBL::Feature::equals() returns false,
02087                      then the transcripts are *not* equal.
02088                   2. If the biotypes differ, then the transcripts are
02089                      *not* equal.
02090                   3. If both transcripts have stable IDs: if these are
02091                      the same, the transcripts are equal, otherwise not.
02092                   4. If both transcripts have the same number of exons
02093                      and if these are (when compared pair-wise sorted by
02094                      start-position and length) the same, then they are
02095                      equal, otherwise not.
02096 
02097   Return type   : Boolean (0, 1)
02098 
02099   Exceptions    : Thrown if a non-transcript is passed as the argument.
02100 
02101 =cut
02102 
02103 sub equals {
02104   my ( $self, $transcript ) = @_;
02105 
02106   if ( !defined($transcript) ) { return 0 }
02107   if ( $self eq $transcript ) { return 1 }
02108 
02109   assert_ref( $transcript, 'Bio::EnsEMBL::Transcript' );
02110 
02111   my $feature_equals = $self->SUPER::equals($transcript);
02112   if ( defined($feature_equals) && $feature_equals == 0 ) {
02113     return 0;
02114   }
02115 
02116   if ( $self->biotype() ne $transcript->biotype() ) {
02117     return 0;
02118   }
02119 
02120   if ( defined( $self->stable_id() ) &&
02121        defined( $transcript->stable_id() ) )
02122   {
02123     if ( $self->stable_id() eq $transcript->stable_id() ) {
02124       return 1;
02125     }
02126     else {
02127       return 0;
02128     }
02129   }
02130 
02131   my @self_exons = sort {
02132     $a->start() <=> $b->start() ||
02133       $a->length() <=> $b->length()
02134   } @{ $self->get_all_Exons() };
02135   my @transcript_exons = sort {
02136     $a->start() <=> $b->start() ||
02137       $a->length() <=> $b->length()
02138   } @{ $transcript->get_all_Exons() };
02139 
02140   if ( scalar(@self_exons) != scalar(@transcript_exons) ) {
02141     return 0;
02142   }
02143 
02144   while (@self_exons) {
02145     my $self_exon       = shift(@self_exons);
02146     my $transcript_exon = shift(@transcript_exons);
02147 
02148     if ( !$self_exon->equals($transcript_exon) ) {
02149       return 0;
02150     }
02151   }
02152 
02153   return 1;
02154 } ## end sub equals
02155 
02156 =head2 transform
02157 
02158   Arg  1     : String $coordinate_system_name
02159   Arg [2]    : String $coordinate_system_version
02160   Example    : $transcript = $transcript->transform('contig');
02161                $transcript = $transcript->transform('chromosome', 'NCBI33');
02162   Description: Moves this Transcript to the given coordinate system.
02163                If this Transcript has Exons attached, they move as well.
02164                A new Transcript is returned. If the transcript cannot be
02165                transformed to the destination coordinate system undef is
02166                returned instead.
02167   Returntype : Bio::EnsEMBL::Transcript
02168   Exceptions : wrong parameters
02169   Caller     : general
02170   Status     : Medium Risk
02171              : deprecation needs to be removed at some time
02172 
02173 =cut
02174 
02175 
02176 sub transform {
02177   my $self = shift;
02178 
02179   # catch for old style transform calls
02180   if( ref $_[0] eq 'HASH') {
02181     deprecate("Calling transform with a hashref is deprecate.\n" .
02182               'Use $trans->transfer($slice) or ' .
02183               '$trans->transform("coordsysname") instead.');
02184     my (undef, $new_ex) = each(%{$_[0]});
02185     return $self->transfer($new_ex->slice);
02186   }
02187 
02188   my $new_transcript = $self->SUPER::transform(@_);
02189   if ( !defined($new_transcript) ) {
02190     my @segments = @{ $self->project(@_) };
02191     # if it projects, maybe the exons transform well?
02192     # lazy load them here
02193     if ( !@segments ) {
02194       return undef;
02195     }
02196     $self->get_all_Exons();
02197   }
02198 
02199 
02200   if( exists $self->{'_trans_exon_array'} ) {
02201     my @new_exons;
02202     my ( $low_start, $hi_end, $slice );
02203     # we want to check whether the transform preserved 5prime 3prime
02204     # ordering. This assumes 5->3 order. No complaints on transsplicing.
02205 
02206     my ( $last_new_start, $last_old_strand, 
02207      $last_new_strand, $start_exon, $end_exon,
02208     $last_seq_region_name );
02209     my $first = 1;
02210     my $ignore_order = 0;
02211     my $order_broken = 0;
02212 
02213     for my $old_exon ( @{$self->{'_trans_exon_array'}} ) {      
02214       my $new_exon = $old_exon->transform( @_ );
02215       return undef if( !defined $new_exon );
02216       if( ! defined $new_transcript ) {
02217     if( !$first ) {
02218       if( $old_exon->strand() != $last_old_strand ) {
02219         # transsplicing, ignore ordering
02220         $ignore_order = 1;  
02221       }
02222 
02223       if( $new_exon->slice()->seq_region_name() ne 
02224           $last_seq_region_name ) {
02225         return undef;
02226       }
02227 
02228       if( $last_new_strand == 1 and 
02229           $new_exon->start() < $last_new_start ) {
02230         $order_broken = 1;
02231       }
02232 
02233       if( $last_new_strand == -1 and
02234           $new_exon->start() > $last_new_start ) {
02235         $order_broken = 1;
02236       }
02237 
02238     #additional check that if exons were on same strand previously, they should be again
02239     if(($last_old_strand == $old_exon->strand()) and !($last_new_strand == $new_exon->strand())){
02240       return undef;
02241     }
02242 
02243       if( $new_exon->start() < $low_start ) {
02244         $low_start = $new_exon->start();
02245       }
02246       if( $new_exon->end() > $hi_end ) {
02247         $hi_end = $new_exon->end();
02248       }
02249     } else {
02250       $first = 0;
02251       $low_start = $new_exon->start();
02252       $hi_end = $new_exon->end();
02253     }
02254 
02255     $last_seq_region_name = $new_exon->slice()->seq_region_name();
02256     $last_old_strand = $old_exon->strand();
02257     $last_new_start = $new_exon->start();
02258     $last_new_strand = $new_exon->strand();
02259       }
02260 
02261       if( defined $self->{'translation'} ) {
02262         if( $self->translation()->start_Exon() == $old_exon ) {
02263           $start_exon = $new_exon;
02264         }
02265         if( $self->translation()->end_Exon() == $old_exon ) {
02266           $end_exon = $new_exon;
02267         }
02268       }
02269       push( @new_exons, $new_exon );
02270     }
02271 
02272     if( $order_broken && !$ignore_order ) {
02273       warning( "Order of exons broken in transform of ".$self->dbID() ); 
02274       return undef;
02275     }
02276 
02277     if( !defined $new_transcript ) {
02278       %$new_transcript = %$self;
02279       bless $new_transcript, ref( $self );
02280       $new_transcript->start( $low_start );
02281       $new_transcript->end( $hi_end );
02282       $new_transcript->slice( $new_exons[0]->slice() );
02283       $new_transcript->strand( $new_exons[0]->strand() );
02284     }
02285 
02286     $new_transcript->{'_trans_exon_array'} = \@new_exons;
02287 
02288     # should be ok to do inside exon array loop
02289     # translations only exist together with the exons ...
02290 
02291     if( defined $self->{'translation'} ) {
02292       my $new_translation;
02293       %$new_translation = %{$self->{'translation'}};;
02294       bless $new_translation, ref( $self->{'translation'} );
02295       $new_transcript->{'translation'} = $new_translation;
02296       $new_translation->start_Exon( $start_exon );
02297       $new_translation->end_Exon( $end_exon );
02298     }
02299   }
02300 
02301   if( exists $self->{'_supporting_evidence'} ) {
02302     my @new_features;
02303     for my $old_feature ( @{$self->{'_supporting_evidence'}} ) {
02304       my $new_feature = $old_feature->transform( @_ );
02305       if (defined $new_feature) { 
02306         push @new_features, $new_feature;
02307       }
02308     }
02309     $new_transcript->{'_supporting_evidence'} = \@new_features;
02310   }
02311 
02312 
02313   # flush cached internal values that depend on the exon coords
02314   $new_transcript->{'transcript_mapper'}   = undef;
02315   $new_transcript->{'coding_region_start'} = undef;
02316   $new_transcript->{'coding_region_end'}   = undef;
02317   $new_transcript->{'cdna_coding_start'}   = undef;
02318   $new_transcript->{'cdna_coding_end'}     = undef;
02319 
02320   return $new_transcript;
02321 }
02322 
02323 
02324 =head2 transfer
02325 
02326   Arg  1     : Bio::EnsEMBL::Slice $destination_slice
02327   Example    : $transcript = $transcript->transfer($slice);
02328   Description: Moves this transcript to the given slice.
02329                If this Transcripts has Exons attached, they move as well.
02330   Returntype : Bio::EnsEMBL::Transcript
02331   Exceptions : none
02332   Caller     : general
02333   Status     : Stable
02334 
02335 =cut
02336 
02337 
02338 sub transfer {
02339   my $self = shift;
02340 
02341   my $new_transcript = $self->SUPER::transfer( @_ );
02342   return undef unless $new_transcript;
02343 
02344   if( defined $self->{'translation'} ) {
02345     my $new_translation;
02346     %$new_translation = %{$self->{'translation'}};;
02347     bless $new_translation, ref( $self->{'translation'} );
02348     $new_transcript->{'translation'} = $new_translation;
02349   }
02350 
02351   if( exists $self->{'_trans_exon_array'} ) {
02352     my @new_exons;
02353     for my $old_exon ( @{$self->{'_trans_exon_array'}} ) {
02354       my $new_exon = $old_exon->transfer( @_ );
02355       if( defined $new_transcript->{'translation'} ) {
02356         if( $new_transcript->translation()->start_Exon() == $old_exon ) {
02357           $new_transcript->translation()->start_Exon( $new_exon );
02358         }
02359         if( $new_transcript->translation()->end_Exon() == $old_exon ) {
02360           $new_transcript->translation()->end_Exon( $new_exon );
02361         }
02362       }
02363       push( @new_exons, $new_exon );
02364     }
02365 
02366     $new_transcript->{'_trans_exon_array'} = \@new_exons;
02367   }
02368 
02369   if( exists $self->{'_supporting_evidence'} ) {
02370     my @new_features;
02371     for my $old_feature ( @{$self->{'_supporting_evidence'}} ) {
02372       my $new_feature = $old_feature->transfer( @_ );
02373       push( @new_features, $new_feature );
02374     }
02375     $new_transcript->{'_supporting_evidence'} = \@new_features;
02376   }
02377 
02378 
02379   # flush cached internal values that depend on the exon coords
02380   $new_transcript->{'transcript_mapper'}   = undef;
02381   $new_transcript->{'coding_region_start'} = undef;
02382   $new_transcript->{'coding_region_end'}   = undef;
02383   $new_transcript->{'cdna_coding_start'}   = undef;
02384   $new_transcript->{'cdna_coding_end'}     = undef;
02385 
02386   return $new_transcript;
02387 }
02388 
02389 
02390 =head recalculate_coordinates
02391 
02392   Args       : none
02393   Example    : none
02394   Description: called when exon coordinate change happened to recalculate the
02395                coords of the transcript.  This method should be called if one
02396                of the exons has been changed.
02397   Returntype : none
02398   Exceptions : none
02399   Caller     : internal
02400   Status     : Stable
02401 
02402 =cut
02403 
02404 sub recalculate_coordinates {
02405   my ($self) = @_;
02406 
02407   my $exons = $self->get_all_Exons();
02408 
02409   if ( !$exons || !@{$exons} ) { return }
02410 
02411   my ( $slice, $start, $end, $strand );
02412 
02413   my $e_index;
02414   for ( $e_index = 0; $e_index < @{$exons}; $e_index++ ) {
02415     my $e = $exons->[$e_index];
02416 
02417     # Skip missing or unmapped exons!
02418     if ( defined($e) && defined( $e->start() ) ) {
02419       $slice  = $e->slice();
02420       $strand = $e->strand();
02421       $start  = $e->start();
02422       $end    = $e->end();
02423 
02424       last;
02425     }
02426   }
02427 
02428   my $transsplicing = 0;
02429 
02430   # Start loop after first exon with coordinates
02431   for ( ; $e_index < @{$exons}; $e_index++ ) {
02432     my $e = $exons->[$e_index];
02433 
02434     # Skip missing or unmapped exons!
02435     if ( !defined($e) || !defined( $e->start() ) ) { next }
02436 
02437     if ( $e->start() < $start ) {
02438       $start = $e->start();
02439     }
02440 
02441     if ( $e->end() > $end ) {
02442       $end = $e->end();
02443     }
02444 
02445     if (    defined($slice)
02446          && $e->slice()
02447          && $e->slice()->name() ne $slice->name() )
02448     {
02449       throw(   "Exons with different slices "
02450              . "are not allowed on one Transcript" );
02451     }
02452 
02453     if ( $e->strand() != $strand ) {
02454       $transsplicing = 1;
02455     }
02456   } ## end for ( ; $e_index < @{$exons...})
02457   if ($transsplicing) {
02458     warning("Transcript contained trans splicing event");
02459   }
02460 
02461   $self->start($start);
02462   $self->end($end);
02463   $self->strand($strand);
02464   $self->slice($slice);
02465 
02466   # flush cached internal values that depend on the exon coords
02467   $self->{'transcript_mapper'}   = undef;
02468   $self->{'coding_region_start'} = undef;
02469   $self->{'coding_region_end'}   = undef;
02470   $self->{'cdna_coding_start'}   = undef;
02471   $self->{'cdna_coding_end'}     = undef;
02472 } ## end sub recalculate_coordinates
02473 
02474 
02475 =head2 display_id
02476 
02477   Arg [1]    : none
02478   Example    : print $transcript->display_id();
02479   Description: This method returns a string that is considered to be
02480                the 'display' identifier. For transcripts this is (depending on
02481                availability and in this order) the stable Id, the dbID or an
02482                empty string.
02483   Returntype : string
02484   Exceptions : none
02485   Caller     : web drawing code
02486   Status     : Stable
02487 
02488 =cut
02489 
02490 sub display_id {
02491   my $self = shift;
02492   return $self->{'stable_id'} || $self->dbID || '';
02493 }
02494 
02495 
02496 =head2 get_all_peptide_variations
02497 
02498   Description: See Bio::EnsEMBL::Utils::TranscriptSNPs::get_all_peptide_variations
02499   Status  : At Risk
02500           : Will be replaced with modules from the ensembl-variation package
02501 
02502 
02503 =cut
02504 
02505 sub get_all_peptide_variations {
02506   my ($self, $source, $snps) = @_;
02507 
02508   if(!$snps) {
02509     my $shash = Bio::EnsEMBL::Utils::TranscriptSNPs::get_all_cdna_SNPs($self, $source);
02510     $snps = $shash->{'coding'};
02511   }
02512 
02513   return Bio::EnsEMBL::Utils::TranscriptSNPs::get_all_peptide_variations($self,
02514                                                                         $snps);
02515 }
02516 
02517 
02518 =head2 get_all_SNPs
02519 
02520   Description: See Bio::EnsEMBL::Utils::TranscriptSNPs::get_all_SNPs
02521 
02522   Status  : At Risk
02523           : Will be replaced with modules from the ensembl-variation package
02524 
02525 =cut
02526 
02527 sub get_all_SNPs {
02528   return Bio::EnsEMBL::Utils::TranscriptSNPs::get_all_SNPs(@_);
02529 }
02530 
02531 
02532 =head2 get_all_cdna_SNPs
02533 
02534   Description: See Bio::EnsEMBL::Utils::TranscriptSNPs::get_all_cdna_SNPs
02535  
02536   Status  : At Risk
02537           : Will be replaced with modules from the ensembl-variation package
02538 
02539 =cut
02540 
02541 sub get_all_cdna_SNPs {
02542   return Bio::EnsEMBL::Utils::TranscriptSNPs::get_all_cdna_SNPs(@_);
02543 }
02544 
02545 
02546 =head2 get_all_DASFactories
02547 
02548   Arg [1]   : none
02549   Function  : Retrieves a listref of registered DAS objects
02550   Returntype: [ DAS_objects ]
02551   Exceptions:
02552   Caller    :
02553   Example   : $dasref = $prot->get_all_DASFactories
02554   Status    : Stable
02555 
02556 =cut
02557 
02558 sub get_all_DASFactories {
02559    my $self = shift;
02560    return [ $self->adaptor()->db()->_each_DASFeatureFactory ];
02561 }
02562 
02563 
02564 =head2 get_all_DAS_Features
02565 
02566   Arg [1]    : none
02567   Example    : $features = $prot->get_all_DAS_Features;
02568   Description: Retreives a hash reference to a hash of DAS feature
02569                sets, keyed by the DNS, NOTE the values of this hash
02570                are an anonymous array containing:
02571                 (1) a pointer to an array of features;
02572                 (2) a pointer to the DAS stylesheet
02573   Returntype : hashref of Bio::SeqFeatures
02574   Exceptions : ?
02575   Caller     : webcode
02576   Status    : Stable
02577 
02578 
02579 =cut
02580 
02581 sub get_all_DAS_Features {
02582   my ($self,@args) = @_;
02583 
02584   my $db = $self->adaptor->db;
02585   my $GeneAdaptor = $db->get_GeneAdaptor;
02586   my $Gene = $GeneAdaptor->fetch_by_transcript_stable_id($self->stable_id); 
02587   my $slice = $Gene->feature_Slice;
02588   return $self->SUPER::get_all_DAS_Features($slice);
02589 }
02590 
02591 
02592 
02593 =head2 _compare_xrefs
02594 
02595   Description: compare xrefs based on priority (descending), then
02596                name (ascending), then display_label (ascending)
02597 
02598 =cut
02599 
02600 sub _compare_xrefs {
02601   # compare on priority first (descending)
02602   if ( $a->priority() != $b->priority() ) {
02603     return $b->priority() <=> $a->priority();
02604   } else {
02605     # equal priorities, compare on external_db name
02606     if ( $a->dbname() ne $b->dbname() ) {
02607       return $a->dbname() cmp $b->dbname();
02608     } else {
02609       # equal priorities and names, compare on display_label
02610       return $a->display_id() cmp $b->display_id();
02611     }
02612   }
02613 }
02614 
02615 
02616 =head2 load
02617 
02618   Arg [1]       : Boolean $load_xrefs
02619                   Load (or don't load) xrefs.  Default is to load xrefs.
02620   Example       : $transcript->load();
02621   Description   : The Ensembl API makes extensive use of
02622                   lazy-loading.  Under some circumstances (e.g.,
02623                   when copying genes between databases), all data of
02624                   an object needs to be fully loaded.  This method
02625                   loads the parts of the object that are usually
02626                   lazy-loaded.  It will also call the equivalent
02627                   method on any translation and on all exons of the
02628                   transcript.
02629   Returntype    : None
02630 
02631 =cut
02632 
02633 sub load {
02634   my ( $self, $load_xrefs ) = @_;
02635 
02636   if ( !defined($load_xrefs) ) { $load_xrefs = 1 }
02637 
02638   my $translation = $self->translation();
02639   if ( defined($translation) ) {
02640     $translation->load($load_xrefs);
02641 
02642     my $alt_translations = $self->get_all_alternative_translations();
02643 
02644     if ( defined($alt_translations) ) {
02645       foreach my $alt_translation ( @{$alt_translations} ) {
02646         $alt_translation->load($load_xrefs);
02647       }
02648     }
02649   }
02650 
02651   foreach my $exon ( @{ $self->get_all_Exons() } ) {
02652     $exon->load();
02653   }
02654 
02655   $self->stable_id();
02656   $self->analysis();
02657   $self->get_all_Attributes();
02658   $self->get_all_supporting_features();
02659 
02660   if ($load_xrefs) {
02661     $self->get_all_DBEntries();
02662   }
02663 
02664 } ## end sub load
02665 
02666 =head2 summary_as_hash
02667 
02668   Example       : $transcript_summary = $transcript->summary_as_hash();
02669   Description   : Extends Feature::summary_as_hash
02670                   Retrieves a summary of this Transcript.
02671   Returns       : hashref of descriptive strings
02672   Status        : Intended for internal use
02673 =cut
02674 
02675 sub summary_as_hash {
02676   my $self = shift;
02677   my $summary_ref = $self->SUPER::summary_as_hash;
02678   $summary_ref->{'description'} = $self->description;
02679   $summary_ref->{'biotype'} = $self->biotype;
02680   my $parent_gene = $self->get_Gene();
02681   $summary_ref->{'Parent'} = $parent_gene->display_id;
02682   return $summary_ref;
02683 }
02684 
02685 =head2 get_Gene
02686   
02687   Example     : $gene = $transcript->get_Gene;
02688   Description : Locates the parent Gene using a transcript dbID
02689   Returns     : Bio::EnsEMBL::Gene
02690 
02691 =cut
02692 
02693 sub get_Gene {
02694   my $self = shift;
02695   my $gene_adaptor = $self->adaptor->db->get_GeneAdaptor();
02696   my $parent_gene = $gene_adaptor->fetch_by_transcript_id($self->dbID);
02697   return $parent_gene;
02698 }
02699 
02700 ###########################
02701 # DEPRECATED METHODS FOLLOW
02702 ###########################
02703 
02704 =head2 sort
02705 
02706   Description: DEPRECATED.  This method is no longer needed.  Exons are sorted
02707                automatically when added to the transcript.
02708 
02709 =cut
02710 
02711 sub sort {
02712   my $self = shift;
02713 
02714   deprecate( "Exons are kept sorted, you dont have to call sort any more" );
02715   # Fetch all the features
02716   my @exons = @{$self->get_all_Exons()};
02717   
02718   # Empty the feature table
02719   $self->flush_Exons();
02720 
02721   # Now sort the exons and put back in the feature table
02722   my $strand = $exons[0]->strand;
02723 
02724   if ($strand == 1) {
02725     @exons = sort { $a->start <=> $b->start } @exons;
02726   } elsif ($strand == -1) {
02727     @exons = sort { $b->start <=> $a->start } @exons;
02728   }
02729 
02730   foreach my $e (@exons) {
02731     $self->add_Exon($e);
02732   }
02733 }
02734 
02735 
02736 # _translation_id
02737 # Usage   : DEPRECATED - not needed anymore
02738 
02739 sub _translation_id {
02740    my $self = shift;
02741    deprecate( "This method shouldnt be necessary any more" );
02742    if( @_ ) {
02743       my $value = shift;
02744       $self->{'_translation_id'} = $value;
02745     }
02746     return $self->{'_translation_id'};
02747 
02748 }
02749 
02750 
02751 =head2 created
02752 
02753  Description: DEPRECATED - this attribute is not part of transcript anymore
02754 
02755 =cut
02756 
02757 sub created{
02758    my $obj = shift;
02759    deprecate( "This attribute is no longer supported" );
02760    if( @_ ) {
02761       my $value = shift;
02762       $obj->{'created'} = $value;
02763     }
02764     return $obj->{'created'};
02765 }
02766 
02767 
02768 =head2 modified
02769 
02770   Description: DEPRECATED - this attribute is not part of transcript anymore
02771 
02772 =cut
02773 
02774 sub modified{
02775    my $obj = shift;
02776    deprecate( "This attribute is no longer supported" );
02777    if( @_ ) {
02778       my $value = shift;
02779       $obj->{'modified'} = $value;
02780     }
02781     return $obj->{'modified'};
02782 }
02783 
02784 
02785 =head2 temporary_id
02786 
02787  Function: DEPRECATED: Use dbID or stable_id or something else instead
02788 
02789 =cut
02790 
02791 sub temporary_id{
02792    my ($obj,$value) = @_;
02793    deprecate( "I cant see what a temporary_id is good for, please use dbID" .
02794                "or stableID or\ntry without an id." );
02795    if( defined $value) {
02796       $obj->{'temporary_id'} = $value;
02797     }
02798     return $obj->{'temporary_id'};
02799 }
02800 
02801 
02802 =head2 type
02803 
02804   Description: DEPRECATED. Use biotype() instead.
02805 
02806 =cut
02807 
02808 sub type {
02809   deprecate("Use biotype() instead");
02810   biotype(@_);
02811 }
02812 
02813 
02814 =head2 confidence
02815 
02816   Description: DEPRECATED. Use status() instead.
02817 
02818 =cut
02819 
02820 sub confidence {
02821   deprecate("Use status() instead");
02822   status(@_);
02823 }
02824 
02825 
02826 1;
02827