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

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3