diff variant_effect_predictor/Bio/SeqIO/game/seqHandler.pm @ 0:21066c0abaf5 draft

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/SeqIO/game/seqHandler.pm	Fri Aug 03 10:04:48 2012 -0400
@@ -0,0 +1,289 @@
+# $Id: seqHandler.pm,v 1.15 2002/06/24 04:29:31 jason Exp $
+#
+# BioPerl module for Bio::SeqIO::game::seqHandler
+#
+# Cared for by Brad Marshall <[e-mail]>
+#         
+# Copyright Brad Marshall
+#
+# You may distribute this module under the same terms as perl itself
+# _history
+# June 25, 2000     written by Brad Marshall
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::SeqIO::game::seqHandler - GAME helper via PerlSAX helper.
+
+=head1 SYNOPSIS
+
+GAME helper for parsing new Sequence objects from GAME XML. Do not use directly
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and 
+other Bioperl modules. Send your comments and suggestions preferably 
+to one of the Bioperl mailing lists.  Your participation is much appreciated.
+
+  [e-mail]        - Bioperl list
+  [e-mail]        - Technical discussion - Moderate volume
+  [e-mail]   - General Announcements - Pretty dead
+  http://www.bioxml.org/MailingLists/         - About the mailing lists
+
+=head1 AUTHOR - Brad Marshall
+
+Email: [e-mail]
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object
+methods. Internal methods are usually preceded with a _
+
+=cut
+
+# This template file is in the Public Domain.
+# You may do anything you want with this file.
+#
+
+package Bio::SeqIO::game::seqHandler;
+use vars qw{ $AUTOLOAD @ISA };
+
+use XML::Handler::Subs;
+use Bio::Root::Root;
+use Bio::Seq::SeqFactory;
+
+@ISA = qw(Bio::Root::Root XML::Handler::Subs);
+
+sub new {
+    my ($class,@args) = @_;
+    my $self = $class->SUPER::new(@args);
+    my ($seq,$sb) = $self->_rearrange([qw(SEQ SEQBUILDER)], @args);
+    $self->{'string'} = '';
+    $self->{'seq'} = $seq;
+    $self->sequence_factory($sb || new Bio::Seq::SeqFactory(-type => 'Bio::Seq'));
+    return $self;
+}
+
+=head2 sequence_factory
+
+ Title   : sequence_factory
+ Usage   : $seqio->sequence_factory($builder)
+ Function: Get/Set the Bio::Factory::SequenceFactoryI
+ Returns : Bio::Factory::SequenceFactoryI
+ Args    : [optional] Bio::Factory::SequenceFactoryI
+
+
+=cut
+
+sub sequence_factory{
+   my ($self,$obj) = @_;   
+   if( defined $obj ) {
+       if( ! ref($obj) || ! $obj->isa('Bio::Factory::SequenceFactoryI') ) {
+	   $self->throw("Must provide a valid Bio::Factory::SequenceFactoryI object to ".ref($self)." sequence_factory()");
+       }
+       $self->{'_seqio_seqfactory'} = $obj;
+   }
+   if( ! defined $self->{'_seqio_seqfactory'} ) {
+       $self->throw("No SequenceBuilder defined for SeqIO::game::seqHandler object");
+   }
+
+   return $self->{'_seqio_seqfactory'};
+}
+
+=head2 start_document
+
+ Title   : start_document
+ Usage   : $obj->start_document
+ Function: PerlSAX method called when a new document is initialized
+ Returns : nothing
+ Args    : document name
+
+=cut
+
+# Basic PerlSAX
+sub start_document            {
+    my ($self, $document) = @_;
+    $self->{'in_current_seq'} = 'false';    
+    $self->{'Names'} = [];
+    $self->{'string'} = '';
+}
+
+=head2 end_document
+
+ Title   : end_document
+ Usage   : $obj->end_document
+ Function: PerlSAX method called when a document is finished for cleaning up
+ Returns : list of sequences seen
+ Args    : document name
+
+=cut
+
+sub end_document     {
+    my ($self, $document) = @_;
+    delete $self->{'Names'};
+    return  $self->sequence_factory->create
+	( -seq => $self->{'residues'},
+	  -alphabet => $self->{'alphabet'},
+	  -id => $self->{'seq'},
+	  -accession => $self->{'accession'},
+	  -desc => $self->{'desc'},
+	  -length => $self->{'length'},
+	  );
+}
+
+
+=head2 start_element
+
+ Title   : start_element
+ Usage   : $obj->start_element
+ Function: PerlSAX method called when a new element is reached
+ Returns : nothing
+ Args    : element object
+
+=cut
+
+sub start_element             {
+    my ($self, $element) = @_;
+
+    push @{$self->{'Names'}}, $element->{'Name'};
+    $self->{'string'} = '';
+
+    if ($element->{'Name'} eq 'bx-seq:seq') {
+	if ($element->{'Attributes'}->{'bx-seq:id'} eq $self->{'seq'}) {
+	    $self->{'in_current_seq'} = 'true';
+	    $self->{'alphabet'} = $element->{'Attributes'}->{'bx-seq:type'};
+	    $self->{'length'} =  $element->{'Attributes'}->{'bx-seq:length'};
+	} else {
+	    #This is not the sequence we want to import, but that's ok
+	}
+    }
+    return 0;
+}
+
+=head2 end_element
+
+ Title   : end_element
+ Usage   : $obj->end_element
+ Function: PerlSAX method called when an element is finished
+ Returns : nothing
+ Args    : element object
+
+=cut
+
+sub end_element               {
+    my ($self, $element) = @_;
+
+    if ($self->{'in_current_seq'} eq 'true') {      
+	if ($self->in_element('bx-seq:residues')) {
+	    while ($self->{'string'} =~ s/\s+//) {};
+	    $self->{'residues'} = $self->{'string'};
+	}
+
+
+	if ($self->in_element('bx-seq:name')) {
+	    $self->{'string'} =~ s/^\s+//g;
+	    $self->{'string'} =~ s/\s+$//;
+	    $self->{'string'} =~ s/\n//g;
+	    $self->{'name'} = $self->{'string'};
+	}
+
+
+	if ($self->in_element('bx-link:id')  && $self->within_element('bx-link:dbxref')) {
+	    $self->{'string'} =~ s/^\s+//g;
+	    $self->{'string'} =~ s/\s+$//;
+	    $self->{'string'} =~ s/\n//g;
+	    $self->{'accession'} = $self->{'string'};
+	}
+
+	if ($self->in_element('bx-seq:description')) {
+	    $self->{'desc'} = $self->{'string'};
+	}
+
+	if ($self->in_element('bx-seq:seq')) {
+	    $self->{'in_current_seq'} = 'false';
+	}
+    }
+
+    pop @{$self->{'Names'}};
+
+}
+
+=head2 characters
+
+ Title   : characters
+ Usage   : $obj->end_element
+ Function: PerlSAX method called when text between XML tags is reached
+ Returns : nothing
+ Args    : text
+
+=cut
+
+sub characters   {
+    my ($self, $text) = @_;
+    $self->{'string'} .= $text->{'Data'};
+}
+
+=head2 in_element
+
+ Title   : in_element
+ Usage   : $obj->in_element
+ Function: PerlSAX method called to test if state is in a specific element
+ Returns : boolean
+ Args    : name of element
+
+=cut
+
+sub in_element {
+    my ($self, $name) = @_;
+
+    return ($self->{'Names'}[-1] eq $name);
+}
+
+=head2 within_element
+
+ Title   : within_element
+ Usage   : $obj->within_element
+ Function: PerlSAX method called to list depth within specific element
+ Returns : boolean
+ Args    : name of element
+
+=cut
+
+sub within_element {
+    my ($self, $name) = @_;
+
+    my $count = 0;
+    foreach my $el_name (@{$self->{'Names'}}) {
+	$count ++ if ($el_name eq $name);
+    }
+
+    return $count;
+}
+
+=head2 AUTOLOAD
+
+ Title   : AUTOLOAD
+ Usage   : do not use directly
+ Function: autoload handling of missing DESTROY method
+ Returns : nothing
+ Args    : text
+
+=cut
+
+# Others
+sub AUTOLOAD {
+    my $self = shift;
+
+    my $method = $AUTOLOAD;
+    $method =~ s/.*:://;
+    return if $method eq 'DESTROY';
+
+    print "UNRECOGNIZED $method\n";
+}
+
+1;
+
+__END__