Toolbar

Summary

Bio::AlignIO::xmfa - XMFA MSA Sequence input/output stream

Package variables

Inherit

Bio::AlignIO

Synopsis

Do not use this module directly. Use it via the Bio::AlignIO
class.

Description

This object can transform Bio::SimpleAlign objects from
XMFA flat file databases. For more information, see:

  http://asap.ahabs.wisc.edu/mauve-aligner/mauve-user-guide/mauve-output-file-formats.html

This module is based on the AlignIO::fasta parser written by
Peter Schattner

Methods

Methods description

 Title   : next_aln
 Usage   : $aln = $stream->next_aln
 Function: returns the next alignment in the stream.
 Returns : Bio::Align::AlignI object - returns 0 on end of file
            or on error
 Args    : -width => optional argument to specify the width sequence
           will be written (60 chars by default)

 Title   : write_aln
 Usage   : $stream->write_aln(@aln)
 Function: writes the $aln object into the stream in xmfa format
 Returns : 1 for success and 0 for error
 Args    : Bio::Align::AlignI object

 Title   : _get_len
 Usage   : 
 Function: determine number of alphabetic chars
 Returns : integer
 Args    : sequence string

 Title   : width
 Usage   : $obj->width($newwidth)
           $width = $obj->width;
 Function: Get/set width of alignment
 Returns : integer value of width 
 Args    : on set, new value (a scalar or undef, optional)

Methods code

sub next_aln {

    my $self = shift;
    my ($width) = $self->_rearrange([qw(WIDTH)],@_);
    $self->width($width || $WIDTH);

    my ($name, $tempname, $seqchar);
    my $aln = Bio::SimpleAlign->new();
    my $seqs = 0;
    # alignments
    while (defined (my $entry = $self->_readline) ) {
        chomp $entry;
        if ( index($entry, '=') == 0 ) {
            if (defined $name && $seqchar) {
                my $seq = $self->_process_seq($name, $seqchar);
                $aln->add_seq($seq);
            }
            if ($aln && $entry =~ m{score\s*=\s*(\d+)}) {
                $aln->score($1);
            }
            $seqchar = '';
            undef $name;
            last;
        } elsif ( $entry =~ m{^>.+$}xms) {
            if ( defined $name ) {
                my $seq = $self->_process_seq($name, $seqchar);
                $aln->add_seq($seq);
            }
            $seqchar = '';
            $name = $entry;
        } else {
            $seqchar .= $entry;
        }
    }
    
    # this catches last sequence if '=' is not present (Mauve)
    if ( defined $name ) {
        my $seq = $self->_process_seq($name, $seqchar);
        $aln->add_seq($seq);
    }
    $aln->num_sequences ? return $aln : return;

}

sub write_aln {

    my ($self,@aln) = @_;
    my $width = $self->width;
    my ($seq,$desc,$rseq,$name,$count,$length,$seqsub,$start,$end,$strand,$id);

    foreach my $aln (@aln) {
        if( ! $aln || ! $aln->isa('Bio::Align::AlignI')  ) { 
            $self->warn("Must provide a Bio::Align::AlignI object when calling write_aln");
            next;
        }
        #if( $self->force_displayname_flat ) {
        #    $aln->set_displayname_flat(1);
        #}
        my $seqct = 1;
        foreach $rseq ( $aln->each_seq() ) {
            ($start, $end, $strand, $id) = ($rseq->start, $rseq->end, $rseq->strand || 0,
                                            $rseq->display_id);
            $strand = ($strand == 1)  ? '+' :
                      ($strand == -1) ? '-' :
                      '';
            $name = sprintf("%d:%d-%d %s %s",$seqct,$start,$end,$strand,$id);
            $seq  = $rseq->seq();
            $desc = $rseq->description || '';
            $self->_print (">$name $desc\n") or return ;	
            $count = 0;
            $length = length($seq);
            if(defined $seq && $length > 0) {
            $seq =~ s/(.{1,$width})/$1\n/g;
            } else {
            $seq = "\n";
            }
            $self->_print($seq) || return 0;
            $seqct++;
        }
        my $alndesc = '';
        $alndesc = "score = ".$aln->score if ($aln->score);
        $self->_print("= $alndesc\n") || return 0;
        
    }
    $self->flush if $self->_flush_on_write && defined $self->_fh;
    return 1;

}

sub _get_len {

    my ($self,$seq) = @_;
    $seq =~ s/[^A-Z]//gi;
    return CORE::length($seq);

}

sub width {

    my $self = shift;

    return $self->{'_width'} = shift if @_;
    return $self->{'_width'} || $WIDTH;
}

####### PRIVATE #######

}

sub _process_seq {

    my ($self, $entry, $seq) = @_;
    my ($start, $end, $strand, $seqname, $desc, $all);
    # put away last name and sequence
    if ( $entry =~ m{^>\s*\d+:(\d+)-(\d+)\s([+-]{1})(?:\s+(\S+)\s*(\S\.*)?)?} ) {
        ($start, $end, $seqname, $desc) = ($1, $2, $4, $5);
        $strand = ($3 eq '+')  ?  1  : -1;
    } else {
        $self->throw("Line does not comform to XMFA format:\n$entry");
    }
    my $seqobj = Bio::LocatableSeq->new(
					-nowarnonempty => 1,
					-strand      => $strand,
					-seq         => $seq,
					-display_id  => $seqname,
					-description => $desc || $all,
					-start       => $start,
					-end         => $end,
					-alphabet    => $self->alphabet,
					);
    $self->debug("Reading $seqname\n");
    return $seqobj;
}

1;

}

General documentation

Finish write_aln(), clean up code, allow LargeLocatableSeq (ie for
very large sequences a'la Mauve)

Please direct usage questions or support issues to the mailing list:
bioperl-l@bioperl.org
rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
with code and data examples if at all possible.

Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution. Bug reports can be submitted via the
web:

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

Chris Fields

The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _