File Coverage

blib/lib/Bio/PrimerDesigner/Tables.pm
Criterion Covered Total %
statement 36 66 54.5
branch 7 26 26.9
condition 4 18 22.2
subroutine 8 11 72.7
pod 7 7 100.0
total 62 128 48.4


line stmt bran cond sub pod time code
1             package Bio::PrimerDesigner::Tables;
2              
3             # $Id: Tables.pm 9 2008-11-06 22:48:20Z kyclark $
4              
5             =pod
6              
7             =head1 NAME
8              
9             Bio::PrimerDesigner::Table -- Draw HTML tables for PCR primer display
10              
11             =head1 DESCRIPTION
12              
13             Draws simple HTML tables to display Bio::PrimerDesigner PCR primer
14             design and e-PCR results for web applications.
15              
16             =head1 METHODS
17              
18             =cut
19              
20 2     2   5065 use strict;
  2         6  
  2         75  
21 2     2   12 use warnings;
  2         5  
  2         65  
22 2     2   11 use Readonly;
  2         3  
  2         272  
23              
24             Readonly our
25             $VERSION => sprintf "%s", q$Revision: 24 $ =~ /(\d+)/;
26              
27 2     2   11 use base 'Class::Base';
  2         3  
  2         1815  
28              
29             # -------------------------------------------------------------------
30             sub info_table {
31              
32             =head2 info_table
33              
34             Prints a two-column table for generic, key-value style annotations.
35             Expects to be passed the name of the gene/feature/etc. and a hash of
36             attributes. If there is an 'image' key, the value is assumed to be an
37             image URL, which is printed in a double-wide cell at the bottom of the
38             table.
39              
40              
41             my $gene = 'Abc-1';
42             my %gene_info = (
43             Chromosome => I,
44             Start => 100450,
45             Stop => 102893,
46             Strand => '+'
47             );
48              
49             my $page = Bio::PrimerDesigner::Tables->new;
50             $page->info_table( $gene, %gene_info );
51              
52             =cut
53              
54 1     1 1 7 my $self = shift;
55 1 50       4 my $name = shift or return $self->error('No name argument');
56 1 50       5 my %info = @_ or return $self->error('No attributes');
57 1   50     6 my $image = $info{'image'} || '';
58 1 50       2 delete $info{'image'} if $image;
59 1         4 my $table .= <<" END";
60            
61            
62            
63             $name Information
64            
65            
66             END
67              
68 1         4 for my $key (sort keys %info) {
69 1 50       4 next if $key eq 'other';
70            
71 1         2 my $ukey = ucfirst $key;
72            
73 1         11 $table .= <<" END";
74            
75            
76             $ukey
77            
78            
79             $info{$key}
80            
81            
82             END
83             }
84            
85 1         3 my $other = $info{'other'};
86 1 50       3 $table .= <<" END" if $other;
87            
88            
89             Other
90            
91            
92             $other
93            
94            
95             END
96            
97 1 50       23 $table .= $image ? "
$image
"
98             : "
";
99             }
100              
101             # -------------------------------------------------------------------
102             sub PCR_header {
103              
104             =head2 PCR_header
105              
106             Returns a generic header for the PCR primer table. Does not expect
107             any argumments.
108              
109             =cut
110              
111 1     1 1 2 my $self = shift;
112              
113 1         5 return "
114            
115            
116            
117             PCR Primers
118            
119            
120            
121             "
122             }
123              
124             # -------------------------------------------------------------------
125             sub PCR_set {
126              
127             =head2 PCR_set
128              
129             Returns the top row for the PCR primer table. Expects the primer set
130             number as its only argument.
131              
132             =cut
133              
134 1     1 1 3 my $self = shift;
135 1   50     7 my $num = shift || '';
136              
137 1         6 return "
138            
139            
140            
141             Set $num
142            
143             Primer
144             Sequence
145             Tm
146             Coordinate
147             Primer Pair Quality
148            
149             ";
150             }
151              
152             # -------------------------------------------------------------------
153             sub PCR_row {
154              
155             =head2 PCR_row
156              
157             Returns table rows with PCR primer info. Should be called once for
158             each primer pair. Expects to be passed a hash containing the
159             Bio::PrimerDesigner::Result object and the primer set number and an
160             (optional) label.
161              
162             my $pcr_row = PCR_row(
163             primers => $result_obj,
164             setnum => $set_number,
165             label => $label
166             );
167              
168             =cut
169              
170 1     1 1 2 my $self = shift;
171 1 50       7 my %primers = @_ or return $self->error('No arguments for PCR_row method');
172 1   50     7 my $set = $primers{'setnum'} || 1;
173 1   50     6 my $label = $primers{'label'} || 1;
174 1         2 my %args = %{$primers{'primers'}{$set}};
  1         209  
175            
176 0           return "
177            
178             $label
179             Forward
180             $args{'left'}
181             $args{'tmleft'}
182             $args{'startleft'}
183              
184            
185            
186              
187             Reverse
188             $args{'right'}
189             $args{'tmright'}
190             $args{'startright'}
191             $args{'qual'}
192            
193             ";
194             }
195              
196             # -------------------------------------------------------------------
197             sub ePCR_row {
198              
199             =head2 ePCR_row
200              
201             Returns table rows summarizing e-PCR results. Expects to be passed an
202             Bio::PrimerDesigner::Result e-PCR results object and an optional e-PCR label.
203              
204             =cut
205              
206 0     0 1   my $self = shift;
207 0 0         my $args = shift or return $self->error('No arguments for ePCR_row method');
208 0           my %epcr = %$args;
209 0           my $label = shift;
210 0           my $num_prods = $epcr{1}{'products'};
211 0 0         my $s = $num_prods > 1 ? 's' : '';
212 0   0       $num_prods ||= 'No';
213 0           my $sizes = '';
214              
215 0           for (1..$num_prods) {
216 0 0         if ($_ == 1) {
    0          
217 0           $sizes = "Size$s $epcr{$_}{'size'}"
218             }
219             elsif ($_ < $num_prods) {
220 0           $sizes .= ", " . $epcr{$_}{'size'}
221             }
222             else {
223 0           $sizes .= "and " . $epcr{$_}{'size'}
224             }
225             }
226 0 0         $sizes .= " bp" if $num_prods ne 'No';
227 0           my $row = "
228            
229            
230             $label e-PCR Results:
231              $num_prods product${s}
232               
233             $sizes
234            
235            
236            
 
237             ";
238              
239 0           $row;
240             }
241              
242             # -------------------------------------------------------------------
243             sub render {
244              
245             =head2 render
246              
247             Renders the image URL. Expects to be passed a hash of the map start
248             and stop, and other features to be mapped (i.e.
249             gene,forward_primer,reverse_primer, label,start and stop of each
250             feature, and gene strand).
251              
252             my $image = $page->render(
253             start => $startleft,
254             stop => $startright,
255             feat => $features
256             );
257              
258             =cut
259              
260 0     0 1   my $self = shift;
261 0 0         my %draw = @_ or return $self->error('No name argument');
262 0   0       my $start = $draw{'start'} || 0;
263 0   0       my $stop = $draw{'stop'} || 0;
264 0   0       my $feat = $draw{'feat'} || '';
265              
266 0           (my $config = <<"END") =~ s/^\s+//gm;
267             [general]
268             bases = $start-$stop
269             height = 12
270              
271             [gene]
272             glyph = transcript2
273             bgcolor = cyan
274             label = 1
275             description = 1
276             height = 7
277              
278             [forward_primer]
279             glyph = triangle
280             bgcolor = blue
281             orient = E
282             height = 7
283             label = 1
284              
285             [reverse_primer]
286             glyph = triangle
287             bgcolor = green
288             orient = W
289             height = 7
290             label = 1
291              
292             $feat
293             END
294              
295 0           $config =~ s/\n/@@/gm;
296 0           $config =~ s/\s+/%20/g;
297              
298 0           $config = "
299             "perl/render?width=700;text=\'$config\'\">";
300 0           return $config;
301             }
302              
303             # -------------------------------------------------------------------
304             sub PCR_map {
305              
306             =head2 PCR_map
307              
308             Returns a 6 column wide table cell with the info.
309             Will display the image of mapped primers in the browser when
310             passed the image URL.
311              
312             =cut
313              
314 0     0 1   my $self = shift;
315 0   0       my $image_url = shift || '';
316            
317 0           return "
318            
319            
320             $image_url
321            
322            
323            
324              
325            
326             ";
327             }
328              
329             1;
330              
331             # -------------------------------------------------------------------
332              
333             =pod
334              
335             =head1 AUTHOR
336              
337             Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE.
338              
339             =head1 LICENSE
340              
341             This program is free software; you can redistribute it and/or modify
342             it under the terms of the GNU General Public License as published by
343             the Free Software Foundation; version 3 or any later version.
344              
345             This program is distributed in the hope that it will be useful, but
346             WITHOUT ANY WARRANTY; without even the implied warranty of
347             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
348             General Public License for more details.
349              
350             You should have received a copy of the GNU General Public License
351             along with this program; if not, write to the Free Software
352             Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
353             USA.
354              
355             =head1 SEE ALSO
356              
357             Bio::PrimerDesigner::primer3, Bio::PrimerDesigner::epcr.
358              
359             =cut