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

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (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.2 sub assign_functions_to_dna
197 : olson 1.1 {
198 : olson 1.10 my($self, $input, $min_hits, $max_gap, $blast) = @_;
199 : olson 1.1
200 : olson 1.12 $min_hits = 3 unless defined($min_hits);
201 :     $max_gap = 600 unless defined($max_gap);
202 : olson 1.13 $blast = 0 unless defined($blast);
203 : olson 1.12
204 : olson 1.2 my $wq;
205 : olson 1.1
206 : olson 1.2 if (ref($input) eq 'ARRAY')
207 : olson 1.1 {
208 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
209 : olson 1.1 }
210 :     else
211 :     {
212 : olson 1.2 $wq = FastaWorkQueue->new($input);
213 : olson 1.1 }
214 : olson 1.2
215 : olson 1.13 my $req_bytes = $blast ? 1000 : 500000;
216 : olson 1.10 my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];
217 :     return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',
218 :     \&id_seq_pair_bundler,
219 : olson 1.11 \&tab_delimited_output_parser, $params, $req_bytes);
220 : olson 1.2 }
221 :    
222 :     sub id_seq_pair_bundler
223 :     {
224 :     my($item) = @_;
225 :     my($id, $seq) = @$item[0,2];
226 :     return "id_seq", join(",", $id, (ref($seq) eq 'SCALAR' ? $$seq : $seq));
227 :     }
228 :    
229 :     sub tab_delimited_output_parser
230 :     {
231 :     my($line) = @_;
232 :     chomp $line;
233 :     my @cols = split(/\t/, $line);
234 :     return \@cols;
235 :     }
236 :    
237 :    
238 :     sub tab_delimited_dna_data_output_parser
239 :     {
240 :     my($line) = @_;
241 :     chomp $line;
242 :     my ($id, $idbe, $fam) = split(/\t/, $line);
243 :     my ($beg, $end) = $idbe =~ /_(\d+)_(\d+)$/;
244 :     return [$id, $beg, $end, $fam];
245 : olson 1.1 }
246 :    
247 : olson 1.2 package ResultHandler;
248 : olson 1.1 use strict;
249 : olson 1.2 use Data::Dumper;
250 : olson 1.1
251 :     sub new
252 :     {
253 : olson 1.11 my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser, $form_vars, $req_bytes) = @_;
254 : olson 1.2
255 : olson 1.1 my $self = {
256 : olson 1.2 work_queue => $work_queue,
257 :     server_url => $server_url,
258 :     function => $function,
259 :     input_bundler => $input_bundler,
260 :     output_parser => $output_parser,
261 :     ua => LWP::UserAgent->new(),
262 :     cur_result => undef,
263 : olson 1.5 form_vars => $form_vars ? $form_vars : [],
264 : olson 1.13 req_bytes => ($req_bytes ? $req_bytes : 16000),
265 : olson 1.1 };
266 : olson 1.14 $self->{ua}->timeout(20 * 60);
267 : olson 1.1 return bless $self, $class;
268 :     }
269 :    
270 :     sub get_next
271 :     {
272 :     my($self) = @_;
273 :    
274 : olson 1.10 my $res = $self->get_next_from_result();
275 : olson 1.13 # print "gnfr returns: " , Dumper($res);
276 : olson 1.10
277 :     if ($res)
278 : olson 1.2 {
279 : olson 1.10 return $res;
280 : olson 1.2 }
281 :     else
282 :     {
283 : olson 1.13
284 :     while (my @inp = $self->{work_queue}->get_next_n_bytes($self->{req_bytes}))
285 : olson 1.2 {
286 : olson 1.5 my $form = [@{$self->{form_vars}}];
287 :     push(@$form, function => $self->{function},
288 :     map { &{$self->{input_bundler}}($_) } @inp);
289 : olson 1.8 # print "Invoke " .Dumper($form);
290 : olson 1.2
291 :     my $res = $self->{ua}->post($self->{server_url}, $form);
292 :     if ($res->is_success)
293 :     {
294 : olson 1.13 eval {
295 :     $self->{cur_result} = [YAML::Load($res->content)];
296 :     };
297 :     if ($@)
298 :     {
299 :     die "Query returned unparsable content ($@): " . $res->content;
300 :     }
301 :     # print "res: " . Dumper($self->{cur_result});
302 :     my $oneres = $self->get_next_from_result();
303 :     if ($oneres)
304 :     {
305 :     return $oneres;
306 :     }
307 : olson 1.2 }
308 :     else
309 :     {
310 : olson 1.3 die "error " . $res->status_line . " on post " . $res->content;
311 : olson 1.2 }
312 :     }
313 : olson 1.13 return;
314 : olson 1.2 }
315 :     }
316 :    
317 :     sub get_next_from_result
318 :     {
319 :     my($self) = @_;
320 : olson 1.10 my $l = $self->{cur_result};
321 :     if ($l and @$l)
322 :     {
323 :     return shift(@$l);
324 :     }
325 :     else
326 : olson 1.2 {
327 : olson 1.10 delete $self->{cur_result};
328 :     return undef;
329 : olson 1.2 }
330 :     }
331 :    
332 :     package SequenceWorkQueue;
333 :     use strict;
334 :    
335 :     sub new
336 :     {
337 :     my($class) = @_;
338 :    
339 :     my $self = {};
340 :    
341 :     return bless $self, $class;
342 :     }
343 : olson 1.1
344 : olson 1.2 sub get_next_n
345 :     {
346 :     my($self, $n) = @_;
347 :     my @out;
348 :    
349 :     for (my $i = 0;$i < $n; $i++)
350 : olson 1.1 {
351 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
352 :     if (defined($id))
353 :     {
354 :     push(@out, [$id, $com, $seqp]);
355 :     }
356 :     else
357 :     {
358 :     last;
359 :     }
360 : olson 1.1 }
361 : olson 1.2 return @out;
362 :     }
363 :    
364 :     sub get_next_n_bytes
365 :     {
366 :     my($self, $n) = @_;
367 :     my @out;
368 :    
369 :     my $size = 0;
370 :     while ($size < $n)
371 : olson 1.1 {
372 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
373 :     if (defined($id))
374 :     {
375 :     push(@out, [$id, $com, $seqp]);
376 :     $size += (ref($seqp) eq 'SCALAR') ? length($$seqp) : length($seqp);
377 :     }
378 :     else
379 :     {
380 :     last;
381 :     }
382 : olson 1.1 }
383 : olson 1.2 return @out;
384 : olson 1.1 }
385 :    
386 : olson 1.2 package FastaWorkQueue;
387 : olson 1.1 use strict;
388 : olson 1.2 use base 'SequenceWorkQueue';
389 : olson 1.1 use FileHandle;
390 :    
391 :     sub new
392 :     {
393 : olson 1.2 my($class, $input) = @_;
394 : olson 1.1
395 :     my $fh;
396 :     if (ref($input))
397 :     {
398 :     $fh = $input;
399 :     }
400 :     else
401 :     {
402 :     $fh = new FileHandle("<$input");
403 :     }
404 : olson 1.2
405 :     my $self = $class->SUPER::new();
406 :    
407 :     $self->{fh} = $fh;
408 :    
409 : olson 1.1 return bless $self, $class;
410 :     }
411 :    
412 :     sub get_next
413 :     {
414 :     my($self) = @_;
415 :    
416 : olson 1.14 my($id, $seqp, $com) = read_fasta_record($self->{fh});
417 : olson 1.2 return defined($id) ? ($id, $com, $seqp) : ();
418 :     }
419 :    
420 : olson 1.14 sub read_fasta_record {
421 :     my ($file_handle) = @_;
422 :     my ($old_end_of_record, $fasta_record, @lines, $head, $sequence, $seq_id, $comment, @parsed_fasta_record);
423 :    
424 :     if (not defined($file_handle)) { $file_handle = \*STDIN; }
425 :    
426 :     $old_end_of_record = $/;
427 :     $/ = "\n>";
428 :    
429 :     if (defined($fasta_record = <$file_handle>)) {
430 :     chomp $fasta_record;
431 :     @lines = split( /\n/, $fasta_record );
432 :     $head = shift @lines;
433 :     $head =~ s/^>?//;
434 :     $head =~ m/^(\S+)/;
435 :     $seq_id = $1;
436 :     if ($head =~ m/^\S+\s+(.*)$/) { $comment = $1; } else { $comment = ""; }
437 :     $sequence = join( "", @lines );
438 :     @parsed_fasta_record = ( $seq_id, \$sequence, $comment );
439 :     } else {
440 :     @parsed_fasta_record = ();
441 :     }
442 :    
443 :     $/ = $old_end_of_record;
444 :    
445 :     return @parsed_fasta_record;
446 :     }
447 :    
448 : olson 1.2 package SequenceListWorkQueue;
449 :     use strict;
450 :     use base 'SequenceWorkQueue';
451 : olson 1.1
452 : olson 1.2 sub new
453 :     {
454 :     my($class, $input) = @_;
455 :    
456 :     my $fh;
457 :     if (ref($input) ne 'ARRAY')
458 : olson 1.1 {
459 : olson 1.2 die "SequenceWorkQueue requires a list as input";
460 : olson 1.1 }
461 : olson 1.2
462 :     my $self = $class->SUPER::new();
463 :    
464 :     $self->{list} = $input;
465 :    
466 :     return bless $self, $class;
467 :     }
468 :    
469 :     sub get_next
470 :     {
471 :     my($self) = @_;
472 :    
473 :     my $top = shift @{$self->{list}};
474 :    
475 :     return defined($top) ? @$top : ();
476 : olson 1.1 }
477 : olson 1.2
478 :    
479 : olson 1.1 1;
480 : olson 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3