← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/DB/SwissProt.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/DB/SwissProt.pm
2
2
#
3
3
# BioPerl module for Bio::DB::SwissProt
4
4
#
5
 
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
 
5
# Please direct questions and support issues to <bioperl-l@bioperl.org>
6
6
#
7
7
# Cared for by Jason Stajich <jason@bioperl.org>
8
8
#
26
26
    $seq = $sp->get_Seq_by_id('KPY1_ECOLI'); # SwissProt ID
27
27
    # <4-letter-identifier>_<species 5-letter code>
28
28
    # or ...
29
 
    $seq = $sp->get_Seq_by_acc('P43780'); # SwissProt AC      
 
29
    $seq = $sp->get_Seq_by_acc('P43780'); # SwissProt AC
30
30
    # [OPQ]xxxxx
31
31
 
32
32
 
33
 
    # In fact in this implementation 
34
 
    # these methods call the same webscript so you can use 
 
33
    # In fact in this implementation
 
34
    # these methods call the same webscript so you can use
35
35
    # then interchangeably
36
36
 
37
37
    # choose a different server to query
68
68
  bioperl-l@bioperl.org                  - General discussion
69
69
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
70
70
 
71
 
=head2 Support 
 
71
=head2 Support
72
72
 
73
73
Please direct usage questions or support issues to the mailing list:
74
74
 
75
75
I<bioperl-l@bioperl.org>
76
76
 
77
 
rather than to the module maintainer directly. Many experienced and 
78
 
reponsive experts will be able look at the problem and quickly 
79
 
address it. Please include a thorough description of the problem 
 
77
rather than to the module maintainer directly. Many experienced and
 
78
reponsive experts will be able look at the problem and quickly
 
79
address it. Please include a thorough description of the problem
80
80
with code and data examples if at all possible.
81
81
 
82
82
=head2 Reporting Bugs
95
95
Institute of Bioinformatics for helping point us in the direction of
96
96
the correct expasy scripts and for swissknife references.
97
97
 
98
 
Also thanks to Heikki Lehvaslaiho E<lt>heikki-at-bioperl-dot-orgE<gt> 
 
98
Also thanks to Heikki Lehvaslaiho E<lt>heikki-at-bioperl-dot-orgE<gt>
99
99
for help with adding EBI swall server.
100
100
 
101
101
=head1 APPENDIX
121
121
# our $DEFAULTIDTRACKER = 'http://www.expasy.ch';
122
122
 
123
123
# you can add your own here theoretically.
124
 
