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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3