Translation.pm 20.1 KB
Newer Older
Ewan Birney's avatar
Ewan Birney committed
1
#
2
# Ensembl module for Bio::EnsEMBL::Translation
Ewan Birney's avatar
Ewan Birney committed
3
4
5
6
7
8
9
10
#
#
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code

=head1 NAME

11
12
Bio::EnsEMBL::Translation - A class representing the translation of a
transcript
Ewan Birney's avatar
Ewan Birney committed
13
14
15

=head1 SYNOPSIS

16

Ewan Birney's avatar
Ewan Birney committed
17
18
=head1 DESCRIPTION

19
A Translation object defines the CDS and UTR regions of a Transcript
20
through the use of start_Exon/end_Exon, and start/end attributes.
Ewan Birney's avatar
Ewan Birney committed
21
22
23

=head1 CONTACT

24
Post questions to the EnsEMBL Developer list: ensembl-dev@ebi.ac.uk
Ewan Birney's avatar
Ewan Birney committed
25

26
=head1 METHODS
Ewan Birney's avatar
Ewan Birney committed
27
28
29
30
31
32
33
34

=cut


package Bio::EnsEMBL::Translation;
use vars qw($AUTOLOAD @ISA);
use strict;

35
36
use Bio::EnsEMBL::Utils::Exception qw( deprecate throw warning );
use Bio::EnsEMBL::Utils::Argument qw( rearrange );
Ewan Birney's avatar
Ewan Birney committed
37

38
use Bio::EnsEMBL::Storable;
Ewan Birney's avatar
Ewan Birney committed
39

40
@ISA = qw(Bio::EnsEMBL::Storable);
Ewan Birney's avatar
Ewan Birney committed
41
42


43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

=head2 new

  Arg [-START_EXON] : The Exon object in which the translation (CDS) starts
  Arg [-END_EXON]   : The Exon object in which the translation (CDS) ends
  Arg [-SEQ_START]  : The offset in the start_Exon indicating the start
                      position of the CDS.
  Arg [-SEQ_END]    : The offset in the end_Exon indicating the end
                      position of the CDS.
  Arg [-STABLE_ID]  : The stable identifier for this Translation
  Arg [-VERSION]    : The version of the stable identifier
  Arg [-DBID]       : The internal identifier of this Translation
  Arg [-ADAPTOR]    : The TranslationAdaptor for this Translation
  Arg [-SEQ]        : Manually sets the peptide sequence of this translation.
                      May be useful if this translation is not stored in
                      a database.
  Example    : my $tl = Bio::EnsEMBL::Translation->new
                   (-START_EXON => $ex1,
                    -END_EXON   => $ex2,
                    -SEQ_START  => 98,
                    -SEQ_END    => 39);
  Description: Constructor.  Creates a new Translation object
  Returntype : Bio::EnsEMBL::Translation
  Exceptions : none
  Caller     : general

=cut

71
sub new {
Graham McVicker's avatar
Graham McVicker committed
72
  my $caller = shift;
73

Graham McVicker's avatar
Graham McVicker committed
74
  my $class = ref($caller) || $caller;
Ewan Birney's avatar
Ewan Birney committed
75

76
  my ( $start_exon, $end_exon, $seq_start, $seq_end,
77
78
       $stable_id, $version, $dbID, $adaptor, $seq,
       $created_date, $modified_date ) = 
79
    rearrange( [ "START_EXON", "END_EXON", "SEQ_START", "SEQ_END",
80
                 "STABLE_ID", "VERSION", "DBID", "ADAPTOR",
81
                 "SEQ", "CREATED_DATE", "MODIFIED_DATE" ], @_ );
82
83
84

  my $self = bless {
		    'start_exon' => $start_exon,
85
86
87
88
89
90
91
		    'end_exon'   => $end_exon,
		    'adaptor'    => $adaptor,
		    'dbID'       => $dbID,
		    'start'      => $seq_start,
		    'end'        => $seq_end,
		    'stable_id'  => $stable_id,
		    'version'    => $version,
92
93
		    'created_date' => $created_date,
		    'modified_date' => $modified_date,
94
        'seq'        => $seq
95
96
97
		   }, $class;

  return $self;
Ewan Birney's avatar
Ewan Birney committed
98
99
100
101
102
103
104
}


=head2 start

 Title   : start
 Usage   : $obj->start($newval)
