← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/FeatureIO/interpro.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
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 Support 
29
 
 
30
 
Please direct usage questions or support issues to the mailing list:
31
 
 
32
 
I<bioperl-l@bioperl.org>
33
 
 
34
 
rather than to the module maintainer directly. Many experienced and 
35
 
reponsive experts will be able look at the problem and quickly 
36
 
address it. Please include a thorough description of the problem 
37
 
with code and data examples if at all possible.
38
 
 
39
 
=head2 Reporting Bugs
40
 
 
41
 
Report bugs to the Bioperl bug tracking system to help us keep track
42
 
of the bugs and their resolution. Bug reports can be submitted via
43
 
the web:
44
 
 
45
 
  https://redmine.open-bio.org/projects/bioperl/
46
 
 
47
 
=head1 AUTHOR - Allen Day
48
 
 
49
 
Email allenday@ucla.edu
50
 
 
51
 
=head1 APPENDIX
52
 
 
53
 
The rest of the documentation details each of the object methods.
54
 
Internal methods are usually preceded with a _
55
 
 
56
 
=cut
57
 
 
58
 
 
59
 
# Let the code begin...
60
 
 
61
 
package Bio::FeatureIO::interpro;
62
 
 
63
 
use strict;
64
 
use base qw(Bio::FeatureIO);
65
 
use Bio::SeqFeature::Annotated;
66
 
use Bio::OntologyIO;
67
 
 
68
 
use Bio::Annotation::Comment;
69
 
use Bio::Annotation::DBLink;
70
 
use Bio::Annotation::OntologyTerm;
71
 
use Bio::Annotation::SimpleValue;
72
 
use Bio::Annotation::Target;
73
 
 
74
 
use URI::Escape;
75
 
use XML::DOM;
76
 
use XML::DOM::XPath;
77
 
 
78
 
sub _initialize {
79
 
  my($self,%arg) = @_;
80
 
 
81
 
  $self->SUPER::_initialize(%arg);
82
 
  $self->xml_parser(XML::DOM::Parser->new());
83
 
  my $buf;
84
 
  while(($buf = $self->_readline()) && $buf !~ /<protein/){
85
 
    next;
86
 
  }
87
 
  $self->_pushback($buf);
88
 
}
89
 
 
90
 
sub next_feature {
91
 
  my $self =shift;
92
 
  my $buf;    #line buffer
93
 
  my $ok = 0; #true if there is another <protein/> record in stream
94
 
  my $record; #holds the record to be parsed and returned.
95
 
 
96
 
  #try to dump buffer from last record before moving on to next record
97
 
  my $f = $self->_shift_feature_buffer();
98
 
  if($f){
99
 
    return $f;
100
 
  }
101
 
 
102
 
  while(my $buf = $self->_readline()){
103
 
    $ok = 1 if $buf =~ m!<protein!;
104
 
    $record .= $buf;
105
 
    last if $buf =~ m!</protein>!;
106
 
  }
107
 
  return unless $ok;
108
 
 
109
 
  my $dom = $self->xml_parser->parse($record);
110
 
 
111
 
 
112
 
  my ($pNode) = $dom->findnodes('/protein');
113
 
 
114
 
  my @iNodes = $pNode->findnodes('/protein/interpro');
115
 
 
116
 
  foreach my $iNode (@iNodes){
117
 
    my @cNodes = $iNode->findnodes('classification');
118
 
    my @mNodes = $iNode->findnodes('match');
119
 
 
120
 
    #we don't handle these
121
 
    #my @nNodes = $iNode->findnodes('contains');
122
 
    #my @fNodes = $iNode->findnodes('found_in');
123
 
 
124
 
    foreach my $mNode (@mNodes){
125
 
      my @lNodes = $mNode->findnodes('location');
126
 
      foreach my $lNode (@lNodes){
127
 
        my $feature = Bio::SeqFeature::Annotated->new(
128
 
                                                      -start  => $lNode->getAttribute('start'),
129
 
                                                      -end    => $lNode->getAttribute('end'),
130
 
                                                      -score  => $lNode->getAttribute('score'),
131
 
#                                                      -seq_id => $pNode->getAttribute('id'),
132
 
                                                     );
133
 
        $feature->seq_id->value($pNode->getAttribute('id'));
134
 
 
135
 
#warn $pNode->getAttribute('id');
136
 
 
137
 
        $feature->source( $lNode->getAttribute('evidence') );
138
 
 
139
 
        my $t = Bio::Annotation::OntologyTerm->new(-identifier => 'SO:0000417', -name => 'polypeptide_domain');
140
 
        $feature->add_Annotation('type',$t);
141
 
 
142
 
        my $c = Bio::Annotation::Comment->new(-tagname => 'comment', -text => $iNode->getAttribute('name'));
143
 
        $feature->add_Annotation($c);
144
 
 
145
 
        my $d = Bio::Annotation::DBLink->new();
146
 
        $d->database($mNode->getAttribute('dbname'));
147
 
        $d->primary_id($mNode->getAttribute('id'));
148
 
        $d->optional_id($mNode->getAttribute('name'));
149
 
        $feature->annotation->add_Annotation('dblink',$d);
150
 
 
151
 
        my $s = Bio::Annotation::SimpleValue->new(-tagname => 'status', -value => $lNode->getAttribute('status'));
152
 
        $feature->annotation->add_Annotation($s);
153
 
 
154
 
        foreach my $cNode (@cNodes){
155
 
          my $o = Bio::Annotation::OntologyTerm->new(-identifier => $cNode->getAttribute('id'));
156
 
          $feature->annotation->add_Annotation('ontology_term',$o);
157
 
        }
158
 
 
159
 
        $self->_push_feature_buffer($feature);
160
 
      }
161
 
    }
162
 
  }
163
 
 
164
 
  return $self->_shift_feature_buffer;
165
 
}
166
 
 
167
 
=head2 _push_feature_buffer()
168
 
 
169
 
 Usage   :
170
 
 Function:
171
 
 Returns : 
172
 
 Args    :
173
 
 
174
 
 
175
 
=cut
176
 
 
177
 
sub _push_feature_buffer {
178
 
  my ($self,$f) = @_;
179
 
 
180
 
  if(ref($f)){
181
 
    push @{ $self->{feature_buffer} }, $f;
182
 
  }
183
 
}
184
 
 
185
 
=head2 _shift_feature_buffer()
186
 
 
187
 
 Usage   :
188
 
 Function:
189
 
 Returns : 
190
 
 Args    :
191
 
 
192
 
 
193
 
=cut
194
 
 
195
 
sub _shift_feature_buffer {
196
 
  my ($self) = @_;
197
 
  return $self->{feature_buffer} ? shift @{ $self->{feature_buffer} } : undef;
198
 
}
199
 
 
200
 
=head2 xml_parser()
201
 
 
202
 
 Usage   : $obj->xml_parser($newval)
203
 
 Function: 
204
 
 Example : 
205
 
 Returns : value of xml_parser (a scalar)
206
 
 Args    : on set, new value (a scalar or undef, optional)
207
 
 
208
 
 
209
 
=cut
210
 
 
211
 
sub xml_parser {
212
 
  my($self,$val) = @_;
213
 
  $self->{'xml_parser'} = $val if defined($val);
214
 
  return $self->{'xml_parser'};
215
 
}
216
 
 
217
 
1;