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

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3