lib/Bio/SeqIO/bsml_sax.pm

   1 # BioPerl module for Bio::SeqIO::bsml_sax
   2 #
   3 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   4 #
   5 # Cared for by Jason Stajich
   6 #
   7
   8 =head1 NAME
   9
  10 Bio::SeqIO::bsml_sax - BSML sequence input/output stream using SAX
  11
  12 =head1 SYNOPSIS
  13
  14  It is probably best not to use this object directly, but rather go
  15  through the SeqIO handler system. To read a BSML file:
  16
  17     $stream = Bio::SeqIO->new( -file => $filename, -format => 'bsml');
  18
  19     while ( my $bioSeqObj = $stream->next_seq() ) {
  20         # do something with $bioSeqObj
  21     }
  22
  23  To write a Seq object to the current file handle in BSML XML format:
  24
  25     $stream->write_seq( -seq => $seqObj);
  26
  27  If instead you would like a XML::DOM object containing the BSML, use:
  28
  29     my $newXmlObject = $stream->to_bsml( -seq => $seqObj);
  30
  31 =head1 DEPENDENCIES
  32
  33  In addition to parts of the Bio:: hierarchy, this module uses:
  34
  35  XML::SAX
  36
  37 =head1 DESCRIPTION
  38
  39  This object can transform Bio::Seq objects to and from BSML (XML)
  40  flatfiles.
  41
  42 =head1 FEEDBACK
  43
  44 =head2 Mailing Lists
  45
  46 User feedback is an integral part of the evolution of this and other
  47 Bioperl modules. Send your comments and suggestions preferably to one
  48 of the Bioperl mailing lists.  Your participation is much appreciated.
  49
  50   bioperl-l@bioperl.org                  - General discussion
  51   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  52
  53 =head2 Support
  54
  55 Please direct usage questions or support issues to the mailing list:
  56
  57 I<bioperl-l@bioperl.org>
  58
  59 rather than to the module maintainer directly. Many experienced and
  60 reponsive experts will be able look at the problem and quickly
  61 address it. Please include a thorough description of the problem
  62 with code and data examples if at all possible.
  63
  64 =head2 Reporting Bugs
  65
  66  Report bugs to the Bioperl bug tracking system to help us keep track
  67  the bugs and their resolution. Bug reports can be submitted via the
  68  web:
  69
  70   https://github.com/bioperl/bioperl-live/issues
  71
  72 =head1 AUTHOR - Jason Stajich
  73
  74 Email jason-at-bioperl-dot-org
  75
  76 =cut
  77
  78 package Bio::SeqIO::bsml_sax;
  79 use vars qw($Default_Source);
  80 use strict;
  81
  82 use Bio::SeqFeature::Generic;
  83 use Bio::Species;
  84 use XML::SAX;
  85 use Bio::Seq::SeqFactory;
  86 use Bio::Annotation::Collection;
  87 use Bio::Annotation::Comment;
  88 use Bio::Annotation::Reference;
  89 use Bio::Annotation::DBLink;
  90
  91 use base qw(Bio::SeqIO XML::SAX::Base);
  92
  93 $Default_Source = 'BSML';
  94
  95 sub _initialize {
  96     my ($self) = shift;
  97     $self->SUPER::_initialize(@_);
  98     $self->{'_parser'} = XML::SAX::ParserFactory->parser('Handler' => $self);
  99     if( ! defined $self->sequence_factory ) {
 100         $self->sequence_factory(Bio::Seq::SeqFactory->new
 101                                 (-verbose => $self->verbose(),
 102                                  -type => 'Bio::Seq::RichSeq'));
 103     }
 104     return;
 105 }
 106
 107 =head1 METHODS
 108
 109 =cut
 110
 111 =head2 next_seq
 112
 113  Title   : next_seq
 114  Usage   : my $bioSeqObj = $stream->next_seq
 115  Function: Retrieves the next sequence from a SeqIO::bsml stream.
 116  Returns : A reference to a Bio::Seq::RichSeq object
 117  Args    :
 118
 119 =cut
 120
 121 sub next_seq {
 122     my $self = shift;
 123     if( @{$self->{'_seendata'}->{'_seqs'} || []} ||
 124         eof($self->_fh)) {
 125         return shift @{$self->{'_seendata'}->{'_seqs'}};
 126     }
 127     $self->{'_parser'}->parse_file($self->_fh);
 128     return shift @{$self->{'_seendata'}->{'_seqs'}};
 129 }
 130
 131 # XML::SAX::Base methods
 132
 133 sub start_document {
 134     my ($self,$doc) = @_;
 135     $self->{'_seendata'} = {'_seqs'    => [],
 136                             '_authors' => [],
 137                             '_feats'   => [] };
 138     $self->SUPER::start_document($doc);
 139 }
 140
 141 sub end_document {
 142     my ($self,$doc) = @_;
 143     $self->SUPER::end_document($doc);
 144 }
 145
 146
 147 sub start_element {
 148     my ($self,$ele) = @_;
 149     my $name = uc($ele->{'LocalName'});
 150     my $attr = $ele->{'Attributes'};
 151     my $seqid = defined $self->{'_seendata'}->{'_seqs'}->[-1] ?
 152         $self->{'_seendata'}->{'_seqs'}->[-1]->display_id : undef;
 153     for my $k ( keys %$attr ) {
 154         $attr->{uc $k} = $attr->{$k};
 155         delete $attr->{$k};
 156     }
 157     if( $name eq 'BSML' ) {
 158
 159     } elsif( $name eq 'DEFINITIONS' ) {
 160     } elsif( $name eq 'SEQUENCES' ) {
 161
 162     } elsif( $name eq 'SEQUENCE' ) {
 163         my ($id,$acc,$title,
 164             $desc,$length,$topology,
 165             $mol) =  map { $attr->{'{}'.$_}->{'Value'} } qw(ID IC-ACCKEY
 166                                                             TITLE COMMENT
 167                                                             LENGTH
 168                                                             TOPOLOGY
 169                                                             MOLECULE);
 170         push @{$self->{'_seendata'}->{'_seqs'}},
 171         $self->sequence_factory->create
 172             (
 173              -display_id          => $id,
 174              -accession_number    => $acc,
 175              -description         => $desc,
 176              -length              => $length,
 177              -is_circular         => ($topology =~ /^linear$/i) ? 0 : 1,
 178              -molecule            => $mol,
 179              );
 180
 181     } elsif( $name eq 'FEATURE-TABLES' ) {
 182     } elsif( $name eq 'ATTRIBUTE' ) {
 183         my $curseq = $self->{'_seendata'}->{'_seqs'}->[-1];
 184         my ($name,$content) = map { $attr->{'{}'.$_}->{'Value'} } qw(NAME CONTENT);
 185         if($name =~ /^version$/i ) {
 186             my ($version);
 187             if($content =~ /^[^\.]+\.(\d+)/) {
 188                 $version = $1;
 189             } else { $version = $content }
 190             $curseq->seq_version($version);
 191         } elsif( $name eq 'organism-species') {
 192             my ($genus,$species,$subsp) = split(/\s+/,$content,3);
 193             $curseq->species(Bio::Species->new(-sub_species => $subsp,
 194                                                -classification =>
 195                                                [$species,$genus]));
 196         } elsif( $name eq 'organism-classification' ) {
 197             my (@class) =(split(/\s*;\s*/,$content),$curseq->species->species);
 198             $curseq->species->classification([reverse @class]);
 199         } elsif( $name eq 'database-xref' ) {
 200             my ($db,$id) = split(/:/,$content);
 201             $curseq->annotation->add_Annotation('dblink',
 202                                               Bio::Annotation::DBLink->new
 203                                                 ( -database  => $db,
 204                                                   -primary_id=> $id));
 205         } elsif( $name eq 'date-created' ||
 206                  $name eq 'date-last-updated' ) {
 207             $curseq->add_date($content);
 208         }
 209     } elsif( $name eq 'FEATURE' ) {
 210         my ($id,$class,$type,$title,$display_auto)
 211             =  map { $attr->{'{}'.$_}->{'Value'} } qw(ID CLASS VALUE-TYPE
 212                                                       TITLE DISPLAY-AUTO);
 213
 214         push @{$self->{'_seendata'}->{'_feats'}},
 215         Bio::SeqFeature::Generic->new
 216             ( -seq_id      => $self->{'_seendata'}->{'_seqs'}->[-1]->display_id,
 217               -source_tag  => $Default_Source,
 218               -primary_tag => $type,
 219               -tag => {'ID'    => $id,
 220                    });
 221
 222     } elsif( $name eq 'QUALIFIER') {
 223         my ($type,$value) =  map { $attr->{'{}'.$_}->{'Value'} } qw(VALUE-TYPE
 224                                                                     VALUE);
 225         my $curfeat = $self->{'_seendata'}->{'_feats'}->[-1];
 226         $curfeat->add_tag_value($type,$value);
 227     } elsif( $name eq 'INTERVAL-LOC' ) {
 228         my $curfeat = $self->{'_seendata'}->{'_feats'}->[-1];
 229         my ($start,$end,$strand) =
 230             map { $attr->{'{}'.$_}->{'Value'} } qw(STARTPOS
 231                                                    ENDPOS
 232                                                    COMPLEMENT);
 233
 234         $curfeat->start($start);
 235         $curfeat->end($end);
 236         $curfeat->strand(-1) if($strand);
 237     } elsif( $name eq 'REFERENCE' ) {
 238         push @{$self->{'_seendata'}->{'_annot'}},
 239         Bio::Annotation::Reference->new();
 240     }
 241
 242     push @{$self->{'_state'}}, $name;
 243     $self->SUPER::start_element($ele);
 244 }
 245
 246 sub end_element {
 247     my ($self,$ele) = @_;
 248     pop @{$self->{'_state'}};
 249     my $name = uc $ele->{'LocalName'};
 250     my $curseq = $self->{'_seendata'}->{'_seqs'}->[-1];
 251     if( $name eq 'REFERENCE') {
 252         my $ref = pop @{$self->{'_seendata'}->{'_annot'}};
 253         $curseq->annotation->add_Annotation('reference',$ref);
 254     } elsif( $name eq 'FEATURE' ) {
 255         my $feat = pop @{$self->{'_seendata'}->{'_feats'}};
 256         $curseq->add_SeqFeature($feat);
 257     }
 258     $self->SUPER::end_element($ele);
 259 }
 260
 261 sub characters {
 262     my ($self,$data) = @_;
 263     if( ! @{$self->{'_state'}} ) {
 264         $self->warn("Calling characters with no previous start_element call. Ignoring data");
 265     } else {
 266         my $curseq = $self->{'_seendata'}->{'_seqs'}->[-1];
 267         my $curfeat = $self->{'_seendata'}->{'_feats'}->[-1];
 268         my $curannot = $self->{'_seendata'}->{'_annot'}->[-1];
 269         my $name = $self->{'_state'}->[-1];
 270         if( $name eq 'REFAUTHORS' ) {
 271             $curannot->authors($data->{'Data'});
 272         } elsif( $name eq 'REFTITLE') {
 273             $curannot->title($data->{'Data'});
 274         } elsif( $name eq 'REFJOURNAL') {
 275             $curannot->location($data->{'Data'});
 276         } elsif( $name eq 'SEQ-DATA') {
 277             $data->{'Data'} =~ s/\s+//g;
 278             $curseq->seq($data->{'Data'});
 279         }
 280     }
 281     $self->SUPER::characters($data);
 282 }
 283
 284 1;