File Coverage

Bio/Tools/Phylo/Phylip/ProtDist.pm
Criterion Covered Total %
statement 40 44 90.9
branch 7 10 70.0
condition 2 3 66.6
subroutine 5 5 100.0
pod 2 2 100.0
total 56 64 87.5


line stmt bran cond sub pod time code
1             # BioPerl module for Bio::Tools::Phylo::Phylip::ProtDist
2             #
3             # Please direct questions and support issues to
4             #
5             # Cared for by Shawn Hoon
6             #
7             # Copyright Shawn Hoon
8             #
9             # You may distribute this module under the same terms as perl itself
10              
11             # POD documentation - main docs before the code
12              
13             =head1 NAME
14              
15             Bio::Tools::Phylo::Phylip::ProtDist - parser for ProtDist output
16              
17             =head1 SYNOPSIS
18              
19             use Bio::Tools::Phylo::Phylip::ProtDist;
20             my $parser = Bio::Tools::Phylo::Phylip::ProtDist->new(-file => 'outfile');
21             while( my $result = $parser->next_matrix) {
22             # do something with it
23             }
24              
25             =head1 DESCRIPTION
26              
27             A parser for ProtDist output into a L object.
28             See also L this module may go away.
29              
30             =head1 FEEDBACK
31              
32             =head2 Mailing Lists
33              
34             User feedback is an integral part of the evolution of this and other
35             Bioperl modules. Send your comments and suggestions preferably to
36             the Bioperl mailing list. Your participation is much appreciated.
37              
38             bioperl-l@bioperl.org - General discussion
39             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
40              
41             =head2 Support
42              
43             Please direct usage questions or support issues to the mailing list:
44              
45             I
46              
47             rather than to the module maintainer directly. Many experienced and
48             reponsive experts will be able look at the problem and quickly
49             address it. Please include a thorough description of the problem
50             with code and data examples if at all possible.
51              
52             =head2 Reporting Bugs
53              
54             Report bugs to the Bioperl bug tracking system to help us keep track
55             of the bugs and their resolution. Bug reports can be submitted via the
56             web:
57              
58             https://github.com/bioperl/bioperl-live/issues
59              
60             =head1 AUTHOR - Shawn Hoon
61              
62             Email shawnh@fugu-sg.org
63              
64             =head1 APPENDIX
65              
66             The rest of the documentation details each of the object methods.
67             Internal methods are usually preceded with a _
68              
69             =cut
70              
71              
72             # Let the code begin...
73              
74              
75             package Bio::Tools::Phylo::Phylip::ProtDist;
76 1     1   446 use strict;
  1         2  
  1         23  
77              
78 1     1   254 use Bio::Matrix::PhylipDist;
  1         2  
  1         23  
79              
80              
81 1     1   4 use base qw(Bio::Root::Root Bio::Root::IO);
  1         1  
  1         343  
82              
83             =head2 new
84              
85             Title : new
86             Usage : my $obj = Bio::Tools::Phylo::Phylip::ProtDist->new();
87             Function: Builds a new Bio::Tools::Phylo::Phylip::ProtDist object
88             Returns : Bio::Tools::ProtDist
89             Args : -fh/-file => $val, # for initing input, see Bio::Root::IO
90             -program => 'programname' # name of the program
91              
92             =cut
93              
94             sub new {
95 2     2 1 17 my($class,@args) = @_;
96              
97 2         9 my $self = $class->SUPER::new(@args);
98 2         10 $self->_initialize_io(@args);
99 2         6 my ($prog) = $self->_rearrange([qw(PROGRAM)], @args);
100 2         5 $self->{'_program'} = $prog;
101 2         4 return $self;
102             }
103              
104             =head2 next_matrix
105              
106             Title : next_matrix
107             Usage : my $matrix = $parser->next_matrix
108             Function: Get the next result set from parser data
109             Returns : L
110             Args : none
111              
112              
113             =cut
114              
115             sub next_matrix{
116 2     2 1 4 my ($self) = @_;
117 2         2 my @names;
118             my @values;
119 0         0 my $entry;
120 2         3 my $size = 0;
121 2         7 while ($entry=$self->_readline) {
122 202 50 66     1256 if($#names >=0 && $entry =~/^\s+\d+\n$/){
    100          
    100          
123 0         0 $self->_pushback($entry);
124 0         0 last;
125             } elsif($entry=~/^\s+(\d+)\n$/){
126 2         3 $size = $1;
127 2         4 next;
128             } elsif( $entry =~ s/^\s+(\-?\d+\.\d+)/$1/ ) {
129 156         552 my (@line) = split( /\s+/,$entry);
130 156         93 push @{$values[-1]}, @line;
  156         302  
131 156         310 next;
132             }
133 44         209 my ($n,@line) = split( /\s+/,$entry);
134            
135 44         54 push @names, $n;
136 44         112 push @values, [@line];
137             }
138 2 50       6 if( scalar @names != $size ) {
139 0         0 $self->warn("The number of entries ".(scalar @names).
140             " is not the same $size");
141             }
142 2 50       5 $#names>=0 || return;
143 2         3 my %dist;
144 2         1 my $i=0;
145 2         3 for my $name (@names){
146 44         25 my $j=0;
147 44         33 for my $n (@names) {
148 1546         1503 $dist{$name}{$n} = [$i,$j];
149 1546         943 $j++;
150             }
151 44         29 $i++;
152             }
153 2         18 return Bio::Matrix::PhylipDist->new(-program => $self->{'_program'},
154             -matrix => \%dist,
155             -names => \@names,
156             -values => \@values);
157             }
158              
159             1;