[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.14, Fri Jun 19 17:30:02 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 112  Line 116 
116    
117      if ($res->is_success)      if ($res->is_success)
118      {      {
119          return Load($res->content);          my $content = $res->content;
120    #       print "Got $content\n";
121            my $ret;
122            eval {
123                $ret = Load($content);
124            };
125            if ($@)
126            {
127                die "Query returned unparsable content ($@): " . $content;
128            }
129            return $ret;
130      }      }
131      else      else
132      {      {
# Line 149  Line 163 
163  {  {
164      my($self, $input, $min_hits, $max_gap, $blast) = @_;      my($self, $input, $min_hits, $max_gap, $blast) = @_;
165    
166        $min_hits = 3 unless defined($min_hits);
167        $max_gap = 600 unless defined($max_gap);
168        $blast = 0 unless defined($blast);
169    
170      my $wq;      my $wq;
171    
172      if (ref($input) eq 'ARRAY')      if (ref($input) eq 'ARRAY')
# Line 160  Line 178 
178          $wq = FastaWorkQueue->new($input);          $wq = FastaWorkQueue->new($input);
179      }      }
180    
181      my $req_bytes = $blast ? 1000 : 16000;      my $req_bytes = $blast ? 1000 : 500000;
182      my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];      my $params = [min_hits => $min_hits, max_gap => $max_gap, blast => $blast];
183      return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',      return ResultHandler->new($wq, $self->{server_url}, 'assign_functions_to_DNA',
184                                \&id_seq_pair_bundler,                                \&id_seq_pair_bundler,
# Line 209  Line 227 
227          ua => LWP::UserAgent->new(),          ua => LWP::UserAgent->new(),
228          cur_result => undef,          cur_result => undef,
229          form_vars => $form_vars ? $form_vars : [],          form_vars => $form_vars ? $form_vars : [],
230          req_byts => ($req_bytes ? $req_bytes : 16000),          req_bytes => ($req_bytes ? $req_bytes : 16000),
231      };      };
232        $self->{ua}->timeout(20 * 60);
233      return bless $self, $class;      return bless $self, $class;
234  }  }
235    
# Line 219  Line 238 
238      my($self) = @_;      my($self) = @_;
239    
240      my $res =  $self->get_next_from_result();      my $res =  $self->get_next_from_result();
241        # print "gnfr returns: " , Dumper($res);
242    
243      if ($res)      if ($res)
244      {      {
# Line 226  Line 246 
246      }      }
247      else      else
248      {      {
249          my @inp = $self->{work_queue}->get_next_n_bytes(16000);  
250          if (@inp)          while (my @inp = $self->{work_queue}->get_next_n_bytes($self->{req_bytes}))
251          {          {
252              my $form = [@{$self->{form_vars}}];              my $form = [@{$self->{form_vars}}];
253              push(@$form, function => $self->{function},              push(@$form, function => $self->{function},
# Line 237  Line 257 
257              my $res = $self->{ua}->post($self->{server_url}, $form);              my $res = $self->{ua}->post($self->{server_url}, $form);
258              if ($res->is_success)              if ($res->is_success)
259              {              {
260                    eval {
261                  $self->{cur_result} = [YAML::Load($res->content)];                  $self->{cur_result} = [YAML::Load($res->content)];
262                  #print "res: $self->{cur_result}\n";                  };
263                  return $self->get_next_from_result();                  if ($@)
264                    {
265                        die "Query returned unparsable content ($@): " . $res->content;
266              }              }
267              else                  # print "res: " . Dumper($self->{cur_result});
268                    my $oneres =  $self->get_next_from_result();
269                    if ($oneres)
270              {              {
271                  die "error " . $res->status_line . " on post " . $res->content;                      return $oneres;
272              }              }
273          }          }
274          else          else
275          {          {
276              return;                  die "error " . $res->status_line . " on post " . $res->content;
277          }          }
278      }      }
279            return;
280        }
281  }  }
282    
283  sub get_next_from_result  sub get_next_from_result
# Line 326  Line 353 
353  use strict;  use strict;
354  use base 'SequenceWorkQueue';  use base 'SequenceWorkQueue';
355  use FileHandle;  use FileHandle;
 use FIG;  
356    
357  sub new  sub new
358  {  {
# Line 353  Line 379 
379  {  {
380      my($self) = @_;      my($self) = @_;
381    
382      my($id, $seqp, $com) = &FIG::read_fasta_record($self->{fh});      my($id, $seqp, $com) = read_fasta_record($self->{fh});
383      return defined($id) ? ($id, $com, $seqp) : ();      return defined($id) ? ($id, $com, $seqp) : ();
384  }  }
385    
386    sub read_fasta_record {
387        my ($file_handle) = @_;
388        my ($old_end_of_record, $fasta_record, @lines, $head, $sequence, $seq_id, $comment, @parsed_fasta_record);
389    
390        if (not defined($file_handle))  { $file_handle = \*STDIN; }
391    
392        $old_end_of_record = $/;
393        $/ = "\n>";
394    
395        if (defined($fasta_record = <$file_handle>)) {
396            chomp $fasta_record;
397            @lines  =  split( /\n/, $fasta_record );
398            $head   =  shift @lines;
399            $head   =~ s/^>?//;
400            $head   =~ m/^(\S+)/;
401            $seq_id = $1;
402            if ($head  =~ m/^\S+\s+(.*)$/)  { $comment = $1; } else { $comment = ""; }
403            $sequence  =  join( "", @lines );
404            @parsed_fasta_record = ( $seq_id, \$sequence, $comment );
405        } else {
406            @parsed_fasta_record = ();
407        }
408    
409        $/ = $old_end_of_record;
410    
411        return @parsed_fasta_record;
412    }
413    
414  package SequenceListWorkQueue;  package SequenceListWorkQueue;
415  use strict;  use strict;
416  use base 'SequenceWorkQueue';  use base 'SequenceWorkQueue';

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3