Philip Lijnzaad's avatar
docu  
Philip Lijnzaad committed
105
106
 Function: return or assign the value of start, which is a position within
           the exon given by start_exon_id.
Ewan Birney's avatar
Ewan Birney committed
107
108
109
110
111
112
113
114
115
116
 Returns : value of start
 Args    : newvalue (optional)


=cut

sub start{
   my $obj = shift;
   if( @_ ) {
      my $value = shift;
Laura Clarke's avatar
 
Laura Clarke committed
117
      
Ewan Birney's avatar
Ewan Birney committed
118
119
120
121
122
123
124
      $obj->{'start'} = $value;
    }
    return $obj->{'start'};

}


125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
=head2 end

 Title   : end
 Usage   : $obj->end($newval)
 Function: return or assign the value of end, which is a position within
           the exon given by end_exon.
 Returns : value of end
 Args    : newvalue (optional)


=cut

sub end {
   my $self = shift;
   if( @_ ) {
      my $value = shift;
Laura Clarke's avatar
 
Laura Clarke committed
141
      
142
143
144
145
146
147
148
      $self->{'end'} = $value;
    }
    return $self->{'end'};

}


Graham McVicker's avatar
Graham McVicker committed
149
=head2 start_Exon
150
151

 Title   : start_exon
Graham McVicker's avatar
Graham McVicker committed
152
 Usage   : $obj->start_Exon($newval)
153
 Function: return or assign the value of start_exon, which denotes the
Philip Lijnzaad's avatar
docu  
Philip Lijnzaad committed
154
155
           exon at which translation starts (and within this exon, at the
           position indicated by start, see above).
156
 Returns : value of start_exon (Exon object)
Ewan Birney's avatar
Ewan Birney committed
157
158
159
160
161
 Args    : newvalue (optional)


=cut

Graham McVicker's avatar
Graham McVicker committed
162
sub start_Exon {
163
   my $self = shift;
164

Ewan Birney's avatar
Ewan Birney committed
165
166
   if( @_ ) {
      my $value = shift;
167
      if( !ref $value || !$value->isa('Bio::EnsEMBL::Exon') ) {
168
         throw("Got to have an Exon object, not a $value");
169
170
      }
      $self->{'start_exon'} = $value;
Ewan Birney's avatar
Ewan Birney committed
171
    }
172
   return $self->{'start_exon'};
Ewan Birney's avatar
Ewan Birney committed
173
174
175
}


176
177


Graham McVicker's avatar
Graham McVicker committed
178
=head2 end_Exon
179
180

 Title   : end_exon
Graham McVicker's avatar
Graham McVicker committed
181
 Usage   : $obj->end_Exon($newval)
182
183
184
185
 Function: return or assign the value of end_exon, which denotes the
           exon at which translation ends (and within this exon, at the
           position indicated by end, see above).
 Returns : value of end_exon (Exon object)
Ewan Birney's avatar
Ewan Birney committed
186
187
188
189
190
 Args    : newvalue (optional)


=cut

Graham McVicker's avatar
Graham McVicker committed
191
sub end_Exon {
192
   my $self = shift;
Ewan Birney's avatar
Ewan Birney committed
193
194
   if( @_ ) {
      my $value = shift;
195
      if( !ref $value || !$value->isa('Bio::EnsEMBL::Exon') ) {
196
         throw("Got to have an Exon object, not a $value");
197
198
      }
      $self->{'end_exon'} = $value;
199
    } 
Ewan Birney's avatar
Ewan Birney committed
200

201
    return $self->{'end_exon'};
Ewan Birney's avatar
Ewan Birney committed
202
203
204
}


Graham McVicker's avatar
Graham McVicker committed
205

206
=head2 version
207

208
209
210
211
212
213
  Arg [1]    : string $version
  Example    : none
  Description: get/set for attribute version
  Returntype : string
  Exceptions : none
  Caller     : general
Ewan Birney's avatar
Ewan Birney committed
214
215
216

=cut

217
sub version {
218
   my $self = shift;
219
220
  $self->{'version'} = shift if( @_ );
  return $self->{'version'};
Ewan Birney's avatar
Ewan Birney committed
221
}
222
223


224
=head2 stable_id
Graham McVicker's avatar
Graham McVicker committed
225

226
227
228
229
230
231
  Arg [1]    : string $stable_id
  Example    : none
  Description: get/set for attribute stable_id
  Returntype : string
  Exceptions : none
  Caller     : general
232
233
234

=cut

