[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.5, Mon May 11 20:55:05 2009 UTC revision 1.18, Mon Jul 20 21:48:52 2009 UTC
# Line 1  Line 1 
1    
2  package FFserver;  package FFserver;
3    
4    #
5    # This is a SAS Component
6    #
7    
8  use LWP::UserAgent;  use LWP::UserAgent;
9  use Data::Dumper;  use Data::Dumper;
10  use YAML;  use YAML;
# Line 18  Line 22 
22          server_url => $server_url,          server_url => $server_url,
23          ua => LWP::UserAgent->new(),          ua => LWP::UserAgent->new(),
24      };      };
25        $self->{ua}->timeout(20 * 60);
26    
27      return bless $self, $class;      return bless $self, $class;
28  }  }
# Line 28  Line 33 
33      return $self->run_query('members_of_families', @ids);      return $self->run_query('members_of_families', @ids);
34  }  }
35    
36    sub families_containing_peg
37    {
38        my($self, @ids) = @_;
39        return $self->run_query('families_containing_peg', @ids);
40    }
41    
42    sub function_of
43    {
44        my($self, @ids) = @_;
45        return $self->run_query('function_of', @ids);
46    }
47    
48    sub org_of
49    {
50        my($self, @ids) = @_;
51        return $self->run_query('org_of', @ids);
52    }
53    
54    sub seq_of
55    {
56        my($self, @ids) = @_;
57        return $self->run_query('seq_of', @ids);
58    }
59    
60    sub aliases_of
61    {
62        my($self, @ids) = @_;
63        return $self->run_query('aliases_of', @ids);
64    }
65    
66    sub families_implementing_role
67    {
68        my($self,@roles) = @_;
69        return $self->run_query('families_implementing_role', @roles);
70    }
71    
72    sub families_with_function
73    {
74        my($self,@functions) = @_;
75        return $self->run_query('families_with_function', @functions);
76    }
77    
78    sub families_in_genome
79    {
80        my($self,@genomes) = @_;
81        return $self->run_query('families_in_genome', @genomes);
82    }
83    
84    sub get_subsystem_based_figfams
85    {
86        my ($self) = @_;
87        return $self->run_query('get_subsystem_based_figfams');
88    }
89    
90  sub should_be_member  sub should_be_member
91  {  {
92      my($self, @id_seq_pairs) = @_;      my($self, @id_seq_pairs) = @_;
# Line 51  Line 110 
110    
111  sub run_query_form  sub run_query_form
112  {  {
113      my($self, $form) = @_;      my($self, $form, $raw) = @_;
114    
115      my $res = $self->{ua}->post($self->{server_url}, $form);      my $res = $self->{ua}->post($self->{server_url}, $form);
116    
117      if ($res->is_success)      if ($res->is_success)
118      {      {
119          return Load($res->content);          my $content = $res->content;
120            if ($raw)
121            {
122                return $content;
123            }
124    
125    #       print "Got $content\n";
126            my $ret;
127            eval {
128                $ret = Load($content);
129            };
130            if ($@)
131            {
132                die "Query returned unparsable content ($@): " . $content;
133            }
134            return $ret;
135      }      }
136      else      else
137      {      {
138          die "error on post " . $res->content;          die "error on post " . $res->status_line . " " . $res->content;
139      }      }
140  }  }
141    
142  sub assign_function_to_prot  sub assign_function_to_prot
143  {  {
144      my($self, $input) = @_;      my($self, $input, $blast, $min_hits, $assignToAll) = @_;
145    
146      my $wq;      my $wq;
147    
148        my $params = [blast => $blast, min_hits => $min_hits, assign_to_all => ($assignToAll ? 1 : 0)];
149    
150      if (ref($input) eq 'ARRAY')      if (ref($input) eq 'ARRAY')
151      {      {
152          $wq = SequenceListWorkQueue->new($input);          $wq = SequenceListWorkQueue->new($input);
# Line 80  Line 156 
156          $wq = FastaWorkQueue->new($input);          $wq = FastaWorkQueue->new($input);
157      }      }
158    
159      return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler, \&tab_delimited_output_parser);      my $req_bytes = $blast ? 1000 : 16000;
160    
161        return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler,
162                                  #\&tab_delimited_output_parser,
163                                  \&YAML::Load,
164                                  $params, $req_bytes);
165    }
166    
167    sub call_genes
168    {
169        my($self, $input, $genetic_code) = @_;
170    
171        if (ref($input) ne 'ARRAY')
172        {
173            my $fh;
174            if (ref($input))
175            {
176                $fh = $input;
177            }
178            else
179            {
180                my $fasta_file = $input;
181                open($fh, "<", $fasta_file);
182            }
183            $input = [];
184            while (my($id, $seqp, $com) = FastaWorkQueue::read_fasta_record($fh))
185            {
186                push(@$input, "$id,$$seqp");
187            }
188            close($fh);
189        }
190    
191        return $self->run_query_form([function => "call_genes",
192                                      genetic_code => $genetic_code,
193                                      id_seq => $input]);
194    }
195    
196    sub find_rnas
197    {
198        my($self, $input, $genus, $species, $domain) = @_;
199    
200        if (ref($input) ne 'ARRAY')
201        {
202            my $fh;
203            if (ref($input))
204            {
205                $fh = $input;
206            }
207            else
208            {
209                my $fasta_file = $input;
210                open($fh, "<", $fasta_file);
211            }
212            $input = [];
213            while (my($id, $seqp, $com) = FastaWorkQueue::read_fasta_record($fh))
214            {
215                push(@$input, "$id,$$seqp");
216            }
217            close($fh);
218        }
219    
220        return $self->run_query_form([function => "find_rnas",
221                                      genus => $genus,
222                                      species => $species,
223                                      domain => $domain,
224                                      id_seq => $input]);
225  }  }
226    
227  sub assign_functions_to_dna  sub assign_functions_to_dna
228  {  {
229      my($self, $input, $min_hits, $max_gap) = @_;      my($self, $input, $min_hits, $max_gap, $blast) = @_;
230    
231        $min_hits = 3 unless defined($min_hits);
232        $max_gap = 600 unless defined($max_gap);
233        $blast = 0 unless defined($blast);
234    
235      my $wq;      my $wq;
236    
# Line 98  Line 243 
243          $wq = FastaWorkQueue->new($input);          $wq = FastaWorkQueue->new($input);
244      }      }
245    
246      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]);      my $req_bytes = $blast ? 1000 : 500000;
247        my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];
248        return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',
249                                  \&id_seq_pair_bundler,
250                                  \&tab_delimited_output_parser, $params, $req_bytes);
251  }  }
252    
253  sub id_seq_pair_bundler  sub id_seq_pair_bundler
# Line 132  Line 281 
281    
282  sub new  sub new
283  {  {
284      my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser, $form_vars) = @_;      my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser, $form_vars, $req_bytes) = @_;
285    
286      my $self = {      my $self = {
287          work_queue => $work_queue,          work_queue => $work_queue,
# Line 143  Line 292 
292          ua => LWP::UserAgent->new(),          ua => LWP::UserAgent->new(),
293          cur_result => undef,          cur_result => undef,
294          form_vars => $form_vars ? $form_vars : [],          form_vars => $form_vars ? $form_vars : [],
295            req_bytes => ($req_bytes ? $req_bytes : 16000),
296      };      };
297        $self->{ua}->timeout(20 * 60);
298      return bless $self, $class;      return bless $self, $class;
299  }  }
300    
# Line 151  Line 302 
302  {  {
303      my($self) = @_;      my($self) = @_;
304    
305      if ($self->{cur_result})      my $res =  $self->get_next_from_result();
306        # print "gnfr returns: " , Dumper($res);
307    
308        if ($res)
309      {      {
310          return $self->get_next_from_result();          return $res;
311      }      }
312      else      else
313      {      {
314          my @inp = $self->{work_queue}->get_next_n_bytes(16000);  
315          if (@inp)          while (my @inp = $self->{work_queue}->get_next_n_bytes($self->{req_bytes}))
316          {          {
317              my $form = [@{$self->{form_vars}}];              my $form = [@{$self->{form_vars}}];
318              push(@$form, function => $self->{function},              push(@$form, function => $self->{function},
319                           map { &{$self->{input_bundler}}($_) } @inp);                           map { &{$self->{input_bundler}}($_) } @inp);
320              print "Invoke " .Dumper($form);              # print "Invoke " .Dumper($form);
321    
322              my $res = $self->{ua}->post($self->{server_url}, $form);              my $res = $self->{ua}->post($self->{server_url}, $form);
323              if ($res->is_success)              if ($res->is_success)
324              {              {
325                  $self->{cur_result} = $res->content;                  eval {
326                  #print "res: $self->{cur_result}\n";                      $self->{cur_result} = [YAML::Load($res->content)];
327                  return $self->get_next_from_result();                  };
328                    if ($@)
329                    {
330                        die "Query returned unparsable content ($@): " . $res->content;
331              }              }
332              else                  # print "res: " . Dumper($self->{cur_result});
333                    my $oneres =  $self->get_next_from_result();
334                    if ($oneres)
335              {              {
336                  die "error " . $res->status_line . " on post " . $res->content;                      return $oneres;
337              }              }
338          }          }
339          else          else
340          {          {
341              return;                  die "error " . $res->status_line . " on post " . $res->content;
342                }
343          }          }
344            return;
345      }      }
346  }  }
347    
348  sub get_next_from_result  sub get_next_from_result
349  {  {
350      my($self) = @_;      my($self) = @_;
351      if ($self->{cur_result} =~ s/^([^\n]*)\n//)      my $l = $self->{cur_result};
352        if ($l and @$l)
353        {
354            return shift(@$l);
355        }
356        else
357      {      {
358          return &{$self->{output_parser}}($1);          delete $self->{cur_result};
359            return undef;
360      }      }
361  }  }
362    
# Line 251  Line 418 
418  use strict;  use strict;
419  use base 'SequenceWorkQueue';  use base 'SequenceWorkQueue';
420  use FileHandle;  use FileHandle;
 use FIG;  
421    
422  sub new  sub new
423  {  {
# Line 278  Line 444 
444  {  {
445      my($self) = @_;      my($self) = @_;
446    
447      my($id, $seqp, $com) = &FIG::read_fasta_record($self->{fh});      my($id, $seqp, $com) = read_fasta_record($self->{fh});
448      return defined($id) ? ($id, $com, $seqp) : ();      return defined($id) ? ($id, $com, $seqp) : ();
449  }  }
450    
451    sub read_fasta_record {
452        my ($file_handle) = @_;
453        my ($old_end_of_record, $fasta_record, @lines, $head, $sequence, $seq_id, $comment, @parsed_fasta_record);
454    
455        if (not defined($file_handle))  { $file_handle = \*STDIN; }
456    
457        $old_end_of_record = $/;
458        $/ = "\n>";
459    
460        if (defined($fasta_record = <$file_handle>)) {
461            chomp $fasta_record;
462            @lines  =  split( /\n/, $fasta_record );
463            $head   =  shift @lines;
464            $head   =~ s/^>?//;
465            $head   =~ m/^(\S+)/;
466            $seq_id = $1;
467            if ($head  =~ m/^\S+\s+(.*)$/)  { $comment = $1; } else { $comment = ""; }
468            $sequence  =  join( "", @lines );
469            @parsed_fasta_record = ( $seq_id, \$sequence, $comment );
470        } else {
471            @parsed_fasta_record = ();
472        }
473    
474        $/ = $old_end_of_record;
475    
476        return @parsed_fasta_record;
477    }
478    
479  package SequenceListWorkQueue;  package SequenceListWorkQueue;
480  use strict;  use strict;
481  use base 'SequenceWorkQueue';  use base 'SequenceWorkQueue';

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3