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

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3