line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# BioPerl module for Bio::SeqIO::asciitree |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Please direct questions and support issues to |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Cared for by Chris Mungall |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# Copyright Chris Mungall |
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::SeqIO::asciitree - asciitree sequence input/output stream |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# It is probably best not to use this object directly, but |
21
|
|
|
|
|
|
|
# rather go through the SeqIO handler system. Go: |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
$instream = Bio::SeqIO->new(-file => $filename, |
24
|
|
|
|
|
|
|
-format => 'chadoxml'); |
25
|
|
|
|
|
|
|
$outstream = Bio::SeqIO->new(-file => $filename, |
26
|
|
|
|
|
|
|
-format => 'asciitree'); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
while ( my $seq = $instream->next_seq() ) { |
29
|
|
|
|
|
|
|
$outstream->write_seq(); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 DESCRIPTION |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
This is a WRITE-ONLY SeqIO module. It writes a Bio::SeqI object |
36
|
|
|
|
|
|
|
containing nested SeqFeature objects in such a way that the SeqFeature |
37
|
|
|
|
|
|
|
containment hierarchy is visible as a tree structure |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 FEEDBACK |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head2 Mailing Lists |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
User feedback is an integral part of the evolution of this and other |
45
|
|
|
|
|
|
|
Bioperl modules. Send your comments and suggestions preferably to one |
46
|
|
|
|
|
|
|
of the Bioperl mailing lists. Your participation is much appreciated. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
bioperl-l@bioperl.org - General discussion |
49
|
|
|
|
|
|
|
http://bioperl.org/wiki/Mailing_lists - About the mailing lists |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head2 Support |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Please direct usage questions or support issues to the mailing list: |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
I |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
rather than to the module maintainer directly. Many experienced and |
58
|
|
|
|
|
|
|
reponsive experts will be able look at the problem and quickly |
59
|
|
|
|
|
|
|
address it. Please include a thorough description of the problem |
60
|
|
|
|
|
|
|
with code and data examples if at all possible. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head2 Reporting Bugs |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Report bugs to the Bioperl bug tracking system to help us keep track |
65
|
|
|
|
|
|
|
the bugs and their resolution. Bug reports can be submitted via the web: |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
https://github.com/bioperl/bioperl-live/issues |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 AUTHOR - Chris Mungall |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Email cjm@fruitfly.org |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 APPENDIX |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
The rest of the documentation details each of the object |
76
|
|
|
|
|
|
|
methods. Internal methods are usually preceded with a _ |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=cut |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Let the code begin... |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
package Bio::SeqIO::asciitree; |
83
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
|
86
|
1
|
|
|
1
|
|
4
|
use base qw(Bio::SeqIO); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
733
|
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub _initialize { |
89
|
1
|
|
|
1
|
|
2
|
my($self,@args) = @_; |
90
|
|
|
|
|
|
|
|
91
|
1
|
|
|
|
|
5
|
$self->SUPER::_initialize(@args); |
92
|
|
|
|
|
|
|
# hash for functions for decoding keys. |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head2 show_detail |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Title : show_detail |
98
|
|
|
|
|
|
|
Usage : $obj->show_detail($newval) |
99
|
|
|
|
|
|
|
Function: |
100
|
|
|
|
|
|
|
Example : |
101
|
|
|
|
|
|
|
Returns : value of show_detail (a scalar) |
102
|
|
|
|
|
|
|
Args : on set, new value (a scalar or undef, optional) |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=cut |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub show_detail{ |
108
|
58
|
|
|
58
|
1
|
38
|
my $self = shift; |
109
|
|
|
|
|
|
|
|
110
|
58
|
50
|
|
|
|
75
|
return $self->{'show_detail'} = shift if @_; |
111
|
58
|
|
|
|
|
80
|
return $self->{'show_detail'}; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head2 next_seq |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Title : next_seq |
118
|
|
|
|
|
|
|
Usage : $seq = $stream->next_seq() |
119
|
|
|
|
|
|
|
Function: returns the next sequence in the stream |
120
|
|
|
|
|
|
|
Returns : Bio::Seq object |
121
|
|
|
|
|
|
|
Args : |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=cut |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub next_seq { |
126
|
0
|
|
|
0
|
1
|
0
|
my ($self,@args) = @_; |
127
|
0
|
|
|
|
|
0
|
$self->throw("This is a WRITE-ONLY adapter"); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=head2 write_seq |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Title : write_seq |
134
|
|
|
|
|
|
|
Usage : $stream->write_seq($seq) |
135
|
|
|
|
|
|
|
Function: writes the $seq object (must be seq) to the stream |
136
|
|
|
|
|
|
|
Returns : 1 for success and 0 for error |
137
|
|
|
|
|
|
|
Args : array of 1 to n Bio::SeqI objects |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=cut |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub write_seq { |
142
|
1
|
|
|
1
|
1
|
52
|
my ($self,@seqs) = @_; |
143
|
|
|
|
|
|
|
|
144
|
1
|
|
|
|
|
4
|
foreach my $seq ( @seqs ) { |
145
|
1
|
50
|
|
|
|
3
|
$self->throw("Attempting to write with no seq!") unless defined $seq; |
146
|
|
|
|
|
|
|
|
147
|
1
|
50
|
33
|
|
|
7
|
if( ! ref $seq || ! $seq->isa('Bio::SeqI') ) { |
148
|
0
|
|
|
|
|
0
|
$self->warn(" $seq is not a SeqI compliant module. Attempting to dump, but may fail!"); |
149
|
|
|
|
|
|
|
} |
150
|
1
|
|
|
|
|
10
|
$self->_print("Seq: ".$seq->accession_number); |
151
|
1
|
|
|
|
|
2
|
$self->_print("\n"); |
152
|
1
|
|
|
|
|
5
|
my @top_sfs = $seq->get_SeqFeatures; |
153
|
1
|
|
|
|
|
4
|
$self->write_indented_sf(1, @top_sfs); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub write_indented_sf { |
158
|
59
|
|
|
59
|
0
|
35
|
my $self = shift; |
159
|
59
|
|
|
|
|
41
|
my $indent = shift; |
160
|
59
|
|
|
|
|
49
|
my @sfs = @_; |
161
|
59
|
|
|
|
|
68
|
foreach my $sf (@sfs) { |
162
|
58
|
|
|
|
|
43
|
my $label = ''; |
163
|
58
|
50
|
|
|
|
88
|
if ($sf->has_tag('standard_name')) { |
164
|
0
|
|
|
|
|
0
|
($label) = $sf->get_tag_values('standard_name'); |
165
|
|
|
|
|
|
|
} |
166
|
58
|
100
|
|
|
|
80
|
if ($sf->has_tag('product')) { |
167
|
37
|
|
|
|
|
53
|
($label) = $sf->get_tag_values('product'); |
168
|
|
|
|
|
|
|
} |
169
|
58
|
|
|
|
|
47
|
my $COLS = 60; |
170
|
58
|
|
|
|
|
31
|
my $tab = ' ' x 10; |
171
|
58
|
|
|
|
|
51
|
my @lines = (); |
172
|
58
|
50
|
|
|
|
59
|
if ($self->show_detail) { |
173
|
0
|
|
|
|
|
0
|
my @tags = $sf->all_tags; |
174
|
0
|
|
|
|
|
0
|
foreach my $tag (@tags) { |
175
|
0
|
|
|
|
|
0
|
my @vals = $sf->get_tag_values($tag); |
176
|
0
|
|
|
|
|
0
|
foreach my $val (@vals) { |
177
|
0
|
|
|
|
|
0
|
$val = "\"$val\""; |
178
|
0
|
|
|
|
|
0
|
push(@lines, |
179
|
|
|
|
|
|
|
"$tab/$tag="); |
180
|
0
|
|
|
|
|
0
|
while (my $cut = |
181
|
|
|
|
|
|
|
substr($val, 0, $COLS - length($lines[-1]), '')) { |
182
|
0
|
|
|
|
|
0
|
$lines[-1] .= "$cut"; |
183
|
0
|
0
|
|
|
|
0
|
if ($val) { |
184
|
0
|
|
|
|
|
0
|
push(@lines, $tab); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
} |
190
|
58
|
|
|
|
|
57
|
my $detail = join("\n", @lines); |
191
|
|
|
|
|
|
|
|
192
|
58
|
|
|
|
|
90
|
my @sub_sfs = $sf->get_SeqFeatures; |
193
|
58
|
|
|
|
|
50
|
my $locstr = ''; |
194
|
58
|
50
|
|
|
|
82
|
if (!@sub_sfs) { |
195
|
58
|
|
|
|
|
61
|
$locstr = $self->_locstr($sf); |
196
|
|
|
|
|
|
|
} |
197
|
58
|
|
|
|
|
123
|
my $col1 = sprintf("%s%s $label", |
198
|
|
|
|
|
|
|
' ' x $indent, $sf->primary_tag); |
199
|
58
|
|
|
|
|
148
|
my $line = sprintf("%-50s %s\n", |
200
|
|
|
|
|
|
|
substr($col1, 0, 50), $locstr); |
201
|
58
|
|
|
|
|
113
|
$self->_print($line); |
202
|
58
|
50
|
|
|
|
69
|
if ($detail) { |
203
|
0
|
|
|
|
|
0
|
$self->_print($detail."\n"); |
204
|
|
|
|
|
|
|
} |
205
|
58
|
|
|
|
|
90
|
$self->write_indented_sf($indent+1, @sub_sfs); |
206
|
|
|
|
|
|
|
} |
207
|
59
|
|
|
|
|
80
|
return; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub _locstr { |
211
|
164
|
|
|
164
|
|
110
|
my $self = shift; |
212
|
164
|
|
|
|
|
89
|
my $sf = shift; |
213
|
164
|
|
50
|
|
|
236
|
my $strand = $sf->strand || 0; |
214
|
164
|
|
|
|
|
128
|
my $ss = '.'; |
215
|
164
|
100
|
|
|
|
193
|
$ss = '+' if $strand > 0; |
216
|
164
|
100
|
|
|
|
191
|
$ss = '-' if $strand < 0; |
217
|
|
|
|
|
|
|
|
218
|
164
|
|
|
|
|
98
|
my $splitlocstr = ''; |
219
|
164
|
100
|
|
|
|
373
|
if ($sf->isa("Bio::SeqFeatureI")) { |
220
|
58
|
|
|
|
|
80
|
my @locs = ($sf->location); |
221
|
58
|
100
|
|
|
|
75
|
if ($sf->location->isa("Bio::Location::SplitLocationI")) { |
222
|
26
|
|
|
|
|
36
|
@locs = $sf->location->each_Location; |
223
|
|
|
|
|
|
|
$splitlocstr = "; SPLIT: ".join(" ", |
224
|
26
|
|
|
|
|
30
|
map {$self->_locstr($_)} @locs); |
|
106
|
|
|
|
|
125
|
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
return |
230
|
164
|
|
|
|
|
265
|
sprintf("%d..%d[%s] $splitlocstr", $sf->start, $sf->end, $ss); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
1; |