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

« back to all changes in this revision

Viewing changes to scripts/DB/biofetch_genbank_proxy.PLS

  • 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
* 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:
1
 
#!perl -w
2
 
 
3
 
# dbfetch style caching proxy for GenBank
4
 
use strict;
5
 
use CGI qw(:standard);
6
 
use HTTP::Request::Common;
7
 
use LWP::UserAgent;
8
 
use Cache::FileCache;
9
 
 
10
 
use vars qw(%GOT $BUFFER %MAPPING $CACHE);
11
 
 
12
 
use constant CACHE_LOCATION => '/usr/tmp/dbfetch_cache';
13
 
use constant MAX_SIZE   => 100_000_000;  # 100 megs, roughly
14
 
use constant CACHE_DEPTH => 4;
15
 
use constant EXPIRATION => "1 week";
16
 
use constant PURGE      => "1 hour";
17
 
 
18
 
%MAPPING = (genbank => {db=>'nucleotide',
19
 
                        rettype => 'gb'},
20
 
            genpep  => {db=>'protein',
21
 
                        rettype => 'gp'});
22
 
# we're doing everything in callbacks, so initialize globals.
23
 
$BUFFER = '';
24
 
%GOT    = ();
25
 
 
26
 
print header('text/plain');
27
 
 
28
 
param() or print_usage();
29
 
 
30
 
my $db     = param('db');
31
 
my $style  = param('style');
32
 
my $format = param('format');
33
 
my $id     = param('id');
34
 
my @ids    = split /\s+/,$id;
35
 
 
36
 
$format = 'genbank' if $format eq 'default';  #h'mmmph
37
 
 
38
 
$MAPPING{$db}        or error(1=>"Unknown database [$db]");
39
 
$style  eq 'raw'     or error(2=>"Unknown style [$style]");
40
 
$format eq 'genbank' or error(3=>"Format [$format] not known for database [$db]");
41
 
 
42
 
$CACHE = Cache::FileCache->new({cache_root          => CACHE_LOCATION,
43
 
                                default_expires_in  => EXPIRATION,
44
 
                                cache_DEPTH         => CACHE_DEPTH,
45
 
                                namespace           => 'dbfetch',
46
 
                                auto_purge_interval => PURGE});
47
 
 
48
 
# handle cached entries
49
 
foreach (@ids) {
50
 
  if (my $obj = $CACHE->get($_)) {
51
 
    $GOT{$_}++;
52
 
    print $obj,"//\n";
53
 
  }
54
 
}
55
 
 
56
 
# handle the remainder
57
 
@ids = grep {!$GOT{$_}} @ids;
58
 
if (@ids) {
59
 
  my $request = POST('http://www.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi',
60
 
                     [rettype    => $MAPPING{$db}{rettype},
61
 
                      db         => $MAPPING{$db}{db},
62
 
                      tool       => 'bioperl',
63
 
                      retmode    => 'text',
64
 
                      usehistory => 'n',
65
 
                      id         => join(',',@ids),
66
 
                     ]
67
 
                    );
68
 
 
69
 
  my $ua = LWP::UserAgent->new;
70
 
  my $response = $ua->request($request,\&callback);
71
 
 
72
 
  if ($response->is_error) {
73
 
    my $status = $response->status_line;
74
 
    error(6 => "HTTP error from GenBank [$status]");
75
 
  }
76
 
}
77
 
 
78
 
my @missing_ids = grep {!$GOT{$_}} @ids;
79
 
foreach (@missing_ids) {
80
 
  error(4=>"ID [$_] not found in database [$db]",1);
81
 
}
82
 
 
83
 
# my $response = $response->content;
84
 
 
85
 
sub process_record {
86
 
  my $record = shift;
87
 
  print "$record//\n";
88
 
  my ($locus)       = $record =~ /^LOCUS\s+(\S+)/m;
89
 
  my ($accession)   = $record =~ /^ACCESSION\s+(\S+)/m;
90
 
  my ($version,$gi) = $record =~ /^VERSION\s+(\S+)\s+GI:(\d+)/m;
91
 
  foreach ($locus,$accession,$version,$gi) {
92
 
    $GOT{$_}++;
93
 
    $CACHE->set($_,$record);
94
 
  }
95
 
}
96
 
 
97
 
