[Bio] / FigKernelPackages / FFserver.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : olson 1.1
2 :     package FFserver;
3 :    
4 :     use LWP::UserAgent;
5 :     use FIG_Config;
6 :     use Data::Dumper;
7 :    
8 :     use strict;
9 :    
10 :     sub new
11 :     {
12 :     my($class, $server_url) = @_;
13 :    
14 :     $server_url = $FIG_Config::FFserver_url unless $server_url;
15 :     $server_url = "http://bio-macpro-1.mcs.anl.gov/~disz/FIG/figfam_server.cgi" unless $server_url;
16 :    
17 :    
18 :     my $self = {
19 :     server_url => $server_url,
20 :     ua => LWP::UserAgent->new(),
21 :     };
22 :    
23 :     return bless $self, $class;
24 :     }
25 :    
26 :     sub assign_function_to_prot
27 :     {
28 :     my($self, $input) = @_;
29 :    
30 : olson 1.2 my $wq;
31 :    
32 : olson 1.1 if (ref($input) eq 'ARRAY')
33 :     {
34 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
35 : olson 1.1 }
36 :     else
37 :     {
38 : olson 1.2 $wq = FastaWorkQueue->new($input);
39 : olson 1.1 }
40 : olson 1.2
41 :     return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler, \&tab_delimited_output_parser);
42 : olson 1.1 }
43 :    
44 : olson 1.2 sub assign_functions_to_dna
45 : olson 1.1 {
46 : olson 1.2 my($self, $input) = @_;
47 : olson 1.1
48 : olson 1.2 my $wq;
49 : olson 1.1
50 : olson 1.2 if (ref($input) eq 'ARRAY')
51 : olson 1.1 {
52 : olson 1.2 $wq = SequenceListWorkQueue->new($input);
53 : olson 1.1 }
54 :     else
55 :     {
56 : olson 1.2 $wq = FastaWorkQueue->new($input);
57 : olson 1.1 }
58 : olson 1.2
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 : olson 1.1 }
86 :    
87 : olson 1.2 package ResultHandler;
88 : olson 1.1 use strict;
89 : olson 1.2 use Data::Dumper;
90 : olson 1.1
91 :     sub new
92 :     {
93 : olson 1.2 my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser) = @_;
94 :    
95 : olson 1.1 my $self = {
96 : olson 1.2 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 : olson 1.1 };
104 :     return bless $self, $class;
105 :     }
106 :    
107 :     sub get_next
108 :     {
109 :     my($self) = @_;
110 :    
111 : olson 1.2 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);
125 :     if ($res->is_success)
126 :     {
127 :     $self->{cur_result} = $res->content;
128 :     #print "res: $self->{cur_result}\n";
129 :     return $self->get_next_from_result();
130 :     }
131 :     else
132 :     {
133 :     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 SequenceWorkQueue;
153 :     use strict;
154 :    
155 :     sub new
156 :     {
157 :     my($class) = @_;
158 :    
159 :     my $self = {};
160 :    
161 :     return bless $self, $class;
162 :     }
163 : olson 1.1
164 : olson 1.2 sub get_next_n
165 :     {
166 :     my($self, $n) = @_;
167 :     my @out;
168 :    
169 :     for (my $i = 0;$i < $n; $i++)
170 : olson 1.1 {
171 : olson 1.2 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 : olson 1.1 }
181 : olson 1.2 return @out;
182 :     }
183 :    
184 :     sub get_next_n_bytes
185 :     {
186 :     my($self, $n) = @_;
187 :     my @out;
188 :    
189 :     my $size = 0;
190 :     while ($size < $n)
191 : olson 1.1 {
192 : olson 1.2 my($id, $com, $seqp) = $self->get_next();
193 :     if (defined($id))
194 :     {
195 :     push(@out, [$id, $com, $seqp]);
196 :     $size += (ref($seqp) eq 'SCALAR') ? length($$seqp) : length($seqp);
197 :     }
198 :     else
199 :     {
200 :     last;
201 :     }
202 : olson 1.1 }
203 : olson 1.2 return @out;
204 : olson 1.1 }
205 :    
206 : olson 1.2 package FastaWorkQueue;
207 : olson 1.1 use strict;
208 : olson 1.2 use base 'SequenceWorkQueue';
209 : olson 1.1 use FileHandle;
210 :     use FIG;
211 :    
212 :     sub new
213 :     {
214 : olson 1.2 my($class, $input) = @_;
215 : olson 1.1
216 :     my $fh;
217 :     if (ref($input))
218 :     {
219 :     $fh = $input;
220 :     }
221 :     else
222 :     {
223 :     $fh = new FileHandle("<$input");
224 :     }
225 : olson 1.2
226 :     my $self = $class->SUPER::new();
227 :    
228 :     $self->{fh} = $fh;
229 :    
230 : olson 1.1 return bless $self, $class;
231 :     }
232 :    
233 :     sub get_next
234 :     {
235 :     my($self) = @_;
236 :    
237 : olson 1.2 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 : olson 1.1
245 : olson 1.2 sub new
246 :     {
247 :     my($class, $input) = @_;
248 :    
249 :     my $fh;
250 :     if (ref($input) ne 'ARRAY')
251 : olson 1.1 {
252 : olson 1.2 die "SequenceWorkQueue requires a list as input";
253 : olson 1.1 }
254 : olson 1.2
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 : olson 1.1 }
270 : olson 1.2
271 :    
272 : olson 1.1 1;
273 : olson 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3