← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/DB/Biblio/biofetch.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2007-09-21 22:52:22 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070921225222-tt20m2yy6ycuy2d8
Tags: 1.5.2.102-1
* Developer release.
* Upgraded source package to debhelper 5 and standards-version 3.7.2.
* Added libmodule-build-perl and libtest-harness-perl to
  build-depends-indep.
* Disabled automatic CRAN download.
* Using quilt instead of .diff.gz to manage modifications.
* Updated Recommends list for the binary package.
* Moved the "production-quality" scripts to /usr/bin/.
* New maintainer: Debian-Med packaging team mailing list.
* New uploaders: Charles Plessy and Steffen Moeller.
* Updated Depends, Recommends and Suggests.
* Imported in Debian-Med's SVN repository on Alioth.
* Executing the regression tests during package building.
* Moved the Homepage: field out from the package's description.
* Updated watch file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/DB/Biblio/biofetch.pm
1
 
# $Id: biofetch.pm,v 1.6 2003/06/04 08:36:37 heikki Exp $
 
1
# $Id: biofetch.pm,v 1.10.4.2 2006/10/02 23:10:15 sendu Exp $
2
2
#
3
3
# BioPerl module Bio::DB::Biblio::biofetch.pm
4
4
#
5
 
# Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
 
5
# Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
6
6
# For copyright and disclaimer see below.
7
7
 
8
8
# POD documentation - main docs before the code
40
40
Bioperl modules. Send your comments and suggestions preferably to
41
41
the Bioperl mailing list.  Your participation is much appreciated.
42
42
 
43
 
  bioperl-l@bioperl.org              - General discussion
44
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
43
  bioperl-l@bioperl.org                  - General discussion
 
44
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
45
45
 
46
46
=head2 Reporting Bugs
47
47
 
48
48
Report bugs to the Bioperl bug tracking system to help us keep track
49
 
of the bugs and their resolution. Bug reports can be submitted via
50
 
email or the web:
 
49
of the bugs and their resolution. Bug reports can be submitted via the
 
50
web:
51
51
 
52
 
  bioperl-bugs@bioperl.org
53
 
  http://bugzilla.bioperl.org/
 
52
  http://bugzilla.open-bio.org/
54
53
 
55
54
=head1 AUTHOR
56
55
 
57
 
Heikki Lehvaslaiho (heikki@ebi.ac.uk)
 
56
Heikki Lehvaslaiho (heikki-at-bioperl-dot-org)
58
57
 
59
58
=head1 COPYRIGHT
60
59
 
92
91
 
93
92
 
94
93
package Bio::DB::Biblio::biofetch;
95
 
use vars qw(@ISA %HOSTS  %FORMATMAP  $DEFAULTFORMAT 
96
 
            $Revision $DEFAULT_SERVICE $DEFAULT_NAMESPACE);
 
94
use vars qw(%HOSTS %FORMATMAP  $DEFAULTFORMAT $DEFAULTRETRIEVAL_TYPE
 
95
            $DEFAULT_SERVICE $DEFAULT_NAMESPACE);
97
96
use strict;
98
97
 
99
 
use Bio::Biblio;
100
 
use Bio::DB::DBFetch;
101
98
use Bio::Biblio::IO;
102
99
 
103
 
@ISA = qw( Bio::DB::DBFetch Bio::Biblio);
 
100
use base qw(Bio::DB::DBFetch Bio::Biblio);
104
101
 