sub callback {
98
 
  my $data = shift;
99
 
  $BUFFER .= $data;
100
 
  my $index = 0;
101
 
  while (($index = index($BUFFER,"//\n\n",$index))>=0) {
102
 
    my $record = substr($BUFFER,0,$index);
103
 
    $index += length("//\n\n");
104
 
    substr($BUFFER,0,$index) = '';
105
 
    process_record($record);
106
 
  }
107
 
}
108
 
 
109
 
 
110
 
 
111
 
sub print_usage {
112
 
  print <<'END';
113
 
This script is intended to be used non-interactively.
114
 
 
115
 
Brief summary of arguments:
116
 
URL
117
 
 
118
 
This interface does not specify what happens when biofetch is called
119
 
in interactive context. The implementations can return the entries
120
 
decorated with HTML tags and hypertext links.
121
 
 
122
 
A URL for biofetch consists of four sections:
123
 
 
124
 
                        e.g.
125
 
1. protocol             http://
126
 
2. host                 www.ebi.ac.uk
127
 
3. path to program      /Tools/dbfetch/dbfetch
128
 
4. query string         ?style=raw;format=embl;db=embl;id=J00231
129
 
 
130
 
 
131
 
QUERY STRING
132
 
 
133
 
The query string options are separated from the base URL (protocol +
134
 
host + path) by a question mark (?) and from each other by a semicolon
135
 
';' (or by ampersand '&'). See CGI GET documents at
136
 
http://www.w3.org/CGI/). The order of options is not critical. It is
137
 
recommended to leave the ID to be the last item.
138
 
 
139
 
Input for options should be case insensitive.
140
 
 
141
 
 
142
 
option: db
143
 
 
144
 
  Option  : db
145
 
  Descr   : database name
146
 
  Type    : required
147
 
  Usage   : db=genpep | db=genbank
148
 
  Arg     : string 
149
 
 
150
 
Currently this server accepts "genbank" and "genpep"
151
 
 
152
 
option: style
153
 
 
154
 
  Option  : style
155
 
  Descr   : +/- HTML tags
156
 
  Type    : required
157
 
  Usage   : style=raw | db=html
158
 
  Arg     : enum (raw|html)
159
 
 
160
 
In non-interactive context, always give "style=raw". This uses
161
 
"Content-Type: text/plain". If other content types are needed (XML),
162
 
this part of the spesifications can be extended to accommodate them.
163
 
 
164
 
This server only accepts "raw".
165
 
 
166
 
 
167
 
option: format
168
 
 
169
 
  Option  : format
170
 
  Descr   : format of the database entries returned
171
 
  Type    : optional
172
 
  Usage   : format=genbank
173
 
  Arg     : enum
174
 
 
175
 
Format defaults to the distribution format of the database (embl for
176
 
EMBL database). If some other supported format is needed this option
177
 
is needed (E.g. formats for EMBL: fasta, bsml, agave).
178
 
 
179
 
This server only accepts "genbank" format.
180
 
 
181
 
option: id
182
 
 
183
 
  Option  : id
184
 
  Descr   : unique database identifier(s)
185
 
  Type    : required
186
 
  Usage   : db=J00231 | id=J00231+BUM
187
 
  Arg     : string 
188
 
 
189
 
The ID option should be able to process all UIDS in a database. It
190
 
should not be necessary to know if the UID is an ID, accession number
191
 
or accession.version.
192
 
 
193
 
The number of entry UIDs allowed is implementation specific. If the
194
 
limit is exceeded, the the program reports an error. The UIDs should
195
 
be separated by spaces (use '+' in a GET method string).
196
 
 
197
 
 
198
 
ERROR MESSAGES
199
 
 
200
 
The following standardized one line messages should be printed out in
201
 
case of an error.
202
 
 
203
 
ERROR 1 Unknown database [$db].
204
 
ERROR 2 Unknown style [$style].
205
 
ERROR 3 Format [$format] not known for database [$db].
206
 
ERROR 4 ID [$id] not found in database [$db].
207
 
ERROR 5 Too many IDs [$count]. Max [$MAXIDS] allowed.
208
 
 
209
 
END
210
 
;
211
 
 
212
 
exit 0;
213
 
}
214
 
 
215
 
