~ubuntu-branches/ubuntu/oneiric/bioperl/oneiric

« back to all changes in this revision

Viewing changes to Bio/SeqIO/swissdriver.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (3.1.2 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090310071911-ever3si2bbzx1iks
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# $Id: swissdriver.pm 15212 2008-12-19 05:47:58Z cjfields $
 
2
#
 
3
# BioPerl module for Bio::SeqIO::swissdriver
 
4
#
 
5
# Cared for by Bioperl project bioperl-l(at)bioperl.org
 
6
#
 
7
# Copyright Chris Fields and contributors see AUTHORS section
 
8
#
 
9
# You may distribute this module under the same terms as perl itself
 
10
 
 
11
# POD documentation - main docs before the code
 
12
 
 
13
=head1 NAME
 
14
 
 
15
Bio::SeqIO::swissdriver - SwissProt/UniProt handler-based push parser
 
16
 
 
17
=head1 SYNOPSIS
 
18
 
 
19
  #It is probably best not to use this object directly, but
 
20
  #rather go through the SeqIO handler:
 
21
 
 
22
  $stream = Bio::SeqIO->new(-file => $filename,
 
23
                            -format => 'swissdriver');
 
24
 
 
25
  while ( my $seq = $stream->next_seq() ) {
 
26
      # do something with $seq
 
27
  }
 
28
 
 
29
=head1 DESCRIPTION
 
30
 
 
31
This object can transform Bio::Seq objects to and from UniProt flat file
 
32
databases. The key difference between this parser and the tried-and-true
 
33
Bio::SeqIO::swiss parser is this version separates the parsing and data
 
34
manipulation into a 'driver' method (next_seq) and separate object handlers
 
35
which deal with the data passed to it.
 
36
 
 
37
=head2 The Driver
 
38
 
 
39
The main purpose of the driver routine, in this case next_seq(), is to carve out
 
40
the data into meaningful chunks which are passed along to relevant handlers (see
 
41
below).
 
42
 
 
43
Each chunk of data in the has a NAME tag attached to it, similar to that for XML
 
44
parsing. This designates the type of data passed (annotation type or seqfeature)
 
45
and the handler to be called for processing the data.
 
46
 
 
47
=head1 FEEDBACK
 
48
 
 
49
=head2 Mailing Lists
 
50
 
 
51
User feedback is an integral part of the evolution of this and other
 
52
Bioperl modules. Send your comments and suggestions preferably to one
 
53
of the Bioperl mailing lists.  Your participation is much appreciated.
 
54
 
 
55
  bioperl-l@bioperl.org                  - General discussion
 
56
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 
57
 
 
58
=head2 Reporting Bugs
 
59
 
 
60
Report bugs to the Bioperl bug tracking system to help us keep track
 
61
the bugs and their resolution. Bug reports can be submitted via the web:
 
62
 
 
63
  http://bugzilla.open-bio.org/
 
64
 
 
65
=head1 AUTHOR - Bioperl Project
 
66
 
 
67
bioperl-l at bioperl.org
 
68
 
 
69
=head1 APPENDIX
 
70
 
 
71
The rest of the documentation details each of the object
 
72
methods. Internal methods are usually preceded with a _
 
73
 
 
74
=cut
 
75
 
 
76
# POD is at the end of the module
 
77
 
 
78
# Let the code begin...
 
79
 
 
80
# Let the code begin...
 
81
 
 
82
package Bio::SeqIO::swissdriver;
 
83
use vars qw(%FTQUAL_NO_QUOTE);
 
84
use strict;
 
85
use Bio::SeqIO::Handler::GenericRichSeqHandler;
 
86
use Data::Dumper;
 
87
 
 
88
use base qw(Bio::SeqIO);
 
89
 
 
90
# signals to process what's in the hash prior to next round, maps ann => names 
 
91
my %SEC = (
 
92
    OC      => 'CLASSIFICATION',
 
93
    OH      => 'HOST', # not currently handled, bundled with organism data for now
 
94
    OG      => 'ORGANELLE',
 
95
    OX      => 'CROSSREF',
 
96
    RA      => 'AUTHORS',
 
97
    RC      => 'COMMENT',
 
98
    RG      => 'CONSRTM',
 
99
    RP      => 'POSITION',
 
100
    RX      => 'CROSSREF',
 
101
    RT      => 'TITLE',
 
102
    RL      => 'JOURNAL',
 
103
    AS      => 'ASSEMBLYINFO',  # Third party annotation
 
104
    '//'    => 'RECORDEND'
 
105
    );
 
106
 
 
107
# add specialized delimiters here for easier postprocessing
 
108
my %DELIM = (
 
109
    CC      => "\n",
 
110
    DR      => "\n",
 
111
    DT      => "\n",
 
112
            );
 
113
 
 
114
sub _initialize {
 
115
    my($self,@args) = @_;
 
116
 
 
117
    $self->SUPER::_initialize(@args);
 
118
    my $handler = $self->_rearrange([qw(HANDLER)],@args);
 
119
    # hash for functions for decoding keys.
 
120
    $handler ? $self->seqhandler($handler) :
 
121
    $self->seqhandler(Bio::SeqIO::Handler::GenericRichSeqHandler->new(
 
122
                    -format => 'swiss',
 
123
                    -verbose => $self->verbose,
 
124
                    -builder => $self->sequence_builder
 
125
                    ));
 
126
    if( ! defined $self->sequence_factory ) {
 
127
        $self->sequence_factory(Bio::Seq::SeqFactory->new
 
128
                (-verbose => $self->verbose(),
 
129
                 -type => 'Bio::Seq::RichSeq'));
 
130
    }
 
131
}
 
132
 
 
133
=head2 next_seq
 
134
 
 
135
 Title   : next_seq
 
136
 Usage   : $seq = $stream->next_seq()
 
137
 Function: returns the next sequence in the stream
 
138
 Returns : Bio::Seq object
 
139
 Args    : none
 
140
 
 
141
=cut
 
142
 
 
143
sub next_seq {
 
144
    my $self = shift;
 
145
    my $hobj = $self->seqhandler;
 
146
    local($/) = "\n";
 
147
    # these contain values that need to carry over each round
 
148
    my ($featkey, $qual, $annkey, $seqdata, $location);
 
149
    my $lastann = '';
 
150
    my $ct = 0;
 
151
    # main parser
 
152
    PARSER:
 
153
    while(defined(my $line = $self->_readline)) {
 
154
        chomp $line;
 
155
        my ($ann, $data) = split(m{\s+}, $line, 2);
 
156
        if ($ann) {
 
157
            if ($ann eq 'FT') {
 
158
                # sequence features
 
159
                if ($data =~ m{^(\w+)\s+([\d\?\<]+)\s+([\d\?\>]+)(?:\s+?(\S.*))?}ox) {
 
160
                    # has location data and desc
 
161
                    if ($seqdata) {
 
162
                        $hobj->data_handler($seqdata);
 
163
                        $seqdata = ();
 
164
                    }
 
165
                    ($seqdata->{FEATURE_KEY}, my $loc1, my $loc2, $data) = ($1, $2, $3, $4);
 
166
                    $qual = 'description';
 
167
                    $seqdata->{$qual} = $data;
 
168
                    $seqdata->{NAME} = $ann;
 
169
                    $seqdata->{LOCATION} = "$loc1..$loc2" if defined $loc1;
 
170
                    next PARSER;
 
171
                } elsif ($data =~ m{^\s+/([^=]+)(?:=(.+))?}ox) {
 
172
                    # has qualifer
 
173
                    ($qual, $data) = ($1, $2 || '');
 
174
                    $ct = ($seqdata->{$qual}) ? 
 
175
                        ((ref($seqdata->{$qual}))  ? scalar(@{ $seqdata->{$qual} }) : 1)
 
176
                        : 0 ;
 
177
                }
 
178
                $data =~ s{\.$}{};
 
179
                if ($ct == 0) {
 
180
                    $seqdata->{$qual} .= ($seqdata->{$qual}) ?
 
181
                        ' '.$data : $data;                    
 
182
                } else {
 
183
                    if (!ref($seqdata->{$qual})) {
 
184
                        $seqdata->{$qual} = [$seqdata->{$qual}];
 
185
                    }
 
186
                    ($seqdata->{$qual}->[$ct]) ?
 
187
                        ($seqdata->{$qual}->[$ct] .= ' '.$data) :
 
188
                        ($seqdata->{$qual}->[$ct] .= $data);
 
189
                }
 
190
            } else {
 
191
                # simple annotations
 
192
                if ($ann ne $lastann) {
 
193
                    if (!$SEC{$ann} && $seqdata) {
 
194
                        $hobj->data_handler($seqdata);
 
195
                        # can't use undef here; it can lead to subtle mem leaks
 
196
                        $seqdata = ();
 
197
                    }
 
198
                    $annkey = (!$SEC{$ann})    ? 'DATA'     : # primary data
 
199
                              $SEC{$ann};
 
200
                    $seqdata->{'NAME'} = $ann if !$SEC{$ann};
 
201
                }
 
202
                last PARSER if $ann eq '//';
 
203
                next PARSER if $ann eq 'SQ';
 
204
                my $delim = $DELIM{$ann} || ' ';
 
205
                $seqdata->{$annkey} .= ($seqdata->{$annkey}) ?
 
206
                    $delim.$data : $data;
 
207
                $lastann = $ann;
 
208
            } 
 
209
        } else {
 
210
            # this should only be sequence (fingers crossed!)
 
211
            SEQUENCE:
 
212
            while (defined ($line = $self->_readline)) {
 
213
                if (index($line, '//') == 0) {
 
214
                    $data =~ tr{0-9 \n}{}d;
 
215
                    $seqdata->{DATA} = $data;
 
216
                    #$self->debug(Dumper($seqdata));
 
217
                    $hobj->data_handler($seqdata);
 
218
                    $seqdata = ();
 
219
                    last PARSER;
 
220
                } else {                        
 
221
                    $data .= $line;
 
222
                    $line = undef;
 
223
                }
 
224
            }
 
225
        }
 
226
    }
 
227
    # some files have no // for the last file; this catches the last bit o' data
 
228
    $hobj->data_handler($seqdata) if $seqdata;
 
229
    return $hobj->build_sequence;
 
230
}
 
231
 
 
232
=head2 write_seq
 
233
 
 
234
 Title   : write_seq
 
235
 Usage   : $stream->write_seq($seq)
 
236
 Function: writes the $seq object (must be seq) to the stream
 
237
 Returns : 1 for success and 0 for error
 
238
 Args    : array of 1 to n Bio::SeqI objects
 
239
 
 
240
=cut
 
241
 
 
242
sub write_seq {
 
243
    shift->throw("Use Bio::SeqIO::swiss write_seq() for output");
 
244
    # maybe make a Writer class as well????
 
245
}
 
246
 
 
247
=head2 seqhandler
 
248
 
 
249
 Title   : seqhandler
 
250
 Usage   : $stream->seqhandler($handler)
 
251
 Function: Get/Set teh Bio::Seq::HandlerBaseI object
 
252
 Returns : Bio::Seq::HandlerBaseI 
 
253
 Args    : Bio::Seq::HandlerBaseI 
 
254
 
 
255
=cut
 
256
 
 
257
sub seqhandler {
 
258
    my ($self, $handler) = @_;
 
259
    if ($handler) {
 
260
        $self->throw("Not a Bio::HandlerBaseI") unless
 
261
        ref($handler) && $handler->isa("Bio::HandlerBaseI");
 
262
        $self->{'_seqhandler'} = $handler;
 
263
    }
 
264
    return $self->{'_seqhandler'};
 
265
}
 
266
 
 
267
1;
 
268
 
 
269
__END__
 
270