Gene.pm 35.1 KB
Newer Older
1 2
=head1 LICENSE

3
  Copyright (c) 1999-2010 The European Bioinformatics Institute and
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
  Genome Research Limited.  All rights reserved.

  This software is distributed under a modified Apache license.
  For license details, please see

    http://www.ensembl.org/info/about/code_licence.html

=head1 CONTACT

  Please email comments or questions to the public Ensembl
  developers list at <ensembl-dev@ebi.ac.uk>.

  Questions may also be sent to the Ensembl help desk at
  <helpdesk@ensembl.org>.

=cut
Ewan Birney's avatar
Ewan Birney committed
20 21 22

=head1 NAME

23
Bio::EnsEMBL::Gene - Object representing a genes
Ewan Birney's avatar
Ewan Birney committed
24 25 26

=head1 SYNOPSIS

27
  my $gene = Bio::EnsEMBL::Gene->new(
28 29 30 31
    -START  => 123,
    -END    => 1045,
    -STRAND => 1,
    -SLICE  => $slice
32 33 34
  );

  # print gene information
35 36 37
  print("gene start:end:strand is "
      . join( ":", map { $gene->$_ } qw(start end strand) )
      . "\n" );
38 39 40 41

  # set some additional attributes
  $gene->stable_id('ENSG000001');
  $gene->description('This is the gene description');
Ewan Birney's avatar
Ewan Birney committed
42 43 44

=head1 DESCRIPTION

45 46 47
A representation of a Gene within the Ensembl system. A gene is a set of one or
more alternative transcripts.

48
=head1 METHODS
Ewan Birney's avatar
Ewan Birney committed
49 50 51

=cut

52 53
package Bio::EnsEMBL::Gene;

Ewan Birney's avatar
Ewan Birney committed
54 55
use strict;

Glenn Proctor's avatar
Glenn Proctor committed
56
use POSIX;
57 58 59
use Bio::EnsEMBL::Feature;
use Bio::EnsEMBL::Utils::Argument qw(rearrange);
use Bio::EnsEMBL::Utils::Exception qw(throw warning deprecate);
Ewan Birney's avatar
Ewan Birney committed
60

61
use vars qw(@ISA);
62
@ISA = qw(Bio::EnsEMBL::Feature);
Ewan Birney's avatar
Ewan Birney committed
63

64 65 66

=head2 new

67 68 69 70 71
  Arg [-START]  : 
       int - start postion of the gene
  Arg [-END]    : 
       int - end position of the gene
  Arg [-STRAND] : 
72
       int - 1,-1 tehe strand the gene is on
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
  Arg [-SLICE]  : 
       Bio::EnsEMBL::Slice - the slice the gene is on
  Arg [-STABLE_ID] :
        string - the stable identifier of this gene
  Arg [-VERSION] :
        int - the version of the stable identifier of this gene
  Arg [-EXTERNAL_NAME] :
        string - the external database name associated with this gene
  Arg [-EXTERNAL_DB] :
        string - the name of the database the external name is from
  Arg [-EXTERNAL_STATUS]:
        string - the status of the external identifier
  Arg [-DISPLAY_XREF]:
        Bio::EnsEMBL::DBEntry - The external database entry that is used
        to label this gene when it is displayed.
88 89
  Arg [-TRANSCRIPTS]:
        Listref of Bio::EnsEMBL::Transcripts - this gene's transcripts
90 91 92 93 94 95 96 97
  Arg [-CREATED_DATE]:
        string - the date the gene was created
  Arg [-MODIFIED_DATE]:
        string - the date the gene was last modified
  Arg [-DESCRIPTION]:
        string - the genes description
  Arg [-BIOTYPE]:
        string - the biotype e.g. "protein_coding"
98 99
  Arg [-STATUS]:
        string - the gene status i.e. "KNOWN","NOVEL"
100 101 102 103 104
  Arg [-SOURCE]:
        string - the genes source, e.g. "ensembl"
  Arg [-IS_CURRENT]:
        Boolean - specifies if this is the current version of the gene
  Example    : $gene = Bio::EnsEMBL::Gene->new(...);
105 106 107 108
  Description: Creates a new gene object
  Returntype : Bio::EnsEMBL::Gene
  Exceptions : none
  Caller     : general
109
  Status     : Stable
110 111

=cut
Ewan Birney's avatar
Ewan Birney committed
112