sub error {
216
 
  my ($code,$message,$noexit) = @_;
217
 
  print "ERROR $code $message\n";
218
 
  exit 0 unless $noexit;
219
 
}
220
 
 
221
 
__END__
222
 
 
223
 
=head1 NAME
224
 
 
225
 
biofetch_genbank_proxy.pl - Caching BioFetch-compatible web proxy for GenBank
226
 
 
227
 
=head1 SYNOPSIS
228
 
 
229
 
  Install in cgi-bin directory of a Web server.  Stand back.
230
 
 
231
 
=head1 DESCRIPTION
232
 
 
233
 
This CGI script acts as the server side of the BioFetch protocol as
234
 
described in http://obda.open-bio.org/Specs/.  It provides two
235
 
database access services, one for data source "genbank" (nucleotide
236
 
entries) and the other for data source "genpep" (protein entries).
237
 
 
238
 
This script works by forwarding its requests to NCBI's eutils script,
239
 
which lives at http://www.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi.
240
 
It then reformats the output according to the BioFetch format so the
241
 
sequences can be processed and returned by the Bio::DB::BioFetch
242
 
module.  Returned entries are temporarily cached on the Web server's
243
 
file system, allowing frequently-accessed entries to be retrieved
244
 
without another round trip to NCBI.
245
 
 
246
 
=head2 INSTALLATION
247
 
 
248
 
You must have the following installed in order to run this script:
249
 
 
250
 
   1) perl
251
 
   2) the perl modules LWP and Cache::FileCache
252
 
   3) a web server (Apache recommended)
253
 
 
254
 
To install this script, copy it into the web server's cgi-bin
255
 
directory.  You might want to shorten its name; "dbfetch" is
256
 
recommended.
257
 
 
258
 
There are several constants located at the top of the script that you
259
 
may want to adjust.  These are:
260
 
 
261
 
CACHE_LOCATION
262
 
 
263
 
This is the location on the filesystem where the cached files will be
264
 
located.  The default is /usr/tmp/dbfetch_cache.
265
 
 
266
 
MAX_SIZE
267
 
 
268
 
This is the maximum size that the cache can grow to.  When the cache
269
 
exceeds this size older entries will be deleted automatically.  The
270
 
default setting is 100,000,000 bytes (100 MB).
271
 
 
272
 
EXPIRATION
273
 
 
274
 
Entries that haven't been accessed in this length of time will be
275
 
removed from the cache.  The default is 1 week.
276
 
 
277
 
PURGE
278
 
 
279
 
This constant specifies how often the cache will be purged for older
280
 
entries.  The default is 1 hour.
281
 
 
282
 
=head1 TESTING
283
 
 
284
 
To see if this script is performing as expected, you may test it with
285
 
this script:
286
 
 
287
 
 use Bio::DB::BioFetch;
288
 
 my $db = Bio::DB::BioFetch->new(-baseaddress=>'http://localhost/cgi-bin/dbfetch',
289
 
                                 -format     =>'genbank',
290
 
                                 -db         =>'genbank');
291
 
 my $seq = $db->get_Seq_by_id('DDU63596');
292
 
 print $seq->seq,"\n";
293
 
 
294
 
This should print out a DNA sequence.
295
 
 
296
 
=head1 SEE ALSO
297
 
 
298
 
L<Bio::DB::BioFetch>, L<Bio::DB::Registry>
299
 
 
300
 
=head1 AUTHOR
301
 
 
302
 
Lincoln Stein, E<lt>lstein-at-cshl.orgE<gt>
303
 
 
304
 
Copyright (c) 2003 Cold Spring Harbor Laboratory
305
 
 
306
 
This library is free software; you can redistribute it and/or modify
307
 
it under the same terms as Perl itself.  See DISCLAIMER.txt for
308
 
disclaimers of warranty.
309
 
 
310
 
=cut
311