235
sub stable_id {
236
   my $self = shift;
237
238
  $self->{'stable_id'} = shift if( @_ );
  return $self->{'stable_id'};
239
240
}

241
242
243
244
245
246
247
248
249
250
251
252
253
sub created_date {
  my $self = shift;
  $self->{'created_date'} = shift if ( @_ );
  return $self->{'created_date'};
}


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

254

Graham McVicker's avatar
Graham McVicker committed
255

256
257
=head2 transform

258
259
260
261
262
  Arg  1    : hashref $old_new_exon_map
              a hash that maps old to new exons for a whole gene
  Function  : maps start end end exon according to mapping table
              if an exon is not mapped, just keep the old one
  Returntype: none
263
  Exceptions: none
264
  Caller    : Transcript->transform() 
265
266
267
268
269
270
271

=cut

sub transform {
  my $self = shift;
  my $href_exons = shift;

Graham McVicker's avatar
Graham McVicker committed
272
273
  my $start_exon = $self->start_Exon();
  my $end_exon = $self->end_Exon();
274

Arne Stabenau's avatar
Arne Stabenau committed
275
276
  if ( exists $href_exons->{$start_exon} ) {
    $self->start_Exon($href_exons->{$start_exon});
277
278
  } else {
    # do nothing, the start exon wasnt mapped
279
280
  }

Arne Stabenau's avatar
Arne Stabenau committed
281
282
  if ( exists $href_exons->{$end_exon} ) {
    $self->end_Exon($href_exons->{$end_exon});
283
284
  } else { 
    # do nothing, the end exon wasnt mapped
285
286
287
  }
}

288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308

=head2 get_all_DBEntries

  Arg [1]    : none
  Example    : @dbentries = @{$gene->get_all_DBEntries()};
  Description: Retrieves DBEntries (xrefs) for this translation.  

               This method will attempt to lazy-load DBEntries from a
               database if an adaptor is available and no DBEntries are present
               on the translation (i.e. they have not already been added or 
               loaded).
  Returntype : list reference to Bio::EnsEMBL::DBEntry objects
  Exceptions : none
  Caller     : get_all_DBLinks, TranslationAdaptor::store

=cut

sub get_all_DBEntries {
  my $self = shift;

  #if not cached, retrieve all of the xrefs for this gene
309
310
311
  if(!defined $self->{'dbentries'}) {
    my $adaptor = $self->adaptor();
    my $dbID    = $self->dbID();
Graham McVicker's avatar
Graham McVicker committed
312
313
314
315

    return [] if(!$adaptor || !$dbID);

    $self->{'dbentries'} =
316
317
318
      $self->adaptor->db->get_DBEntryAdaptor->fetch_all_by_Translation($self);
  }

319
320
  $self->{'dbentries'} ||= [];

321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
  return $self->{'dbentries'};
}


=head2 add_DBEntry

  Arg [1]    : Bio::EnsEMBL::DBEntry $dbe
               The dbEntry to be added
  Example    : @dbentries = @{$gene->get_all_DBEntries()};
  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

=cut

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

  unless($dbe && ref($dbe) && $dbe->isa('Bio::EnsEMBL::DBEntry')) {
344
    throw('Expected DBEntry argument');
345
346
347
348
349
350
351
  }

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


Stephen Keenan's avatar
Stephen Keenan committed
352
353
=head2 get_all_DBLinks

354
355
356
357
358
359
360
  Arg [1]    : see get_all_DBEntries
  Example    : see get_all_DBEntries
  Description: This is here for consistancy with the Transcript and Gene 
               classes.  It is a synonym for the get_all_DBEntries method.
  Returntype : see get_all_DBEntries
  Exceptions : none
  Caller     : general
Stephen Keenan's avatar
Stephen Keenan committed
361
362
363
364
365

=cut

sub get_all_DBLinks {
  my $self = shift;
366
  return $self->get_all_DBEntries(@_);
Stephen Keenan's avatar
Stephen Keenan committed
367
368
}

369

370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408


=head2 get_all_ProteinFeatures

  Arg [1]    : (optional) string $logic_name
               The analysis logic_name of the features to retrieve.  If not
               specified, all features are retrieved instead.
  Example    : $features = $self->get_all_ProteinFeatures('PFam');
  Description: Retrieves all ProteinFeatures associated with this 
               Translation. If a logic_name is specified, only features with 
               that logic_name are returned.  If no logic_name is provided all
               associated protein_features are returned.
  Returntype : Bio::EnsEMBL::ProteinFeature
  Exceptions : none
  Caller     : general