Arne Stabenau's avatar
Arne Stabenau committed
113
sub new {
114
  my $caller = shift;
115

116 117
  my $class = ref($caller) || $caller;
  my $self = $class->SUPER::new(@_);
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
  my (
    $stable_id,               $version,
    $external_name,           $type,
    $external_db,             $external_status,
    $display_xref,            $description,
    $transcripts,             $created_date,
    $modified_date,           $confidence,
    $biotype,                 $source,
    $status,                  $is_current,
    $canonical_transcript_id, $canonical_transcript,
    $canonical_annotation
    )
    = rearrange( [
      'STABLE_ID',               'VERSION',
      'EXTERNAL_NAME',           'TYPE',
      'EXTERNAL_DB',             'EXTERNAL_STATUS',
      'DISPLAY_XREF',            'DESCRIPTION',
      'TRANSCRIPTS',             'CREATED_DATE',
      'MODIFIED_DATE',           'CONFIDENCE',
      'BIOTYPE',                 'SOURCE',
      'STATUS',                  'IS_CURRENT',
      'CANONICAL_TRANSCRIPT_ID', 'CANONICAL_TRANSCRIPT',
      'CANONICAL_ANNOTATION'
    ],
    @_
    );
144 145 146 147 148

  if ($transcripts) {
    $self->{'_transcript_array'} = $transcripts;
    $self->recalculate_coordinates();
  }
149

150 151 152
  $self->stable_id($stable_id);
  $self->version($version);
  $self->{'created_date'}  = $created_date;
153 154
  $self->{'modified_date'} = $modified_date;

155 156 157 158 159 160 161
  $self->external_name($external_name) if ( defined $external_name );
  $self->external_db($external_db)     if ( defined $external_db );
  $self->external_status($external_status)
    if ( defined $external_status );
  $self->display_xref($display_xref) if ( defined $display_xref );
  $self->biotype($type)              if ( defined $type );
  $self->biotype($biotype)           if ( defined $biotype );
162
  $self->description($description);
163 164 165 166
  $self->status($confidence);    # incase old naming is used.
      # kept to ensure routine is backwards compatible.
  $self->status($status);    # add new naming
  $self->source($source);
167 168 169 170

  # default to is_current
  $is_current = 1 unless (defined($is_current));
  $self->{'is_current'} = $is_current;
171

172 173 174 175 176 177 178 179 180 181 182
  # Add the canonical transcript if we were given one, otherwise add the
  # canonical transcript internal ID if we were given one.
  if ( defined($canonical_transcript) ) {
    $self->canonical_transcript($canonical_transcript);
  } elsif ( defined($canonical_transcript_id) ) {
    $self->{'canonical_transcript_id'} = $canonical_transcript_id;
  }

  $self->canonical_annotation($canonical_annotation)
    if ( defined $canonical_annotation );

183
  return $self;
184 185 186
}


187 188
=head2 is_known

189 190 191
  Example    : print "Gene ".$gene->stable_id." is KNOWN\n" if $gene->is_known;
  Description: Returns TRUE if this gene has a status of 'KNOWN'
  Returntype : TRUE if known, FALSE otherwise
Arne Stabenau's avatar
Arne Stabenau committed
192 193
  Exceptions : none
  Caller     : general
194
  Status     : Stable
195 196 197

=cut

Arne Stabenau's avatar
Arne Stabenau committed
198

199
sub is_known{
200
  my $self = shift;
201
  return ( $self->{'status'} eq "KNOWN" );
202 203 204
}


205 206
=head2 external_name

207 208 209 210
  Arg [1]    : (optional) String - the external name to set
  Example    : $gene->external_name('BRCA2');
  Description: Getter/setter for attribute external_name.
  Returntype : String or undef
Arne Stabenau's avatar
Arne Stabenau committed
211
  Exceptions : none
212
  Caller     : general
213
  Status     : Stable
214 215 216 217

=cut

sub external_name {
218
  my  $self  = shift;
219

220
  $self->{'external_name'} = shift if (@_);
221

222
  if (defined $self->{'external_name'}) {
223
    return $self->{'external_name'};
224 225
  }

226
  my $display_xref = $self->display_xref();
227

228 229
  if (defined $display_xref) {
    return $display_xref->display_id();
230 231 232
  } else {
    return undef;
  }
233 234
}

Arne Stabenau's avatar
Arne Stabenau committed
235

236 237
=head2 status

