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

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (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 :     my($self, $input) = @_;
125 :    
126 : olson 1.2 my $wq;
127 :    
128 : olson 1.1 if (ref($input) eq 'ARRAY')
129 :     {
130 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
131 : olson 1.1 }
132 :     else
133 :     {
134 : olson 1.2 $wq = FastaWorkQueue->new($input);
135 : olson 1.1 }
136 : olson 1.2
137 :     return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler, \&tab_delimited_output_parser);
138 : olson 1.1 }
139 :    
140 : olson 1.2 sub assign_functions_to_dna
141 : olson 1.1 {
142 : olson 1.5 my($self, $input, $min_hits, $max_gap) = @_;
143 : olson 1.1
144 : olson 1.2 my $wq;
145 : olson 1.1
146 : olson 1.2 if (ref($input) eq 'ARRAY')
147 : olson 1.1 {
148 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
149 : olson 1.1 }
150 :     else
151 :     {
152 : olson 1.2 $wq = FastaWorkQueue->new($input);
153 : olson 1.1 }
154 : olson 1.2
155 : olson 1.5 return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA', \&id_seq_pair_bundler, \&tab_delimited_output_parser, [min_hits => $min_hits, max_gap => $max_gap]);
156 : olson 1.2 }
157 :    
158 :     sub id_seq_pair_bundler
159 :     {
160 :     my($item) = @_;
161 :     my($id, $seq) = @$item[0,2];
162 :     return "id_seq", join(",", $id, (ref($seq) eq 'SCALAR' ? $$seq : $seq));
163 :     }
164 :    
165 :     sub tab_delimited_output_parser
166 :     {
167 :     my($line) = @_;
168 :     chomp $line;
169 :     my @cols = split(/\t/, $line);
170 :     return \@cols;
171 :     }
172 :    
173 :    
174 :     sub tab_delimited_dna_data_output_parser
175 :     {
176 :     my($line) = @_;
177 :     chomp $line;
178 :     my ($id, $idbe, $fam) = split(/\t/, $line);
179 :     my ($beg, $end) = $idbe =~ /_(\d+)_(\d+)$/;
180 :     return [$id, $beg, $end, $fam];
181 : olson 1.1 }
182 :    
183 : olson 1.2 package ResultHandler;
184 : olson 1.1 use strict;
185 : olson 1.2 use Data::Dumper;
186 : olson 1.1
187 :     sub new
188 :     {
189 : olson 1.5 my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser, $form_vars) = @_;
190 : olson 1.2
191 : olson 1.1 my $self = {
192 : olson 1.2 work_queue => $work_queue,
193 :     server_url => $server_url,
194 :     function => $function,
195 :     input_bundler => $input_bundler,
196 :     output_parser => $output_parser,
197 :     ua => LWP::UserAgent->new(),
198 :     cur_result => undef,
199 : olson 1.5 form_vars => $form_vars ? $form_vars : [],
200 : olson 1.1 };
201 :     return bless $self, $class;
202 :     }
203 :    
204 :     sub get_next
205 :     {
206 :     my($self) = @_;
207 :    
208 : olson 1.2 if ($self->{cur_result})
209 :     {
210 :     return $self->get_next_from_result();
211 :     }
212 :     else
213 :     {
214 :     my @inp = $self->{work_queue}->get_next_n_bytes(16000);
215 :     if (@inp)
216 :     {
217 : olson 1.5 my $form = [@{$self->{form_vars}}];
218 :     push(@$form, function => $self->{function},
219 :     map { &{$self->{input_bundler}}($_) } @inp);
220 : olson 1.8 # print "Invoke " .Dumper($form);
221 : olson 1.2
222 :     my $res = $self->{ua}->post($self->{server_url}, $form);
223 :     if ($res->is_success)
224 :     {
225 :     $self->{cur_result} = $res->content;
226 :     #print "res: $self->{cur_result}\n";
227 :     return $self->get_next_from_result();
228 :     }
229 :     else
230 :     {
231 : olson 1.3 die "error " . $res->status_line . " on post " . $res->content;
232 : olson 1.2 }
233 :     }
234 :     else
235 :     {
236 :     return;
237 :     }
238 :     }
239 :     }
240 :    
241 :     sub get_next_from_result
242 :     {
243 :     my($self) = @_;
244 :     if ($self->{cur_result} =~ s/^([^\n]*)\n//)
245 :     {
246 :     return &{$self->{output_parser}}($1);
247 :     }
248 :     }
249 :    
250 :     package SequenceWorkQueue;
251 :     use strict;
252 :    
253 :     sub new
254 :     {
255 :     my($class) = @_;
256 :    
257 :     my $self = {};
258 :    
259 :     return bless $self, $class;
260 :     }
261 : olson 1.1
262 : olson 1.2 sub get_next_n
263 :     {
264 :     my($self, $n) = @_;
265 :     my @out;
266 :    
267 :     for (my $i = 0;$i < $n; $i++)
268 : olson 1.1 {
269 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
270 :     if (defined($id))
271 :     {
272 :     push(@out, [$id, $com, $seqp]);
273 :     }
274 :     else
275 :     {
276 :     last;
277 :     }
278 : olson 1.1 }
279 : olson 1.2 return @out;
280 :     }
281 :    
282 :     sub get_next_n_bytes
283 :     {
284 :     my($self, $n) = @_;
285 :     my @out;
286 :    
287 :     my $size = 0;
288 :     while ($size < $n)
289 : olson 1.1 {
290 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
291 :     if (defined($id))
292 :     {
293 :     push(@out, [$id, $com, $seqp]);
294 :     $size += (ref($seqp) eq 'SCALAR') ? length($$seqp) : length($seqp);
295 :     }
296 :     else
297 :     {
298 :     last;
299 :     }
300 : olson 1.1 }
301 : olson 1.2 return @out;
302 : olson 1.1 }
303 :    
304 : olson 1.2 package FastaWorkQueue;
305 : olson 1.1 use strict;
306 : olson 1.2 use base 'SequenceWorkQueue';
307 : olson 1.1 use FileHandle;
308 :     use FIG;
309 :    
310 :     sub new
311 :     {
312 : olson 1.2 my($class, $input) = @_;
313 : olson 1.1
314 :     my $fh;
315 :     if (ref($input))
316 :     {
317 :     $fh = $input;
318 :     }
319 :     else
320 :     {
321 :     $fh = new FileHandle("<$input");
322 :     }
323 : olson 1.2
324 :     my $self = $class->SUPER::new();
325 :    
326 :     $self->{fh} = $fh;
327 :    
328 : olson 1.1 return bless $self, $class;
329 :     }
330 :    
331 :     sub get_next
332 :     {
333 :     my($self) = @_;
334 :    
335 : olson 1.2 my($id, $seqp, $com) = &FIG::read_fasta_record($self->{fh});
336 :     return defined($id) ? ($id, $com, $seqp) : ();
337 :     }
338 :    
339 :     package SequenceListWorkQueue;
340 :     use strict;
341 :     use base 'SequenceWorkQueue';
342 : olson 1.1
343 : olson 1.2 sub new
344 :     {
345 :     my($class, $input) = @_;
346 :    
347 :     my $fh;
348 :     if (ref($input) ne 'ARRAY')
349 : olson 1.1 {
350 : olson 1.2 die "SequenceWorkQueue requires a list as input";
351 : olson 1.1 }
352 : olson 1.2
353 :     my $self = $class->SUPER::new();
354 :    
355 :     $self->{list} = $input;
356 :    
357 :     return bless $self, $class;
358 :     }
359 :    
360 :     sub get_next
361 :     {
362 :     my($self) = @_;
363 :    
364 :     my $top = shift @{$self->{list}};
365 :    
366 :     return defined($top) ? @$top : ();
367 : olson 1.1 }
368 : olson 1.2
369 :    
370 : olson 1.1 1;
371 : olson 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3