[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.9 - (view) (download)

1 : redwards 1.9 #__perl__
2 :    
3 : disz 1.1 use strict;
4 : disz 1.2 use Carp;
5 : disz 1.1 use SOAP::Lite;
6 :     use IPC::Open3;
7 :     use FIGO;
8 :     use SOAP::Transport::HTTP;
9 : disz 1.3 use DBMaster;
10 :     use Job48;
11 :     use Data::Dumper;
12 : redwards 1.9 use GenomeMeta;
13 : disz 1.1
14 :     SOAP::Transport::HTTP::CGI
15 :     -> dispatch_to('Scripts')
16 :     -> handle;
17 :    
18 :     package Scripts;
19 : disz 1.2 use FIG;
20 :     use FIG_Config;
21 :     use Data::Dumper;
22 :     use FigFams;
23 :     use FigFam;
24 : disz 1.3 use IPC::Open3;
25 : redwards 1.9 use raelib;
26 : disz 1.3
27 :     =begin WSDL
28 :     _IN auth $string
29 :     _IN args $string
30 :     _RETURN $string jobid
31 :     _DOC Input is a hash with lots of parms and a fasta file, output is a job id | error
32 :     =cut
33 :     sub load_fasta_to_rast {
34 :     my ($class, %args) = @_;
35 :     open FILE, ">/tmp/foo";
36 :     print FILE $args{file};
37 :     #print STDERR &Dumper(\%args);
38 :     #print STDERR "PWD ", $args{password}, "\n";
39 :     #print STDERR "Dumped\n";
40 :    
41 :    
42 :     # We have to authenticate this user first. Check with Daniel how to do that
43 :     my $organism = {name => $args{genome_name},
44 :     tax_id => $args{tax_id},
45 :     lineage => $args{lineage},
46 :     genetic_code => $args{genetic_code}
47 :     };
48 :    
49 :     #print STDERR &Dumper($organism);
50 :     my $msg;
51 :     my $user = $args{user};
52 :     my $seed_id;
53 :     my $project_id = "Test Project";
54 :     my $filename = "/tmp/foo";
55 :    
56 :     my $data = prepare_data_for_create_job( $msg , $seed_id, $organism, $project_id, $filename, $user);
57 :     print STDERR &Dumper($data), "Data\n";
58 :     my ($job_number,$err) = Job48->create_new_job($data);
59 :    
60 :     print STDERR "job, err = $job_number, $err\n";
61 :     return(join ":", $err, $job_number);
62 :    
63 :     }
64 :    
65 :     sub prepare_data_for_create_job{
66 :     my ( $msg , $seed_id, $organism, $project_desc, $filename, $user) = @_;
67 :    
68 :     my $meta = { "upload.timestamp" => time,
69 :     "status.uploaded" => "complete",
70 :     "keep_genecalls" => "0",
71 :     "correction.automatic" => "1" ,
72 :     # "submit.candidate" => $msg,
73 :     # "replace.seedID" => $seed_id,
74 :     };
75 :    
76 :     print STDERR &Dumper($meta), "meta\n";
77 :     open(SEQFILE , "$filename") or die "Can't open file $filename!\n";
78 :     my $data = { taxonomy_id => $organism->{tax_id},
79 :     metagenome => 0,
80 :     genome => $organism->{name},
81 :     user => $user,
82 :     project => $project_desc,
83 :     taxonomy => $organism->{lineage},
84 :     genetic_code => $organism->{genetic_code},
85 :     sequence_file => \*SEQFILE,
86 :     meta => $meta
87 :     };
88 :    
89 :     # print STDERR "made data \n";
90 :    
91 :     # print STDERR &Dumper($data), "data\n";
92 :    
93 :    
94 :     return $data;
95 :     }
96 :    
97 :    
98 :     =begin WSDL
99 :     _IN in $string
100 :     _IN in $string
101 :     _RETURN $string status
102 : redwards 1.5 _DOC Input is a RAST job id, and username output is a status
103 : disz 1.3 =cut
104 :     sub check_rast_job {
105 :     my ($class, $job_id, $login_name) = @_;
106 :    
107 :     #print STDERR "Check $job_id, $login_name";
108 :     $ENV{DBHOST} = 'bioseed.mcs.anl.gov';
109 :     my $dbm = DBMaster->new('FortyEight_WebApplication');
110 :     my $users = $dbm->User->get_objects({ login => $login_name });
111 :     my $user;
112 :     if ($users && @$users) {
113 :     $user = $users->[0];
114 :     my ($stage, $status) = Job48->get_status_of_job($job_id, $user);
115 :     print STDERR "stage $stage, status $status\n";
116 :     return(join ":", $stage, $status);
117 :     } else {
118 :     # print STDERR "no users\n";
119 :     return("No users");
120 :     }
121 :     }
122 : disz 1.1
123 :    
124 : disz 1.3 =begin WSDL
125 :     _IN in $string
126 :     _RETURN $string
127 :     _DOC Input is a RAST jobid file, output is a big file
128 :     =cut
129 :     sub get_rast_results {
130 :     my ($class, $jobid) = @_;
131 :     return ("this should be a big file");
132 :     }
133 :    
134 : redwards 1.5
135 :     =begin WSDL
136 :     _IN job $string
137 :     _IN username $string
138 :     _RETURN $string bindings
139 :     _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.
140 :     =cut
141 :     sub mg_rast_subsystems {
142 :     my ($class, $job_id, $login_name) = @_;
143 :    
144 : redwards 1.9 my $orgdir=$class->_validate_mg_rast_user($job_id, $login_name);
145 :     if ($orgdir =~ /Access Error/ || !(-e $orgdir)) {return $orgdir}
146 :    
147 :     open(IN, "$orgdir/Subsystems/bindings") || return "No subsystems found\n";
148 :     return join("", <IN>);
149 :     }
150 :    
151 :     =begin WSDL
152 :     _IN job $string
153 :     _IN username $string
154 :     _RETURN $string counts
155 :     _DOC Input is a RAST job id and a username, output is a list of tuples of subsystem name and number of occurences
156 :     =cut
157 :     sub mg_rast_subsystem_counts {
158 :     my ($class, $job_id, $login_name) = @_;
159 :    
160 :     my $orgdir=$class->_validate_mg_rast_user($job_id, $login_name);
161 :     if ($orgdir =~ /Access Error/ || !(-e $orgdir)) {return $orgdir}
162 :    
163 :     open(IN, "$orgdir/Subsystems/bindings") || return "No subsystems found\n";
164 :     my %count;
165 :     while (<IN>)
166 :     {
167 :     my @a=split /\t/;
168 :     $count{$a[0]}++;
169 :     }
170 :    
171 :     return map {"$_\t$count{$_}\n"} sort {$a cmp $b} keys %count;
172 :     }
173 :    
174 :     =begin WSDL
175 :     _IN job $string
176 :     _IN username $string
177 :     _IN number $string
178 :     _RETURN $string bindings
179 :     _DOC Input is a RAST job id and a username, output is the DNA sequences in the job. The number is a limit in how many sequences will be returned.
180 :     =cut
181 :     sub mg_rast_sequences {
182 :     my ($class, $job_id, $login_name, $number) = @_;
183 :    
184 :     my $orgdir=$class->_validate_mg_rast_user($job_id, $login_name);
185 :     if ($orgdir =~ /Access Error/ || !(-e $orgdir)) {return $orgdir}
186 :    
187 :     my $fasta;
188 :     eval {$fasta = raelib->read_fasta("$orgdir/contigs")};
189 :     if ($@) {return "Error: $@"}
190 :     my $keys = raelib->rand([keys %$fasta]); # randomize the order of the sequences returned.
191 :     if ($number) {@$keys = splice(@$keys, 0, $number)}
192 :    
193 :     #return join("\n", "keys", @$keys);
194 :     return join("", map {$_ = ">$_\n".$fasta->{$_}."\n"} @$keys);
195 :     }
196 :    
197 :     =begin WSDL
198 :     _IN username $string
199 :     _RETURN $string
200 :     _DOC Input is a username and output is a comma separated list of the users jobs. Note that this list includes both the users jobs and jobs of their organization
201 :     =cut
202 :     sub mg_rast_user_jobs {
203 :     my ($class, $login_name) = @_;
204 :     my ($userj, $orgj)=$class->_user_mg_rast_jobs($login_name);
205 :     return join(",", @$userj, @$orgj);
206 :     }
207 :    
208 :     =begin WSDL
209 :     _IN job $string
210 :     _IN username $string
211 :     _RETURN $string
212 :     _DOC Input is a RAST job id and a username, output is a tuple of latitude and longitude where the sample was taken, if it is known. This is a single point for every sample, and if there is more than one location for a sample it is the average of all locations.
213 :     =cut
214 :     sub mg_rast_lat_lon {
215 :     my ($class, $job_id, $login_name) = @_;
216 :    
217 :     my $orgdir=$class->_validate_mg_rast_user($job_id, $login_name);
218 :     if ($orgdir =~ /Access Error/ || !(-e $orgdir)) {return $orgdir}
219 :    
220 :     my $meta = GenomeMeta->new(undef, "/vol/metagenome-48-hour/Jobs.prod/$job_id/meta.xml");
221 :     return $meta->get_metadata("optional_info.latitude") .",".$meta->get_metadata("optional_info.longitude");
222 :     }
223 :    
224 :     =begin WSDL
225 :     _IN job $string
226 :     _IN username $string
227 :     _RETURN $string
228 :     _DOC Input is a RAST job id and a username, output is the coordinates where the sample was taken. These are semi-colon separated tuples of lat-lon
229 :     =cut
230 :     sub mg_rast_coordinates {
231 :     my ($class, $job_id, $login_name) = @_;
232 : redwards 1.5
233 : redwards 1.9 my $orgdir=$class->_validate_mg_rast_user($job_id, $login_name);
234 :     if ($orgdir =~ /Access Error/ || !(-e $orgdir)) {return $orgdir}
235 :    
236 :     my $meta = GenomeMeta->new(undef, "/vol/metagenome-48-hour/Jobs.prod/$job_id/meta.xml");
237 :     return $meta->get_metadata("optional_info.coordinates");
238 :     }
239 : redwards 1.5
240 : redwards 1.9 =begin WSDL
241 :     _IN job $string
242 :     _IN username $string
243 :     _RETURN $string
244 :     _DOC Input is a RAST job id and a username, output is the date or time that the sample was taken.
245 :     =cut
246 :     sub mg_rast_time {
247 :     my ($class, $job_id, $login_name) = @_;
248 : redwards 1.6
249 : redwards 1.9 my $orgdir=$class->_validate_mg_rast_user($job_id, $login_name);
250 :     if ($orgdir =~ /Access Error/ || !(-e $orgdir)) {return $orgdir}
251 : redwards 1.6
252 : redwards 1.9 my $meta = GenomeMeta->new(undef, "/vol/metagenome-48-hour/Jobs.prod/$job_id/meta.xml");
253 :     return $meta->get_metadata("optional_info.time");
254 : redwards 1.5 }
255 :    
256 : redwards 1.9
257 : disz 1.3 =begin WSDL
258 :     _IN in $string
259 :     _RETURN $string
260 :     _DOC Input is an alias, output is a sequence
261 :     =cut
262 :     sub ali_to_seq {
263 :     my ($class, $arg) = @_;
264 :     return stdin_caller($class, "ali_to_seq", $arg);
265 : disz 1.1 }
266 :    
267 : disz 1.3 =begin WSDL
268 :     _IN in $string
269 :     _RETURN $string
270 : redwards 1.9 _DOC Input is a comma separated list of pegs, and output is the pegs in order along the genome.
271 : disz 1.3 =cut
272 :     sub adjacent {
273 :     my ($class, $arg) = @_;
274 : redwards 1.9 $arg =~ s/\,\s*/\n/g;
275 : disz 1.3 return stdin_caller($class, "adjacent", $arg);
276 :     }
277 : disz 1.1
278 : disz 1.3 =begin WSDL
279 :     _IN in $string
280 :     _RETURN $string
281 :     _DOC Input is a peg, output is two column table of peg\tcluster
282 :     =cut
283 :     sub cluster_by_bbhs {
284 :     my ($class, $arg) = @_;
285 :     return stdin_caller($class, "cluster_by_bbhs", $arg);
286 :     }
287 : disz 1.1
288 : disz 1.3 =begin WSDL
289 :     _IN in $string
290 :     _RETURN $string
291 :     _DOC Input is a peg, output is two column table of peg\cluster
292 :     =cut
293 :     sub cluster_by_sim {
294 : disz 1.1 my ($class, $arg) = @_;
295 : disz 1.3 return stdin_caller($class, "cluster_by_sim", $arg);
296 :     }
297 : disz 1.1
298 : disz 1.3 =begin WSDL
299 :     _IN in $string
300 :     _RETURN $string
301 :     _DOC Input is a peg, output is two column table of peg\text func
302 :     =cut
303 :     sub external_calls {
304 :     my ($class, $arg) = @_;
305 :     return stdin_caller($class, "external_calls", $arg);
306 :     }
307 : disz 1.1
308 : disz 1.3 =begin WSDL
309 :     _IN in $string
310 :     _RETURN $string
311 :     _DOC Input is a peg, output is a function
312 :     =cut
313 :     sub function_of {
314 :     my ($class, $arg) = @_;
315 : redwards 1.7 my $fig=new FIG;
316 :     return scalar($fig->function_of($arg));
317 : disz 1.3 }
318 : disz 1.1
319 : disz 1.3 =begin WSDL
320 :     _IN in $string
321 :     _RETURN $string
322 :     _DOC Input is a peg, output is a single column table of genomes
323 :     =cut
324 :     sub genomes_of {
325 :     my ($class, $arg) = @_;
326 :     return stdin_caller($class, "genomes_of", $arg);
327 :     }
328 : disz 1.1
329 : redwards 1.7
330 :     =begin WSDL
331 :     _IN genome $string
332 :     _RETURN $string
333 :     _DOC Input is a genome ID, output is the genus and species of the genome
334 :     =cut
335 :     sub genus_species {
336 :     my ($class, $arg) = @_;
337 :     my $fig=new FIG;
338 :     return $fig->genus_species($arg);
339 :     }
340 :    
341 :    
342 : disz 1.3 =begin WSDL
343 :     _IN in $string
344 :     _RETURN $string
345 :     _DOC Input is a single column table of pegs, output is a single column table of fasta.DNA
346 :     =cut
347 :     sub fid2dna {
348 :     my ($class, $arg) = @_;
349 :     return stdin_caller($class, "fid2dna", $arg);
350 :     }
351 : disz 1.1
352 : disz 1.3 =begin WSDL
353 :     _IN in $string
354 :     _RETURN $string
355 : redwards 1.7 _DOC Input is a genome id, output is a list of pegs in that genome
356 :     =cut
357 :     sub pegs_of {
358 :     my ($class, $arg) = @_;
359 :     my $fig = new FIG;
360 :     return (join ",", $fig->pegs_of($arg));
361 :     }
362 :    
363 :     =begin WSDL
364 :     _IN genome $string
365 :     _IN contig $string
366 :     _RETURN $string
367 :     _DOC Input is a genome id and a contig name, return is the length of the contig
368 :     =cut
369 :     sub contig_ln {
370 :     my $class = shift();
371 :     my $fig = new FIG;
372 :     return $fig->contig_ln(@_);
373 :     }
374 :    
375 :     =begin WSDL
376 :     _IN in $string
377 :     _RETURN $string
378 : disz 1.3 _DOC Input is a single column table of pegs, output is a single column table of archaeal pegs
379 :     =cut
380 :     sub is_archaeal {
381 :     my ($class, $arg) = @_;
382 :     return stdin_caller($class, "is_archaeal", $arg);
383 :     }
384 : disz 1.1
385 : disz 1.3 =begin WSDL
386 :     _IN in $string
387 :     _RETURN $string
388 :     _DOC Input is a single column table of pegs, output is a single column table of bacterial pegs
389 :     =cut
390 :     sub is_bacterial {
391 :     my ($class, $arg) = @_;
392 :     return stdin_caller($class, "is_bacterial", $arg);
393 :     }
394 : disz 1.1
395 : disz 1.3 =begin WSDL
396 :     _IN in $string
397 :     _RETURN $string
398 :     _DOC Input is a single column table of pegs, output is a single column table of eukaryotic pegs
399 :     =cut
400 :     sub is_eukaryotic {
401 :     my ($class, $arg) = @_;
402 :     return stdin_caller($class, "is_eukaryotic", $arg);
403 :     }
404 : disz 1.1
405 : disz 1.3 =begin WSDL
406 :     _IN in $string
407 :     _RETURN $string
408 :     _DOC Input is a single column table of pegs, output is a single column table of prokaryotic pegs
409 :     =cut
410 :     sub is_prokaryotic {
411 :     my ($class, $arg) = @_;
412 :     return stdin_caller($class, "is_prokaryotic", $arg);
413 : disz 1.1 }
414 :    
415 : disz 1.3 =begin WSDL
416 :     _IN in $string
417 :     _RETURN $string
418 :     _DOC Input is a peg, output is peg-Translation
419 :     =cut
420 :     sub translation_of {
421 :     my ($class, $arg) = @_;
422 :     return stdin_caller($class, "translation_of", $arg);
423 :     }
424 : disz 1.1
425 : disz 1.3 =begin WSDL
426 :     _IN in $string
427 :     _RETURN $string
428 :     _DOC Input is a peg, output is tab separated string of aliases
429 :     =cut
430 :     sub aliases_of {
431 :     my ($class, $arg) = @_;
432 :     return stdin_caller($class, "aliases_of", $arg);
433 :     }
434 : disz 1.1
435 : disz 1.3 =begin WSDL
436 :     _IN in $string
437 :     _RETURN $string
438 :     _DOC Input is an alias, output is a peg
439 :     =cut
440 :     sub alias2fig {
441 :     my ($class, $arg) = @_;
442 :     return stdin_caller($class, "alias2fig", $arg);
443 : disz 1.1 }
444 :    
445 :    
446 : disz 1.3
447 :     =begin WSDL
448 :     _IN in $string ec code
449 :     _RETURN $string ec name
450 :     _DOC Input is aec code , output is ec name
451 :     =cut
452 : disz 1.2 sub ec_name {
453 :     my $class = shift();
454 :     my $fig = new FIG;
455 :     my $result = $fig->ec_name(@_);
456 :     return $result;
457 :     }
458 :    
459 : disz 1.3 =begin WSDL
460 :     _IN in $string
461 : redwards 1.8 _RETURN $string
462 :     _DOC Input is a peg, output is list of [protein, score] for things that are coupled to this peg
463 :     =cut
464 :     sub coupled_to {
465 :     my $class = shift();
466 :     my $fig = new FIG;
467 :     my $return=undef;
468 :     my @result = $fig->coupled_to(@_);
469 :     if (@result)
470 :     {
471 :     $return = join("\n", map {$_->[0].",".$_->[1]} @result);
472 :     }
473 :     return $return;
474 :     }
475 :    
476 :     =begin WSDL
477 :     _IN in $string
478 :     _RETURN $string
479 :     _DOC Input is a peg, output is list of [protein, score] for things that are coupled to this peg
480 : disz 1.3 =cut
481 : disz 1.2 sub abstract_coupled_to {
482 :     my $class = shift();
483 :     my $fig = new FIG;
484 : redwards 1.8 my $return=undef;
485 : disz 1.2 my @result = $fig->abstract_coupled_to(@_);
486 : redwards 1.8 if (@result)
487 :     {
488 :     $return = join("\n", map {$_->[0].",".$_->[1]} @result);
489 :     }
490 :     return $return;
491 : disz 1.2 }
492 :    
493 : disz 1.3 =begin WSDL
494 :     _IN complete $string
495 :     _IN restrictions $string
496 :     _IN domain $string
497 :     _RETURN @string
498 : redwards 1.7 _DOC Input is constraints, output is a comma separated list of genomes
499 :     =cut
500 :     sub all_genomes {
501 :     my $class = shift();
502 :     my $fig=new FIG;
503 :     my @genomes=$fig->genomes(@_);
504 :     return join(",", @genomes);
505 :     }
506 :    
507 :     =begin WSDL
508 :     _IN complete $string
509 :     _IN restrictions $string
510 :     _IN domain $string
511 :     _RETURN @string
512 : disz 1.3 _DOC Input is constraints, output is list of genomes
513 :     =cut
514 : disz 1.1 sub genomes {
515 :     my $class = shift();
516 :     my $fig = new FIG;
517 :     my @result = $fig->genomes(@_);
518 : disz 1.3 my @genomes;
519 :     foreach my $genome (@result)
520 :     {
521 :     print STDERR "Genome is -$genome-\n";
522 :    
523 :     my $genus_species = $fig->genus_species($genome);
524 :     push @genomes, join("\t",$genome,$genus_species);
525 :     # print STDERR join("\t",$genome,$genus_species);
526 :     }
527 :    
528 :     #print STDERR @genomes;
529 :     return @genomes;
530 :     #return @result;
531 :     }
532 :    
533 :     =begin WSDL
534 :     _IN in $string
535 :     _RETURN @string
536 :     _DOC Input is a peg, output is list of loc on contig
537 :     =cut
538 : disz 1.1 sub feature_location {
539 :     my ($class, $arg1) = @_;
540 :     my $fig = new FIG;
541 : disz 1.2 my @result = ($fig->feature_location($arg1));
542 : disz 1.1 return @result;
543 :     }
544 :    
545 : disz 1.3 =begin WSDL
546 :     _IN in $string
547 :     _RETURN $string
548 :     _DOC Input is a peg, output is translation
549 :     =cut
550 : disz 1.1 sub get_translation {
551 :     my ($class, $arg1) = @_;
552 :     my $fig = new FIG;
553 :     my $result = $fig->get_translation($arg1);
554 :     return $result;
555 :     }
556 :    
557 : disz 1.3 =begin WSDL
558 :     _IN pat1 $string
559 :     _IN pat2 $string
560 :     _RETURN @string
561 :     _DOC Input is two patterns, first one is used in search_index, second used to grep the results
562 :     =cut
563 : disz 1.1 sub search_and_grep {
564 :     my ($class, $arg1, $arg2) = @_;
565 :    
566 :     my $fig = new FIG;
567 :    
568 :     my ($pegs, $roles) = $fig->search_index($arg1);
569 :    
570 :     my (@result_list, $entry);
571 :    
572 :     for $entry (@$pegs) {
573 :     push (@result_list, grep(/$arg2/, @$entry));
574 :     }
575 :     push (@result_list, grep(/$arg2/, @$roles));
576 :     chomp @result_list;
577 :     my $return_value = join ("\n", @result_list);
578 :     return $return_value;
579 :     }
580 :    
581 : redwards 1.4
582 :     =begin WSDL
583 :     _IN pat1 $string
584 :     _RETURN @string
585 :     _DOC Input is a pattern to search for, output is tab separated list of pegs and roles
586 :     =cut
587 :     sub simple_search {
588 :     my ($class, $arg1)=@_;
589 :    
590 :     my $fig = new FIG;
591 :    
592 :     my ($pegs, $roles) = $fig->search_index($arg1);
593 :    
594 :     my (@result_list, $entry);
595 :    
596 :     for $entry (@$pegs) {
597 :     push (@result_list, (join("\t", @$entry)));
598 :     }
599 :    
600 :     push (@result_list, (join("\t", @$roles)));
601 :     chomp @result_list;
602 :     my $return_value = join ("\n", @result_list);
603 :     return $return_value;
604 :     }
605 :    
606 :    
607 : disz 1.3 =begin WSDL
608 :     _RETURN $string list of families
609 :     _DOC No Input, output is list of all families
610 :     =cut
611 :     sub all_families {
612 :     my ($class) = @_;
613 :     my $fig = new FIG;
614 :     my $figfams = new FigFams($fig);
615 : disz 1.1
616 : disz 1.3 my @out = $figfams->all_families;
617 :     print STDERR Dumper(@out);
618 :     return @out;
619 : disz 1.1 }
620 : disz 1.2
621 : disz 1.3 =begin WSDL
622 :     _RETURN $string list of families and funcs
623 :     _DOC No Input, output is list of all families
624 :     =cut
625 :     sub all_families_with_funcs {
626 : disz 1.2 my ($class) = @_;
627 :     my $fig = new FIG;
628 :     my $figfams = new FigFams($fig);
629 :    
630 : disz 1.3 my @out =$figfams->all_families_with_funcs;
631 : disz 1.2 return @out;
632 :     }
633 :    
634 : disz 1.3 =begin WSDL
635 :     _IN in $string list of famids
636 :     _RETURN $string 2 col table, famid, peg
637 :     _DOC Input is list of families, outoput is 2 col table of famid, peg
638 :     =cut
639 : disz 1.2 sub list_members {
640 :     my ($class, $famids) = @_;
641 :     my $fig = new FIG;
642 :     my $figfams = new FigFams($fig);
643 :     my @in = split(/\t/, $famids);
644 :     warn("Starting 2 list members $famids\n");
645 :     my @out = ();
646 :     foreach my $famid (@in)
647 :     {
648 :     my $famO = new FigFam($fig,$famid);
649 :     foreach my $peg ($famO->list_members)
650 :     {
651 :     push(@out,[$famid,$peg]);
652 :     }
653 :     }
654 :     return @out;
655 :     }
656 :    
657 : disz 1.3 =begin WSDL
658 :     _IN in $string list of pegs
659 :     _RETURN $string returns a 3-column table [PEG,Function,AliasesCommaSeparated]
660 :     _DOC Input is list of families,returns a 3-column table [PEG,Function,AliasesCommaSeparated]
661 :     =cut
662 : disz 1.2 sub CDS_data {
663 :     my ($class, $pegs) = @_;
664 :     my $fig = new FIG;
665 :     my $figfams = new FigFams($fig);
666 :     my @in = split(/\t/, $pegs);
667 :    
668 :     #warn("Starting CDS data $pegs\n");
669 :     #print STDERR &Dumper($pegs);
670 :    
671 :     my @out = ();
672 :     foreach my $peg (@in)
673 :     {
674 :     my @famids = $figfams->families_containing_peg($peg);
675 :     foreach my $famid (@famids)
676 :     {
677 :     push(@out,[$peg,scalar $fig->function_of($peg),[$fig->feature_aliases($peg)]]);
678 :     }
679 :     }
680 :     return @out;
681 :     }
682 :    
683 : disz 1.3 =begin WSDL
684 :     _IN in $string list of pegs
685 :     _RETURN $string a 2-column table [PEG,Sequence]
686 :     _DOC Input is list of families,returns a 2-column table [PEG,Sequence]
687 :     =cut
688 : disz 1.2 sub CDS_sequences {
689 :     my ($class, $pegs) = @_;
690 :     my $fig = new FIG;
691 :     my $figfams = new FigFams($fig);
692 :     my @in = split(/\t/, $pegs);
693 :    
694 :     #warn("Starting CDS seq $pegs\n");
695 :     #print STDERR &Dumper($pegs);
696 :     my @out = ();
697 :     foreach my $peg (@in)
698 :     {
699 :     push(@out,[$peg,$fig->get_translation($peg)]);
700 :     }
701 :     return @out;
702 :     }
703 :    
704 : disz 1.3 =begin WSDL
705 :     _IN in $string list of id seq pairs
706 :     _RETURN $string returns a 2-column table [Id,FamilyID]
707 :     _DOC Input is list of families,returns a 2-column table [Id,FamilyID]
708 :     =cut
709 : disz 1.2 sub is_member_of {
710 :     my ($class, $id_seqs) = @_;
711 :     my $fig = new FIG;
712 :     my $figfams = new FigFams($fig);
713 :     #warn("Doing is member $id_seqs\n");
714 :     #print STDERR &Dumper($id_seqs);
715 :    
716 :     my @in = split(/\n/, $id_seqs);
717 :     my @out = ();
718 :     foreach my $pair (@in)
719 :     {
720 :     my($id,$seq) = split(/\t/, $pair);
721 :     my($famO,undef) = $figfams->place_in_family($seq);
722 :     if ($famO)
723 :     {
724 :     push(@out,[$id,$famO->family_id]);
725 :     }
726 :     }
727 :     return @out;
728 :     }
729 :    
730 : redwards 1.9 =begin WSDL
731 :     _IN peg $string
732 :     _IN maxN $string
733 :     _IN maxP $string
734 :     _RETURN $string
735 :     _DOC Input is a peg, an optional maximum number of hits (default=50), and an optional maximum E value (default=1e-5), return is a list of sims
736 :     =cut
737 :     sub sims {
738 :     my ($class, $peg, $maxN, $maxP)=@_;
739 :     unless (defined $maxN) {$maxN=50}
740 :     unless (defined $maxP) {$maxP=1e-5}
741 :     my $fig=new FIG;
742 :     my $return=undef;
743 :     foreach my $sim ($fig->sims($peg, $maxN, $maxP, 'figx'))
744 :     {
745 :     $return .= join("\t", @$sim). "\n";
746 :     }
747 :    
748 :     return $return;
749 :     }
750 :    
751 : disz 1.2
752 : disz 1.3 sub stdin_caller {
753 :     my ($class, $name, $arg) = @_;
754 :     my($rd, $wr, $err, $pid, $std_err, $return_value, @std_out);
755 :     if (!($pid = open3($wr, $rd, $err, "$FIG_Config::bin/$name")))
756 :     {
757 :     die "Cannot run open3 $name: $!";
758 :     }
759 :    
760 :     $wr->write($arg);
761 :     close($wr);
762 :    
763 :     @std_out= <$rd>;
764 :     close($rd);
765 :     waitpid $pid, 0;
766 :     $return_value = join ("", @std_out);
767 :     return $return_value;
768 :     }
769 : redwards 1.4
770 :    
771 :    
772 :     =begin WSDL
773 :     _IN genome $string
774 :     _IN location1 $string
775 :     _IN location2 $string
776 :     _RETURN @string
777 :     _DOC Input is a genome ID and one or more locations in the form contig_start_stop, output is the DNA sequence
778 :     =cut
779 :     sub dna_sequence {
780 :     my ($class, $genome, @locations)=@_;
781 :     my $fig = new FIG;
782 :     my $seq=$fig->dna_seq($genome,@locations);
783 :     return $seq;
784 :     }
785 :    
786 : redwards 1.9
787 :    
788 :     sub _validate_mg_rast_user {
789 :     # a common method for validating a user. Please note that at the moment this does not use the password (but it should!)
790 :     # this is shared by several things above.
791 :    
792 :     # If the user is valid will return a path to the job directory, otherwise will return "Access Error"
793 :    
794 :     my ($self, $job_id, $login_name)=@_;
795 :     $ENV{DBHOST} = 'bioseed.mcs.anl.gov';
796 :     my $dbm = DBMaster->new(-database => 'FortyEight_WebApplication');
797 :     my $users = $dbm->User->get_objects({ login => $login_name });
798 :     my $org=$users->[0]->{organisation};
799 :     my $user;
800 :    
801 :     # get the metagenome job directory. This is hard wired at the moment, but
802 :     # shouldn't be. Not sure if the job directory is in FIG_Config
803 :     # Also, I return "Access Error" regardless of whether the job is there or not to stop people
804 :     # hacking.
805 :     $job_id="/vol/metagenome-48-hour/Jobs.prod/$job_id";
806 :     return "Access Error 1" unless (-e $job_id); # simple check that we have that id
807 :    
808 :     # now make sure we are a valid user. If we are not a valid user this should throw an error
809 :    
810 :     my $job;
811 :     eval {$job = Job48->new($job_id, $user->[0])};
812 :     if ($@ || !$job) {return "Access Error 2"}
813 :    
814 :     # another user check -- this is just a simple check and doesn't allow for public data or common
815 :     # organizations, so it is not as good. But it works
816 :     return "Access Error 3" unless ($job->user eq $login_name || $job->getUserObject->{organisation} == $org);
817 :    
818 :     return "Access Error: job deleted" if ($job->to_be_deleted);
819 :    
820 :     my $orgdir=$job->orgdir;
821 :    
822 :     return $orgdir;
823 :     }
824 :    
825 :     sub _user_mg_rast_jobs {
826 :     # a method to extract all the jobs for a user. Returns references to two arrays.
827 :     # The first is user jobs, and the second is jobs of the users organization
828 :     my ($self, $login_name)=@_;
829 :     $ENV{DBHOST} = 'bioseed.mcs.anl.gov';
830 :     my $dbm = DBMaster->new(-database => 'FortyEight_WebApplication');
831 :     my $users = $dbm->User->get_objects({ login => $login_name });
832 :     my $org=$users->[0]->{organisation};
833 :    
834 :     my @user; my @org;
835 :    
836 :     opendir(DIR, "/vol/metagenome-48-hour/Jobs.prod/") || die "Can't open /vol/metagenome-48-hour/Jobs.prod/";
837 :     foreach my $dir (grep {m/^\d+$/} readdir(DIR))
838 :     {
839 :     my $job_id="/vol/metagenome-48-hour/Jobs.prod/$dir";
840 :     my $job;
841 :     eval {$job = Job48->new($job_id)};
842 :     die $@ if ($@ || !$job);
843 :     next if ($job->to_be_deleted);
844 :     ($job->user eq $login_name) ? push @user, $job->id :
845 :     ($job->getUserObject->{organisation} == $org) ? push @org, $job->id : 1;
846 :     }
847 :     @user = sort {$a <=> $b} @user;
848 :     @org = sort {$a <=> $b} @org;
849 :    
850 :     return \@user, \@org;
851 :     }
852 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3