Bio::SeqIO::tinyseq::tinyseqHandler - XML event handlers to support NCBI TinySeq XML parsing

  $stream = Bio::SeqIO->new( -file => $filename, -format => 'tinyseq' );

  while ( my $seq = $stream->next_seq ) {
    ....
  }

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

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

  Title		: new
  Usage		: $handler = Bio::SeqIO::tinyseq::tinyseqHandler->new()
  Function	: instantiates a tinyseqHandler for use by
                  XML::Parser::PerlSAX
  Returns	: Bio::SeqIO::tinyseq::tinyseqHandler object
  Args		: NONE

  Title		: start_document
  Usage		: NONE
  Function	: start_document handler for use by XML::Parser::PerlSAX
  Returns	: NONE
  Args		: NONE

  Title		: end_document
  Usage		: NONE
  Function	: end_document handler for use by XML::Parser::PerlSAX
  Returns	: NONE
  Args		: NONE

  Title		: start_element
  Usage		: NONE
  Function	: start_element handler for use by XML::Parser::PerlSAX
  Returns	: NONE
  Args		: NONE

  Title		: end_element
  Usage		: NONE
  Function	: end_element handler for use by XML::Parser::PerlSAX
  Returns	: NONE
  Args		: NONE

  Title		: characters
  Usage		: NONE
  Function	: characters handler for use by XML::Parser::PerlSAX
  Returns	: NONE
  Args		: NONE

  Title		: TSeq
  Usage		: NONE
  Function	: event handler for END of a TSeq element
  Returns	: loh of parsed sequence atts for Bio::SeqIO::tinyseq
  Args		: NONE

  Title		: _current_element
  Usage		: Internal method
  Function	: Utility method to return current element info
  Returns	: XML::Parser::PerlSAX hash for current element
  Args		: NONE

# BioPerl module for Bio::SeqIO::tinyseqHandler
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Donald Jackson, donald.jackson@bms.com
#
# Copyright Bristol-Myers Squibb
#
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code

package Bio::SeqIO::tinyseq::tinyseqHandler;

use strict;
use warnings;


use vars qw(%ATTMAP);

use base qw(Bio::Root::Root);

# %ATTMAP defines correspondence between TSeq elements, PrimarySeq attributes
# Format: element_name => { xml_attname => pseq_attname }
%ATTMAP	= ( TSeq_sequence	=> { Data	=> '-seq'},
	    TSeq_gi		=> { Data	=> '-primary_id' },
	    TSeq_defline	=> { Data	=> '-desc' },
	    TSeq_sid		=> { Data	=> '-sid' },
	    TSeq_accver		=> { Data	=> '-accver' },
	    TSeq_taxid		=> { Data	=> '-taxid' },
	    TSeq_orgname	=> { Data	=> '-organism' }
	   );

sub new {
    my ($proto, @args) = @_;
    my $class = ref($proto) || $proto;

    my $self =  bless({}, $class);

    return $self;
}

#######################################
# Event hadling methods for PerlSax   #
#######################################

sub doctype_decl {
    my ($self, $doctype) = @_;
    # make sure we have a tinyseq
    unless ($doctype->{'SystemId'} eq 'http://www.ncbi.nlm.nih.gov/dtd/NCBI_TSeq.dtd') {
	$self->throw("This document doesn't use the NCBI TinySeq dtd; it's a ", $doctype->{'SystemId'} );
    }

}

sub start_document {
    my ($self) = @_;

    $self->{'_seqatts'} = [];
    $self->{'_elements'} = [];
}

sub end_document {
    my ($self) = @_;
    return $self->{'_seqatts'};
}

sub start_element {
    my ($self, $starting) = @_;

    push(@{$self->{'_elements'}}, $starting);
}

sub end_element {
    my ($self, $ending) = @_;

    # do I have a handler for this element?
    my $ename = $ending->{'Name'};
    $self->$ename if ($self->can($ename));
}

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

    my $data = $characters->{'Data'};

    return unless (defined($data) and $data =~ /\S/);

    my $current = $self->_current_element;
    $current->{'Data'} = $data;
}


###########################################
# Element-specific handlers
# called at END of element name
##########################################

sub TSeq {
    my ($self) = @_;

    my %seqatts;

    # map elements onto PrimarySeq keys
    while (my $element = pop @{ $self->{'_elements'} }) {
	my $element_name = $element->{'Name'};
	last if ($element_name eq 'TSeq');

	my $conversion = $ATTMAP{$element_name} or next;

	while(my($element_att, $pseq_att) = each %$conversion) {
	    $seqatts{$pseq_att} = $element->{$element_att};
	}
    }

    push(@{ $self->{'_seqatts'} }, \%seqatts);

}

#############################################
# Utility method to return current element info
##############################################

sub _current_element {
    my ($self) = @_;
    return $self->{'_elements'}->[-1];
}




1;