[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.6 - (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 : redwards 1.5 _DOC Input is a RAST job id, and username output is a status
99 : disz 1.3 =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 : redwards 1.5
131 :     =begin WSDL
132 :     _IN job $string
133 :     _IN username $string
134 :     _RETURN $string bindings
135 :     _DOC Input is a RAST job id and a username, output is the bindings that join that job to the subsystems. This is a tple of subsystem name, protein function, and sequence within the metagenome.
136 :     =cut
137 :     sub mg_rast_subsystems {
138 :     my ($class, $job_id, $login_name) = @_;
139 :     $ENV{DBHOST} = 'bioseed.mcs.anl.gov';
140 :     my $dbm = DBMaster->new(-database => 'FortyEight_WebApplication');
141 :     my $users = $dbm->User->get_objects({ login => $login_name });
142 :     my $user;
143 :    
144 :     # get the metagenome job directory. This is hard wired at the moment, but
145 :     # shouldn't be. Not sure if the job directory is in FIG_Config
146 :     # Also, I return "Access Error" regardless of whether the job is there or not to stop people
147 :     # hacking.
148 :     $job_id="/vol/metagenome-48-hour/Jobs.prod/$job_id";
149 :     return "Access Error" unless (-e $job_id); # simple check that we have that id
150 :    
151 :     # now make sure we are a valid user. If we are not a valid user this should throw an error
152 :    
153 :     my $job;
154 :     eval {$job = Job48->new($job_id, $user->[0])};
155 :     if ($@ || !$job) {return "Access error"}
156 : redwards 1.6
157 :     # another user check -- this is just a simple check and doesn't allow for public data or common
158 :     # organizations, so it is not as good. But it works
159 :     return "Access Error" unless ($job->user eq $login_name);
160 :    
161 : redwards 1.5 my $orgdir=$job->orgdir;
162 :     print STDERR "$job\n";
163 :     open(IN, "$orgdir/Subsystems/bindings") || return "No subsystems found\n";
164 :     return join("", <IN>);
165 :     }
166 :    
167 : disz 1.3 =begin WSDL
168 :     _IN in $string
169 :     _RETURN $string
170 :     _DOC Input is an alias, output is a sequence
171 :     =cut
172 :     sub ali_to_seq {
173 :     my ($class, $arg) = @_;
174 :     return stdin_caller($class, "ali_to_seq", $arg);
175 : disz 1.1 }
176 :    
177 : disz 1.3 =begin WSDL
178 :     _IN in $string
179 :     _RETURN $string
180 :     _DOC Input is an alias, output is peg \t peg
181 :     =cut
182 :     sub adjacent {
183 :     my ($class, $arg) = @_;
184 :     return stdin_caller($class, "adjacent", $arg);
185 :     }
186 : disz 1.1
187 : disz 1.3 =begin WSDL
188 :     _IN in $string
189 :     _RETURN $string
190 :     _DOC Input is a peg, output is two column table of peg\tcluster
191 :     =cut
192 :     sub cluster_by_bbhs {
193 :     my ($class, $arg) = @_;
194 :     return stdin_caller($class, "cluster_by_bbhs", $arg);
195 :     }
196 : disz 1.1
197 : disz 1.3 =begin WSDL
198 :     _IN in $string
199 :     _RETURN $string
200 :     _DOC Input is a peg, output is two column table of peg\cluster
201 :     =cut
202 :     sub cluster_by_sim {
203 : disz 1.1 my ($class, $arg) = @_;
204 : disz 1.3 return stdin_caller($class, "cluster_by_sim", $arg);
205 :     }
206 : disz 1.1
207 : disz 1.3 =begin WSDL
208 :     _IN in $string
209 :     _RETURN $string
210 :     _DOC Input is a peg, output is two column table of peg\text func
211 :     =cut
212 :     sub external_calls {
213 :     my ($class, $arg) = @_;
214 :     return stdin_caller($class, "external_calls", $arg);
215 :     }
216 : disz 1.1
217 : disz 1.3 =begin WSDL
218 :     _IN in $string
219 :     _RETURN $string
220 :     _DOC Input is a peg, output is a function
221 :     =cut
222 :     sub function_of {
223 :     my ($class, $arg) = @_;
224 :     return stdin_caller($class, "function_of", $arg);
225 :     }
226 : disz 1.1
227 : disz 1.3 =begin WSDL
228 :     _IN in $string
229 :     _RETURN $string
230 :     _DOC Input is a peg, output is a single column table of genomes
231 :     =cut
232 :     sub genomes_of {
233 :     my ($class, $arg) = @_;
234 :     return stdin_caller($class, "genomes_of", $arg);
235 :     }
236 : disz 1.1
237 : disz 1.3 =begin WSDL
238 :     _IN in $string
239 :     _RETURN $string
240 :     _DOC Input is a single column table of pegs, output is a single column table of fasta.DNA
241 :     =cut
242 :     sub fid2dna {
243 :     my ($class, $arg) = @_;
244 :     return stdin_caller($class, "fid2dna", $arg);
245 :     }
246 : disz 1.1
247 : disz 1.3 =begin WSDL
248 :     _IN in $string
249 :     _RETURN $string
250 :     _DOC Input is a single column table of pegs, output is a single column table of archaeal pegs
251 :     =cut
252 :     sub is_archaeal {
253 :     my ($class, $arg) = @_;
254 :     return stdin_caller($class, "is_archaeal", $arg);
255 :     }
256 : disz 1.1
257 : disz 1.3 =begin WSDL
258 :     _IN in $string
259 :     _RETURN $string
260 :     _DOC Input is a single column table of pegs, output is a single column table of bacterial pegs
261 :     =cut
262 :     sub is_bacterial {
263 :     my ($class, $arg) = @_;
264 :     return stdin_caller($class, "is_bacterial", $arg);
265 :     }
266 : disz 1.1
267 : disz 1.3 =begin WSDL
268 :     _IN in $string
269 :     _RETURN $string
270 :     _DOC Input is a single column table of pegs, output is a single column table of eukaryotic pegs
271 :     =cut
272 :     sub is_eukaryotic {
273 :     my ($class, $arg) = @_;
274 :     return stdin_caller($class, "is_eukaryotic", $arg);
275 :     }
276 : disz 1.1
277 : disz 1.3 =begin WSDL
278 :     _IN in $string
279 :     _RETURN $string
280 :     _DOC Input is a single column table of pegs, output is a single column table of prokaryotic pegs
281 :     =cut
282 :     sub is_prokaryotic {
283 :     my ($class, $arg) = @_;
284 :     return stdin_caller($class, "is_prokaryotic", $arg);
285 : disz 1.1 }
286 :    
287 : disz 1.3 =begin WSDL
288 :     _IN in $string
289 :     _RETURN $string
290 :     _DOC Input is a peg, output is peg-Translation
291 :     =cut
292 :     sub translation_of {
293 :     my ($class, $arg) = @_;
294 :     return stdin_caller($class, "translation_of", $arg);
295 :     }
296 : disz 1.1
297 : disz 1.3 =begin WSDL
298 :     _IN in $string
299 :     _RETURN $string
300 :     _DOC Input is a peg, output is tab separated string of aliases
301 :     =cut
302 :     sub aliases_of {
303 :     my ($class, $arg) = @_;
304 :     return stdin_caller($class, "aliases_of", $arg);
305 :     }
306 : disz 1.1
307 : disz 1.3 =begin WSDL
308 :     _IN in $string
309 :     _RETURN $string
310 :     _DOC Input is an alias, output is a peg
311 :     =cut
312 :     sub alias2fig {
313 :     my ($class, $arg) = @_;
314 :     return stdin_caller($class, "alias2fig", $arg);
315 : disz 1.1 }
316 :    
317 :    
318 : disz 1.3
319 :     =begin WSDL
320 :     _IN in $string ec code
321 :     _RETURN $string ec name
322 :     _DOC Input is aec code , output is ec name
323 :     =cut
324 : disz 1.2 sub ec_name {
325 :     my $class = shift();
326 :     my $fig = new FIG;
327 :     my $result = $fig->ec_name(@_);
328 :     return $result;
329 :     }
330 :    
331 : disz 1.3 =begin WSDL
332 :     _IN in $string
333 :     _RETURN @string
334 :     _DOC Input is a peg, output is list of 4 tuples
335 :     =cut
336 : disz 1.2 sub abstract_coupled_to {
337 :     my $class = shift();
338 :     my $fig = new FIG;
339 :     my @result = $fig->abstract_coupled_to(@_);
340 :     return @result;
341 :     }
342 :    
343 : disz 1.3 =begin WSDL
344 :     _IN complete $string
345 :     _IN restrictions $string
346 :     _IN domain $string
347 :     _RETURN @string
348 :     _DOC Input is constraints, output is list of genomes
349 :     =cut
350 : disz 1.1 sub genomes {
351 :     my $class = shift();
352 :     my $fig = new FIG;
353 :     my @result = $fig->genomes(@_);
354 : disz 1.3 my @genomes;
355 :     foreach my $genome (@result)
356 :     {
357 :     print STDERR "Genome is -$genome-\n";
358 :    
359 :     my $genus_species = $fig->genus_species($genome);
360 :     push @genomes, join("\t",$genome,$genus_species);
361 :     # print STDERR join("\t",$genome,$genus_species);
362 :     }
363 :    
364 :     #print STDERR @genomes;
365 :     return @genomes;
366 :     #return @result;
367 :     }
368 :    
369 :     =begin WSDL
370 :     _IN in $string
371 :     _RETURN @string
372 :     _DOC Input is a peg, output is list of loc on contig
373 :     =cut
374 : disz 1.1 sub feature_location {
375 :     my ($class, $arg1) = @_;
376 :     my $fig = new FIG;
377 : disz 1.2 my @result = ($fig->feature_location($arg1));
378 : disz 1.1 return @result;
379 :     }
380 :    
381 : disz 1.3 =begin WSDL
382 :     _IN in $string
383 :     _RETURN $string
384 :     _DOC Input is a peg, output is translation
385 :     =cut
386 : disz 1.1 sub get_translation {
387 :     my ($class, $arg1) = @_;
388 :     my $fig = new FIG;
389 :     my $result = $fig->get_translation($arg1);
390 :     return $result;
391 :     }
392 :    
393 : disz 1.3 =begin WSDL
394 :     _IN pat1 $string
395 :     _IN pat2 $string
396 :     _RETURN @string
397 :     _DOC Input is two patterns, first one is used in search_index, second used to grep the results
398 :     =cut
399 : disz 1.1 sub search_and_grep {
400 :     my ($class, $arg1, $arg2) = @_;
401 :    
402 :     my $fig = new FIG;
403 :    
404 :     my ($pegs, $roles) = $fig->search_index($arg1);
405 :    
406 :     my (@result_list, $entry);
407 :    
408 :     for $entry (@$pegs) {
409 :     push (@result_list, grep(/$arg2/, @$entry));
410 :     }
411 :     push (@result_list, grep(/$arg2/, @$roles));
412 :     chomp @result_list;
413 :     my $return_value = join ("\n", @result_list);
414 :     return $return_value;
415 :     }
416 :    
417 : redwards 1.4
418 :     =begin WSDL
419 :     _IN pat1 $string
420 :     _RETURN @string
421 :     _DOC Input is a pattern to search for, output is tab separated list of pegs and roles
422 :     =cut
423 :     sub simple_search {
424 :     my ($class, $arg1)=@_;
425 :    
426 :     my $fig = new FIG;
427 :    
428 :     my ($pegs, $roles) = $fig->search_index($arg1);
429 :    
430 :     my (@result_list, $entry);
431 :    
432 :     for $entry (@$pegs) {
433 :     push (@result_list, (join("\t", @$entry)));
434 :     }
435 :    
436 :     push (@result_list, (join("\t", @$roles)));
437 :     chomp @result_list;
438 :     my $return_value = join ("\n", @result_list);
439 :     return $return_value;
440 :     }
441 :    
442 :    
443 : disz 1.3 =begin WSDL
444 :     _RETURN $string list of families
445 :     _DOC No Input, output is list of all families
446 :     =cut
447 :     sub all_families {
448 :     my ($class) = @_;
449 :     my $fig = new FIG;
450 :     my $figfams = new FigFams($fig);
451 : disz 1.1
452 : disz 1.3 my @out = $figfams->all_families;
453 :     print STDERR Dumper(@out);
454 :     return @out;
455 : disz 1.1 }
456 : disz 1.2
457 : disz 1.3 =begin WSDL
458 :     _RETURN $string list of families and funcs
459 :     _DOC No Input, output is list of all families
460 :     =cut
461 :     sub all_families_with_funcs {
462 : disz 1.2 my ($class) = @_;
463 :     my $fig = new FIG;
464 :     my $figfams = new FigFams($fig);
465 :    
466 : disz 1.3 my @out =$figfams->all_families_with_funcs;
467 : disz 1.2 return @out;
468 :     }
469 :    
470 : disz 1.3 =begin WSDL
471 :     _IN in $string list of famids
472 :     _RETURN $string 2 col table, famid, peg
473 :     _DOC Input is list of families, outoput is 2 col table of famid, peg
474 :     =cut
475 : disz 1.2 sub list_members {
476 :     my ($class, $famids) = @_;
477 :     my $fig = new FIG;
478 :     my $figfams = new FigFams($fig);
479 :     my @in = split(/\t/, $famids);
480 :     warn("Starting 2 list members $famids\n");
481 :     my @out = ();
482 :     foreach my $famid (@in)
483 :     {
484 :     my $famO = new FigFam($fig,$famid);
485 :     foreach my $peg ($famO->list_members)
486 :     {
487 :     push(@out,[$famid,$peg]);
488 :     }
489 :     }
490 :     return @out;
491 :     }
492 :    
493 : disz 1.3 =begin WSDL
494 :     _IN in $string list of pegs
495 :     _RETURN $string returns a 3-column table [PEG,Function,AliasesCommaSeparated]
496 :     _DOC Input is list of families,returns a 3-column table [PEG,Function,AliasesCommaSeparated]
497 :     =cut
498 : disz 1.2 sub CDS_data {
499 :     my ($class, $pegs) = @_;
500 :     my $fig = new FIG;
501 :     my $figfams = new FigFams($fig);
502 :     my @in = split(/\t/, $pegs);
503 :    
504 :     #warn("Starting CDS data $pegs\n");
505 :     #print STDERR &Dumper($pegs);
506 :    
507 :     my @out = ();
508 :     foreach my $peg (@in)
509 :     {
510 :     my @famids = $figfams->families_containing_peg($peg);
511 :     foreach my $famid (@famids)
512 :     {
513 :     push(@out,[$peg,scalar $fig->function_of($peg),[$fig->feature_aliases($peg)]]);
514 :     }
515 :     }
516 :     return @out;
517 :     }
518 :    
519 : disz 1.3 =begin WSDL
520 :     _IN in $string list of pegs
521 :     _RETURN $string a 2-column table [PEG,Sequence]
522 :     _DOC Input is list of families,returns a 2-column table [PEG,Sequence]
523 :     =cut
524 : disz 1.2 sub CDS_sequences {
525 :     my ($class, $pegs) = @_;
526 :     my $fig = new FIG;
527 :     my $figfams = new FigFams($fig);
528 :     my @in = split(/\t/, $pegs);
529 :    
530 :     #warn("Starting CDS seq $pegs\n");
531 :     #print STDERR &Dumper($pegs);
532 :     my @out = ();
533 :     foreach my $peg (@in)
534 :     {
535 :     push(@out,[$peg,$fig->get_translation($peg)]);
536 :     }
537 :     return @out;
538 :     }
539 :    
540 : disz 1.3 =begin WSDL
541 :     _IN in $string list of id seq pairs
542 :     _RETURN $string returns a 2-column table [Id,FamilyID]
543 :     _DOC Input is list of families,returns a 2-column table [Id,FamilyID]
544 :     =cut
545 : disz 1.2 sub is_member_of {
546 :     my ($class, $id_seqs) = @_;
547 :     my $fig = new FIG;
548 :     my $figfams = new FigFams($fig);
549 :     #warn("Doing is member $id_seqs\n");
550 :     #print STDERR &Dumper($id_seqs);
551 :    
552 :     my @in = split(/\n/, $id_seqs);
553 :     my @out = ();
554 :     foreach my $pair (@in)
555 :     {
556 :     my($id,$seq) = split(/\t/, $pair);
557 :     my($famO,undef) = $figfams->place_in_family($seq);
558 :     if ($famO)
559 :     {
560 :     push(@out,[$id,$famO->family_id]);
561 :     }
562 :     }
563 :     return @out;
564 :     }
565 :    
566 :    
567 : disz 1.3 sub stdin_caller {
568 :     my ($class, $name, $arg) = @_;
569 :     my($rd, $wr, $err, $pid, $std_err, $return_value, @std_out);
570 :     if (!($pid = open3($wr, $rd, $err, "$FIG_Config::bin/$name")))
571 :     {
572 :     die "Cannot run open3 $name: $!";
573 :     }
574 :    
575 :     $wr->write($arg);
576 :     close($wr);
577 :    
578 :     @std_out= <$rd>;
579 :     close($rd);
580 :     waitpid $pid, 0;
581 :     $return_value = join ("", @std_out);
582 :     return $return_value;
583 :     }
584 : redwards 1.4
585 :    
586 :    
587 :     =begin WSDL
588 :     _IN genome $string
589 :     _IN location1 $string
590 :     _IN location2 $string
591 :     _RETURN @string
592 :     _DOC Input is a genome ID and one or more locations in the form contig_start_stop, output is the DNA sequence
593 :     =cut
594 :     sub dna_sequence {
595 :     my ($class, $genome, @locations)=@_;
596 :     my $fig = new FIG;
597 :     my $seq=$fig->dna_seq($genome,@locations);
598 :     return $seq;
599 :     }
600 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3