=cut

sub get_all_ProteinFeatures {
  my $self = shift;
  my $logic_name = shift;

  if(!$self->{'protein_features'}) {
    my $adaptor = $self->adaptor();
    my $dbID    = $self->dbID();
    if(!$adaptor || !$dbID) {
      warning("Cannot retrieve ProteinFeatures from translation without " .
              "an attached adaptor and a dbID. Returning empty list.");
      return [];
    }

    my %hash;
    $self->{'protein_features'} = \%hash;

    my $pfa = $adaptor->db()->get_ProteinFeatureAdaptor();
    my $name;
    foreach my $f (@{$pfa->fetch_all_by_translation_id($dbID)}) {
      my $analysis = $f->analysis();
      if($analysis) {
409
        $name = lc($f->analysis->logic_name());
James Stalker's avatar
James Stalker committed
410
	#warn "$dbID has analysis $name\n";
411
      } else {
412
413
        warning("ProteinFeature has no attached analysis\n");
        $name = '';
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
      }
      $hash{$name} ||= [];
      push @{$hash{$name}}, $f;
    }
  }

  #a specific type of protein feature was requested
  if(defined($logic_name)) {
    $logic_name = lc($logic_name);
    return $self->{'protein_features'}->{$logic_name} || [];
  }

  my @features;

  #all protein features were requested
  foreach my $type (keys %{$self->{'protein_features'}}) {
    push @features, @{$self->{'protein_features'}->{$type}};
  }

  return \@features;    
}



=head2 get_all_DomainFeatures

  Arg [1]    : none
  Example    : @domain_feats = @{$translation->get_all_DomainFeatures};
  Description: A convenience method which retrieves all protein features
               that are considered to be 'Domain' features.  Features which
               are 'domain' features are those with analysis logic names:
               'pfscan', 'scanprosite', 'superfamily', 'pfam', 'prints'.
  Returntype : listref of Bio::EnsEMBL::ProteinFeatures
  Exceptions : none
  Caller     : webcode (protview)

=cut

sub get_all_DomainFeatures{
 my ($self) = @_;

 my @features;

 my @types = ('pfscan',      #profile (prosite or pfam motifs) 
              'scanprosite', #prosite 
              'superfamily', 
              'pfam',
              'prints');

 foreach my $type (@types) {
   push @features, @{$self->get_all_ProteinFeatures($type)};
 }

 return \@features;
}

470
471


472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
=head2 display_id

  Arg [1]    : none
  Example    : print $translation->display_id();
  Description: This method returns a string that is considered to be
               the 'display' identifier.  For translations this is the 
               stable id if it is available otherwise it is an empty string.
  Returntype : string
  Exceptions : none
  Caller     : web drawing code

=cut

sub display_id {
  my $self = shift;
  return $self->{'stable_id'} || '';
}


491
492
493
494
495
496
497
498
499
500
501
502
=head2 length

  Arg [1]    : none
  Example    : print "Peptide length =", $translation->length();
  Description: Retrieves the length of the peptide sequence (i.e. number of
               amino acids) represented by this Translation object.
  Returntype : int
  Exceptions : none
  Caller     : webcode (protview etc.)

=cut

Web Admin's avatar
Web Admin committed
503
sub length {
504
505
  my $self = shift;
  my $seq = $self->seq();
Web Admin's avatar
testing  
Web Admin committed
506

507
  return ($seq) ? CORE::length($seq) : 0;
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
}


=head2 seq

  Arg [1]    : none
  Example    : print $translation->seq();
  Description: Retrieves a string representation of the peptide sequence
               of this Translation.  This retrieves the transcript from the
               database and gets its sequence, or retrieves the sequence which
               was set via the constructor.  If no adaptor is attached to this
               translation.
  Returntype : string
  Exceptions : warning if the sequence is not set and cannot be retrieved from
               the database.
  Caller     : webcode (protview etc.)

=cut

