[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.11, Thu May 21 21:53:17 2009 UTC revision 1.16, Wed Jul 1 17:43:53 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(10 * 60);      $self->{ua}->timeout(20 * 60);
26    
27      return bless $self, $class;      return bless $self, $class;
28  }  }
# Line 106  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      {      {
# Line 122  Line 141 
141    
142  sub assign_function_to_prot  sub assign_function_to_prot
143  {  {
144      my($self, $input, $blast, $min_hits) = @_;      my($self, $input, $blast, $min_hits, $assignToAll) = @_;
145    
146      my $wq;      my $wq;
147    
148      my $params = [blast => $blast, min_hits => $min_hits];      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      {      {
# Line 145  Line 164 
164                                $params, $req_bytes);                                $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], 1);
194    }
195    
196  sub assign_functions_to_dna  sub assign_functions_to_dna
197  {  {
198      my($self, $input, $min_hits, $max_gap, $blast) = @_;      my($self, $input, $min_hits, $max_gap, $blast) = @_;
199    
200        $min_hits = 3 unless defined($min_hits);
201        $max_gap = 600 unless defined($max_gap);
202        $blast = 0 unless defined($blast);
203    
204      my $wq;      my $wq;
205    
206      if (ref($input) eq 'ARRAY')      if (ref($input) eq 'ARRAY')
# Line 160  Line 212 
212          $wq = FastaWorkQueue->new($input);          $wq = FastaWorkQueue->new($input);
213      }      }
214    
215      my $req_bytes = $blast ? 1000 : 16000;      my $req_bytes = $blast ? 1000 : 500000;
216      my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];      my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];
217      return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',      return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',
218                                \&id_seq_pair_bundler,                                \&id_seq_pair_bundler,
# Line 209  Line 261 
261          ua => LWP::UserAgent->new(),          ua => LWP::UserAgent->new(),
262          cur_result => undef,          cur_result => undef,
263          form_vars => $form_vars ? $form_vars : [],          form_vars => $form_vars ? $form_vars : [],
264          req_byts => ($req_bytes ? $req_bytes : 16000),          req_bytes => ($req_bytes ? $req_bytes : 16000),
265      };      };
266        $self->{ua}->timeout(20 * 60);
267      return bless $self, $class;      return bless $self, $class;
268  }  }
269    
# Line 219  Line 272 
272      my($self) = @_;      my($self) = @_;
273    
274      my $res =  $self->get_next_from_result();      my $res =  $self->get_next_from_result();
275        # print "gnfr returns: " , Dumper($res);
276    
277      if ($res)      if ($res)
278      {      {
# Line 226  Line 280 
280      }      }
281      else      else
282      {      {
283          my @inp = $self->{work_queue}->get_next_n_bytes(16000);  
284          if (@inp)          while (my @inp = $self->{work_queue}->get_next_n_bytes($self->{req_bytes}))
285          {          {
286              my $form = [@{$self->{form_vars}}];              my $form = [@{$self->{form_vars}}];
287              push(@$form, function => $self->{function},              push(@$form, function => $self->{function},
# Line 237  Line 291 
291              my $res = $self->{ua}->post($self->{server_url}, $form);              my $res = $self->{ua}->post($self->{server_url}, $form);
292              if ($res->is_success)              if ($res->is_success)
293              {              {
294                    eval {
295                  $self->{cur_result} = [YAML::Load($res->content)];                  $self->{cur_result} = [YAML::Load($res->content)];
296                  #print "res: $self->{cur_result}\n";                  };
297                  return $self->get_next_from_result();                  if ($@)
298                    {
299                        die "Query returned unparsable content ($@): " . $res->content;
300              }              }
301              else                  # print "res: " . Dumper($self->{cur_result});
302                    my $oneres =  $self->get_next_from_result();
303                    if ($oneres)
304              {              {
305                  die "error " . $res->status_line . " on post " . $res->content;                      return $oneres;
306              }              }
307          }          }
308          else          else
309          {          {
310              return;                  die "error " . $res->status_line . " on post " . $res->content;
311          }          }
312      }      }
313            return;
314        }
315  }  }
316    
317  sub get_next_from_result  sub get_next_from_result
# Line 326  Line 387 
387  use strict;  use strict;
388  use base 'SequenceWorkQueue';  use base 'SequenceWorkQueue';
389  use FileHandle;  use FileHandle;
 use FIG;  
390    
391  sub new  sub new
392  {  {
# Line 353  Line 413 
413  {  {
414      my($self) = @_;      my($self) = @_;
415    
416      my($id, $seqp, $com) = &FIG::read_fasta_record($self->{fh});      my($id, $seqp, $com) = read_fasta_record($self->{fh});
417      return defined($id) ? ($id, $com, $seqp) : ();      return defined($id) ? ($id, $com, $seqp) : ();
418  }  }
419    
420    sub read_fasta_record {
421        my ($file_handle) = @_;
422        my ($old_end_of_record, $fasta_record, @lines, $head, $sequence, $seq_id, $comment, @parsed_fasta_record);
423    
424        if (not defined($file_handle))  { $file_handle = \*STDIN; }
425    
426        $old_end_of_record = $/;
427        $/ = "\n>";
428    
429        if (defined($fasta_record = <$file_handle>)) {
430            chomp $fasta_record;
431            @lines  =  split( /\n/, $fasta_record );
432            $head   =  shift @lines;
433            $head   =~ s/^>?//;
434            $head   =~ m/^(\S+)/;
435            $seq_id = $1;
436            if ($head  =~ m/^\S+\s+(.*)$/)  { $comment = $1; } else { $comment = ""; }
437            $sequence  =  join( "", @lines );
438            @parsed_fasta_record = ( $seq_id, \$sequence, $comment );
439        } else {
440            @parsed_fasta_record = ();
441        }
442    
443        $/ = $old_end_of_record;
444    
445        return @parsed_fasta_record;
446    }
447    
448  package SequenceListWorkQueue;  package SequenceListWorkQueue;
449  use strict;  use strict;
450  use base 'SequenceWorkQueue';  use base 'SequenceWorkQueue';

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3