← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/Annotation/Collection.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Annotation/Collection.pm
1
 
# $Id: Collection.pm,v 1.23.4.1 2006/10/02 23:10:12 sendu Exp $
2
 
 
 
1
# $Id: Collection.pm 14802 2008-08-15 06:01:18Z miraceti $
3
2
#
4
3
# BioPerl module for Bio::Annotation::Collection.pm
5
4
#
150
149
    my @anns = ();
151
150
    @keys = $self->get_all_annotation_keys() unless @keys;
152
151
    foreach my $key (@keys) {
153
 
        if(exists($self->{'_annotation'}->{$key})) {
154
 
            push(@anns,
155
 
                 map {
156
 
                     $_->tagname($key) if ! $_->tagname(); $_;
157
 
                 } @{$self->{'_annotation'}->{$key}});
158
 
        }
 
152
      if(exists($self->{'_annotation'}->{$key})) {
 
153
        push(@anns,
 
154
            map {
 
155
            $_->tagname($key) if ! $_->tagname(); $_;
 
156
            } @{$self->{'_annotation'}->{$key}});
 
157
      }
159
158
    }
160
159
    return @anns;
161
160
}
162
161
 
 
162
 
 
163
=head2 get_nested_Annotations
 
164
 
 
165
 Title   : get_nested_Annotations
 
166
 Usage   : my @annotations = $collection->get_nested_Annotations(
 
167
                                '-key' => \@keys,
 
168
                                '-recursive => 1);
 
169
 Function: Retrieves all the Bio::AnnotationI objects for one or more
 
170
           specific key(s). If -recursive is set to true, traverses the nested 
 
171
           annotation collections recursively and returns all annotations 
 
172
           matching the key(s).
 
173
 
 
174
           If no key is given, returns all annotation objects.
 
175
 
 
176
           The returned objects will have their tagname() attribute set to
 
177
           the key under which they were attached, unless the tagname was
 
178
           already set.
 
179
 
 
180
 Returns : list of Bio::AnnotationI - empty if no objects stored for a key
 
181
 Args    : -keys      => arrayref of keys to search for (optional)
 
182
           -recursive => boolean, whether or not to recursively traverse the 
 
183
            nested annotations and return annotations with matching keys.
 
184
 
 
185
=cut
 
186
 
 
187
sub get_nested_Annotations {
 
188
  my ($self, @args) = @_;
 
189
  my ($keys, $recursive) = $self->_rearrange([qw(KEYS RECURSIVE)], @args);
 
190
  $self->verbose(1);
 
191
  
 
192
  my @anns = ();
 
193
  # if not recursive behave exactly like get_Annotations()
 
194
  if (!$recursive) {
 
195
          my @keys = $keys? @$keys : $self->get_all_annotation_keys();
 
196
    foreach my $key (@keys) {
 
197
      if(exists($self->{'_annotation'}->{$key})) {
 
198
        push(@anns,
 
199
            map {
 
200
            $_->tagname($key) if ! $_->tagname(); $_;
 
201
            } @{$self->{'_annotation'}->{$key}});
 
202
      }
 
203
    }
 
204
  }
 
205
  # if recursive search for keys recursively
 
206
  else {
 
207
    my @allkeys = $self->get_all_annotation_keys();
 
208
    foreach my $key (@allkeys) {
 
209
      my $keymatch = 0;
 
210
      foreach my $searchkey (@$keys) {
 
211
        if ($key eq $searchkey) { $keymatch = 1;}
 
212
      }
 
213
      if ($keymatch) {
 
214
        if(exists($self->{'_annotation'}->{$key})) {
 
215
          push(@anns,
 
216
              map {
 
217
              $_->tagname($key) if ! $_->tagname(); $_;
 
218
              } @{$self->{'_annotation'}->{$key}});
 
219
        }
 
220
      }
 
221
      else {
 
222
        my @annotations = @{$self->{'_annotation'}->{$key}};
 
223
        foreach (@annotations) {
 
224
          if ($_->isa("Bio::AnnotationCollectionI")) {
 
225
            push (@anns, 
 
226
                  $_->get_nested_Annotations('-keys' => $keys, '-recursive' => 1)
 
227
                 );
 
228
          }
 
229
        }
 
230
      }
 
231
    }
 
232
  }
 
233
  return @anns;
 
234
}
 
235
 
163
236
=head2 get_all_Annotations
164
237
 
165
238
 Title   : get_all_Annotations
190
263
    } $self->get_Annotations(@keys);
191
264
}
192
265
 
 
266
 
193
267
=head2 get_num_of_annotations
194
268
 
195
269
 Title   : get_num_of_annotations
258
332
   }
259
333
 
260
334
   if( !$object->isa("Bio::AnnotationI") ) {
261
 
       $self->throw("object must be AnnotationI compliant, otherwise we wont add it!");
 
335
       $self->throw("object must be AnnotationI compliant, otherwise we won't add it!");
262
336
   }
263
337
 
264
338
   # ok, now we are ready! If we don't have an archetype, set it
276
350
       # this means isa stuff is executed correctly
277
351
 
278
352
       if( !$self->_typemap()->is_valid($key,$object) ) {
279
 
           $self->throw("Object $object was not valid with key $key. If you were adding new keys in, perhaps you want to make use of the archetype method to allow registration to a more basic type");
 
353
           $self->throw("Object $object was not valid with key $key. ".
 
354
         "If you were adding new keys in, perhaps you want to make use\n".
 
355
         "of the archetype method to allow registration to a more basic type");
280
356
       }
281
357
   } else {
282
358
       $self->_typemap->_add_type_map($key,$archetype);
354
430
 
355
431
=head1 Bio::AnnotationI methods implementations
356
432
 
357
 
   This is to allow nested annotation: you can a collection as an
358
 
   annotation object to an annotation collection.
 
433
   This is to allow nested annotation: you can use a collection as an
 
434
   annotation object for an annotation collection.
359
435
 
360
436
=cut
361
437
 
387
463
    return $txt;
388
464
}
389
465
 
 
466
=head2 display_text
 
467
 
 
468
 Title   : display_text
 
469
 Usage   : my $str = $ann->display_text();
 
470
 Function: returns a string. Unlike as_text(), this method returns a string
 
471
           formatted as would be expected for te specific implementation.
 
472
 
 
473
           One can pass a callback as an argument which allows custom text
 
474
           generation; the callback is passed the current instance and any text
 
475
           returned
 
476
 Example :
 
477
 Returns : a string
 
478
 Args    : [optional] callback
 
479
 
 
480
=cut
 
481
 
 
482
{
 
483
   # this just calls the default display_text output for
 
484
   # any AnnotationI
 
485
  my $DEFAULT_CB = sub {
 
486
    my $obj = shift;
 
487
    my $txt;
 
488
    foreach my $ann ($obj->get_Annotations()) {
 
489
      $txt .= $ann->display_text()."\n";
 
490
    }
 
491
    return $txt;
 
492
    };
 
493
 
 
494
  sub display_text {
 
495
    my ($self, $cb) = @_;
 
496
    $cb ||= $DEFAULT_CB;
 
497
    $self->throw("") if ref $cb ne 'CODE';
 
498
    return $cb->($self);
 
499
  }
 
500
}
 
501
 
 
502
 
390
503
=head2 hash_tree
391
504
 
392
505
 Title   : hash_tree