sub seq {
  my $self = shift;

530
531
532
533
534
  if(@_) {
    $self->{'seq'} = shift;
    return $self->{'seq'};
  }

535
536
537
538
539
540
541
542
543
  return $self->{'seq'} if($self->{'seq'});

  my $adaptor = $self->{'adaptor'};
  if(!$adaptor) {
    warning("Cannot retrieve sequence from Translation - adaptor is not set.");
  }

  my $dbID = $self->{'dbID'};
  if(!$dbID) {
544
    warning("Cannot retrieve sequence from Translation - dbID is not set.");
545
546
547
548
549
550
551
552
553
554
  }
  
  my $tr_adaptor = $self->{'adaptor'}->db()->get_TranscriptAdaptor;

  my $seq = $tr_adaptor->fetch_by_translation_id($dbID)->translate();
  $self->{'seq'} = $seq->seq();

  return $self->{'seq'};
}

555
556
557
558
=head2 get_all_Attributes

  Arg [1]    : optional string $attrib_code
               The code of the attribute type to retrieve values for.
559
  Example    : ($sc_attr) = @{$tl->get_all_Attributes('_selenocysteine')};
560
               @tl_attributes = @{$translation->get_all_Attributes()};
561
562
  Description: Gets a list of Attributes of this translation.
               Optionally just get Attrubutes for given code.
563
               Recognized attribute "_selenocysteine"
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
  Returntype : listref Bio::EnsEMBL::Attribute
  Exceptions : warning if translation does not have attached adaptor and 
               attempts lazy load.
  Caller     : general, modify_translation

=cut

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

  if( ! exists $self->{'attributes' } ) {
    if(!$self->adaptor() ) {
#      warning('Cannot get attributes without an adaptor.');
      return [];
    }

581
582
    my $aa = $self->adaptor->db->get_AttributeAdaptor();
    $self->{'attributes'} = $aa->fetch_all_by_Translation( $self );
583
584
585
  }

  if( defined $attrib_code ) {
586
    my @results = grep { uc($_->code()) eq uc($attrib_code) }
587
588
589
590
591
592
593
594
595
596
597
598
    @{$self->{'attributes'}};
    return \@results;
  } else {
    return $self->{'attributes'};
  }
}


=head2 add_Attributes

  Arg [1...] : Bio::EnsEMBL::Attribute $attribute
               You can have more Attributes as arguments, all will be added.
599
  Example    : $translation->add_Attributes($selenocysteine_attribute);
600
  Description: Adds an Attribute to the Translation. Usefull to 
601
               do _selenocysteine.
602
603
               If you add an attribute before you retrieve any from database, 
               lazy load will be disabled.
604
  Returntype : none
605
  Exceptions : throw on incorrect arguments
606
607
608
609
610
611
612
613
614
615
616
617
618
619
  Caller     : general

=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" )) {
620
      throw( "Argument to add_Attribute must be a Bio::EnsEMBL::Attribute" );
621
622
623
624
625
    }
    push( @{$self->{'attributes'}}, $attrib );
  }
}

626
=head2 get_all_SeqEdits
627

628
629
630
631
632
633
634
  Arg [1]    : none
  Example    : my @seqeds = @{$transcript->get_all_SeqEdits()};
  Description: Retrieves all post transcriptional sequence modifications for
               this transcript.
  Returntype : Bio::EnsEMBL::SeqEdit
  Exceptions : none
  Caller     : spliced_seq()
635
636
637

=cut

638
sub get_all_SeqEdits {
639
640
  my $self = shift;

641
  my @seqeds;
642

643
  my $attribs = $self->get_all_Attributes('_selenocysteine');
644

645
646
647
648
  # convert attributes to SeqEdit objects
  foreach my $a (@$attribs) {
    push @seqeds, Bio::EnsEMBL::SeqEdit->new(-ATTRIB => $a);
  }
649

650
651
  return \@seqeds;
}
652
653
654
655

=head2 modify_translation

  Arg    1   : Bio::Seq $peptide 
656
657
  Example    : my $seq = Bio::Seq->new(-SEQ => $dna)->translate();
               $translation->modify_translation($seq);
658
  Description: Applies sequence edits such as selenocysteines to the Bio::Seq 
659
               peptide thats passed in
660
  Returntype : Bio::Seq
661
  Exceptions :
662
663
664
665
666
667
668
  Caller     : Bio::EnsEMBL::Transcript->translate

=cut

sub modify_translation {
  my ($self, $seq) = @_;

669
  my @seqeds = @{$self->get_all_SeqEdits()};
670

671
672
  # sort in reverse order to avoid complication of adjusting downstream edits
  @seqeds = sort {$b <=> $a} @seqeds;
673

674
675
676
677
  # apply all edits
  my $peptide = $seq->seq();
  foreach my $se (@seqeds) {
    $se->apply_edit(\$peptide);
678
  }
679
  $seq->seq($peptide);
680
681
682
683
684

  return $seq;
}