238 239 240 241
  Arg [1]    : (optional) String - status to set
  Example    : $gene->status('KNOWN');
  Description: Getter/setter for attribute status
  Returntype : String
242 243 244 245 246 247 248 249 250 251 252 253
  Exceptions : none
  Caller     : general
  Status     : Medium Risk

=cut

sub status {
   my $self = shift;
  $self->{'status'} = shift if( @_ );
  return $self->{'status'};
}

254 255 256

=head2 source

257 258 259 260
  Arg [1]    : (optional) String - the source to set
  Example    : $gene->source('ensembl');
  Description: Getter/setter for attribute source
  Returntype : String
261 262
  Exceptions : none
  Caller     : general
263
  Status     : Stable
264 265 266 267 268 269 270 271 272 273

=cut

sub source {
  my $self = shift;
  $self->{'source'} = shift if( @_ );
  return ( $self->{'source'} || "ensembl" );
}


Arne Stabenau's avatar
Arne Stabenau committed
274 275
=head2 external_db	

276 277 278
  Arg [1]    : (optional) String - name of external db to set
  Example    : $gene->external_db('HGNC');
  Description: Getter/setter for attribute external_db. The db is the one that 
279
               belongs to the external_name.  
280
  Returntype : String
Arne Stabenau's avatar
Arne Stabenau committed
281 282
  Exceptions : none
  Caller     : general
283
  Status     : Stable
Arne Stabenau's avatar
Arne Stabenau committed
284 285 286

=cut

287
sub external_db {
288
  my $self = shift;
289

290
  $self->{'external_db'} = shift if( @_ );
291

292 293
  if( exists $self->{'external_db'} ) {
    return $self->{'external_db'};
294 295
  }

296
  my $display_xref = $self->display_xref();
297

298 299 300 301 302
  if( defined $display_xref ) {
    return $display_xref->dbname()
  } else {
    return undef;
  }
303
}
Graham McVicker's avatar
Graham McVicker committed
304

305

306 307
=head2 external_status

308 309 310
  Arg [1]    : (optional) String - status of the external db
  Example    : $gene->external_status('KNOWNXREF');
  Description: Getter/setter for attribute external_status. The status of
311
               the external db of the one that belongs to the external_name.
312
  Returntype : String
313 314
  Exceptions : none
  Caller     : general
315
  Status     : Stable
316 317 318 319

=cut

sub external_status {
320
  my $self = shift;
321

322
  $self->{'_ext_status'} = shift if ( @_ );
323 324 325 326 327 328 329 330 331 332 333 334
  return $self->{'_ext_status'} if exists $self->{'_ext_status'};

  my $display_xref = $self->display_xref();

  if( defined $display_xref ) {
    return $display_xref->status()
  } else {
    return undef;
  }
}


Philip Lijnzaad's avatar
Philip Lijnzaad committed
335
=head2 description
336

337 338 339 340
  Arg [1]    : (optional) String - the description to set
  Example    : $gene->description('This is the gene\'s description');
  Description: Getter/setter for gene description
  Returntype : String
341
  Exceptions : none
Arne Stabenau's avatar
Arne Stabenau committed
342
  Caller     : general
343
  Status     : Stable
344 345 346

=cut

Philip Lijnzaad's avatar
Philip Lijnzaad committed
347
sub description {
348 349 350
    my $self = shift;
    $self->{'description'} = shift if( @_ );
    return $self->{'description'};
351 352
}

353

354 355 356 357 358 359
=head2 canonical_transcript

  Arg [1]    : (optional) Bio::EnsEMBL::Transcipt - canonical_transcript object
  Example    : $gene->canonical_transcript($canonical_transcript);
  Description: Getter/setter for the canonical_transcript
  Returntype : Bio::EnsEMBL::Transcript
360
  Exceptions : Throws if argument is not a transcript object.
361 362 363 364 365 366
  Caller     : general
  Status     : Stable

=cut

