File Coverage

Bio/AlignIO/pfam.pm
Criterion Covered Total %
statement 43 49 87.7
branch 7 14 50.0
condition 2 6 33.3
subroutine 5 5 100.0
pod 2 2 100.0
total 59 76 77.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::AlignIO::pfam
3              
4             # based on the Bio::SeqIO:: modules
5             # by Ewan Birney
6             # and Lincoln Stein
7             #
8             # and the SimpleAlign.pm module of Ewan Birney
9             #
10             # Copyright Peter Schattner
11             #
12             # You may distribute this module under the same terms as perl itself
13             # _history
14             # September 5, 2000
15             # POD documentation - main docs before the code
16              
17             =head1 NAME
18              
19             Bio::AlignIO::pfam - pfam sequence input/output stream
20              
21             =head1 SYNOPSIS
22              
23             Do not use this module directly. Use it via the L class.
24              
25             =head1 DESCRIPTION
26              
27             This object can transform Bio::SimpleAlign objects to and from pfam flat
28             file databases.
29              
30             =head1 FEEDBACK
31              
32             =head2 Support
33              
34             Please direct usage questions or support issues to the mailing list:
35              
36             I
37              
38             rather than to the module maintainer directly. Many experienced and
39             reponsive experts will be able look at the problem and quickly
40             address it. Please include a thorough description of the problem
41             with code and data examples if at all possible.
42              
43             =head2 Reporting Bugs
44              
45             Report bugs to the Bioperl bug tracking system to help us keep track
46             the bugs and their resolution. Bug reports can be submitted via the
47             web:
48              
49             https://github.com/bioperl/bioperl-live/issues
50              
51             =head1 AUTHORS - Peter Schattner
52              
53             Email: schattner@alum.mit.edu
54              
55              
56             =head1 APPENDIX
57              
58             The rest of the documentation details each of the object
59             methods. Internal methods are usually preceded with a _
60              
61             =cut
62              
63             # Let the code begin...
64              
65             package Bio::AlignIO::pfam;
66 6     6   718 use strict;
  6         13  
  6         195  
67              
68 6     6   615 use Bio::SimpleAlign;
  6         12  
  6         233  
69 6     6   39 use base qw(Bio::AlignIO);
  6         13  
  6         2713  
70              
71             =head2 next_aln
72              
73             Title : next_aln
74             Usage : $aln = $stream->next_aln()
75             Function: returns the next alignment in the stream
76             Returns : L object
77             Args : NONE
78              
79             =cut
80              
81             sub next_aln {
82 5     5 1 1821 my $self = shift;
83 5         38 my $entry;
84             my $name;
85 5         0 my $start;
86 5         0 my $end;
87 5         0 my $seq;
88 5         0 my $add;
89 5         0 my $acc;
90 5         0 my %names;
91              
92 5         35 my $aln = Bio::SimpleAlign->new(-source => 'pfam');
93              
94 5         39 while( $entry = $self->_readline) {
95 80         124 chomp $entry;
96 80 50       183 $entry =~ m{^//} && last;
97 80 50       410 if($entry !~ m{^(\S+)/(\d+)-(\d+)\s+(\S+)\s*} ) {
98 0         0 $self->throw("Found a bad line [$_] in the pfam format alignment");
99 0         0 next;
100             }
101              
102 80         190 $name = $1;
103 80         184 $start = $2;
104 80         103 $end = $3;
105 80         141 $seq = $4;
106              
107              
108 80         211 $add = Bio::LocatableSeq->new('-seq' => $seq,
109             '-display_id' => $name,
110             '-start' => $start,
111             '-end' => $end,
112             '-alphabet' => $self->alphabet,
113             );
114              
115 80         208 $aln->add_seq($add);
116              
117             }
118              
119             # If $end <= 0, we have either reached the end of
120             # file in <> or we have encountered some other error
121             #
122              
123 5 50       29 return $aln if $aln->num_sequences;
124 0         0 return;
125             }
126              
127              
128              
129             =head2 write_aln
130              
131             Title : write_aln
132             Usage : $stream->write_aln(@aln)
133             Function: writes the $aln object into the stream
134             Returns : 1 for success and 0 for error
135             Args : L object
136              
137              
138             =cut
139              
140             sub write_aln {
141 13     13 1 67 my ($self,@aln) = @_;
142 13 50       32 if( @aln > 1 ) { $self->warn("Only the 1st pfam alignment will be output since the format does not support multiple alignments in the same file"); }
  0         0  
143 13         23 my $aln = shift @aln;
144 13 50 33     81 if( ! $aln || ! $aln->isa('Bio::Align::AlignI') ) {
145 0         0 $self->warn("Must provide a Bio::Align::AlignI object when calling write_aln");
146 0         0 next;
147             }
148 13         28 my ($namestr,$seq,$add);
149 13         0 my ($maxn);
150 13         37 $maxn = $aln->maxdisplayname_length();
151              
152 13         29 foreach $seq ( $aln->each_seq() ) {
153 65         137 $namestr = $aln->displayname($seq->get_nse());
154 65         94 $add = $maxn - length($namestr) + 2;
155 65         104 $namestr .= " " x $add;
156 65 50       122 $self->_print (sprintf("%s %s\n",$namestr,$seq->seq())) or return;
157             }
158 13 50 33     38 $self->flush() if $self->_flush_on_write && defined $self->_fh;
159 13         34 return 1;
160             }
161              
162             1;