[Bioperl-guts-l] [16290] bioperl-live/trunk/Bio/DB/SwissProt.pm: [bug 2764]

[Christopher John Fields]

Revision: 16290
Author:   cjfields
Date:     2009-10-26 20:57:18 -0400 (Mon, 26 Oct 2009)

Log Message:
-----------
[bug 2764]
* IDTracker service no longer available, so adding a dep. warning to the method

Modified Paths:
--------------
    bioperl-live/trunk/Bio/DB/SwissProt.pm

Modified: bioperl-live/trunk/Bio/DB/SwissProt.pm
===================================================================
--- bioperl-live/trunk/Bio/DB/SwissProt.pm	2009-10-27 00:45:00 UTC (rev 16289)
+++ bioperl-live/trunk/Bio/DB/SwissProt.pm	2009-10-27 00:57:18 UTC (rev 16290)
@@ -468,26 +468,11 @@
 
 sub idtracker {
     my ($self, $id) = @_;
-    return unless defined $id;
-    my $st = $self->servertype;
-    my $base = ($st eq 'expasy') ? "http://".$HOSTS{$st}->{'hosts'}->{$self->hostlocation}
-        : $DEFAULTIDTRACKER;
-    my $url = $base.'/cgi-bin/idtracker?id='.$id;
-    my $response;
-    eval {$response = $self->ua->get($url)};
-    if ($@ || $response->is_error) {
-        my $error = $@ || $response->error_as_HTML;
-        $self->throw("Error:\n".$error);
-    }
-    if ($response->content =~ /was renamed to <b>(.*?)<\/b>/) {
-        return $1;
-    } elsif ($response->content =~ /<tr><th>Entry name<\/th><th>Accession number<\/th><th>Release created<\/th><\/tr>/){
-        # output indicates no mapping needed, return original ID
-        return $id;
-    } else {
-        $self->warn("Unknown response:\n".$response->content);
-        return
-    }
+    $self->deprecated(
+         -message => 'The SwissProt IDTracker service is no longer available',
+         -warn_version    => 1.006 # warn if $VERSION is >= this version
+         -throw_version   => 1.007 # throw if $VERSION is >= this version
+         );
 }
 
 1;