sub canonical_transcript {
367 368 369 370 371 372 373 374
  my ( $self, $transcript ) = @_;

  if ( defined($transcript) ) {
    # We're attaching a new canonical transcript.

    if (
      !(
        ref($transcript)
Steve Trevanion's avatar
Steve Trevanion committed
375
        && $transcript->isa('Bio::EnsEMBL::Transcript') ) )
376 377
    {
      throw('Argument must be a Bio::EnsEMBL::Transcript');
378
    }
379 380 381 382 383 384 385 386 387 388

    $self->{'canonical_transcript'}    = $transcript;
    $self->{'canonical_transcript_id'} = $transcript->dbID();

  } elsif ( !defined( $self->{'canonical_transcript'} )
    && defined( $self->{'canonical_transcript_id'} ) )
  {
    # We have not attached a canoncical transcript, but we have the dbID
    # of one.

389 390 391 392 393 394 395 396 397 398 399
    if ( defined( $self->adaptor() ) ) {
      my $transcript_adaptor =
        $self->adaptor()->db()->get_TranscriptAdaptor();

      $self->{'canonical_transcript'} =
        $transcript_adaptor->fetch_by_dbID(
        $self->{'canonical_transcript_id'} );
    } else {
      warning( "Gene has no adaptor "
          . "when trying to fetch canonical transcript." );
    }
400 401 402 403 404

  }

  return $self->{'canonical_transcript'};
} ## end sub canonical_transcript
405 406 407 408 409


=head2 canonical_annotation

  Arg [1]    : (optional) String - canonical_annotation
410
  Example    : $gene->canonical_annotation('This is the canonical_annotation');
411 412 413 414 415 416 417 418 419 420
  Description: Getter/setter for the canonical_annotation
  Returntype : String
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub canonical_annotation {
    my $self = shift;
Daniel Rios's avatar
Daniel Rios committed
421
    $self->{'canonical_annotation'} = shift if( @_ );
422 423 424 425 426
    return $self->{'canonical_annotation'};
}



Patrick Meidl's avatar
Patrick Meidl committed
427 428
=head2 get_all_Attributes

429 430
  Arg [1]    : (optional) String $attrib_code
               The code of the attribute type to retrieve values for
Patrick Meidl's avatar
Patrick Meidl committed
431
  Example    : my ($author) = @{ $gene->get_all_Attributes('author') };
432
               my @gene_attributes = @{ $gene->get_all_Attributes };
Patrick Meidl's avatar
Patrick Meidl committed
433
  Description: Gets a list of Attributes of this gene.
434 435
               Optionally just get Attributes for given code.
  Returntype : Listref of Bio::EnsEMBL::Attribute
Patrick Meidl's avatar
Patrick Meidl committed
436 437 438 439 440 441 442 443 444 445 446
  Exceptions : warning if gene does not have attached adaptor and attempts lazy
               load.
  Caller     : general
  Status     : Stable

=cut

sub get_all_Attributes {
  my $self = shift;
  my $attrib_code = shift;

447 448
  if ( ! exists $self->{'attributes' } ) {
    if (!$self->adaptor() ) {
Patrick Meidl's avatar
Patrick Meidl committed
449 450 451 452 453 454 455
      return [];
    }

    my $attribute_adaptor = $self->adaptor->db->get_AttributeAdaptor();
    $self->{'attributes'} = $attribute_adaptor->fetch_all_by_Gene($self);
  }

456
  if ( defined $attrib_code ) {
Patrick Meidl's avatar
Patrick Meidl committed
457 458 459 460 461 462 463 464 465 466 467
    my @results = grep { uc($_->code()) eq uc($attrib_code) }
    @{$self->{'attributes'}};
    return \@results;
  } else {
    return $self->{'attributes'};
  }
}


=head2 add_Attributes

468 469 470 471
  Arg [1-N]  : list of Bio::EnsEMBL::Attribute's @attribs
               Attribute(s) to add
  Example    : my $attrib = Bio::EnsEMBL::Attribute->new(...);
               $gene->add_Attributes($attrib);
Patrick Meidl's avatar
Patrick Meidl committed
472
  Description: Adds an Attribute to the Gene. If you add an attribute before
473
               you retrieve any from database, lazy loading will be disabled.
Patrick Meidl's avatar
Patrick Meidl committed
474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498
  Returntype : none
  Exceptions : throw on incorrect arguments
  Caller     : general
  Status     : Stable

=cut

sub add_Attributes {
  my $self = shift;
  my @attribs = @_;

  if( ! exists $self->{'attributes'} ) {
    $self->{'attributes'} = [];
  }

  for my $attrib ( @attribs ) {
    if( ! $attrib->isa( "Bio::EnsEMBL::Attribute" )) {
     throw( "Argument to add_Attribute has to be an Bio::EnsEMBL::Attribute" );
    }
    push( @{$self->{'attributes'}}, $attrib );
  }

  return;
}

