Bio::SeqIO::metafasta - metafasta sequence input/output stream

  use Bio::SeqIO;

  # read the metafasta file
  $io = Bio::SeqIO->new(-file => "test.metafasta",
                        -format => "metafasta" );

  $seq = $io->next_seq;

  >test
  ABCDEFHIJKLMNOPQRSTUVWXYZ
  &charge
  NBNAANCNJCNNNONNCNNUNNXNZ
  &chemical
  LBSAARCLJCLSMOIMCHHULRXRZ

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

 Title   : next_seq
 Usage   : $seq = $stream->next_seq()
 Function: returns the next sequence in the stream
 Returns : Bio::Seq object
 Args    : NONE

 Title   : write_seq
 Usage   : $stream->write_seq(@seq)
 Function: writes the $seq object into the stream
 Returns : 1 for success and 0 for error
 Args    : array of 1 to n Bio::PrimarySeqI objects

 Title   : width
 Usage   : $obj->width($newval)
 Function: Get/Set the line width for METAFASTA output
 Returns : value of width
 Args    : newvalue (optional)

# BioPerl module for Bio::SeqIO::metafasta
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Heikki Lehvaslaiho
#
# Copyright Heikki Lehvaslaiho
#
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code

# Let the code begin...

package Bio::SeqIO::metafasta;
use vars qw($WIDTH);
use strict;

use Bio::Seq::SeqFactory;
use Bio::Seq::SeqFastaSpeedFactory;
use Bio::Seq::Meta;

use base qw(Bio::SeqIO);

BEGIN { $WIDTH = 60}

sub _initialize {
  my($self,@args) = @_;
  $self->SUPER::_initialize(@args);
  my ($width) = $self->_rearrange([qw(WIDTH)], @args);
  $width && $self->width($width);
  unless ( defined $self->sequence_factory ) {
      $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new());
  }
}

sub next_seq {
	my( $self ) = @_;
	my $seq;
	my $alphabet;
	local $/ = "\n>";
	return unless my $entry = $self->_readline;

	chomp($entry);
	if ($entry =~ m/\A\s*\Z/s)  { # very first one
		return unless $entry = $self->_readline;
		chomp($entry);
	}
	$entry =~ s/^>//;

	my ($top,$sequence) = split(/\n/,$entry,2);
	defined $sequence && $sequence =~ s/>//g;

	my @metas;
	($sequence, @metas) = split /\n&/, $sequence;

	my ($id,$fulldesc);
	if( $top =~ /^\s*(\S+)\s*(.*)/ ) {
		($id,$fulldesc) = ($1,$2);
	}

	if (defined $id && $id eq '') {$id=$fulldesc;} # FIX incase no space 
	                                               # between > and name \AE
	defined $sequence && $sequence =~ s/\s//g;	  # Remove whitespace

	# for empty sequences we need to know the mol.type
	$alphabet = $self->alphabet();
	if(defined $sequence && length($sequence) == 0) {
		if(! defined($alphabet)) {
			# let's default to dna
			$alphabet = "dna";
		}
	} else {
		# we don't need it really, so disable
		$alphabet = undef;
	}

	$seq = $self->sequence_factory->create(
						-seq         => $sequence,
						-id          => $id,
					   # Ewan's note - I don't think this healthy
					   # but obviously to taste.
					   #-primary_id  => $id,
					   -desc        => $fulldesc,
					   -alphabet    => $alphabet,
					   -direct      => 1,
													  );

	$seq = $seq->primary_seq;
	bless $seq, 'Bio::Seq::Meta';

	foreach my $meta (@metas) {
		my ($name,$string) = split /\n/, $meta;
		# $split ||= '';
		$string =~ s/\n//g;	# Remove newlines, spaces are important
		$seq->named_meta($name, $string);
	}

	# if there wasn't one before, set the guessed type
	unless ( defined $alphabet ) {
		$self->alphabet($seq->alphabet());
	}
	return $seq;
}

sub write_seq {
   my ($self,@seq) = @_;
   my $width = $self->width;
   foreach my $seq (@seq) {
       $self->throw("Did not provide a valid Bio::PrimarySeqI object") 
	   unless defined $seq && ref($seq) && $seq->isa('Bio::PrimarySeqI');

       my $str = $seq->seq;
       my $top = $seq->display_id();
       if ($seq->can('desc') and my $desc = $seq->desc()) {
	   $desc =~ s/\n//g;
	   $top .= " $desc";
       }
       if(length($str) > 0) {
	   $str =~ s/(.{1,$width})/$1\n/g;
       } else {
	   $str = "\n";
       }
       $self->_print (">",$top,"\n",$str) or return;
       if ($seq->isa('Bio::Seq::MetaI')) {
           foreach my $meta ($seq->meta_names) {
               my $str = $seq->named_meta($meta);
               $str =~ s/(.{1,$width})/$1\n/g;
               $self->_print ("&",$meta,"\n",$str);
           }
       }
   }

   $self->flush if $self->_flush_on_write && defined $self->_fh;
   return 1;
}

sub width{
   my ($self,$value) = @_;
   if( defined $value) {
      $self->{'width'} = $value;
    }
    return $self->{'width'} || $WIDTH;
}

1;