105
102
BEGIN {
106
103
 
107
 
    $Revision = q$Id: biofetch.pm,v 1.6 2003/06/04 08:36:37 heikki Exp $;
108
 
 
109
104
    # you can add your own here theoretically.
110
105
    %HOSTS = (
111
106
               'dbfetch' => {
117
112
              );
118
113
    %FORMATMAP = ( 'default' => 'medlinexml'
119
114
                   );
120
 
    $DEFAULTFORMAT = 'default';
 
115
    $DEFAULTFORMAT = 'medlinexml';
121
116
 
122
117
    $DEFAULT_SERVICE = 'http://www.ebi.ac.uk/cgi-bin/dbfetch';
123
 
 
 
118
         $DEFAULTRETRIEVAL_TYPE = 'tempfile';
124
119
}
125
120
 
126
 
 
127
121
sub new {
128
122
    my ($class, @args ) = @_;
129
123
    my $self = $class->SUPER::new(@args);
133
127
 
134
128
    $self->hosts(\%HOSTS);
135
129
    $self->formatmap(\%FORMATMAP);
 
130
         $self->retrieval_type($DEFAULTRETRIEVAL_TYPE);
136
131
    $self->{'_default_format'} = $DEFAULTFORMAT;
137
132
 
138
133
    return $self;
178
173
=head2 get_seq_stream
179
174
 
180
175
 Title   : get_seq_stream
181
 
 Usage   : my $seqio = $self->get_seq_sream(%qualifiers)
 
176
 Usage   : my $seqio = $self->get_seq_stream(%qualifiers)
182
177
 Function: builds a url and queries a web db
183
178
 Returns : a Bio::SeqIO stream capable of producing sequence
184
179
 Args    : %qualifiers = a hash qualifiers that the implementing class 
187
182
=cut
188
183
 
189
184
sub get_seq_stream {
190
 
    my ($self, %qualifiers) = @_;
191
 
    my ($rformat, $ioformat) = $self->request_format();
192
 
    my $seen = 0;
193
 
    foreach my $key ( keys %qualifiers ) {
194
 
        if( $key =~ /format/i ) {
195
 
            $rformat = $qualifiers{$key};
196
 
            $seen = 1;
 
185
        my ($self, %qualifiers) = @_;
 
186
        my ($rformat, $ioformat) = $self->request_format();
 
187
        my $seen = 0;
 
188
        foreach my $key ( keys %qualifiers ) {
 
189
                if( $key =~ /format/i ) {
 
190
                        $rformat = $qualifiers{$key};
 
191
                        $seen = 1;
 
192
                }
197
193
        }
198
 
    }
199
 
    $qualifiers{'-format'} = $rformat if( !$seen);
200
 
    ($rformat, $ioformat) = $self->request_format($rformat);
 
194
        $qualifiers{'-format'} = $rformat if( !$seen);
 
195
        ($rformat, $ioformat) = $self->request_format($rformat);
201
196
    
202
 
    my $request = $self->get_request(%qualifiers);
203
 
    my ($stream,$resp);
204
 
    if( $self->retrieval_type =~ /temp/i ) {
205
 
        my $dir = $self->io()->tempdir( CLEANUP => 1);
206
 
        my ( $fh, $tmpfile) = $self->io()->tempfile( DIR => $dir );
207
 
        close $fh;
208
 
        my ($resp) = $self->_request($request, $tmpfile);               
209
 
        if( ! -e $tmpfile || -z $tmpfile || ! $resp->is_success() ) {
210
 
            $self->throw("WebDBSeqI Error - check query sequences!\n");
 
197
        my $request = $self->get_request(%qualifiers);
 
198
        my ($stream,$resp);
 
199
        if ( $self->retrieval_type =~ /temp/i ) {
 
200
                my $dir = $self->io()->tempdir( CLEANUP => 1);
 
201
                my ( $fh, $tmpfile) = $self->io()->tempfile( DIR => $dir );
 
202
                close $fh;
 
203
                my ($resp) = $self->_request($request, $tmpfile);               
 
204
                if( ! -e $tmpfile || -z $tmpfile || ! $resp->is_success() ) {
 
205
                        $self->throw("WebDBSeqI Error - check query sequences!\n");
 
206
                }
 
207
                $self->postprocess_data('type' => 'file',
 
208
                                                                                'location' => $tmpfile);        
 
209
                # this may get reset when requesting batch mode
 
210
                ($rformat,$ioformat) = $self->request_format();
 
211
                if ( $self->verbose > 0 ) {
 
212
                        open(my $ERR, "<", $tmpfile);
 
213
                        while(<$ERR>) { $self->debug($_);}
 
214
                } 
 
215
                $stream = new Bio::Biblio::IO('-format' => $ioformat,
 
216
                                                                                                '-file'   => $tmpfile);
 
217
        } elsif ( $self->retrieval_type =~ /io_string/i ) {
 
218
                my ($resp) = $self->_request($request);
 
219
                my $content = $resp->content_ref;
 
220
                $self->debug( "content is $$content\n");
 
221
                if( ! $resp->is_success() || length(${$resp->content_ref()}) == 0 ) {
 
222
                        $self->throw("WebDBSeqI Error - check query sequences!\n");     
 
223
                }  
 
224
                ($rformat,$ioformat) = $self->request_format();
 
225
                $self->postprocess_data('type'=> 'string',
 
226
                                                                                'location' => $content);
 
227
                $stream = new Bio::Biblio::IO('-format' => $ioformat,
 
228
                        # '-data'   => "<tag>". $$content. "</tag>");
 
229
                                                                                                '-data'   => $$content
 
230
                                                                                          );
 
231
        } else { 
 
232
                $self->throw("retrieval type " . $self->retrieval_type . 
 
233
                                                 " unsupported\n");
211
234
        }
212
 
        $self->postprocess_data('type' => 'file',
213
 
                                'location' => $tmpfile);        
214
 
        # this may get reset when requesting batch mode
215
 
        ($rformat,$ioformat) = $self->request_format();
216
 
        if( $self->verbose > 0 ) {
217
 
            open(ERR, "<$tmpfile");
218
 
            while(<ERR>) { $self->debug($_);}
219
 
        } 
220
 
        $stream = new Bio::Biblio::IO('-format' => $ioformat,
221
 
                                      '-file'   => $tmpfile);
222
 
    } elsif( $self->retrieval_type =~ /io_string/i ) {
223
 
        my ($resp) = $self->_request($request);
224
 
        my $content = $resp->content_ref;
225
 
        $self->debug( "content is $$content\n");
226
 
        if( ! $resp->is_success() || length(${$resp->content_ref()}) == 0 ) {
227
 
            $self->throw("WebDBSeqI Error - check query sequences!\n"); 
228
 
        }  
229
 
        ($rformat,$ioformat) = $self->request_format();
230
 
        $self->postprocess_data('type'=> 'string',
231
 
                                'location' => $content);
232
 
        $stream = new Bio::Biblio::IO('-format' => $ioformat,
233
 
#                                     '-data'   => "<tag>". $$content. "</tag>");
234
 
                                      '-data'   => $$content
235
 
                                      );
236
 
    } else { 
237
 
        $self->throw("retrieval type " . $self->retrieval_type . 
238
 
                     " unsupported\n");
239
 
    }
240
 
    return $stream;
 
235
        return $stream;
241
236
}
242
237
 
243
238
 
258
253
# override it with their own method.
259
254
 
260
255
sub postprocess_data {    
261
 
    my ($self, %args) = @_;
262
 
    my $data;
263
 
    my $type = uc $args{'type'};
264
 
    my $location = $args{'location'};
265
 
    if( !defined $type || $type eq '' || !defined $location) {
266
 
        return;
267
 
    } elsif( $type eq 'STRING' ) {
268
 
        $data = $$location; 
269
 
    } elsif ( $type eq 'FILE' ) {
270
 
        open(TMP, $location) or $self->throw("could not open file $location");
271
 
        my @in = <TMP>;
272
 
        close TMP;
273
 
        $data = join("", @in);
274
 
    }
275
 
 
276
 
    $data = "<tag>". $data. "</tag>";
277
 
    
278
 
    if( $type eq 'FILE'  ) {
279
 
        open(TMP, ">$location") or $self->throw("could overwrite file $location");
280
 
        print TMP $data;
281
 
        close TMP;
282
 
    } elsif ( $type eq 'STRING' ) {
283
 
        ${$args{'location'}} = $data;
284
 
    }
285
 
    
286
 
    $self->debug("format is ". $self->request_format(). " data is $data\n");
287
 
 
 
256
        my ($self, %args) = @_;
 
257
        my ($data, $TMP);
 
258
        my $type = uc $args{'type'};
 
259
        my $location = $args{'location'};
 
260
        if( !defined $type || $type eq '' || !defined $location) {
 
261
                return;
 
262
        } elsif( $type eq 'STRING' ) {
 
263
                $data = $$location; 
 
264
        } elsif ( $type eq 'FILE' ) {
 
265
                open($TMP, "<", $location) or $self->throw("could not open file $location");
 
266
                my @in = <$TMP>;
 
267
                $data = join("", @in);
 
268
        }
 
269
 
 
270
        if( $type eq 'FILE'  ) {
 
271
                open($TMP, ">", $location) or $self->throw("could overwrite file $location");
 
272
                print $TMP $data;
 
273
        } elsif ( $type eq 'STRING' ) {
 
274
                ${$args{'location'}} = $data;
 
275
        }
 
276
    
 
277
        $self->debug("format is ". $self->request_format(). " data is $data\n");
288
278
}
289
279
 
290
 
 
291
 
 
292
 
 
293
280
=head2 VERSION and Revision
294
281
 
295
282
 Usage   : print $Bio::DB::Biblio::biofetch::VERSION;