499

500 501 502 503
=head2 add_DBEntry

  Arg [1]    : Bio::EnsEMBL::DBEntry $dbe
               The dbEntry to be added
504 505
  Example    : my $dbe = Bio::EnsEMBL::DBEntery->new(...);
               $gene->add_DBEntry($dbe);
506 507 508 509 510 511
  Description: Associates a DBEntry with this gene. Note that adding DBEntries
               will prevent future lazy-loading of DBEntries for this gene
               (see get_all_DBEntries).
  Returntype : none
  Exceptions : thrown on incorrect argument type
  Caller     : general
512
  Status     : Stable
513 514 515 516 517 518 519 520

=cut

sub add_DBEntry {
  my $self = shift;
  my $dbe = shift;

  unless($dbe && ref($dbe) && $dbe->isa('Bio::EnsEMBL::DBEntry')) {
521
    throw('Expected DBEntry argument');
522 523 524 525 526 527 528 529
  }

  $self->{'dbentries'} ||= [];
  push @{$self->{'dbentries'}}, $dbe;
}


=head2 get_all_DBEntries
530

531 532
  Example    : @dbentries = @{ $gene->get_all_DBEntries };
  Description: Retrieves DBEntries (xrefs) for this gene. This does _not_ 
533 534 535 536 537 538
               include DBEntries that are associated with the transcripts and
               corresponding translations of this gene (see get_all_DBLinks).

               This method will attempt to lazy-load DBEntries from a
               database if an adaptor is available and no DBEntries are present
               on the gene (i.e. they have not already been added or loaded).
539
  Returntype : Listref of Bio::EnsEMBL::DBEntry objects
540
  Exceptions : none
541
  Caller     : get_all_DBLinks, GeneAdaptor::store
542
  Status     : Stable
543 544 545

=cut

546
sub get_all_DBEntries {
Ian Longden's avatar
Ian Longden committed
547
  my ($self, $db_name_exp, $ex_db_type) = @_;
548
  my $cache_name = "dbentries";
549

550 551 552
  if(defined($db_name_exp)){
    $cache_name .= $db_name_exp;
  }
Ian Longden's avatar
Ian Longden committed
553 554
  if(defined($ex_db_type)){
    $cache_name .= $ex_db_type;
555
  }
556
  # if not cached, retrieve all of the xrefs for this gene
557 558
  if(!defined $self->{$cache_name} && $self->adaptor()) {
    $self->{$cache_name} = 
Ian Longden's avatar
Ian Longden committed
559
      $self->adaptor->db->get_DBEntryAdaptor->fetch_all_by_Gene($self,$db_name_exp, $ex_db_type);
560
  }
561

562
  $self->{$cache_name} ||= [];
563

564
  return $self->{$cache_name};
565 566 567
}


568
=head2 get_all_DBLinks
569

570
  Example    : @dblinks = @{ $gene->get_all_DBLinks };
571
             : @dblinks = @{ $gene->get_all_DBLinks("Uniprot%") };
Glenn Proctor's avatar
Glenn Proctor committed
572 573
  Arg [1]    : <optional> database name. SQL wildcard characters (_ and %) can be used to
               specify patterns.
574
  Description: Retrieves _all_ related DBEntries for this gene. This includes
575 576
               all DBEntries that are associated with the transcripts and
               corresponding translations of this gene.
577

578 579 580
               If you only want to retrieve the DBEntries associated with the
               gene (and not the transcript and translations) then you should
               use the get_all_DBEntries call instead.
581 582 583 584 585
         
               Note: Each entry may be listed more than once. No uniqueness checks are done.
                     Also if you put in an incorrect external database name no checks are done
                     to see if this exists, you will just get an empty list.

586
  Returntype : Listref of Bio::EnsEMBL::DBEntry objects
Arne Stabenau's avatar
Arne Stabenau committed
587 588
  Exceptions : none
  Caller     : general
589
  Status     : Stable
590 591 592

=cut

