[Bio] / FigKernelPackages / FFserver.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (view) (download) (as text)

1 : olson 1.1
2 :     package FFserver;
3 :    
4 :     use LWP::UserAgent;
5 :     use Data::Dumper;
6 : olson 1.3 use YAML;
7 : olson 1.1
8 :     use strict;
9 :    
10 :     sub new
11 :     {
12 :     my($class, $server_url) = @_;
13 :    
14 : olson 1.3 $server_url = "http://servers.nmpdr.org/figfam/server.cgi" unless $server_url;
15 : olson 1.1
16 :    
17 :     my $self = {
18 :     server_url => $server_url,
19 :     ua => LWP::UserAgent->new(),
20 :     };
21 : olson 1.11 $self->{ua}->timeout(10 * 60);
22 : olson 1.1
23 :     return bless $self, $class;
24 :     }
25 :    
26 : olson 1.3 sub members_of_families
27 :     {
28 :     my($self, @ids) = @_;
29 : olson 1.4 return $self->run_query('members_of_families', @ids);
30 :     }
31 :    
32 : olson 1.6 sub families_containing_peg
33 :     {
34 :     my($self, @ids) = @_;
35 :     return $self->run_query('families_containing_peg', @ids);
36 :     }
37 :    
38 : arodri7 1.9 sub function_of
39 :     {
40 :     my($self, @ids) = @_;
41 :     return $self->run_query('function_of', @ids);
42 :     }
43 :    
44 :     sub org_of
45 :     {
46 :     my($self, @ids) = @_;
47 :     return $self->run_query('org_of', @ids);
48 :     }
49 :    
50 :     sub seq_of
51 :     {
52 :     my($self, @ids) = @_;
53 :     return $self->run_query('seq_of', @ids);
54 :     }
55 :    
56 :     sub aliases_of
57 :     {
58 :     my($self, @ids) = @_;
59 :     return $self->run_query('aliases_of', @ids);
60 :     }
61 :    
62 :     sub families_implementing_role
63 :     {
64 :     my($self,@roles) = @_;
65 :     return $self->run_query('families_implementing_role', @roles);
66 :     }
67 :    
68 :     sub families_with_function
69 :     {
70 :     my($self,@functions) = @_;
71 :     return $self->run_query('families_with_function', @functions);
72 :     }
73 :    
74 :     sub families_in_genome
75 :     {
76 :     my($self,@genomes) = @_;
77 :     return $self->run_query('families_in_genome', @genomes);
78 :     }
79 :    
80 :     sub get_subsystem_based_figfams
81 :     {
82 :     my ($self) = @_;
83 :     return $self->run_query('get_subsystem_based_figfams');
84 :     }
85 :    
86 : olson 1.4 sub should_be_member
87 :     {
88 :     my($self, @id_seq_pairs) = @_;
89 :     return $self->run_query('should_be_member', @id_seq_pairs);
90 :     }
91 :    
92 :     sub all_families
93 :     {
94 :     my($self) = @_;
95 :     return $self->run_query('all_families');
96 :     }
97 :    
98 :     sub run_query
99 :     {
100 :     my($self, $function, @args ) = @_;
101 :     my $form = [function => $function,
102 :     args => YAML::Dump(@args),
103 :     ];
104 : olson 1.3 return $self->run_query_form($form);
105 :     }
106 :    
107 :     sub run_query_form
108 :     {
109 :     my($self, $form) = @_;
110 :    
111 :     my $res = $self->{ua}->post($self->{server_url}, $form);
112 :    
113 :     if ($res->is_success)
114 :     {
115 : olson 1.13 my $content = $res->content;
116 :     # print "Got $content\n";
117 :     my $ret;
118 :     eval {
119 :     $ret = Load($content);
120 :     };
121 :     if ($@)
122 :     {
123 :     die "Query returned unparsable content ($@): " . $content;
124 :     }
125 :     return $ret;
126 : olson 1.3 }
127 :     else
128 :     {
129 : olson 1.7 die "error on post " . $res->status_line . " " . $res->content;
130 : olson 1.3 }
131 :     }
132 :    
133 : olson 1.1 sub assign_function_to_prot
134 :     {
135 : olson 1.10 my($self, $input, $blast, $min_hits) = @_;
136 : olson 1.1
137 : olson 1.2 my $wq;
138 : olson 1.10
139 :     my $params = [blast => $blast, min_hits => $min_hits];
140 : olson 1.2
141 : olson 1.1 if (ref($input) eq 'ARRAY')
142 :     {
143 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
144 : olson 1.1 }
145 :     else
146 :     {
147 : olson 1.2 $wq = FastaWorkQueue->new($input);
148 : olson 1.1 }
149 : olson 1.2
150 : olson 1.11 my $req_bytes = $blast ? 1000 : 16000;
151 :    
152 : olson 1.10 return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler,
153 :     #\&tab_delimited_output_parser,
154 :     \&YAML::Load,
155 : olson 1.11 $params, $req_bytes);
156 : olson 1.1 }
157 :    
158 : olson 1.2 sub assign_functions_to_dna
159 : olson 1.1 {
160 : olson 1.10 my($self, $input, $min_hits, $max_gap, $blast) = @_;
161 : olson 1.1
162 : olson 1.12 $min_hits = 3 unless defined($min_hits);
163 :     $max_gap = 600 unless defined($max_gap);
164 : olson 1.13 $blast = 0 unless defined($blast);
165 : olson 1.12
166 : olson 1.2 my $wq;
167 : olson 1.1
168 : olson 1.2 if (ref($input) eq 'ARRAY')
169 : olson 1.1 {
170 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
171 : olson 1.1 }
172 :     else
173 :     {
174 : olson 1.2 $wq = FastaWorkQueue->new($input);
175 : olson 1.1 }
176 : olson 1.2
177 : olson 1.13 my $req_bytes = $blast ? 1000 : 500000;
178 : olson 1.10 my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];
179 :     return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',
180 :     \&id_seq_pair_bundler,
181 : olson 1.11 \&tab_delimited_output_parser, $params, $req_bytes);
182 : olson 1.2 }
183 :    
184 :     sub id_seq_pair_bundler
185 :     {
186 :     my($item) = @_;
187 :     my($id, $seq) = @$item[0,2];
188 :     return "id_seq", join(",", $id, (ref($seq) eq 'SCALAR' ? $$seq : $seq));
189 :     }
190 :    
191 :     sub tab_delimited_output_parser
192 :     {
193 :     my($line) = @_;
194 :     chomp $line;
195 :     my @cols = split(/\t/, $line);
196 :     return \@cols;
197 :     }
198 :    
199 :    
200 :     sub tab_delimited_dna_data_output_parser
201 :     {
202 :     my($line) = @_;
203 :     chomp $line;
204 :     my ($id, $idbe, $fam) = split(/\t/, $line);
205 :     my ($beg, $end) = $idbe =~ /_(\d+)_(\d+)$/;
206 :     return [$id, $beg, $end, $fam];
207 : olson 1.1 }
208 :    
209 : olson 1.2 package ResultHandler;
210 : olson 1.1 use strict;
211 : olson 1.2 use Data::Dumper;
212 : olson 1.1
213 :     sub new
214 :     {
215 : olson 1.11 my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser, $form_vars, $req_bytes) = @_;
216 : olson 1.2
217 : olson 1.1 my $self = {
218 : olson 1.2 work_queue => $work_queue,
219 :     server_url => $server_url,
220 :     function => $function,
221 :     input_bundler => $input_bundler,
222 :     output_parser => $output_parser,
223 :     ua => LWP::UserAgent->new(),
224 :     cur_result => undef,
225 : olson 1.5 form_vars => $form_vars ? $form_vars : [],
226 : olson 1.13 req_bytes => ($req_bytes ? $req_bytes : 16000),
227 : olson 1.1 };
228 :     return bless $self, $class;
229 :     }
230 :    
231 :     sub get_next
232 :     {
233 :     my($self) = @_;
234 :    
235 : olson 1.10 my $res = $self->get_next_from_result();
236 : olson 1.13 # print "gnfr returns: " , Dumper($res);
237 : olson 1.10
238 :     if ($res)
239 : olson 1.2 {
240 : olson 1.10 return $res;
241 : olson 1.2 }
242 :     else
243 :     {
244 : olson 1.13
245 :     while (my @inp = $self->{work_queue}->get_next_n_bytes($self->{req_bytes}))
246 : olson 1.2 {
247 : olson 1.5 my $form = [@{$self->{form_vars}}];
248 :     push(@$form, function => $self->{function},
249 :     map { &{$self->{input_bundler}}($_) } @inp);
250 : olson 1.8 # print "Invoke " .Dumper($form);
251 : olson 1.2
252 :     my $res = $self->{ua}->post($self->{server_url}, $form);
253 :     if ($res->is_success)
254 :     {
255 : olson 1.13 eval {
256 :     $self->{cur_result} = [YAML::Load($res->content)];
257 :     };
258 :     if ($@)
259 :     {
260 :     die "Query returned unparsable content ($@): " . $res->content;
261 :     }
262 :     # print "res: " . Dumper($self->{cur_result});
263 :     my $oneres = $self->get_next_from_result();
264 :     if ($oneres)
265 :     {
266 :     return $oneres;
267 :     }
268 : olson 1.2 }
269 :     else
270 :     {
271 : olson 1.3 die "error " . $res->status_line . " on post " . $res->content;
272 : olson 1.2 }
273 :     }
274 : olson 1.13 return;
275 : olson 1.2 }
276 :     }
277 :    
278 :     sub get_next_from_result
279 :     {
280 :     my($self) = @_;
281 : olson 1.10 my $l = $self->{cur_result};
282 :     if ($l and @$l)
283 :     {
284 :     return shift(@$l);
285 :     }
286 :     else
287 : olson 1.2 {
288 : olson 1.10 delete $self->{cur_result};
289 :     return undef;
290 : olson 1.2 }
291 :     }
292 :    
293 :     package SequenceWorkQueue;
294 :     use strict;
295 :    
296 :     sub new
297 :     {
298 :     my($class) = @_;
299 :    
300 :     my $self = {};
301 :    
302 :     return bless $self, $class;
303 :     }
304 : olson 1.1
305 : olson 1.2 sub get_next_n
306 :     {
307 :     my($self, $n) = @_;
308 :     my @out;
309 :    
310 :     for (my $i = 0;$i < $n; $i++)
311 : olson 1.1 {
312 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
313 :     if (defined($id))
314 :     {
315 :     push(@out, [$id, $com, $seqp]);
316 :     }
317 :     else
318 :     {
319 :     last;
320 :     }
321 : olson 1.1 }
322 : olson 1.2 return @out;
323 :     }
324 :    
325 :     sub get_next_n_bytes
326 :     {
327 :     my($self, $n) = @_;
328 :     my @out;
329 :    
330 :     my $size = 0;
331 :     while ($size < $n)
332 : olson 1.1 {
333 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
334 :     if (defined($id))
335 :     {
336 :     push(@out, [$id, $com, $seqp]);
337 :     $size += (ref($seqp) eq 'SCALAR') ? length($$seqp) : length($seqp);
338 :     }
339 :     else
340 :     {
341 :     last;
342 :     }
343 : olson 1.1 }
344 : olson 1.2 return @out;
345 : olson 1.1 }
346 :    
347 : olson 1.2 package FastaWorkQueue;
348 : olson 1.1 use strict;
349 : olson 1.2 use base 'SequenceWorkQueue';
350 : olson 1.1 use FileHandle;
351 :     use FIG;
352 :    
353 :     sub new
354 :     {
355 : olson 1.2 my($class, $input) = @_;
356 : olson 1.1
357 :     my $fh;
358 :     if (ref($input))
359 :     {
360 :     $fh = $input;
361 :     }
362 :     else
363 :     {
364 :     $fh = new FileHandle("<$input");
365 :     }
366 : olson 1.2
367 :     my $self = $class->SUPER::new();
368 :    
369 :     $self->{fh} = $fh;
370 :    
371 : olson 1.1 return bless $self, $class;
372 :     }
373 :    
374 :     sub get_next
375 :     {
376 :     my($self) = @_;
377 :    
378 : olson 1.2 my($id, $seqp, $com) = &FIG::read_fasta_record($self->{fh});
379 :     return defined($id) ? ($id, $com, $seqp) : ();
380 :     }
381 :    
382 :     package SequenceListWorkQueue;
383 :     use strict;
384 :     use base 'SequenceWorkQueue';
385 : olson 1.1
386 : olson 1.2 sub new
387 :     {
388 :     my($class, $input) = @_;
389 :    
390 :     my $fh;
391 :     if (ref($input) ne 'ARRAY')
392 : olson 1.1 {
393 : olson 1.2 die "SequenceWorkQueue requires a list as input";
394 : olson 1.1 }
395 : olson 1.2
396 :     my $self = $class->SUPER::new();
397 :    
398 :     $self->{list} = $input;
399 :    
400 :     return bless $self, $class;
401 :     }
402 :    
403 :     sub get_next
404 :     {
405 :     my($self) = @_;
406 :    
407 :     my $top = shift @{$self->{list}};
408 :    
409 :     return defined($top) ? @$top : ();
410 : olson 1.1 }
411 : olson 1.2
412 :    
413 : olson 1.1 1;
414 : olson 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3