File Coverage

blib/lib/Bio/MUST/Core/Taxonomy/Labeler.pm
Criterion Covered Total %
statement 12 24 50.0
branch 0 6 0.0
condition 0 4 0.0
subroutine 4 6 66.6
pod 1 2 50.0
total 17 42 40.4


line stmt bran cond sub pod time code
1             package Bio::MUST::Core::Taxonomy::Labeler;
2             # ABSTRACT: Helper class for simple labeler based on taxonomy
3             $Bio::MUST::Core::Taxonomy::Labeler::VERSION = '0.212530';
4 17     17   11500 use Moose;
  17         50  
  17         124  
5 17     17   118049 use namespace::autoclean;
  17         51  
  17         165  
6              
7 17     17   1704 use Carp;
  17         54  
  17         1318  
8              
9 17     17   136 use Bio::MUST::Core::Types;
  17         48  
  17         5080  
10             with 'Bio::MUST::Core::Roles::Taxable';
11              
12              
13             has 'labels' => (
14             is => 'ro',
15             isa => 'Bio::MUST::Core::IdList',
16             required => 1,
17             coerce => 1,
18             handles => {
19             all_labels => 'all_ids',
20             is_a_label => 'is_listed',
21             },
22             );
23              
24              
25             sub BUILD {
26 0     0 0   my $self = shift;
27              
28             # warn in case of ambiguous taxa
29 0           for my $taxon ( $self->all_labels ) {
30 0 0         carp "[BMC] Warning: $taxon is taxonomically ambiguous in labeler!"
31             if $self->tax->is_dupe($taxon);
32             }
33              
34 0           return;
35             }
36              
37              
38              
39             sub classify {
40 0     0 1   my $self = shift;
41 0           my $seq_id = shift;
42 0   0       my $args = shift // {};
43              
44 0   0       my $greedy = $args->{greedy} // 0;
45              
46 0           my @lineage = $self->tax->fetch_lineage($seq_id);
47 0 0         while (my $taxon = $greedy ? shift @lineage : pop @lineage) {
48 0 0         return $taxon if $self->is_a_label($taxon);
49             }
50              
51             # return undef if no suitable taxon
52 0           return;
53             }
54              
55             __PACKAGE__->meta->make_immutable;
56             1;
57              
58             __END__
59              
60             =pod
61              
62             =head1 NAME
63              
64             Bio::MUST::Core::Taxonomy::Labeler - Helper class for simple labeler based on taxonomy
65              
66             =head1 VERSION
67              
68             version 0.212530
69              
70             =head1 SYNOPSIS
71              
72             # TODO
73              
74             =head1 DESCRIPTION
75              
76             # TODO
77              
78             =head1 METHODS
79              
80             =head2 classify
81              
82             =head1 AUTHOR
83              
84             Denis BAURAIN <denis.baurain@uliege.be>
85              
86             =head1 COPYRIGHT AND LICENSE
87              
88             This software is copyright (c) 2013 by University of Liege / Unit of Eukaryotic Phylogenomics / Denis BAURAIN.
89              
90             This is free software; you can redistribute it and/or modify it under
91             the same terms as the Perl 5 programming language system itself.
92              
93             =cut