File Coverage

blib/lib/Bio/SeqIO/nexml.pm
Criterion Covered Total %
statement 21 62 33.8
branch 0 8 0.0
condition 0 3 0.0
subroutine 7 13 53.8
pod 4 4 100.0
total 32 90 35.5


line stmt bran cond sub pod time code
1             # BioPerl module for Bio::SeqIO::nexml
2             #
3             # Please direct questions and support issues to
4             #
5             # Cared for by Chase Miller
6             #
7             # Copyright Chase Miller
8             #
9             # You may distribute this module under the same terms as perl itself
10             # _history
11             # May, 2009 Largely written by Chase Miller
12              
13             # POD documentation - main docs before the code
14              
15             =head1 NAME
16              
17             Bio::SeqIO::nexml - NeXML sequence input/output stream
18              
19             =head1 SYNOPSIS
20              
21             Do not use this module directly. Use it via the Bio::SeqIO class.
22              
23             =head1 DESCRIPTION
24              
25             This object can transform Bio::Seq objects to and from NeXML format.
26             For more information on the NeXML standard, visit L.
27              
28             =head1 FEEDBACK
29              
30             =head2 Mailing Lists
31              
32             User feedback is an integral part of the evolution of this and other
33             Bioperl modules. Send your comments and suggestions preferably to one
34             of the Bioperl mailing lists. Your participation is much appreciated.
35              
36             bioperl-l@bioperl.org - General discussion
37             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
38              
39             =head2 Support
40              
41             Please direct usage questions or support issues to the mailing list:
42              
43             I
44              
45             rather than to the module maintainer directly. Many experienced and
46             reponsive experts will be able look at the problem and quickly
47             address it. Please include a thorough description of the problem
48             with code and data examples if at all possible.
49              
50             =head2 Reporting Bugs
51              
52             Report bugs to the Bioperl bug tracking system to help us keep track
53             the bugs and their resolution. Bug reports can be submitted via the
54             web:
55              
56             https://github.com/bioperl/bioperl-live/issues
57              
58             =head1 AUTHORS - Chase Miller
59              
60             Email: chmille4@gmail.com
61              
62             =head1 CONTRIBUTORS
63              
64             Mark Jensen, maj@fortinbras.us
65             Rutger Vos, rutgeraldo@gmail.com
66              
67             =head1 APPENDIX
68              
69             The rest of the documentation details each of the object
70             methods. Internal methods are usually preceded with a _
71              
72             =cut
73              
74             # Let the code begin...
75              
76             package Bio::SeqIO::nexml;
77              
78 2     2   784 use strict;
  2         2  
  2         55  
79              
80 2     2   384 use lib '../..';
  2         482  
  2         9  
81 2     2   1220 use Bio::Seq;
  2         3  
  2         52  
82 2     2   818 use Bio::Seq::SeqFactory;
  2         2  
  2         46  
83 2     2   1002 use Bio::Nexml::Factory;
  2         7  
  2         71  
84 2     2   10 use Bio::Phylo::IO qw (parse unparse);
  2         3  
  2         102  
85              
86 2     2   9 use base qw(Bio::SeqIO);
  2         3  
  2         1022  
87              
88             sub _initialize {
89 0     0     my($self,@args) = @_;
90 0           $self->SUPER::_initialize(@args);
91 0           $self->{_doc} = undef;
92             }
93              
94             =head2 next_seq
95              
96             Title : next_seq
97             Usage : $seq = $stream->next_seq()
98             Function: returns the next sequence in the stream
99             Returns : L object
100             Args : NONE
101              
102             =cut
103              
104             sub next_seq {
105 0     0 1   my ($self) = @_;
106 0 0         unless ( $self->{'_parsed'} ) {
107             #use a parse function to load all the sequence objects found in the nexml file at once
108 0           $self->_parse;
109             }
110 0           return $self->{'_seqs'}->[ $self->{'_seqiter'}++ ];
111             }
112              
113             =head2 rewind
114              
115             Title : rewind
116             Usage : $seqio->rewind
117             Function: Resets the stream
118             Returns : none
119             Args : none
120              
121              
122             =cut
123              
124             sub rewind {
125 0     0 1   my $self = shift;
126 0           $self->{'_seqiter'} = 0;
127             }
128              
129             =head2 doc
130              
131             Title : doc
132             Usage : $treeio->doc
133             Function: Returns the biophylo nexml document object
134             Returns : Bio::Phylo::Project
135             Args : none or Bio::Phylo::Project object
136              
137             =cut
138              
139             sub doc {
140 0     0 1   my ($obj,$value) = @_;
141 0 0         if( defined $value) {
142 0           $obj->{'_doc'} = $value;
143             }
144 0           return $obj->{'_doc'};
145             }
146              
147             sub _parse {
148 0     0     my ($self) = @_;
149            
150 0           $self->{'_parsed'} = 1;
151 0           $self->{'_seqiter'} = 0;
152 0           my $fac = Bio::Nexml::Factory->new();
153            
154             # Only pass filename if filehandle is not available,
155             # or "Bio::Phylo" will create a new filehandle that ends
156             # out of scope and can't be closed directly, leaving 2 open
157             # filehandles for the same file (so file can't be deleted)
158 0           my $file_arg;
159             my $file_value;
160 0 0 0       if ( exists $self->{'_filehandle'}
161             and defined $self->{'_filehandle'}
162             ) {
163 0           $file_arg = '-handle';
164 0           $file_value = $self->{'_filehandle'};
165             }
166             else {
167 0           $file_arg = '-file';
168 0           $file_value = $self->{'_file'};
169             }
170            
171 0           $self->doc(Bio::Phylo::IO->parse(
172             $file_arg => $file_value,
173             '-format' => 'nexml',
174             '-as_project' => '1'
175             )
176             );
177 0           $self->{'_seqs'} = $fac->create_bperl_seq($self);
178            
179 0 0         unless(@{ $self->{'_seqs'} } == 0) {
  0            
180             # self->debug("no seqs in $self->{_file}");
181             }
182             }
183              
184             =head2 write_seq
185              
186             Title : write_seq
187             Usage : $stream->write_seq(@seq)
188             Function: Writes the $seq object into the stream
189             Returns : 1 for success and 0 for error
190             Args : Array of 1 or more L objects
191              
192             =cut
193              
194             sub write_seq {
195            
196 0     0 1   my ($self, $bp_seq) = @_;
197            
198 0           my $fac = Bio::Nexml::Factory->new();
199 0           my $taxa = $fac->create_bphylo_taxa($bp_seq);
200 0           my ($seq) = $fac->create_bphylo_seq($bp_seq, $taxa);
201            
202 0           my $matrix = Bio::Phylo::Factory->create_matrix('-type' => $seq->get_type());
203 0           $matrix->insert($seq);
204 0           $matrix->set_taxa($taxa);
205            
206             #set matrix label
207 0           my $feat = ($bp_seq->get_SeqFeatures())[0];
208 0           $matrix->set_name($feat->get_tag_values('matrix_label'));
209            
210 0           $self->doc(Bio::Phylo::Factory->create_project());
211            
212 0           $self->doc->insert($matrix);
213            
214 0           my $ret = $self->_print($self->doc->to_xml());
215 0           $self->flush;
216 0           return $ret
217             }
218              
219              
220             1;