File Coverage

Bio/Symbol/Alphabet.pm
Criterion Covered Total %
statement 26 38 68.4
branch 8 14 57.1
condition 4 9 44.4
subroutine 5 6 83.3
pod 4 4 100.0
total 47 71 66.2


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Symbol::Alphabet
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
7             #
8             # Copyright Jason Stajich
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::Symbol::Alphabet - BSANE/BioCORBA compliant symbol list alphabet
17              
18             =head1 SYNOPSIS
19              
20             {
21             my $alphabet = Bio::Symbols::Alphabet->new(-symbols => [ @s ],
22             -subalphabets => [ @alphas ] );
23              
24             my @symbols = $alphabet->symbols;
25             my @subalphas = $alphabet->alphabets;
26             if( $alphabet->contains($symbol) ) {
27             # do something
28             }
29             }
30              
31             =head1 DESCRIPTION
32              
33             Alphabet contains set of symbols, which can be concatenated to
34             form symbol lists. Sequence string, for example, is stringified
35             representation of the symbol list (tokens of symbols).
36              
37             This module was implemented for the purposes of meeting the
38             BSANE/BioCORBA spec 0.3 only.
39              
40             =head1 FEEDBACK
41              
42             =head2 Mailing Lists
43              
44             User feedback is an integral part of the evolution of this and other
45             Bioperl modules. Send your comments and suggestions preferably to
46             the Bioperl mailing list. Your participation is much appreciated.
47              
48             bioperl-l@bioperl.org - General discussion
49             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
50              
51             =head2 Support
52              
53             Please direct usage questions or support issues to the mailing list:
54              
55             I
56              
57             rather than to the module maintainer directly. Many experienced and
58             reponsive experts will be able look at the problem and quickly
59             address it. Please include a thorough description of the problem
60             with code and data examples if at all possible.
61              
62             =head2 Reporting Bugs
63              
64             Report bugs to the Bioperl bug tracking system to help us keep track
65             of the bugs and their resolution. Bug reports can be submitted via the
66             web:
67              
68             https://github.com/bioperl/bioperl-live/issues
69              
70             =head1 AUTHOR - Jason Stajich
71              
72             Email jason@bioperl.org
73              
74             =head1 APPENDIX
75              
76             The rest of the documentation details each of the object methods.
77             Internal methods are usually preceded with a _
78              
79             =cut
80              
81              
82             # Let the code begin...
83              
84              
85             package Bio::Symbol::Alphabet;
86 2     2   434 use strict;
  2         3  
  2         56  
87              
88             # Object preamble - inherits from Bio::Root::Root
89              
90              
91 2     2   7 use base qw(Bio::Root::Root Bio::Symbol::AlphabetI);
  2         3  
  2         503  
92              
93             =head2 new
94              
95             Title : new
96             Usage : my $obj = Bio::Symbol::Alphabet->new();
97             Function: Builds a new Bio::Symbol::Alphabet object
98             Returns : Bio::Symbol::Alphabet
99             Args : -symbols => Array ref of Bio::Symbol::SymbolI objects
100             -subalphas=> Array ref of Bio::Symbol::AlphabetI objects
101             representing sub alphabets
102              
103             =cut
104              
105             sub new {
106 18     18 1 35 my($class,@args) = @_;
107              
108 18         33 my $self = $class->SUPER::new(@args);
109 18         33 $self->{'_symbols'} = [];
110 18         23 $self->{'_alphabets'} = [];
111 18         45 my ($symbols, $subalphas) = $self->_rearrange([qw(SYMBOLS SUBALPHAS)],
112             @args);
113              
114 18 100 66     93 defined $symbols && ref($symbols) =~ /array/i && $self->symbols(@$symbols);
115 18 50 33     29 defined $subalphas && ref($subalphas) =~ /array/i && $self->alphabets(@$subalphas);
116 18         30 return $self;
117             }
118              
119             =head2 AlphabetI Interface methods
120              
121             =cut
122              
123             =head2 symbols
124              
125             Title : symbols
126             Usage : my @symbols = $alphabet->symbols();
127             Function: Get/Set Symbol list for an alphabet
128             List of symbols, which make up this alphabet.
129             Returns : Array of Bio::Symbol::SymbolI objects
130             Args : (optionalalphabets) Array of Bio::Symbol::SymbolI objects
131              
132             =cut
133              
134             sub symbols {
135 25     25 1 1230 my ($self,@args) = @_;
136 25 100       33 if( @args ) {
137 18         27 $self->{'_symbols'} = [];
138 18         23 foreach my $symbol ( @args ) {
139 86 50 33     270 if( ! defined $symbol || ! ref($symbol) ||
140             ! $symbol->isa('Bio::Symbol::SymbolI') ) {
141 0         0 $self->warn("Did not provide a proper Bio::Symbol::SymbolI to method 'symbols' (got $symbol)");
142             } else {
143 86         70 push @{$self->{'_symbols'}}, $symbol;
  86         120  
144             }
145             }
146             }
147 25         26 return @{$self->{'_symbols'}};
  25         43  
148             }
149              
150             =head2 alphabets
151              
152             Title : alphabets
153             Usage : my @alphabets = $alphabet->alphabets();
154             Function: Get/Set Sub Alphabet list for an alphabet
155             Sub-alphabets. E.g. codons made from DNAxDNAxDNA alphabets
156             Returns : Array of Bio::Symbol::AlphabetI objects
157             Args : (optional) Array of Bio::Symbol::AlphabetI objects
158              
159             =cut
160              
161             sub alphabets {
162 0     0 1 0 my ($self,@args) = @_;
163 0 0       0 if( @args ) {
164 0         0 $self->{'_alphabets'} = [];
165 0         0 foreach my $alpha ( @args ) {
166 0 0       0 if( ! $alpha->isa('Bio::Symbol::AlphabetI') ) {
167 0         0 $self->warn("Did not provide a proper Bio::Symbol::AlphabetI to method 'alphabets' (got $alpha)");
168             } else {
169 0         0 push @{$self->{'_alphabets'}}, $alpha;
  0         0  
170             }
171             }
172             }
173 0         0 return @{$self->{'_alphabets'}};
  0         0  
174             }
175              
176             =head2 contains
177              
178             Title : contains
179             Usage : if($alphabet->contains($symbol)) { }
180             Function: Tests of Symbol is contained in this alphabet
181             Returns : Boolean
182             Args : Bio::Symbol::SymbolI
183              
184             =cut
185              
186             sub contains{
187 4     4 1 473 my ($self,$testsymbol) = @_;
188 4         8 foreach my $symbol ( $self->symbols ) {
189 10 100       43 return 1 if( $symbol->equals($testsymbol) );
190             }
191 0           return 0;
192             }
193              
194             1;