File Coverage

Bio/CodonUsage/IO.pm
Criterion Covered Total %
statement 55 57 96.4
branch 19 22 86.3
condition 4 9 44.4
subroutine 6 6 100.0
pod 3 3 100.0
total 87 97 89.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::CodonUsage::IO
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Richard Adams (richard.adams@ed.ac.uk)
7             #
8             # Copyright Richard Adams
9             #
10             # You may distribute this module under the same terms as perl itself
11             # POD documentation - main docs before the code
12              
13             =head1 NAME
14              
15             Bio::CodonUsage::IO - for reading and writing codon usage tables to file
16              
17             =head1 SYNOPSIS
18              
19             use Bio::CodonUsage::IO;
20              
21             ## read in a codon usage file
22             my $io = Bio::CodonUsage::IO->new(-file => "in");
23             my $cut = $io->next_data();
24              
25             ## write it out again
26             my $out = Bio::CodonUsage::IO->new(-file => ">out");
27             $out->write_data($cut);
28              
29             =head1 DESCRIPTION
30              
31             This class provides standard IO methods for reading and writing text files
32             of codon usage tables. These tables can initially be retrieved using
33             Bio::DB::CUTG. At present only this format is supported for read/write.
34              
35             Reading a CUTG will return a Bio::CodonUsage::Table object.
36              
37             =head1 SEE ALSO
38              
39             L,
40             L,
41             L,
42             L
43              
44             =head1 FEEDBACK
45              
46             =head2 Mailing Lists
47              
48             User feedback is an integral part of the evolution of this and other
49             Bioperl modules. Send your comments and suggestions preferably to one
50             of the Bioperl mailing lists. Your participation is much appreciated.
51              
52             bioperl-l@bioperl.org - General discussion
53             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
54              
55             =head2 Support
56              
57             Please direct usage questions or support issues to the mailing list:
58              
59             I
60              
61             rather than to the module maintainer directly. Many experienced and
62             reponsive experts will be able look at the problem and quickly
63             address it. Please include a thorough description of the problem
64             with code and data examples if at all possible.
65              
66             =head2 Reporting Bugs
67              
68             Report bugs to the Bioperl bug tracking system to help us keep track
69             the bugs and their resolution. Bug reports can be submitted via the
70             web:
71              
72             https://github.com/bioperl/bioperl-live/issues
73              
74             =head1 AUTHORS
75              
76             Richard Adams, Richard.Adams@ed.ac.uk
77              
78             =head1 APPENDIX
79              
80             The rest of the documentation details each of the object
81             methods. Internal methods are usually preceded with a _
82              
83             =cut
84              
85              
86             # Let the code begin
87              
88             package Bio::CodonUsage::IO;
89 2     2   1383 use Bio::CodonUsage::Table;
  2         6  
  2         46  
90              
91 2     2   8 use base qw(Bio::Root::IO);
  2         2  
  2         1223  
