[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.2, Thu Apr 30 20:33:41 2009 UTC
# Line 27  Line 27 
27  {  {
28      my($self, $input) = @_;      my($self, $input) = @_;
29    
30      my $handle;      my $wq;
31    
32      if (ref($input) eq 'ARRAY')      if (ref($input) eq 'ARRAY')
33      {      {
34          $handle = ListInputHandle->new($input, sub { $self->assign_function_to_prot_one(@_); });          $wq = SequenceListWorkQueue->new($input);
35        }
36        else
37        {
38            $wq = FastaWorkQueue->new($input);
39        }
40    
41        return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler, \&tab_delimited_output_parser);
42      }      }
43      elsif (ref($input))  
44    sub assign_functions_to_dna
45    {
46        my($self, $input) = @_;
47    
48        my $wq;
49    
50        if (ref($input) eq 'ARRAY')
51      {      {
52          $handle = FileInputHandle->new($input, sub { $self->assign_function_to_prot_one(@_); });          $wq = SequenceListWorkQueue->new($input);
53      }      }
54      else      else
55      {      {
56          $handle = FileInputHandle->new($input, sub { $self->assign_function_to_prot_one(@_); });          $wq = FastaWorkQueue->new($input);
57      }      }
58    
59        return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_DNA', \&id_seq_pair_bundler, \&tab_delimited_dna_data_output_parser);
60    }
61    
62    sub id_seq_pair_bundler
63    {
64        my($item) = @_;
65        my($id, $seq) = @$item[0,2];
66        return "id_seq", join(",", $id, (ref($seq) eq 'SCALAR' ? $$seq : $seq));
67    }
68    
69    sub tab_delimited_output_parser
70    {
71        my($line) = @_;
72        chomp $line;
73        my @cols = split(/\t/, $line);
74        return \@cols;
75    }
76    
77    
78    sub tab_delimited_dna_data_output_parser
79    {
80        my($line) = @_;
81        chomp $line;
82        my ($id, $idbe, $fam) = split(/\t/, $line);
83        my ($beg, $end) = $idbe =~ /_(\d+)_(\d+)$/;
84        return [$id, $beg, $end, $fam];
85  }  }
86    
87  sub assign_function_to_prot_one  package ResultHandler;
88    use strict;
89    use Data::Dumper;
90    
91    sub new
92  {  {
93      my($self, $dat) = @_;      my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser) = @_;
94    
95      my($id, undef, $seq) = @$dat;      my $self = {
96            work_queue => $work_queue,
97            server_url => $server_url,
98            function => $function,
99            input_bundler => $input_bundler,
100            output_parser => $output_parser,
101            ua => LWP::UserAgent->new(),
102            cur_result => undef,
103        };
104        return bless $self, $class;
105    }
106    
107      my $form = [function => 'assign_function_to_prot',  sub get_next
108                  id_seq => "$id,$seq"];  {
109        my($self) = @_;
110    
111      print Dumper($self->{server_url}, $form);      if ($self->{cur_result})
112        {
113            return $self->get_next_from_result();
114        }
115        else
116        {
117            my @inp = $self->{work_queue}->get_next_n_bytes(16000);
118            if (@inp)
119            {
120                my $form = [function => $self->{function},
121                            map { &{$self->{input_bundler}}($_) } @inp ];
122                # print "Invoke " .Dumper($form);
123    
124      my $res = $self->{ua}->post($self->{server_url}, $form);      my $res = $self->{ua}->post($self->{server_url}, $form);
125      if ($res->is_success)      if ($res->is_success)
126      {      {
127          my $txt = $res->content;                  $self->{cur_result} = $res->content;
128          return $txt;                  #print "res: $self->{cur_result}\n";
129                    return $self->get_next_from_result();
130      }      }
131      else      else
132      {      {
133          die "error on post " . $res->content;          die "error on post " . $res->content;
134      }      }
135            }
136            else
137            {
138                return;
139            }
140        }
141    }
142    
143    sub get_next_from_result
144    {
145        my($self) = @_;
146        if ($self->{cur_result} =~ s/^([^\n]*)\n//)
147        {
148            return &{$self->{output_parser}}($1);
149        }
150  }  }
151    
152  package ListInputHandle;  package SequenceWorkQueue;
153  use strict;  use strict;
154    
155  sub new  sub new
156  {  {
157      my($class, $list, $handler) = @_;      my($class) = @_;
158      my $self = {  
159          list => $list,      my $self = {};
160          handler => $handler,  
     };  
161      return bless $self, $class;      return bless $self, $class;
162  }  }
163    
164  sub get_next  sub get_next_n
165  {  {
166      my($self) = @_;      my($self, $n) = @_;
167        my @out;
168    
169      my $l = $self->{list};      for (my $i = 0;$i < $n; $i++)
170        {
171            my($id, $com, $seqp) = $self->get_next();
172            if (defined($id))
173            {
174                push(@out, [$id, $com, $seqp]);
175            }
176            else
177            {
178                last;
179            }
180        }
181        return @out;
182    }
183    
184    sub get_next_n_bytes
185    {
186        my($self, $n) = @_;
187        my @out;
188    
189      if (@$l)      my $size = 0;
190        while ($size < $n)
191      {      {
192          my $ent = shift @$l;          my($id, $com, $seqp) = $self->get_next();
193          my $res = &{$self->{handler}}($ent);          if (defined($id))
194          my($id, $val) = split(/\t/, $res);          {
195          chomp $val;              push(@out, [$id, $com, $seqp]);
196          return $val;              $size += (ref($seqp) eq 'SCALAR') ? length($$seqp) : length($seqp);
197      }      }
198      else      else
199      {      {
200          return undef;              last;
201            }
202      }      }
203        return @out;
204  }  }
205    
206  package FileInputHandle;  package FastaWorkQueue;
207  use strict;  use strict;
208    use base 'SequenceWorkQueue';
209  use FileHandle;  use FileHandle;
210  use FIG;  use FIG;
211    
212  sub new  sub new
213  {  {
214      my($class, $input, $handler) = @_;      my($class, $input) = @_;
215    
216      my $fh;      my $fh;
217      if (ref($input))      if (ref($input))
# Line 118  Line 223 
223          $fh = new FileHandle("<$input");          $fh = new FileHandle("<$input");
224      }      }
225    
226      my $self = {      my $self = $class->SUPER::new();
227          fh => $fh,  
228          handler => $handler,      $self->{fh} = $fh;
229      };  
230      return bless $self, $class;      return bless $self, $class;
231  }  }
232    
# Line 129  Line 234 
234  {  {
235      my($self) = @_;      my($self) = @_;
236    
237      my($id, $seqp) = &FIG::read_fasta_record($self->{fh});      my($id, $seqp, $com) = &FIG::read_fasta_record($self->{fh});
238        return defined($id) ? ($id, $com, $seqp) : ();
239    }
240    
241    package SequenceListWorkQueue;
242    use strict;
243    use base 'SequenceWorkQueue';
244    
245      if ($id)  sub new
246      {      {
247          my $ent = [$id, undef, $$seqp];      my($class, $input) = @_;
248          my $res = &{$self->{handler}}($ent);  
249          my($id, $val) = split(/\t/, $res);      my $fh;
250          chomp $val;      if (ref($input) ne 'ARRAY')
         return $val;  
     }  
     else  
251      {      {
252          close($self->{fh});          die "SequenceWorkQueue requires a list as input";
         return undef;  
253      }      }
254    
255        my $self = $class->SUPER::new();
256    
257        $self->{list} = $input;
258    
259        return bless $self, $class;
260  }  }
261    
262    sub get_next
263    {
264        my($self) = @_;
265    
266        my $top = shift @{$self->{list}};
267    
268        return defined($top) ? @$top : ();
269    }
270    
271    
272  1;  1;
273    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3