File Coverage

Bio/Matrix/IO/mlagan.pm
Criterion Covered Total %
statement 34 35 97.1
branch 7 10 70.0
condition 1 3 33.3
subroutine 5 5 100.0
pod 2 2 100.0
total 49 55 89.0


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Matrix::IO::mlagan
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Sendu Bala
7             #
8             # Copyright Sendu Bala
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::Matrix::IO::mlagan - A parser for the mlagan substitution matrix
17              
18             =head1 SYNOPSIS
19              
20             use Bio::Matrix::IO;
21             my $parser = Bio::Matrix::IO->new(-format => 'mlagan',
22             -file => 'nucmatrix.txt');
23             my $matrix = $parser->next_matrix;
24             my $gap_open = $parser->gap_open;
25             my $gap_continue = $parser->gap_continue;
26              
27             =head1 DESCRIPTION
28              
29             Use to read in and write out substitution matrix files suitable for use by
30             mlagan.
31              
32             =head1 FEEDBACK
33              
34             =head2 Mailing Lists
35              
36             User feedback is an integral part of the evolution of this and other
37             Bioperl modules. Send your comments and suggestions preferably to
38             the Bioperl mailing list. Your participation is much appreciated.
39              
40             bioperl-l@bioperl.org - General discussion
41             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
42              
43             =head2 Support
44              
45             Please direct usage questions or support issues to the mailing list:
46              
47             I
48              
49             rather than to the module maintainer directly. Many experienced and
50             reponsive experts will be able look at the problem and quickly
51             address it. Please include a thorough description of the problem
52             with code and data examples if at all possible.
53              
54             =head2 Reporting Bugs
55              
56             Report bugs to the Bioperl bug tracking system to help us keep track
57             of the bugs and their resolution. Bug reports can be submitted via
58             the web:
59              
60             https://github.com/bioperl/bioperl-live/issues
61              
62             =head1 AUTHOR - Sendu Bala
63              
64             Email bix@sendu.me.uk
65              
66             =head1 APPENDIX
67              
68             The rest of the documentation details each of the object methods.
69             Internal methods are usually preceded with a _
70              
71             =cut
72              
73             # Let the code begin...
74              
75             package Bio::Matrix::IO::mlagan;
76 1     1   4 use strict;
  1         1  
  1         24  
77              
78 1     1   315 use Bio::Matrix::Mlagan;
  1         2  
  1         23  
79 1     1   4 use base qw(Bio::Matrix::IO);
  1         1  
  1         312  
80              
81             =head2 new
82              
83             Title : new
84             Usage : my $obj = Bio::Matrix::IO::mlagan->new();
85             Function: Builds a new Bio::Matrix::IO::mlagan object
86             Returns : an instance of Bio::Matrix::IO::mlagan
87             Args :
88              
89             =cut
90              
91             =head2 next_matrix
92              
93             Title : next_matrix
94             Usage : my $matrix = $obj->next_matrix();
95             Function: parses a matrix file
96             Returns : L
97             Args : none
98              
99             =cut
100              
101             sub next_matrix {
102 2     2 1 3 my $self = shift;
103            
104 2         2 my (@matrix, $gap_open, $gap_cont);
105 2         6 while (defined ($_ = $self->_readline)) {
106 18 100       40 if (/^[ACGTN\.]/) {
    100          
107 12         29 my (undef, @values) = split;
108 12         23 push(@matrix, \@values);
109             }
110             elsif (/^[-\d]/) {
111 2         5 ($gap_open, $gap_cont) = split;
112 2         3 last;
113             }
114             }
115            
116 2 50       4 @matrix == 6 || $self->throw("Something wrong with file, was it the correct format?");
117            
118 2         11 my $matrix = Bio::Matrix::Mlagan->new(-values => \@matrix,
119             -gap_open => $gap_open,
120             -gap_continue => $gap_cont);
121            
122 2         8 return $matrix;
123             }
124              
125             =head2 write_matrix
126              
127             Title : write_matrix
128             Usage : $obj->write_matrix($matrix)
129             Function: Write out a matrix in mlagan format
130             Returns : n/a
131             Args : L
132              
133             =cut
134              
135             sub write_matrix {
136 1     1 1 2 my ($self, $matrix) = @_;
137 1 50       2 $matrix || $self->throw("Matrix required as input");
138 1         2 my $gap_open = $matrix->gap_open;
139 1         2 my $gap_continue = $matrix->gap_continue;
140            
141 1 50 33     4 unless (defined $gap_open && defined $gap_continue) {
142 0         0 $self->throw("gap_open() and gap_continue() in the supplied matrix object must both be set");
143             }
144            
145 1         5 $self->_print(" A C G T . N\n");
146            
147 1         2 foreach my $char (qw(A C G T . N)) {
148 6         15 my @row = $matrix->get_row($char);
149 6         6 my $row = $char;
150 6         6 foreach my $val (@row) {
151 36         35 $row .= " " x (5 - length($val)) . $val;
152             }
153            
154 6         12 $self->_print($row."\n");
155             }
156            
157 1         3 $self->_print("\n$gap_open $gap_continue");
158            
159 1         2 return;
160             }
161              
162             1;