File Coverage

blib/lib/Bio/AlignIO/nexml.pm
Criterion Covered Total %
statement 15 53 28.3
branch 0 8 0.0
condition 0 3 0.0
subroutine 5 11 45.4
pod 4 4 100.0
total 24 79 30.3


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