92              
93             =head2 new
94              
95             Title : new
96             Usage : my $io = Bio::CodonUsage::IO->new(-file => "CUTfile");
97             Purpose: To read/write a Bio:CodonUsage::Table object
98             Returns: A Bio:CodonUsage::IO object
99             Args : a file or file handle
100              
101             =cut
102              
103             sub new {
104 4     4 1 8 my ($class , @args) = @_;
105 4         17 my $self = $class->SUPER::new(@args);
106             }
107              
108              
109             =head2 next_data
110              
111             Title : next_data
112             Usage : my $cut = $io->next_data();
113             Purpose: To obtain a Bio:CodonUsage::Table object
114             Returns: A Bio:CodonUsage::Table object
115             Args : none
116              
117             =cut
118              
119             sub next_data {
120 3     3 1 4 my $self = shift;
121 3         6 my $cut = $self->_parse;
122 3         9 return $cut;
123             }
124              
125             =head2 write_data
126              
127             Title : write_data
128             Usage : $io->write_data($cut);
129             Purpose: To write a CUT to file
130             Returns: void
131             Args : a Bio::CodonUsage::Table object reference
132              
133             =cut
134              
135              
136             sub write_data {
137 1     1 1 1 my ($self, $cut) = @_;
138 1 50 33     8 if (!$cut || ! $cut->isa(Bio::CodonUsage::Table)) {
139 0         0 $self->throw("must supply a Bio::CodonUsage::Table object for writing\n");
140             }
141 1         1 my $outstring = "Codon usage table\n\n";
142              
143 1         101 my $sp_string = $cut->species . "[" . $cut->_gb_db . "] " .
144             $cut->cds_count . " CDS's\n\n";
145 1         2 $outstring .= $sp_string;
146 1         2 my $colhead = sprintf("%-9s%-9s%15s%12s%12s\n\n", "AmAcid",
147             "Codon", "Number", "/1000", "Fraction");
148 1         1 $outstring .= $colhead;
149              
150             ### now write bulk of codon data ##
151 1         6 my $ctable = Bio::Tools::CodonTable->new;
152              
153 1         2 for my $f (qw(G A T C)) {
154 4         5 for my $s (qw(G A T C)) {
155 16         13 for my $t (qw(G A T C)) {
156 64         58 $cod = $f . $s . $t;
157 64         106 my $aa =$Bio::SeqUtils::THREECODE {$ctable->translate($cod)};
158             my $codstr = sprintf("%-9s%-9s%15.2f%12.2f%12.2f\n",
159              
160             $aa, $cod, my $tt = $cut->codon_count($cod)|| 0.00,
161 64   50     108 my $ll =$cut->{'_table'}{$aa}{$cod}{'per1000'}|| 0.00,
      50        
      50        
162             my $ss = $cut->codon_rel_frequency($cod) || 0.00);
163 64         104 $outstring .= $codstr;
164             }
165 16         17 $outstring .= "\n";
166             }
167             }
168 1         2 $outstring .= "\n\n";
169              
170             ## now append GC data
171 1         3 $outstring .= "Coding GC ". $cut->get_coding_gc('all'). "%\n";
172 1         2 $outstring .= "1st letter GC ". $cut->get_coding_gc(1). "%\n";
173 1         3 $outstring .= "2nd letter GC ". $cut->get_coding_gc(2). "%\n";
174 1         3 $outstring .= "3rd letter GC ". $cut->get_coding_gc(3). "%\n";
175 1         3 $outstring .= "Genetic code " . $cut->genetic_code() ."\n\n\n";
176              
177 1         6 $self->_print ($outstring);
178 1         2 $self->flush();
179              
180             }
181              
182             sub _parse {
183 3     3   4 my $self = shift;
184 3         14 my $cdtableobj = Bio::CodonUsage::Table->new();
185 3         12 while (my $line = $self->_readline() ) {
186 281 100       473 next if $line =~ /^$/ ;
187 216         169 $line =~ s/End/Ter/;
188             ## now parse in species name, cds number
189              
190 216 100       666 if ($line =~ /^(.+?)\s*\[(\w+)\].+?(\d+)/) {
    100          
191 3         7 $cdtableobj->species($1);
192 3         5 $cdtableobj->{'_gb_db'} = $2;
193 3         7 $cdtableobj->cds_count($3);
194             }
195              
196             ## now parse in bulk of codon usage table
197             elsif ( $line =~ /^(\w\w\w)\s+(\w+)\s+(\d+\.\d+)
198             \s+(\d+\.\d+)\s+(\d+\.\d+)/x){
199 192 50       251 if (defined ($1)) {
200 192         561 $cdtableobj->{'_table'}{$1}{$2} = {
201             'abs_count'=>$3,
202             'per1000'=> $4,
203             'rel_freq'=> $5,
204             };
205             }
206             }
207              
208             ## now parse in gc data ####
209 216 100       767 if($line =~ /^Cod.+?(\d\d\.\d\d)/ ){
    100          
    100          
    100          
    100          
210 3         12 $cdtableobj->{'_coding_gc'}{'all'} = $1;
211             }
212             elsif ($line =~ /^1st.+?(\d\d\.\d\d)/){
213 3         9 $cdtableobj->{'_coding_gc'}{'1'} = $1;
214             }
215             elsif($line =~ /^2nd.+?(\d\d\.\d\d)/){
216 3         8 $cdtableobj->{'_coding_gc'}{'2'} = $1;
217             }
218             elsif ($line =~ /^3rd.+?(\d\d\.\d\d)/){
219 3         8 $cdtableobj->{'_coding_gc'}{'3'} = $1;
220             }
221              
222             elsif ($line =~ /^Gen.+?(\d+)/){
223 3         8 $cdtableobj->{'_genetic_code'} = $1;
224             }
225             }
226             ## check has been parsed ok ##
227 3 50       3 if (scalar keys %{$cdtableobj->{'_table'}} != 21) {
  3         13  
228 0         0 $cdtableobj->warn("probable parsing error - should be 21 entries for 20aa + stop codon");
229             }
230 3         4 return $cdtableobj;
231            
232             }
233              
234             1;
235              
236             __END__