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

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.14 - (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 :     my($self, $form) = @_;
114 :    
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 :     # print "Got $content\n";
121 :     my $ret;
122 :     eval {
123 :     $ret = Load($content);
124 :     };
125 :     if ($@)
126 :     {
127 :     die "Query returned unparsable content ($@): " . $content;
128 :     }
129 :     return $ret;
130 : olson 1.3 }
131 :     else
132 :     {
133 : olson 1.7 die "error on post " . $res->status_line . " " . $res->content;
134 : olson 1.3 }
135 :     }
136 :    
137 : olson 1.1 sub assign_function_to_prot
138 :     {
139 : olson 1.10 my($self, $input, $blast, $min_hits) = @_;
140 : olson 1.1
141 : olson 1.2 my $wq;
142 : olson 1.10
143 :     my $params = [blast => $blast, min_hits => $min_hits];
144 : olson 1.2
145 : olson 1.1 if (ref($input) eq 'ARRAY')
146 :     {
147 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
148 : olson 1.1 }
149 :     else
150 :     {
151 : olson 1.2 $wq = FastaWorkQueue->new($input);
152 : olson 1.1 }
153 : olson 1.2
154 : olson 1.11 my $req_bytes = $blast ? 1000 : 16000;
155 :    
156 : olson 1.10 return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler,
157 :     #\&tab_delimited_output_parser,
158 :     \&YAML::Load,
159 : olson 1.11 $params, $req_bytes);
160 : olson 1.1 }
161 :    
162 : olson 1.2 sub assign_functions_to_dna
163 : olson 1.1 {
164 : olson 1.10 my($self, $input, $min_hits, $max_gap, $blast) = @_;
165 : olson 1.1
166 : olson 1.12 $min_hits = 3 unless defined($min_hits);
167 :     $max_gap = 600 unless defined($max_gap);
168 : olson 1.13 $blast = 0 unless defined($blast);
169 : olson 1.12
170 : olson 1.2 my $wq;
171 : olson 1.1
172 : olson 1.2 if (ref($input) eq 'ARRAY')
173 : olson 1.1 {
174 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
175 : olson 1.1 }
176 :     else
177 :     {
178 : olson 1.2 $wq = FastaWorkQueue->new($input);
179 : olson 1.1 }
180 : olson 1.2
181 : olson 1.13 my $req_bytes = $blast ? 1000 : 500000;
182 : olson 1.10 my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];
183 :     return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',
184 :     \&id_seq_pair_bundler,
185 : olson 1.11 \&tab_delimited_output_parser, $params, $req_bytes);
186 : olson 1.2 }
187 :    
188 :     sub id_seq_pair_bundler
189 :     {
190 :     my($item) = @_;
191 :     my($id, $seq) = @$item[0,2];
192 :     return "id_seq", join(",", $id, (ref($seq) eq 'SCALAR' ? $$seq : $seq));
193 :     }
194 :    
195 :     sub tab_delimited_output_parser
196 :     {
197 :     my($line) = @_;
198 :     chomp $line;
199 :     my @cols = split(/\t/, $line);
200 :     return \@cols;
201 :     }
202 :    
203 :    
204 :     sub tab_delimited_dna_data_output_parser
205 :     {
206 :     my($line) = @_;
207 :     chomp $line;
208 :     my ($id, $idbe, $fam) = split(/\t/, $line);
209 :     my ($beg, $end) = $idbe =~ /_(\d+)_(\d+)$/;
210 :     return [$id, $beg, $end, $fam];
211 : olson 1.1 }
212 :    
213 : olson 1.2 package ResultHandler;
214 : olson 1.1 use strict;
215 : olson 1.2 use Data::Dumper;
216 : olson 1.1
217 :     sub new
218 :     {
219 : olson 1.11 my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser, $form_vars, $req_bytes) = @_;
220 : olson 1.2
221 : olson 1.1 my $self = {
222 : olson 1.2 work_queue => $work_queue,
223 :     server_url => $server_url,
224 :     function => $function,
225 :     input_bundler => $input_bundler,
226 :     output_parser => $output_parser,
227 :     ua => LWP::UserAgent->new(),
228 :     cur_result => undef,
229 : olson 1.5 form_vars => $form_vars ? $form_vars : [],
230 : olson 1.13 req_bytes => ($req_bytes ? $req_bytes : 16000),
231 : olson 1.1 };
232 : olson 1.14 $self->{ua}->timeout(20 * 60);
233 : olson 1.1 return bless $self, $class;
234 :     }
235 :    
236 :     sub get_next
237 :     {
238 :     my($self) = @_;
239 :    
240 : olson 1.10 my $res = $self->get_next_from_result();
241 : olson 1.13 # print "gnfr returns: " , Dumper($res);
242 : olson 1.10
243 :     if ($res)
244 : olson 1.2 {
245 : olson 1.10 return $res;
246 : olson 1.2 }
247 :     else
248 :     {
249 : olson 1.13
250 :     while (my @inp = $self->{work_queue}->get_next_n_bytes($self->{req_bytes}))
251 : olson 1.2 {
252 : olson 1.5 my $form = [@{$self->{form_vars}}];
253 :     push(@$form, function => $self->{function},
254 :     map { &{$self->{input_bundler}}($_) } @inp);
255 : olson 1.8 # print "Invoke " .Dumper($form);
256 : olson 1.2
257 :     my $res = $self->{ua}->post($self->{server_url}, $form);
258 :     if ($res->is_success)
259 :     {
260 : olson 1.13 eval {
261 :     $self->{cur_result} = [YAML::Load($res->content)];
262 :     };
263 :     if ($@)
264 :     {
265 :     die "Query returned unparsable content ($@): " . $res->content;
266 :     }
267 :     # print "res: " . Dumper($self->{cur_result});
268 :     my $oneres = $self->get_next_from_result();
269 :     if ($oneres)
270 :     {
271 :     return $oneres;
272 :     }
273 : olson 1.2 }
274 :     else
275 :     {
276 : olson 1.3 die "error " . $res->status_line . " on post " . $res->content;
277 : olson 1.2 }
278 :     }
279 : olson 1.13 return;
280 : olson 1.2 }
281 :     }
282 :    
283 :     sub get_next_from_result
284 :     {
285 :     my($self) = @_;
286 : olson 1.10 my $l = $self->{cur_result};
287 :     if ($l and @$l)
288 :     {
289 :     return shift(@$l);
290 :     }
291 :     else
292 : olson 1.2 {
293 : olson 1.10 delete $self->{cur_result};
294 :     return undef;
295 : olson 1.2 }
296 :     }
297 :    
298 :     package SequenceWorkQueue;
299 :     use strict;
300 :    
301 :     sub new
302 :     {
303 :     my($class) = @_;
304 :    
305 :     my $self = {};
306 :    
307 :     return bless $self, $class;
308 :     }
309 : olson 1.1
310 : olson 1.2 sub get_next_n
311 :     {
312 :     my($self, $n) = @_;
313 :     my @out;
314 :    
315 :     for (my $i = 0;$i < $n; $i++)
316 : olson 1.1 {
317 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
318 :     if (defined($id))
319 :     {
320 :     push(@out, [$id, $com, $seqp]);
321 :     }
322 :     else
323 :     {
324 :     last;
325 :     }
326 : olson 1.1 }
327 : olson 1.2 return @out;
328 :     }
329 :    
330 :     sub get_next_n_bytes
331 :     {
332 :     my($self, $n) = @_;
333 :     my @out;
334 :    
335 :     my $size = 0;
336 :     while ($size < $n)
337 : olson 1.1 {
338 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
339 :     if (defined($id))
340 :     {
341 :     push(@out, [$id, $com, $seqp]);
342 :     $size += (ref($seqp) eq 'SCALAR') ? length($$seqp) : length($seqp);
343 :     }
344 :     else
345 :     {
346 :     last;
347 :     }
348 : olson 1.1 }
349 : olson 1.2 return @out;
350 : olson 1.1 }
351 :    
352 : olson 1.2 package FastaWorkQueue;
353 : olson 1.1 use strict;
354 : olson 1.2 use base 'SequenceWorkQueue';
355 : olson 1.1 use FileHandle;
356 :    
357 :     sub new
358 :     {
359 : olson 1.2 my($class, $input) = @_;
360 : olson 1.1
361 :     my $fh;
362 :     if (ref($input))
363 :     {
364 :     $fh = $input;
365 :     }
366 :     else
367 :     {
368 :     $fh = new FileHandle("<$input");
369 :     }
370 : olson 1.2
371 :     my $self = $class->SUPER::new();
372 :    
373 :     $self->{fh} = $fh;
374 :    
375 : olson 1.1 return bless $self, $class;
376 :     }
377 :    
378 :     sub get_next
379 :     {
380 :     my($self) = @_;
381 :    
382 : olson 1.14 my($id, $seqp, $com) = read_fasta_record($self->{fh});
383 : olson 1.2 return defined($id) ? ($id, $com, $seqp) : ();
384 :     }
385 :    
386 : olson 1.14 sub read_fasta_record {
387 :     my ($file_handle) = @_;
388 :     my ($old_end_of_record, $fasta_record, @lines, $head, $sequence, $seq_id, $comment, @parsed_fasta_record);
389 :    
390 :     if (not defined($file_handle)) { $file_handle = \*STDIN; }
391 :    
392 :     $old_end_of_record = $/;
393 :     $/ = "\n>";
394 :    
395 :     if (defined($fasta_record = <$file_handle>)) {
396 :     chomp $fasta_record;
397 :     @lines = split( /\n/, $fasta_record );
398 :     $head = shift @lines;
399 :     $head =~ s/^>?//;
400 :     $head =~ m/^(\S+)/;
401 :     $seq_id = $1;
402 :     if ($head =~ m/^\S+\s+(.*)$/) { $comment = $1; } else { $comment = ""; }
403 :     $sequence = join( "", @lines );
404 :     @parsed_fasta_record = ( $seq_id, \$sequence, $comment );
405 :     } else {
406 :     @parsed_fasta_record = ();
407 :     }
408 :    
409 :     $/ = $old_end_of_record;
410 :    
411 :     return @parsed_fasta_record;
412 :     }
413 :    
414 : olson 1.2 package SequenceListWorkQueue;
415 :     use strict;
416 :     use base 'SequenceWorkQueue';
417 : olson 1.1
418 : olson 1.2 sub new
419 :     {
420 :     my($class, $input) = @_;
421 :    
422 :     my $fh;
423 :     if (ref($input) ne 'ARRAY')
424 : olson 1.1 {
425 : olson 1.2 die "SequenceWorkQueue requires a list as input";
426 : olson 1.1 }
427 : olson 1.2
428 :     my $self = $class->SUPER::new();
429 :    
430 :     $self->{list} = $input;
431 :    
432 :     return bless $self, $class;
433 :     }
434 :    
435 :     sub get_next
436 :     {
437 :     my($self) = @_;
438 :    
439 :     my $top = shift @{$self->{list}};
440 :    
441 :     return defined($top) ? @$top : ();
442 : olson 1.1 }
443 : olson 1.2
444 :    
445 : olson 1.1 1;
446 : olson 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3