view release on metacpan or  search on metacpan

Bio/AlignIO/proda.pm  view on Meta::CPAN

        # we ended up the first block and now are on the second
        @ids_copy = @ids unless(defined($ids_copy[0])); #FIXME - hacky
        my $seqname_with_coords = shift(@ids_copy);
        if ($seqname_with_coords !~ /$seqname/) {
            {
                $self->throw("header and body of the alignment dont match");
            }
        }
        $alignments{$seqname_with_coords} .= $aln_line;

        if ( !$seen_block ) {
            if (exists $order{$seqname_with_coords}) {
                $self->warn("Duplicate sequence : $seqname\n".
                            "Can't guarantee alignment quality");
            }
            else {
                $order{$seqname_with_coords} = $order++;
            }
        }

    }

    my ( $sname, $start, $end );
    foreach my $name ( sort { $order{$a} <=> $order{$b} } keys %alignments ) {
        if ( $name =~ /(\S+):(\d+)-(\d+)/ ) {
            ( $sname, $start, $end ) = ( $1, $2, $3 );
        }
        else {
            ( $sname, $start ) = ( $name, 1 );
            my $str = $alignments{$name};
            $str =~ s/[^A-Za-z]//g;
            $end = length($str);
        }
        my $seq = Bio::LocatableSeq->new(
					 -seq      => $alignments{$name},
					 -id       => $sname,
					 -start    => $start,
					 -end      => $end,
					 -alphabet => $self->alphabet,
					 );
        $aln->add_seq($seq);
    }
    
    return $aln if $aln->num_sequences;
    return;
}

=head2 write_aln

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

=cut

sub write_aln {
    my ($self,@aln) = @_;
    $self->throw_not_implemented();
}

=head2 percentages

 Title   : percentages
 Usage   : $obj->percentages($newval)
 Function: Set the percentages flag - whether or not to show percentages in
           each output line
 Returns : value of percentages
 Args    : newvalue (optional)


=cut

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

=head2 line_length

 Title   : line_length
 Usage   : $obj->line_length($newval)
 Function: Set the alignment output line length
 Returns : value of line_length
 Args    : newvalue (optional)


=cut

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

=head2 no_header

 Title   : no_header
 Usage   : $obj->no_header($newval)
 Function: Set if the alignment input has a CLUSTAL header or not
 Returns : value of no_header
 Args    : newvalue (optional)


=cut

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