view release on metacpan or  search on metacpan

Bio/SeqIO/ace.pm  view on Meta::CPAN

=cut

#'
# Let the code begin...

package Bio::SeqIO::ace;
use strict;

use Bio::Seq;
use Bio::Seq::SeqFactory;

use base qw(Bio::SeqIO);

sub _initialize {
  my($self,@args) = @_;
  $self->SUPER::_initialize(@args);
  if( ! defined $self->sequence_factory ) {
      $self->sequence_factory(Bio::Seq::SeqFactory->new(-verbose => $self->verbose(), -type => 'Bio::PrimarySeq'));
  }
}

=head2 next_seq

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

=cut

{
    my %bio_mol_type = (
        'dna'       => 'dna',
        'peptide'   => 'protein',
    );

    sub next_seq {
        my( $self ) = @_;
        local $/ = "";  # Split input on blank lines

        my $fh = $self->_filehandle;
        my( $type, $id );
        while (<$fh>) {
            if (($type, $id) = /^(DNA|Peptide)[\s:]+(.+?)\s*\n/si) {
                s/^.+$//m;  # Remove first line
                s/\s+//g;   # Remove whitespace
                last;
            }
        }
        # Return if there weren't any DNA or peptide objects
        return unless $type;

        # Choose the molecule type
        my $mol_type = $bio_mol_type{lc $type}
            or $self->throw("Can't get Bio::Seq molecule type for '$type'");

        # Remove quotes from $id
        $id =~ s/^"|"$//g;

        # Un-escape forward slashes, double quotes, percent signs,
        # semi-colons, tabs, and backslashes (if you're mad enough
        # to have any of these as part of object names in your acedb
        # database).
	$id =~ s/\\([\/"%;\t\\])/$1/g;
#"
	# Called as next_seq(), so give back a Bio::Seq
	return $self->sequence_factory->create(
					       -seq        => $_,
					       -primary_id => $id,
					       -display_id => $id,
					       -alphabet    => $mol_type,
					       );
    }
}

=head2 write_seq

 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    : Bio::Seq object(s)


=cut

sub write_seq {
    my ($self, @seq) = @_;

    foreach my $seq (@seq) {
	$self->throw("Did not provide a valid Bio::PrimarySeqI object")
	    unless defined $seq && ref($seq) && $seq->isa('Bio::PrimarySeqI');
        my $mol_type = $seq->alphabet;
        my $id = $seq->display_id;

        # Escape special charachers in id
        $id =~ s/([\/"%;\t\\])/\\$1/g;
#"
        # Print header for DNA or Protein object
        if ($mol_type eq 'dna') {
            $self->_print(
                qq{\nSequence : "$id"\nDNA "$id"\n},
                qq{\nDNA : "$id"\n},
            );
        }
        elsif ($mol_type eq 'protein') {
            $self->_print(
                qq{\nProtein : "$id"\nPeptide "$id"\n},
                qq{\nPeptide : "$id"\n},
            );
        }
        else {
            $self->throw("Don't know how to produce ACeDB output for '$mol_type'");
        }

        # Print the sequence
        my $str = $seq->seq;
        my( $formatted_seq );
        while ($str =~ /(.{1,60})/g) {
            $formatted_seq .= "$1\n";