[Bio] / FigWebServices / fig_scripts_service.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/fig_scripts_service.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (view) (download)

1 : disz 1.1 use strict;
2 : disz 1.2 use Carp;
3 : disz 1.1 use SOAP::Lite;
4 :     use IPC::Open3;
5 :     use FIGO;
6 :     use SOAP::Transport::HTTP;
7 : disz 1.3 use DBMaster;
8 :     use Job48;
9 :     use Data::Dumper;
10 : disz 1.1
11 :     SOAP::Transport::HTTP::CGI
12 :     -> dispatch_to('Scripts')
13 :     -> handle;
14 :    
15 :     package Scripts;
16 : disz 1.2 use FIG;
17 :     use FIG_Config;
18 :     use Data::Dumper;
19 :     use FigFams;
20 :     use FigFam;
21 : disz 1.3 use IPC::Open3;
22 :    
23 :     =begin WSDL
24 :     _IN auth $string
25 :     _IN args $string
26 :     _RETURN $string jobid
27 :     _DOC Input is a hash with lots of parms and a fasta file, output is a job id | error
28 :     =cut
29 :     sub load_fasta_to_rast {
30 :     my ($class, %args) = @_;
31 :     open FILE, ">/tmp/foo";
32 :     print FILE $args{file};
33 :     #print STDERR &Dumper(\%args);
34 :     #print STDERR "PWD ", $args{password}, "\n";
35 :     #print STDERR "Dumped\n";
36 :    
37 :    
38 :     # We have to authenticate this user first. Check with Daniel how to do that
39 :     my $organism = {name => $args{genome_name},
40 :     tax_id => $args{tax_id},
41 :     lineage => $args{lineage},
42 :     genetic_code => $args{genetic_code}
43 :     };
44 :    
45 :     #print STDERR &Dumper($organism);
46 :     my $msg;
47 :     my $user = $args{user};
48 :     my $seed_id;
49 :     my $project_id = "Test Project";
50 :     my $filename = "/tmp/foo";
51 :    
52 :     my $data = prepare_data_for_create_job( $msg , $seed_id, $organism, $project_id, $filename, $user);
53 :     print STDERR &Dumper($data), "Data\n";
54 :     my ($job_number,$err) = Job48->create_new_job($data);
55 :    
56 :     print STDERR "job, err = $job_number, $err\n";
57 :     return(join ":", $err, $job_number);
58 :    
59 :     }
60 :    
61 :     sub prepare_data_for_create_job{
62 :     my ( $msg , $seed_id, $organism, $project_desc, $filename, $user) = @_;
63 :    
64 :     my $meta = { "upload.timestamp" => time,
65 :     "status.uploaded" => "complete",
66 :     "keep_genecalls" => "0",
67 :     "correction.automatic" => "1" ,
68 :     # "submit.candidate" => $msg,
69 :     # "replace.seedID" => $seed_id,
70 :     };
71 :    
72 :     print STDERR &Dumper($meta), "meta\n";
73 :     open(SEQFILE , "$filename") or die "Can't open file $filename!\n";
74 :     my $data = { taxonomy_id => $organism->{tax_id},
75 :     metagenome => 0,
76 :     genome => $organism->{name},
77 :     user => $user,
78 :     project => $project_desc,
79 :     taxonomy => $organism->{lineage},
80 :     genetic_code => $organism->{genetic_code},
81 :     sequence_file => \*SEQFILE,
82 :     meta => $meta
83 :     };
84 :    
85 :     # print STDERR "made data \n";
86 :    
87 :     # print STDERR &Dumper($data), "data\n";
88 :    
89 :    
90 :     return $data;
91 :     }
92 :    
93 :    
94 :     =begin WSDL
95 :     _IN in $string
96 :     _IN in $string
97 :     _RETURN $string status
98 :     _DOC Input is a RAST job id, output is a status
99 :     =cut
100 :     sub check_rast_job {
101 :     my ($class, $job_id, $login_name) = @_;
102 :    
103 :     #print STDERR "Check $job_id, $login_name";
104 :     $ENV{DBHOST} = 'bioseed.mcs.anl.gov';
105 :     my $dbm = DBMaster->new('FortyEight_WebApplication');
106 :     my $users = $dbm->User->get_objects({ login => $login_name });
107 :     my $user;
108 :     if ($users && @$users) {
109 :     $user = $users->[0];
110 :     my ($stage, $status) = Job48->get_status_of_job($job_id, $user);
111 :     print STDERR "stage $stage, status $status\n";
112 :     return(join ":", $stage, $status);
113 :     } else {
114 :     # print STDERR "no users\n";
115 :     return("No users");
116 :     }
117 :     }
118 : disz 1.1
119 :    
120 : disz 1.3 =begin WSDL
121 :     _IN in $string
122 :     _RETURN $string
123 :     _DOC Input is a RAST jobid file, output is a big file
124 :     =cut
125 :     sub get_rast_results {
126 :     my ($class, $jobid) = @_;
127 :     return ("this should be a big file");
128 :     }
129 :    
130 :     =begin WSDL
131 :     _IN in $string
132 :     _RETURN $string
133 :     _DOC Input is an alias, output is a sequence
134 :     =cut
135 :     sub ali_to_seq {
136 :     my ($class, $arg) = @_;
137 :     return stdin_caller($class, "ali_to_seq", $arg);
138 : disz 1.1 }
139 :    
140 : disz 1.3 =begin WSDL
141 :     _IN in $string
142 :     _RETURN $string
143 :     _DOC Input is an alias, output is peg \t peg
144 :     =cut
145 :     sub adjacent {
146 :     my ($class, $arg) = @_;
147 :     return stdin_caller($class, "adjacent", $arg);
148 :     }
149 : disz 1.1
150 : disz 1.3 =begin WSDL
151 :     _IN in $string
152 :     _RETURN $string
153 :     _DOC Input is a peg, output is two column table of peg\tcluster
154 :     =cut
155 :     sub cluster_by_bbhs {
156 :     my ($class, $arg) = @_;
157 :     return stdin_caller($class, "cluster_by_bbhs", $arg);
158 :     }
159 : disz 1.1
160 : disz 1.3 =begin WSDL
161 :     _IN in $string
162 :     _RETURN $string
163 :     _DOC Input is a peg, output is two column table of peg\cluster
164 :     =cut
165 :     sub cluster_by_sim {
166 : disz 1.1 my ($class, $arg) = @_;
167 : disz 1.3 return stdin_caller($class, "cluster_by_sim", $arg);
168 :     }
169 : disz 1.1
170 : disz 1.3 =begin WSDL
171 :     _IN in $string
172 :     _RETURN $string
173 :     _DOC Input is a peg, output is two column table of peg\text func
174 :     =cut
175 :     sub external_calls {
176 :     my ($class, $arg) = @_;
177 :     return stdin_caller($class, "external_calls", $arg);
178 :     }
179 : disz 1.1
180 : disz 1.3 =begin WSDL
181 :     _IN in $string
182 :     _RETURN $string
183 :     _DOC Input is a peg, output is a function
184 :     =cut
185 :     sub function_of {
186 :     my ($class, $arg) = @_;
187 :     return stdin_caller($class, "function_of", $arg);
188 :     }
189 : disz 1.1
190 : disz 1.3 =begin WSDL
191 :     _IN in $string
192 :     _RETURN $string
193 :     _DOC Input is a peg, output is a single column table of genomes
194 :     =cut
195 :     sub genomes_of {
196 :     my ($class, $arg) = @_;
197 :     return stdin_caller($class, "genomes_of", $arg);
198 :     }
199 : disz 1.1
200 : disz 1.3 =begin WSDL
201 :     _IN in $string
202 :     _RETURN $string
203 :     _DOC Input is a single column table of pegs, output is a single column table of fasta.DNA
204 :     =cut
205 :     sub fid2dna {
206 :     my ($class, $arg) = @_;
207 :     return stdin_caller($class, "fid2dna", $arg);
208 :     }
209 : disz 1.1
210 : disz 1.3 =begin WSDL
211 :     _IN in $string
212 :     _RETURN $string
213 :     _DOC Input is a single column table of pegs, output is a single column table of archaeal pegs
214 :     =cut
215 :     sub is_archaeal {
216 :     my ($class, $arg) = @_;
217 :     return stdin_caller($class, "is_archaeal", $arg);
218 :     }
219 : disz 1.1
220 : disz 1.3 =begin WSDL
221 :     _IN in $string
222 :     _RETURN $string
223 :     _DOC Input is a single column table of pegs, output is a single column table of bacterial pegs
224 :     =cut
225 :     sub is_bacterial {
226 :     my ($class, $arg) = @_;
227 :     return stdin_caller($class, "is_bacterial", $arg);
228 :     }
229 : disz 1.1
230 : disz 1.3 =begin WSDL
231 :     _IN in $string
232 :     _RETURN $string
233 :     _DOC Input is a single column table of pegs, output is a single column table of eukaryotic pegs
234 :     =cut
235 :     sub is_eukaryotic {
236 :     my ($class, $arg) = @_;
237 :     return stdin_caller($class, "is_eukaryotic", $arg);
238 :     }
239 : disz 1.1
240 : disz 1.3 =begin WSDL
241 :     _IN in $string
242 :     _RETURN $string
243 :     _DOC Input is a single column table of pegs, output is a single column table of prokaryotic pegs
244 :     =cut
245 :     sub is_prokaryotic {
246 :     my ($class, $arg) = @_;
247 :     return stdin_caller($class, "is_prokaryotic", $arg);
248 : disz 1.1 }
249 :    
250 : disz 1.3 =begin WSDL
251 :     _IN in $string
252 :     _RETURN $string
253 :     _DOC Input is a peg, output is peg-Translation
254 :     =cut
255 :     sub translation_of {
256 :     my ($class, $arg) = @_;
257 :     return stdin_caller($class, "translation_of", $arg);
258 :     }
259 : disz 1.1
260 : disz 1.3 =begin WSDL
261 :     _IN in $string
262 :     _RETURN $string
263 :     _DOC Input is a peg, output is tab separated string of aliases
264 :     =cut
265 :     sub aliases_of {
266 :     my ($class, $arg) = @_;
267 :     return stdin_caller($class, "aliases_of", $arg);
268 :     }
269 : disz 1.1
270 : disz 1.3 =begin WSDL
271 :     _IN in $string
272 :     _RETURN $string
273 :     _DOC Input is an alias, output is a peg
274 :     =cut
275 :     sub alias2fig {
276 :     my ($class, $arg) = @_;
277 :     return stdin_caller($class, "alias2fig", $arg);
278 : disz 1.1 }
279 :    
280 :    
281 : disz 1.3
282 :     =begin WSDL
283 :     _IN in $string ec code
284 :     _RETURN $string ec name
285 :     _DOC Input is aec code , output is ec name
286 :     =cut
287 : disz 1.2 sub ec_name {
288 :     my $class = shift();
289 :     my $fig = new FIG;
290 :     my $result = $fig->ec_name(@_);
291 :     return $result;
292 :     }
293 :    
294 : disz 1.3 =begin WSDL
295 :     _IN in $string
296 :     _RETURN @string
297 :     _DOC Input is a peg, output is list of 4 tuples
298 :     =cut
299 : disz 1.2 sub abstract_coupled_to {
300 :     my $class = shift();
301 :     my $fig = new FIG;
302 :     my @result = $fig->abstract_coupled_to(@_);
303 :     return @result;
304 :     }
305 :    
306 : disz 1.3 =begin WSDL
307 :     _IN complete $string
308 :     _IN restrictions $string
309 :     _IN domain $string
310 :     _RETURN @string
311 :     _DOC Input is constraints, output is list of genomes
312 :     =cut
313 : disz 1.1 sub genomes {
314 :     my $class = shift();
315 :     my $fig = new FIG;
316 :     my @result = $fig->genomes(@_);
317 : disz 1.3 my @genomes;
318 :     foreach my $genome (@result)
319 :     {
320 :     print STDERR "Genome is -$genome-\n";
321 :    
322 :     my $genus_species = $fig->genus_species($genome);
323 :     push @genomes, join("\t",$genome,$genus_species);
324 :     # print STDERR join("\t",$genome,$genus_species);
325 :     }
326 :    
327 :     #print STDERR @genomes;
328 :     return @genomes;
329 :     #return @result;
330 :     }
331 :    
332 :     =begin WSDL
333 :     _IN in $string
334 :     _RETURN @string
335 :     _DOC Input is a peg, output is list of loc on contig
336 :     =cut
337 : disz 1.1 sub feature_location {
338 :     my ($class, $arg1) = @_;
339 :     my $fig = new FIG;
340 : disz 1.2 my @result = ($fig->feature_location($arg1));
341 : disz 1.1 return @result;
342 :     }
343 :    
344 : disz 1.3 =begin WSDL
345 :     _IN in $string
346 :     _RETURN $string
347 :     _DOC Input is a peg, output is translation
348 :     =cut
349 : disz 1.1 sub get_translation {
350 :     my ($class, $arg1) = @_;
351 :     my $fig = new FIG;
352 :     my $result = $fig->get_translation($arg1);
353 :     return $result;
354 :     }
355 :    
356 : disz 1.3 =begin WSDL
357 :     _IN pat1 $string
358 :     _IN pat2 $string
359 :     _RETURN @string
360 :     _DOC Input is two patterns, first one is used in search_index, second used to grep the results
361 :     =cut
362 : disz 1.1 sub search_and_grep {
363 :     my ($class, $arg1, $arg2) = @_;
364 :    
365 :     my $fig = new FIG;
366 :    
367 :     my ($pegs, $roles) = $fig->search_index($arg1);
368 :    
369 :     my (@result_list, $entry);
370 :    
371 :     for $entry (@$pegs) {
372 :     push (@result_list, grep(/$arg2/, @$entry));
373 :     }
374 :     push (@result_list, grep(/$arg2/, @$roles));
375 :     chomp @result_list;
376 :     my $return_value = join ("\n", @result_list);
377 :     return $return_value;
378 :     }
379 :    
380 : redwards 1.4
381 :     =begin WSDL
382 :     _IN pat1 $string
383 :     _RETURN @string
384 :     _DOC Input is a pattern to search for, output is tab separated list of pegs and roles
385 :     =cut
386 :     sub simple_search {
387 :     my ($class, $arg1)=@_;
388 :    
389 :     my $fig = new FIG;
390 :    
391 :     my ($pegs, $roles) = $fig->search_index($arg1);
392 :    
393 :     my (@result_list, $entry);
394 :    
395 :     for $entry (@$pegs) {
396 :     push (@result_list, (join("\t", @$entry)));
397 :     }
398 :    
399 :     push (@result_list, (join("\t", @$roles)));
400 :     chomp @result_list;
401 :     my $return_value = join ("\n", @result_list);
402 :     return $return_value;
403 :     }
404 :    
405 :    
406 : disz 1.3 =begin WSDL
407 :     _RETURN $string list of families
408 :     _DOC No Input, output is list of all families
409 :     =cut
410 :     sub all_families {
411 :     my ($class) = @_;
412 :     my $fig = new FIG;
413 :     my $figfams = new FigFams($fig);
414 : disz 1.1
415 : disz 1.3 my @out = $figfams->all_families;
416 :     print STDERR Dumper(@out);
417 :     return @out;
418 : disz 1.1 }
419 : disz 1.2
420 : disz 1.3 =begin WSDL
421 :     _RETURN $string list of families and funcs
422 :     _DOC No Input, output is list of all families
423 :     =cut
424 :     sub all_families_with_funcs {
425 : disz 1.2 my ($class) = @_;
426 :     my $fig = new FIG;
427 :     my $figfams = new FigFams($fig);
428 :    
429 : disz 1.3 my @out =$figfams->all_families_with_funcs;
430 : disz 1.2 return @out;
431 :     }
432 :    
433 : disz 1.3 =begin WSDL
434 :     _IN in $string list of famids
435 :     _RETURN $string 2 col table, famid, peg
436 :     _DOC Input is list of families, outoput is 2 col table of famid, peg
437 :     =cut
438 : disz 1.2 sub list_members {
439 :     my ($class, $famids) = @_;
440 :     my $fig = new FIG;
441 :     my $figfams = new FigFams($fig);
442 :     my @in = split(/\t/, $famids);
443 :     warn("Starting 2 list members $famids\n");
444 :     my @out = ();
445 :     foreach my $famid (@in)
446 :     {
447 :     my $famO = new FigFam($fig,$famid);
448 :     foreach my $peg ($famO->list_members)
449 :     {
450 :     push(@out,[$famid,$peg]);
451 :     }
452 :     }
453 :     return @out;
454 :     }
455 :    
456 : disz 1.3 =begin WSDL
457 :     _IN in $string list of pegs
458 :     _RETURN $string returns a 3-column table [PEG,Function,AliasesCommaSeparated]
459 :     _DOC Input is list of families,returns a 3-column table [PEG,Function,AliasesCommaSeparated]
460 :     =cut
461 : disz 1.2 sub CDS_data {
462 :     my ($class, $pegs) = @_;
463 :     my $fig = new FIG;
464 :     my $figfams = new FigFams($fig);
465 :     my @in = split(/\t/, $pegs);
466 :    
467 :     #warn("Starting CDS data $pegs\n");
468 :     #print STDERR &Dumper($pegs);
469 :    
470 :     my @out = ();
471 :     foreach my $peg (@in)
472 :     {
473 :     my @famids = $figfams->families_containing_peg($peg);
474 :     foreach my $famid (@famids)
475 :     {
476 :     push(@out,[$peg,scalar $fig->function_of($peg),[$fig->feature_aliases($peg)]]);
477 :     }
478 :     }
479 :     return @out;
480 :     }
481 :    
482 : disz 1.3 =begin WSDL
483 :     _IN in $string list of pegs
484 :     _RETURN $string a 2-column table [PEG,Sequence]
485 :     _DOC Input is list of families,returns a 2-column table [PEG,Sequence]
486 :     =cut
487 : disz 1.2 sub CDS_sequences {
488 :     my ($class, $pegs) = @_;
489 :     my $fig = new FIG;
490 :     my $figfams = new FigFams($fig);
491 :     my @in = split(/\t/, $pegs);
492 :    
493 :     #warn("Starting CDS seq $pegs\n");
494 :     #print STDERR &Dumper($pegs);
495 :     my @out = ();
496 :     foreach my $peg (@in)
497 :     {
498 :     push(@out,[$peg,$fig->get_translation($peg)]);
499 :     }
500 :     return @out;
501 :     }
502 :    
503 : disz 1.3 =begin WSDL
504 :     _IN in $string list of id seq pairs
505 :     _RETURN $string returns a 2-column table [Id,FamilyID]
506 :     _DOC Input is list of families,returns a 2-column table [Id,FamilyID]
507 :     =cut
508 : disz 1.2 sub is_member_of {
509 :     my ($class, $id_seqs) = @_;
510 :     my $fig = new FIG;
511 :     my $figfams = new FigFams($fig);
512 :     #warn("Doing is member $id_seqs\n");
513 :     #print STDERR &Dumper($id_seqs);
514 :    
515 :     my @in = split(/\n/, $id_seqs);
516 :     my @out = ();
517 :     foreach my $pair (@in)
518 :     {
519 :     my($id,$seq) = split(/\t/, $pair);
520 :     my($famO,undef) = $figfams->place_in_family($seq);
521 :     if ($famO)
522 :     {
523 :     push(@out,[$id,$famO->family_id]);
524 :     }
525 :     }
526 :     return @out;
527 :     }
528 :    
529 :    
530 : disz 1.3 sub stdin_caller {
531 :     my ($class, $name, $arg) = @_;
532 :     my($rd, $wr, $err, $pid, $std_err, $return_value, @std_out);
533 :     if (!($pid = open3($wr, $rd, $err, "$FIG_Config::bin/$name")))
534 :     {
535 :     die "Cannot run open3 $name: $!";
536 :     }
537 :    
538 :     $wr->write($arg);
539 :     close($wr);
540 :    
541 :     @std_out= <$rd>;
542 :     close($rd);
543 :     waitpid $pid, 0;
544 :     $return_value = join ("", @std_out);
545 :     return $return_value;
546 :     }
547 : redwards 1.4
548 :    
549 :    
550 :     =begin WSDL
551 :     _IN genome $string
552 :     _IN location1 $string
553 :     _IN location2 $string
554 :     _RETURN @string
555 :     _DOC Input is a genome ID and one or more locations in the form contig_start_stop, output is the DNA sequence
556 :     =cut
557 :     sub dna_sequence {
558 :     my ($class, $genome, @locations)=@_;
559 :     my $fig = new FIG;
560 :     my $seq=$fig->dna_seq($genome,@locations);
561 :     return $seq;
562 :     }
563 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3