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

« back to all changes in this revision

Viewing changes to Bio/Cluster/SequenceFamily.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
104
104
package Bio::Cluster::SequenceFamily;
105
105
 
106
106
use strict;
107
 
 
 
107
use warnings;
108
108
use base qw(Bio::Root::Root Bio::Cluster::FamilyI);
109
109
 
110
 
 
111
110
=head2 new
112
111
 
113
112
 Title   : new
323
322
=cut
324
323
 
325
324
sub get_members {
326
 
        my $self = shift;
327
 
        my @ret;
 
325
    my $self = shift;
 
326
    return @{$self->{'_members'}} unless @_;
328
327
 
329
 
        if(@_) {
330
 
                my %hash = @_;
331
 
                foreach my $mem ( @{$self->{'_members'}} ) {
332
 
                        foreach my $key ( keys %hash){
333
 
                                my $method = $key;
334
 
                                $method=~s/-//g;
335
 
                                if($mem->can('species')){
336
 
                                        my $species = $mem->species;
337
 
                                        $species->can($method) ||
338
 
                                          $self->throw("$method is an invalid criteria");
339
 
                                        if($species->$method() eq $hash{$key} ){
340
 
                                                push @ret, $mem;
341
 
                                        }
342
 
                                }
343
 
                        }
344
 
                }
345
 
                return @ret;
346
 
        }
347
 
        return @{$self->{'_members'}};
 
328
    ## since the logic behind the checks is OR, we keep the ids in an hash for
 
329
    ## performance (skip the test if it's already there) and to avoid repats
 
330
    my %match;
 
331
    my %filter = @_;
 
332
    foreach my $key (keys %filter) {
 
333
        (my $method = $key) =~ s/^-//;
 
334
        %match = (%match, map { $_ => $_ } grep {
 
335
            ! $match{$_} && $_->species &&
 
336
            ($_->species->can($method) ||
 
337
                $self->throw("$method is an invalid criteria")) &&
 
338
            $_->species->$method() eq $filter{$key}
 
339
        } @{$self->{'_members'}});
 
340
    }
 
341
    return map {$match{$_}} keys (%match);
348
342
}
349
343
 
350
344
=head2 size