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

Diff of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.13

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3