our %HOSTS = ( 
125
 
           'expasy' => { 
 
124
our %HOSTS = (
 
125
           'expasy' => {
126
126
               'default' => 'us',
127
127
               'baseurl' => 'http://%s/cgi-bin/sprot-retrieve-list.pl',
128
 
               'hosts'   =>            
129
 
               { 
 
128
               'hosts'   =>
 
129
               {
130
130
                   'switzerland'  => 'ch.expasy.org',
131
131
                   'canada' => 'ca.expasy.org',
132
132
                   'china'  => 'cn.expasy.org',
138
138
               # ick, CGI variables
139
139
               'jointype' => ' ',
140
140
               'idvar'    => 'list',
141
 
               'basevars' => [ ],              
 
141
               'basevars' => [ ],
142
142
           },
143
143
           'ebi'    => {
144
144
               'default' => 'uk',
145
145
               'baseurl' => 'http://%s/Tools/dbfetch/dbfetch',
146
 
               'hosts' => { 
 
146
               'hosts' => {
147
147
                   'uk'   => 'www.ebi.ac.uk',
148
148
               },
149
149
               'jointype' => ',',
174
174
    my ($class, @args) = @_;
175
175
    my $self = $class->SUPER::new(@args);
176
176
 
177
 
    my ($format, $hostlocation,$servertype) = 
 
177
    my ($format, $hostlocation,$servertype) =
178
178
        $self->_rearrange([qw(FORMAT HOSTLOCATION SERVERTYPE)],
179
 
                          @args);    
 
179
                          @args);
180
180
 
181
181
    if( $format && $format !~ /(swiss)|(fasta)/i ) {
182
182
        $self->warn("Requested Format $format is ignored because only SwissProt and Fasta formats are currently supported");
183
183
        $format = $self->default_format;
184
 
    } 
 
184
    }
185
185
    $servertype = $DEFAULTSERVERTYPE unless $servertype;
186
186
    $servertype = lc $servertype;
187
187
    $self->servertype($servertype);
247
247
  Title   : get_Stream_by_batch
248
248
  Usage   : $seq = $db->get_Stream_by_batch($ref);
249
249
  Function: Retrieves Seq objects from SwissProt 'en masse', rather than one
250
 
            at a time.  This is implemented the same way as get_Stream_by_id, 
251
 
            but is provided here in keeping with access methods of NCBI 
 
250
            at a time.  This is implemented the same way as get_Stream_by_id,
 
251
            but is provided here in keeping with access methods of NCBI
252
252
            modules.
253
253
  Example :
254
254
  Returns : a Bio::SeqIO stream object
259
259
 
260
260
=cut
261
261
 
262
 
*get_Stream_by_batch = sub { 
 
262
*get_Stream_by_batch = sub {
263
263
   my $self = shift;
264
264
   $self->deprecated('get_Stream_by_batch() is deprecated; use get_Stream_by_id() instead');
265
 
   $self->get_Stream_by_id(@_) 
 
265
   $self->get_Stream_by_id(@_)
266
266
};
267
267
 
268
268
=head2 Implemented Routines from Bio::DB::WebDBSeqI interface
274
274
 Title   : get_request
275
275
 Usage   : my $url = $self->get_request
276
276
 Function: returns a HTTP::Request object
277
 
 Returns : 
 
277
 Returns :
278
278
 Args    : %qualifiers = a hash of qualifiers (ids, format, etc)
279
279
 
280
280
=cut
288
288
        $self->throw("Must specify a value for uids to query");
289
289
    }
290
290
    my ($f,undef) = $self->request_format($format);
291
 
    
292
 
    my %vars = ( 
293
 
                 @{$HOSTS{$self->servertype}->{'basevars'}}, 
 
291
 
 
292
    my %vars = (
 
293
                 @{$HOSTS{$self->servertype}->{'basevars'}},
294
294
                 ( 'format' => $f )
295
295
                 );
296
 
    
 
296
 
297
297
    my $url = $self->location_url;
298
 
    
 
298
 
299
299
    my $uid;
300
300
    my $jointype = $HOSTS{$self->servertype}->{'jointype'} || ' ';
301
301
    my $idvar = $HOSTS{$self->servertype}->{'idvar'} || 'id';
302
 
    
303
 
    if( ref($uids) =~ /ARRAY/i ) {      
 
302
 
 
303
    if( ref($uids) =~ /ARRAY/i ) {
304
304
        # HTTP::Request automagically converts the ' ' to %20
305
 
        $uid = join($jointype, @$uids); 
 
305
        $uid = join($jointype, @$uids);
306
306
    } else {
307
307
        $uid = $uids;
308
308
    }
319
319
 Function: process downloaded data before loading into a Bio::SeqIO
320
320
 Returns : void
321
321
 Args    : hash with two keys - 'type' can be 'string' or 'file'
322
 
                              - 'location' either file location or string 
 
322
                              - 'location' either file location or string
323
323
                                           reference containing data
324
324
 
325
325
=cut
326
326
 
327
 
# don't need to do anything 
 
327
# don't need to do anything
328
328
 
329
329
sub postprocess_data {
330
 
    my ($self, %args) = @_;    
 
330
    my ($self, %args) = @_;
331
331
    return;
332
332
}
333
333
 
362
362
 
363
363
sub servertype {
364
364
    my ($self, $servertype) = @_;
365
 
    if( defined $servertype && $servertype ne '') {             
 
365
    if( defined $servertype && $servertype ne '') {
366
366
        $self->throw("You gave an invalid server type ($servertype)".
367
 
                         " - available types are ".  
 
367
                         " - available types are ".
368
368
                         keys %HOSTS) unless( $HOSTS{$servertype} );
369
369
        $self->{'_servertype'} = $servertype;
370
370
        $self->{'_hostlocation'} = $HOSTS{$servertype}->{'default'};
371
 
        
 
371
 
372
372
        # make sure format is reset properly in that different
373
373
        # servers have different syntaxes
374
374
        my ($existingformat,$seqioformat) = $self->request_format;
375
 
        $self->request_format($existingformat);         
 
375
        $self->request_format($existingformat);
376
376
    }
377
377
    return $self->{'_servertype'} || $DEFAULTSERVERTYPE;
378
378
}
381
381
=head2 hostlocation
382
382
 
383
383
 Title   : hostlocation
384
 
 Usage   : my $location = $self->hostlocation() 
385
 
          $self->hostlocation($location) 
386
 
 Function: Set/Get Hostlocation 
 
384
 Usage   : my $location = $self->hostlocation()
 
385
          $self->hostlocation($location)
 
386
 Function: Set/Get Hostlocation
387
387
 Returns : string representing hostlocation
388
388
 Args    : string specifying hostlocation [optional]
389
389
 
393
393
    my ($self, $location ) = @_;
394
394
    my $servertype = $self->servertype;
395
395
    $self->throw("Must have a valid servertype defined not $servertype")
396
 
        unless defined $servertype; 
 
396
        unless defined $servertype;
397
397
    my %hosts = %{$HOSTS{$servertype}->{'hosts'}};
398
398
    if( defined $location && $location ne '' ) {
399
399
    $location = lc $location;
400
400
        if( ! $hosts{$location} ) {
401
401
            $self->throw("Must specify a known host, not $location,".
402
402
                         " possible values (".
403
 
                         join(",", sort keys %hosts ). ")"); 
 
403
                         join(",", sort keys %hosts ). ")");
404
404
        }
405
405
        $self->{'_hostlocation'} = $location;
406
406
    }
418
418
=cut
419
419
 
420
420
sub location_url {
421
 
    my ($self) = @_;    
 
421
    my ($self) = @_;
422
422
    my $servertype = $self->servertype();
423
423
    my $location = $self->hostlocation();
424
424
 
425
 
    if( ! defined $location || !defined $servertype )  {        
 
425
    if( ! defined $location || !defined $servertype )  {
426
426
        $self->throw("must have a valid hostlocation and servertype set before calling location_url");
427
427
    }
428
 
    return sprintf($HOSTS{$servertype}->{'baseurl'}, 
 
428
    return sprintf($HOSTS{$servertype}->{'baseurl'},
429
429
                   $HOSTS{$servertype}->{'hosts'}->{$location});
430
 
}                  
 
430
}
431
431
 
432
432
=head2 request_format
433
433
 
438
438
 Function: Get/Set sequence format retrieval. The get-form will normally
439
439
           not be used outside of this and derived modules.
440
440
 Returns : Array of two strings, the first representing the format for
441
 
           retrieval, and the second specifying the corresponding SeqIO 
 
441
           retrieval, and the second specifying the corresponding SeqIO
442
442
           format.
443
443
 Args    : $format = sequence format
444
444
 
449
449
    if( defined $value ) {
450
450
        if( $self->servertype =~ /expasy/ ) {
451
451
            if( $value =~ /sprot/ || $value =~ /swiss/ ) {
452
 
                $self->{'_format'} = [ 'sprot', 'swiss'];           
 
452
                $self->{'_format'} = [ 'sprot', 'swiss'];
453
453
            } elsif( $value =~ /^fa/ ) {
454
454
                $self->{'_format'} = [ 'fasta', 'fasta'];
455
455
            } else {
457
457
                $self->{'_format'} = [ 'fasta', 'fasta'];
458
458
            }
459
459
        } elsif( $self->servertype =~ /ebi/ ) {
460
 
            if( $value =~ /sprot/ || $value =~ /swiss/ ) {              
 
460
            if( $value =~ /sprot/ || $value =~ /swiss/ ) {
461
461
                $self->{'_format'} = [ 'swissprot', 'swiss' ];
462
462
            } elsif( $value =~ /^fa/ ) {
463
463
                $self->{'_format'} = [ 'fasta', 'fasta'];
464
 
            } else { 
 
464
            } else {
465
465
                $self->warn("Unrecognized format $value requested");
466
466
                $self->{'_format'} = [ 'swissprot', 'swiss'];
467
467
            }
474
474
 
475
475
 Title   : idtracker
476
476
 Usage   : my ($newid) = $self->idtracker($oldid);
477
 
 Function: Retrieve new ID using old ID. 
 
477
 Function: Retrieve new ID using old ID.
478
478
 Returns : single ID if one is found
479
 
 Args    : ID to look for 
 
479
 Args    : ID to look for
480
480
 
481
481
=cut
482
482
 
496
496
 Usage   : my $map = $self->id_mapper( -from => '',
497
497
                                       -to   => '',
498
498
                                       -ids  => \@ids);
499
 
 Function: Retrieve new ID using old ID. 
 
499
 Function: Retrieve new ID using old ID.
500
500
 Returns : hash reference of successfully mapped IDs
501
501
 Args    : -from : database mapping from
502
502
           -to   : database mapped to
527
527
        $self->_sleep;
528
528
        $response = $ua->get($response->base);
529
529
    }
530
 
    
 
530
 
531
531
    my %map;
532
532
    if ($response->is_success) {
533
533
        for my $line (split("\n", $response->content)) {
534
534
            my ($id_from, $id_to) = split(/\s+/, $line, 2);
535
535
            next if $id_from eq 'From';
536
 
            $map{$id_from} = $id_to;
 
536
            push @{$map{$id_from}}, $id_to;
537
537
        }
538
538
    } else {
539
539
        $self->throw("Error: ".$response->status_line."\n");