Bio/AlignIO/nexml.pm

   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<Bio::AlignIO> class.
  16
  17 =head1 DESCRIPTION
  18
  19 This object can transform L<Bio::SimpleAlign> objects to and from
  20 NeXML format. For more information on NeXML, visit L<http://www.nexml.org>.
  21
  22 =head1 FEEDBACK
  23
  24 =head2 Support
  25
  26 Please direct usage questions or support issues to the mailing list:
  27
  28 I<bioperl-l@bioperl.org>
  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 use strict;
  64 use lib '../..';
  65 use Bio::Nexml::Factory;
  66 use Bio::Phylo::IO qw(parse unparse);
  67
  68 use base qw(Bio::AlignIO);
  69
  70
  71 sub _initialize {
  72   my($self,@args) = @_;
  73   $self->SUPER::_initialize(@args);
  74   $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<Bio::Align::AlignI>
  87
  88 =cut
  89
  90 sub next_aln {
  91         my ($self) = @_;
  92     unless ( $self->{'_parsed'} ) {
  93         #use a parse function to load all the alignment objects found in the nexml file at once
  94         $self->_parse;
  95     }
  96     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     my $self = shift;
 112     $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         my ($obj,$value) = @_;
 127    if( defined $value) {
 128       $obj->{'_doc'} = $value;
 129         }
 130         return $obj->{'_doc'};
 131 }
 132
 133 sub _parse {
 134     my ($self) = @_;
 135
 136     $self->{'_parsed'}   = 1;
 137     $self->{'_alnsiter'} = 0;
 138     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     my $file_arg;
 145     my $file_value;
 146     if (     exists $self->{'_filehandle'}
 147         and defined $self->{'_filehandle'}
 148         ) {
 149         $file_arg   = '-handle';
 150         $file_value = $self->{'_filehandle'};
 151     }
 152     else {
 153         $file_arg   = '-file';
 154         $file_value = $self->{'_file'};
 155     }
 156
 157     $self->doc(parse(
 158                      $file_arg     => $file_value,
 159                      '-format'     => 'nexml',
 160                      '-as_project' => '1'
 161                      )
 162     );
 163     $self->{'_alns'} = $fac->create_bperl_aln($self);
 164
 165     if(@{ $self->{'_alns'} } == 0) {
 166         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<Bio::Align::AlignI> object
 177
 178 See L<Bio::Align::AlignI>
 179
 180 =cut
 181
 182 sub write_aln {
 183         my ($self, $aln) = @_;
 184
 185     my $fac = Bio::Nexml::Factory->new();
 186     my $taxa = $fac->create_bphylo_taxa($aln);
 187         my ($matrix) = $fac->create_bphylo_aln($aln, $taxa);
 188         $matrix->set_taxa($taxa);
 189
 190         $self->doc(Bio::Phylo::Factory->create_project());
 191         $self->doc->insert($matrix);
 192         my $ret = $self->_print($self->doc->to_xml());
 193         $self->flush;
 194         return $ret;
 195 }
 196
 197
 198
 199
 200
 201
 202
 203
 204 1;