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

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3