593 594
sub get_all_DBLinks {
   my $self = shift;
595
   my $db_name_exp = shift;
Ian Longden's avatar
Ian Longden committed
596
   my $ex_db_type = shift;
Arne Stabenau's avatar
Arne Stabenau committed
597

Ian Longden's avatar
Ian Longden committed
598
   my @links = @{$self->get_all_DBEntries($db_name_exp, $ex_db_type)};
599

600
   # add all of the transcript and translation xrefs to the return list
601
   foreach my $transc (@{$self->get_all_Transcripts}) {
Ian Longden's avatar
Ian Longden committed
602
     push @links, @{$transc->get_all_DBEntries($db_name_exp, $ex_db_type)};
603

604
     my $transl = $transc->translation();
Ian Longden's avatar
Ian Longden committed
605
     push @links, @{$transl->get_all_DBEntries($db_name_exp, $ex_db_type)} if($transl);
606
   }
607

608 609
   return \@links;
}
610

611

612 613
=head2 get_all_Exons

614 615 616
  Example    : my @exons = @{ $gene->get_all_Exons };
  Description: Returns a set of all the exons associated with this gene.
  Returntype : Listref of Bio::EnsEMBL::Exon objects
Arne Stabenau's avatar
Arne Stabenau committed
617 618
  Exceptions : none
  Caller     : general
619
  Status     : Stable
620 621 622

=cut

Arne Stabenau's avatar
Arne Stabenau committed
623

624
sub get_all_Exons {
625
  my $self = shift;
626

627 628
  my %h;
  my @out = ();
Graham McVicker's avatar
Graham McVicker committed
629

630 631 632 633 634
  foreach my $trans ( @{$self->get_all_Transcripts} ) {
    foreach my $e ( @{$trans->get_all_Exons} ) {
      $h{$e->start()."-".$e->end()."-".$e->strand()."-".$e->phase()."-".$e->end_phase()} = $e;
    }
  }
635

636
  push @out, values %h;
637

638
  return \@out;
Graham McVicker's avatar
Graham McVicker committed
639
}
640

641

Will Spooner's avatar
Will Spooner committed
642
=head2 get_all_homologous_Genes
643

644 645
  Description: Queries the Ensembl Compara database and retrieves all
               Genes from other species that are orthologous.
646 647 648
               REQUIRES properly setup Registry conf file. Meaning that
               one of the aliases for each core db has to be "Genus species"
               e.g. "Homo sapiens" (as in the name column in genome_db table
649
               in the compara database).
650 651 652
  Returntype : listref [
                        Bio::EnsEMBL::Gene,
                        Bio::EnsEMBL::Compara::Homology,
653
                        string $species # needed as cannot get spp from Gene 
654 655 656
                       ]
  Exceptions : none
  Caller     : general
657
  Status     : Stable
658 659 660

=cut

661
sub get_all_homologous_Genes {
662 663 664 665 666 667 668 669 670 671
  my $self = shift;

  if( exists( $self->{'homologues'} ) ){
    return $self->{'homologues'};
  }
  $self->{'homologues'} = [];

  # TODO: Find a robust way of retrieving compara dba directly.
  # For now look through all DBAs
  my $compara_dba;
672
  foreach my $dba( @{Bio::EnsEMBL::Registry->get_all_DBAdaptors} ){
673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690
    if( $dba->isa('Bio::EnsEMBL::Compara::DBSQL::DBAdaptor') ){
      $compara_dba = $dba;
      last;
    }
  }
  unless( $compara_dba ){
    warning("No compara in Bio::EnsEMBL::Registry");
    return $self->{'homologues'};
  }

  # Get the compara 'member' corresponding to self
  my $member_adaptor   = $compara_dba->get_adaptor('Member');
  my $query_member = $member_adaptor->fetch_by_source_stable_id
      ("ENSEMBLGENE",$self->stable_id);
  unless( $query_member ){ return $self->{'homologues'} };

  # Get the compara 'homologies' corresponding to 'member'
  my $homology_adaptor = $compara_dba->get_adaptor('Homology');
691
  my @homolos = @{$homology_adaptor->fetch_all_by_Member($query_member)};
692 693 694 695 696 697 698 699
  unless( scalar(@homolos) ){ return $self->{'homologues'} };

  # Get the ensembl 'genes' corresponding to 'homologies'
  foreach my $homolo( @homolos ){
    foreach my $member_attrib( @{$homolo->get_all_Member_Attribute} ){
      my ($member, $attrib) = @{$member_attrib};
      my $hstable_id = $member->stable_id;
      next if ($hstable_id eq $query_member->stable_id); # Ignore self     
700 701
      my $hgene = undef;
      eval { $hgene = $member->get_Gene;} ;
702 703 704 705
      unless( $hgene ){
        # Something up with DB. Create a new gene is best we can do
        $hgene = Bio::EnsEMBL::Gene->new
            ( -stable_id=>$hstable_id,
Will Spooner's avatar
Will Spooner committed
706
              -description=>$member->description, );
707 708 709 710 711 712 713
      }
      my $hspecies = $member->genome_db->name;
      push @{$self->{'homologues'}}, [$hgene,$homolo,$hspecies];
    }
  }
  return $self->{'homologues'};
}
Arne Stabenau's avatar
Arne Stabenau committed
714

