Bio/FeatureIO/interpro.pm

   1
   2 =head1 NAME
   3
   4 Bio::FeatureIO::interpro - read features from InterPro XML
   5
   6 =head1 SYNOPSIS
   7
   8   my $in = Bio::FeatureIO(-format=>'interpro');
   9   while (my $feat = $in->next_feature) {
  10     # do something with the Bio::SeqFeatureI object
  11   }
  12
  13 =head1 DESCRIPTION
  14
  15 See L<http://www.ebi.ac.uk/interpro/documentation.html>.
  16
  17 =head1 FEEDBACK
  18
  19 =head2 Mailing Lists
  20
  21 User feedback is an integral part of the evolution of this and other
  22 Bioperl modules. Send your comments and suggestions preferably to
  23 the Bioperl mailing list.  Your participation is much appreciated.
  24
  25   bioperl-l@bioperl.org                  - General discussion
  26   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  27
  28 =head2 Reporting Bugs
  29
  30 Report bugs to the Bioperl bug tracking system to help us keep track
  31 of the bugs and their resolution. Bug reports can be submitted via
  32 the web:
  33
  34   http://bugzilla.open-bio.org/
  35
  36 =head1 AUTHOR - Allen Day
  37
  38 Email allenday@ucla.edu
  39
  40 =head1 APPENDIX
  41
  42 The rest of the documentation details each of the object methods.
  43 Internal methods are usually preceded with a _
  44
  45 =cut
  46
  47
  48 # Let the code begin...
  49
  50 package Bio::FeatureIO::interpro;
  51
  52 use strict;
  53 use base qw(Bio::FeatureIO);
  54 use Bio::SeqFeature::Annotated;
  55 use Bio::OntologyIO;
  56
  57 use Bio::Annotation::Comment;
  58 use Bio::Annotation::DBLink;
  59 use Bio::Annotation::OntologyTerm;
  60 use Bio::Annotation::SimpleValue;
  61 use Bio::Annotation::Target;
  62
  63 use URI::Escape;
  64 use XML::DOM;
  65 use XML::DOM::XPath;
  66
  67 sub _initialize {
  68   my($self,%arg) = @_;
  69
  70   $self->SUPER::_initialize(%arg);
  71   $self->xml_parser(XML::DOM::Parser->new());
  72   my $buf;
  73   while(($buf = $self->_readline()) && $buf !~ /<protein/){
  74     next;
  75   }
  76   $self->_pushback($buf);
  77 }
  78
  79 sub next_feature {
  80   my $self =shift;
  81   my $buf;    #line buffer
  82   my $ok = 0; #true if there is another <protein/> record in stream
  83   my $record; #holds the record to be parsed and returned.
  84
  85   #try to dump buffer from last record before moving on to next record
  86   my $f = $self->_shift_feature_buffer();
  87   if($f){
  88     return $f;
  89   }
  90
  91   while(my $buf = $self->_readline()){
  92     $ok = 1 if $buf =~ m!<protein!;
  93     $record .= $buf;
  94     last if $buf =~ m!</protein>!;
  95   }
  96   return unless $ok;
  97
  98   my $dom = $self->xml_parser->parse($record);
  99
 100
 101   my ($pNode) = $dom->findnodes('/protein');
 102
 103   my @iNodes = $pNode->findnodes('/protein/interpro');
 104
 105   foreach my $iNode (@iNodes){
 106     my @cNodes = $iNode->findnodes('classification');
 107     my @mNodes = $iNode->findnodes('match');
 108
 109     #we don't handle these
 110     #my @nNodes = $iNode->findnodes('contains');
 111     #my @fNodes = $iNode->findnodes('found_in');
 112
 113     foreach my $mNode (@mNodes){
 114       my @lNodes = $mNode->findnodes('location');
 115       foreach my $lNode (@lNodes){
 116         my $feature = Bio::SeqFeature::Annotated->new(
 117                                                       -start  => $lNode->getAttribute('start'),
 118                                                       -end    => $lNode->getAttribute('end'),
 119                                                       -score  => $lNode->getAttribute('score'),
 120 #                                                      -seq_id => $pNode->getAttribute('id'),
 121                                                      );
 122         $feature->seq_id->value($pNode->getAttribute('id'));
 123
 124 #warn $pNode->getAttribute('id');
 125
 126         $feature->source( $lNode->getAttribute('evidence') );
 127
 128         my $t = Bio::Annotation::OntologyTerm->new(-identifier => 'SO:0000417', -name => 'polypeptide_domain');
 129         $feature->add_Annotation('type',$t);
 130
 131         my $c = Bio::Annotation::Comment->new(-tagname => 'comment', -text => $iNode->getAttribute('name'));
 132         $feature->add_Annotation($c);
 133
 134         my $d = Bio::Annotation::DBLink->new();
 135         $d->database($mNode->getAttribute('dbname'));
 136         $d->primary_id($mNode->getAttribute('id'));
 137         $d->optional_id($mNode->getAttribute('name'));
 138         $feature->annotation->add_Annotation('dblink',$d);
 139
 140         my $s = Bio::Annotation::SimpleValue->new(-tagname => 'status', -value => $lNode->getAttribute('status'));
 141         $feature->annotation->add_Annotation($s);
 142
 143         foreach my $cNode (@cNodes){
 144           my $o = Bio::Annotation::OntologyTerm->new(-identifier => $cNode->getAttribute('id'));
 145           $feature->annotation->add_Annotation('ontology_term',$o);
 146         }
 147
 148         $self->_push_feature_buffer($feature);
 149       }
 150     }
 151   }
 152
 153   return $self->_shift_feature_buffer;
 154 }
 155
 156 =head2 _push_feature_buffer()
 157
 158  Usage   :
 159  Function:
 160  Returns :
 161  Args    :
 162
 163
 164 =cut
 165
 166 sub _push_feature_buffer {
 167   my ($self,$f) = @_;
 168
 169   if(ref($f)){
 170     push @{ $self->{feature_buffer} }, $f;
 171   }
 172 }
 173
 174 =head2 _shift_feature_buffer()
 175
 176  Usage   :
 177  Function:
 178  Returns :
 179  Args    :
 180
 181
 182 =cut
 183
 184 sub _shift_feature_buffer {
 185   my ($self) = @_;
 186   return $self->{feature_buffer} ? shift @{ $self->{feature_buffer} } : undef;
 187 }
 188
 189 =head2 xml_parser()
 190
 191  Usage   : $obj->xml_parser($newval)
 192  Function:
 193  Example :
 194  Returns : value of xml_parser (a scalar)
 195  Args    : on set, new value (a scalar or undef, optional)
 196
 197
 198 =cut
 199
 200 sub xml_parser {
 201   my($self,$val) = @_;
 202   $self->{'xml_parser'} = $val if defined($val);
 203   return $self->{'xml_parser'};
 204 }
 205
 206 1;