685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
=head2 temporary_id

  Description: DEPRECATED This method should not be needed. Use dbID,
               stable_id or something else.

=cut

sub temporary_id {
   my $self = shift;
   deprecate( "I cant see what a temporary_id is good for, please use " .
               "dbID or stableID or\n try without an id." );
  $self->{'temporary_id'} = shift if( @_ );
  return $self->{'temporary_id'};
}


701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
=head2 get_all_DASFactories

  Arg [1]   : none
  Function  : Retrieves a listref of registered DAS objects
  Returntype: [ DAS_objects ]
  Exceptions:
  Caller    :
  Example   : $dasref = $prot->get_all_DASFactories

=cut

sub get_all_DASFactories {
   my $self = shift;
   return [ $self->adaptor()->db()->_each_DASFeatureFactory ];
}


Web Admin's avatar
testing  
Web Admin committed
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
=head2 get_all_DASFeatures

  Arg [1]    : none
  Example    : $features = $prot->get_all_DASFeatures;
  Description: Retreives a hash reference to a hash of DAS feature
               sets, keyed by the DNS, NOTE the values of this hash
               are an anonymous array containing:
                (1) a pointer to an array of features;
                (2) a pointer to the DAS stylesheet
  Returntype : hashref of Bio::SeqFeatures
  Exceptions : ?
  Caller     : webcode

=cut

sub get_all_DASFeatures{
734
735
736
737
  my ($self,@args) = @_;
  $self->{_das_features} ||= {}; # Cache
  my %das_features;
  foreach my $dasfact( @{$self->get_all_DASFactories} ){
738
739
740
741
742
    my $dsn  = $dasfact->adaptor->dsn;
    my $name = $dasfact->adaptor->name;
    $name ||= $dasfact->adaptor->url .'/'. $dsn;
    if( $self->{_das_features}->{$name} ){ # Use cached
      $das_features{$name} = $self->{_das_features}->{$name};
743
744
745
746
      next;
    }
    else{ # Get fresh data
      my @featref = $dasfact->fetch_all_by_DBLink_Container( $self );
747
748
      $self->{_das_features}->{$name} = [@featref];
      $das_features{$name} = [@featref];
Web Admin's avatar
testing  
Web Admin committed
749
    }
750
751
  }
  return \%das_features;
Web Admin's avatar
testing  
Web Admin committed
752
753
}

754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
=head2 get_all_DAS_Features

  Arg [1]    : none
  Example    : $features = $prot->get_all_DAS_Features;
  Description: Retreives a hash reference to a hash of DAS feature
               sets, keyed by the DNS, NOTE the values of this hash
               are an anonymous array containing:
                (1) a pointer to an array of features;
                (2) a pointer to the DAS stylesheet
  Returntype : hashref of Bio::SeqFeatures
  Exceptions : ?
  Caller     : webcode


=cut

sub get_all_DAS_Features{
  my ($self,@args) = @_;
  $self->{_das_features} ||= {}; # Cache
  my %das_features;

  my $db = $self->adaptor->db;
  my $GeneAdaptor = $db->get_GeneAdaptor;
  my $Gene = $GeneAdaptor->fetch_by_translation_stable_id($self->stable_id);	
  my $slice = $Gene->feature_Slice;

  foreach my $dasfact( @{$self->get_all_DASFactories} ){
    my $dsn = $dasfact->adaptor->dsn;
782
    my $name = $dasfact->adaptor->name;
783
    my $type = $dasfact->adaptor->type;
784

785
    my $key = defined($dasfact->adaptor->url) ? $dasfact->adaptor->url .'/'. $dsn : $dasfact->adaptor->protocol .'://'.$dasfact->adaptor->domain.'/'. $dsn;
786
787
788
789
790

	 $name ||= $key;

    if( $self->{_das_features}->{$name} ){ # Use cached
		  $das_features{$key} = $self->{_das_features}->{$name};
791
792
		  next;
    } else{ # Get fresh data
793
794
795
		  my @featref = ($type eq 'ensembl_location') ?  ($name, ($dasfact->fetch_all_by_Slice( $slice ))[0]) : $dasfact->fetch_all_by_ID( $self );
		  $self->{_das_features}->{$name} = [@featref];
		  $das_features{$name} = [@featref];
796
797
798
799
800
	 }
  }
  return \%das_features;
}

801
1;