715 716 717

=head2 biotype

718 719 720 721
  Arg [1]    : (optional) String - the biotype to set
  Example    : $gene->biotype("protein_coding");
  Description: Getter/setter for the attribute biotype
  Returntype : String
722 723
  Exceptions : none
  Caller     : general
724
  Status     : Stable
725 726

=cut
727

728 729
sub biotype {
  my $self = shift;
730

731 732
  $self->{'biotype'} = shift if( @_ );
  return ( $self->{'biotype'} || "protein_coding" );
Arne Stabenau's avatar
Arne Stabenau committed
733 734
}

735

Arne Stabenau's avatar
Arne Stabenau committed
736
=head2 add_Transcript
Ewan Birney's avatar
Ewan Birney committed
737

738 739 740 741 742 743 744
  Arg [1]    : Bio::EnsEMBL::Transcript $trans
               The transcript to add to the gene
  Example    : my $transcript = Bio::EnsEMBL::Transcript->new(...);
               $gene->add_Transcript($transcript);
  Description: Adds another Transcript to the set of alternatively
               spliced Transcripts of this gene. If it shares exons 
               with another Transcript, these should be object-identical.
Arne Stabenau's avatar
Arne Stabenau committed
745 746 747
  Returntype : none
  Exceptions : none
  Caller     : general
748
  Status     : Stable
Ewan Birney's avatar
Ewan Birney committed
749 750 751

=cut

752
sub add_Transcript {
753
   my ($self, $trans) = @_;
Ewan Birney's avatar
Ewan Birney committed
754

755 756 757 758 759
   if( !ref $trans || ! $trans->isa("Bio::EnsEMBL::Transcript") ) {
       throw("$trans is not a Bio::EnsEMBL::Transcript!");
   }

   $self->{'_transcript_array'} ||= [];
760
   push(@{$self->{'_transcript_array'}},$trans);
761

762
   $self->recalculate_coordinates();
Ewan Birney's avatar
Ewan Birney committed
763 764 765
}


766 767
=head2 get_all_Transcripts

768 769 770
  Example    : my @transcripts = @{ $gene->get_all_Transcripts };
  Description: Returns the Transcripts in this gene.
  Returntype : Listref of Bio::EnsEMBL::Transcript objects
Arne Stabenau's avatar
Arne Stabenau committed
771 772
  Exceptions : none
  Caller     : general
773
  Status     : Stable
Ewan Birney's avatar
Ewan Birney committed
774 775 776

=cut

777
sub get_all_Transcripts {
778
  my $self = shift;
Ewan Birney's avatar
Ewan Birney committed
779

780 781 782 783 784 785 786
  if( ! exists $self->{'_transcript_array'} ) {
    if( defined $self->adaptor() ) {
      my $ta = $self->adaptor()->db()->get_TranscriptAdaptor();
      my $transcripts = $ta->fetch_all_by_Gene( $self );
      $self->{'_transcript_array'} = $transcripts;
    }
  }
Graham McVicker's avatar
Graham McVicker committed
787
  return $self->{'_transcript_array'};
Ewan Birney's avatar
Ewan Birney committed
788 789
}

790

791
=head2 get_all_alt_alleles
792

793 794 795 796 797
  Example    : my @alt_genes = @{ $gene->get_all_alt_alleles };
               foreach my $alt_gene (@alt_genes) {
                 print "Alternate allele: " . $alt_gene->stable_id() . "\n";
               }
  Description: Returns a listref of Gene objects that represent this Gene on
798
               an alternative haplotype. Empty list if there is no such
799 800
               Gene (eg there is no overlapping haplotype).
  Returntype : listref of Bio::EnsEMBL::Gene objects
Arne Stabenau's avatar
Arne Stabenau committed
801 802
  Exceptions : none
  Caller     : general
803
  Status     : Stable
804 805 806

=cut

807 808 809 810 811
sub get_all_alt_alleles {
  my $self = shift;
  my $result = $self->adaptor()->fetch_all_alt_alleles( $self );
  return $result;
}
Arne Stabenau's avatar
Arne Stabenau committed
812

813

814
=head2 version
815

816
  Arg [1]    : (optional) Int
817
               A version number for the stable_id
818 819 820
  Example    : $gene->version(2);
  Description: Getter/setter for version number
  Returntype : Int
821 822
  Exceptions : none
  Caller     : general
823
  Status     : Stable
824

825
=cut
826

827
sub version {
828 829 830
  my $self = shift;
  $self->{'version'} = shift if(@_);
  return $self->{'version'};
831 832 833
}


834
=head2 stable_id
835

836 837 838 839
  Arg [1]    : (optional) String - the stable ID to set
  Example    : $gene->stable_id("ENSG0000000001");
  Description: Getter/setter for stable id for this gene.
  Returntype : String
Arne Stabenau's avatar
Arne Stabenau committed
840 841
  Exceptions : none
  Caller     : general
842
  Status     : Stable
843 844 845

=cut

846
sub stable_id {
847 848 849
  my $self = shift;
  $self->{'stable_id'} = shift if(@_);
  return $self->{'stable_id'};
850 851
}

852

853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871
=head2 is_current

  Arg [1]    : Boolean $is_current
  Example    : $gene->is_current(1)
  Description: Getter/setter for is_current state of this gene.
  Returntype : Int
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub is_current {
  my $self = shift;
  $self->{'is_current'} = shift if (@_);
  return $self->{'is_current'};
}


872 873
=head2 created_date

874 875
  Arg [1]    : (optional) String - created date to set (as a UNIX time int)
  Example    : $gene->created_date('1141948800');
876 877
  Description: Getter/setter for attribute created_date
  Returntype : String
878 879 880 881 882 883
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

884 885 886 887 888 889
sub created_date {
  my $self = shift;
  $self->{'created_date'} = shift if ( @_ );
  return $self->{'created_date'};
}

890

891 892
=head2 modified_date

893 894
  Arg [1]    : (optional) String - modified date to set (as a UNIX time int)
  Example    : $gene->modified_date('1141948800');
895 896
  Description: Getter/setter for attribute modified_date
  Returntype : String
897 898 899 900 901 902
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

903 904 905 906 907 908 909
sub modified_date {
  my $self = shift;
  $self->{'modified_date'} = shift if ( @_ );
  return $self->{'modified_date'};
}


910
=head2 transform
Arne Stabenau's avatar
Arne Stabenau committed
911

912 913 914 915 916
  Arg [1]    : String - coordinate system name to transform to
  Arg [2]    : String - coordinate system version
  Example    : my $new_gene = $gene->transform('supercontig');
  Description: Moves this gene to the given coordinate system. If this gene has
               Transcripts attached, they move as well.
917
  Returntype : Bio::EnsEMBL::Gene
918
  Exceptions : throw on wrong parameters
Arne Stabenau's avatar
Arne Stabenau committed
919
  Caller     : general
920
  Status     : Stable
921 922 923

=cut

924 925
sub transform {
  my $self = shift;
926

927
  # catch for old style transform calls
Ian Longden's avatar
Ian Longden committed
928
  if( !@_  || ( ref $_[0] && ($_[0]->isa( "Bio::EnsEMBL::Slice" ) or $_[0]->isa( "Bio::EnsEMBL::LRGSlice" )) )) {
929 930 931
    deprecate('Calling transform without a coord system name is deprecated.');
    return $self->_deprecated_transform(@_);
  }
932

933 934 935 936
  my $new_gene = $self->SUPER::transform(@_);

  if ( !defined($new_gene) ) {
    # check if this gene projects at all to requested coord system,
937
    #  if not we are done.
938 939
    my @segments = @{ $self->project(@_) };
    if ( !@segments ) {
940 941
      return undef;
    }
942
    $self->get_all_Transcripts();
943
  }
944

945 946
  if( exists $self->{'_transcript_array'} ) {
    my @new_transcripts;
947 948 949
    my ( $strand, $slice );
    my $low_start = POSIX::INT_MAX;
    my $hi_end = POSIX::INT_MIN;
950 951
    for my $old_transcript ( @{$self->{'_transcript_array'}} ) {
      my $new_transcript = $old_transcript->transform( @_ );
Arne Stabenau's avatar