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

Annotation of /FigKernelPackages/RAST_submission.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1
2 :     package RAST_submission;
3 :    
4 : olson 1.4
5 : olson 1.1 use strict;
6 :     use Job48;
7 :     use JobUpload;
8 :     use Data::Dumper;
9 : olson 1.4 use FIG;
10 :     use FIG_Config;
11 :     use gjoseqlib;
12 : olson 1.7 use XML::LibXML;
13 : olson 1.4
14 :     use LWP::UserAgent;
15 :     use Bio::DB::RefSeq;
16 :     use Bio::SeqIO;
17 : olson 1.1
18 :     use base 'Class::Accessor';
19 :    
20 : olson 1.4 __PACKAGE__->mk_accessors(qw(rast_dbmaster user_dbmaster user_obj project_cache_dir
21 :     contig_cache_dir max_cache_age ua));
22 : olson 1.1
23 :     sub new
24 :     {
25 :     my($class, $rast_dbmaster, $user_dbmaster, $user_obj) = @_;
26 :    
27 :     my $self = {
28 :     rast_dbmaster => $rast_dbmaster,
29 :     user_dbmaster => $user_dbmaster,
30 :     user_obj => $user_obj,
31 : olson 1.4 project_cache_dir => "$FIG_Config::var/ncbi_project_cache",
32 :     contig_cache_dir => "$FIG_Config::var/ncbi_contig_cache",
33 :     max_cache_age => 86400,
34 :     ua => LWP::UserAgent->new(),
35 : olson 1.13 url_retries => [1, 5, 20],
36 :     codes_to_retry => { map { $_ => 1 } qw(408 500 502 503 504) }
37 : olson 1.1 };
38 :    
39 : olson 1.4 &FIG::verify_dir($self->{project_cache_dir});
40 :     &FIG::verify_dir($self->{contig_cache_dir});
41 :    
42 : olson 1.1
43 :     return bless $self, $class;
44 :     }
45 :    
46 : olson 1.4 sub get_contig_ids_in_project_from_entrez
47 :     {
48 :     my($self, $params) = @_;
49 :    
50 :     #
51 :     # Determine the project ID to use. Which one we take depends on if
52 :     # we were passed a project id, a tax id, or a contig id.
53 :     #
54 :    
55 :     my $proj;
56 :     if ($params->{-tax_id})
57 :     {
58 :     }
59 :     elsif ($params->{-contig_id})
60 :     {
61 :     $proj = $self->determine_project_of_contig($params->{-contig_id});
62 :     }
63 :     elsif ($params->{-project_id})
64 :     {
65 :     $proj = $params->{-project_id};
66 :     }
67 :    
68 :     print STDERR "project is $proj\n";
69 :     my $project_data = $self->retrieve_project_data($proj);
70 :    
71 :     return $self->check_project_for_redundancy($project_data);
72 :     }
73 :    
74 : olson 1.5 sub get_contigs_from_entrez
75 :     {
76 :     my($self, $params) = @_;
77 :    
78 :     my $id_list = $params->{-id};
79 :     if (!ref($id_list))
80 :     {
81 :     $id_list = [$id_list];
82 :     }
83 :    
84 :     my @ret;
85 :     for my $id (@$id_list)
86 :     {
87 : olson 1.6 my $ent = { id => $id };
88 :    
89 : olson 1.5 my $file = $self->retrieve_contig_data($id);
90 : olson 1.6
91 : olson 1.5 open(F, "<", $file);
92 : olson 1.12
93 : olson 1.6 my $txt = <F>;
94 : olson 1.12 my $cur_section;
95 :     my $cur_subsection;
96 : olson 1.6 if ($txt =~ /^LOCUS.*?(\d+)\s+bp/)
97 :     {
98 :     $ent->{length} = $1;
99 : olson 1.12 $cur_section= "LOCUS";
100 : olson 1.6 }
101 :    
102 : olson 1.12 my @sources;
103 :     $_ = <F>;
104 :     $txt .= $_;
105 :     while (defined($_))
106 : olson 1.6 {
107 : olson 1.12 if (/^(\S+)/)
108 :     {
109 :     $cur_section = $1;
110 :     undef $cur_subsection;
111 :     }
112 :    
113 :     if ($cur_section eq 'SOURCE' && /^\s+ORGANISM\s+(.*)/)
114 : olson 1.6 {
115 :     $ent->{name} = $1;
116 :     }
117 :     elsif (/^DBLINK\s+Project:(\d+)/)
118 :     {
119 :     $ent->{project} = $1;
120 :     }
121 : olson 1.12
122 :     if ($cur_section eq 'FEATURES')
123 : olson 1.6 {
124 : olson 1.12 #
125 :     # If we encounter a source, read all the lines
126 :     # of the source and process the continuations.
127 :     #
128 :    
129 :     if (/^ {5}source/)
130 :     {
131 :     my $slines = [];
132 :     push(@sources, $slines);
133 :     my $cur_line = $_;
134 :     $_ = <F>;
135 :     $txt .= $_;
136 :     chomp;
137 :     while (defined($_))
138 :     {
139 :     if (m,^ {5}\S,)
140 :     {
141 :     push(@$slines, $cur_line);
142 :     last;
143 :     }
144 :     if (m,^ {21}/,)
145 :     {
146 :     push(@$slines, $cur_line);
147 :     $cur_line = $_;
148 :     }
149 :     else
150 :     {
151 :     s/^\s+/ /;
152 :     $cur_line .= $_;
153 :     }
154 :     $_ = <F>;
155 :     $txt .= $_;
156 :     chomp;
157 :     }
158 :     next;
159 :     }
160 : olson 1.6 }
161 : olson 1.12 $_ = <F>;
162 :     $txt .= $_;
163 : olson 1.6 }
164 :     $ent->{contents} = $txt;
165 : olson 1.5
166 : olson 1.12 #
167 :     # Determine the taxonomy id. If one of the sources in the source list
168 :     # has the same /organism name as the overall SOURCE, use that source's
169 :     # taxon ID. Otherwise use the first one in the list.
170 :     #
171 :    
172 :     my $tax_id;
173 :     my $first_tax_id;
174 :    
175 :     for my $src_lines (@sources)
176 :     {
177 :     my($org, $tax);
178 :     for my $l (@$src_lines)
179 :     {
180 :     if ($l =~ m,/organism="(.*)",)
181 :     {
182 :     $org = $1;
183 :     }
184 :     elsif ($l =~ m,/db_xref="taxon:(\d+)",)
185 :     {
186 :     $tax = $1;
187 :     if (!defined($first_tax_id))
188 :     {
189 :     $first_tax_id = $tax;
190 :     }
191 :     }
192 :     }
193 :     if ($org eq $ent->{name})
194 :     {
195 :     $tax_id = $tax;
196 :     }
197 :     }
198 :    
199 :     if ($tax_id eq '' && $first_tax_id ne '')
200 :     {
201 :     $tax_id = $first_tax_id;
202 :     }
203 :     $ent->{taxonomy_id} = $tax_id;
204 :    
205 : olson 1.5 close(F);
206 : olson 1.6
207 : olson 1.7 if ($ent->{taxonomy_id})
208 :     {
209 :     #
210 :     # Pull the taxonomy database entry from NCBI.
211 :     #
212 :    
213 :     my $tdata = $self->get_taxonomy_data($ent->{taxonomy_id});
214 :     if ($tdata)
215 :     {
216 :     $ent->{domain} = $tdata->{domain};
217 :     $ent->{taxonomy} = $tdata->{taxonomy};
218 :     $ent->{genetic_code} = $tdata->{genetic_code};
219 :     }
220 :     }
221 : olson 1.6 push(@ret, $ent);
222 : olson 1.5 }
223 :     return \@ret;
224 :     }
225 : olson 1.12
226 : olson 1.5
227 : olson 1.7 sub get_taxonomy_data
228 :     {
229 :     my($self, $tax_id) = @_;
230 :    
231 : olson 1.13 my $res = $self->url_get("http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=taxonomy&id=$tax_id&report=sgml&mode=text");
232 : olson 1.7 if ($res->is_success)
233 :     {
234 :     my $ent = {};
235 :     my $doc = XML::LibXML->new->parse_string($res->content);
236 :    
237 :     my $lin = $doc->findvalue('//Taxon/Lineage');
238 :     $lin =~ s/^cellular organisms;\s+//;
239 :     my $domain = $lin;
240 :     $domain =~ s/;.*$//;
241 :     my $code = $doc->findvalue('//Taxon/GeneticCode/GCId');
242 :    
243 :     $ent->{domain} = $domain;
244 :     $ent->{taxonomy} = $lin;
245 :     $ent->{genetic_code} = $code;
246 :     return $ent;
247 :     }
248 :     return undef;
249 :     }
250 :    
251 : olson 1.4 sub determine_project_of_contig
252 :     {
253 :     my($self, $contig_id) = @_;
254 :    
255 :     my $file = $self->retrieve_contig_data($contig_id);
256 :     open(F, "<", $file) or die "cannot open contig data $file: $!";
257 :    
258 :     my $proj;
259 :     while (<F>)
260 :     {
261 :     if (/DBLINK\s+Project:(\d+)/)
262 :     {
263 :     $proj = $1;
264 :     last;
265 :     }
266 :     }
267 :     close(F);
268 :     return $proj;
269 :    
270 :     }
271 :    
272 :     sub check_project_for_redundancy
273 :     {
274 :     my($self, $file) = @_;
275 :    
276 :     my $seqio_object = Bio::SeqIO->new(
277 :     -file => $file ,
278 :     -format => "genbank",
279 :     );
280 :    
281 :     my @seqs;
282 :     my @ids;
283 :     while ( my $seq = $seqio_object->next_seq ) {
284 :     push(@seqs, [$seq->accession_number, $seq->seq]);
285 :     push(@ids, $seq->accession_number);
286 :     }
287 :    
288 :     my @redundancy = $self->test_for_redundancy(\@seqs);
289 :     return { ids => \@ids, redundancy_report => \@redundancy };
290 :     }
291 :    
292 :     sub test_for_redundancy {
293 :     my($self, $seqs) = @_;
294 :    
295 :     if (@$seqs < 2)
296 :     {
297 :     return ();
298 :     }
299 :    
300 :     my %lens = map { $_->[0] => length($_->[1]) } @$seqs;
301 : olson 1.11 my $tmp = "$FIG_Config::temp/tmp.$$.fasta";
302 : olson 1.4 &gjoseqlib::print_alignment_as_fasta($tmp,$seqs);
303 :     system "formatdb -i $tmp -pF";
304 :     my @blastout = `blastall -m8 -i $tmp -d $tmp -p blastn -FF -e 1.0e-100`;
305 :     system "rm $tmp $tmp\.*";
306 :     my @tuples = ();
307 :     my %seen;
308 :     foreach my $hit (map { chomp; [split(/\t/,$_)] } @blastout)
309 :     {
310 :     my($id1,$id2,$iden,undef,undef,undef,$b1,$e1,$b2,$e2) = @$hit;
311 :     if ((! $seen{"$id1/$id2"}) && ($id1 ne $id2))
312 :     {
313 :     $seen{"$id1/$id2"} = 1;
314 :     if (($iden >= 98) &&
315 :     (abs($e1 - $b1) > (0.9 * $lens{$id1})))
316 :     {
317 :     push(@tuples,[$id1,$lens{$id1},$id2,$lens{$id2}]);
318 :     }
319 :     }
320 :     }
321 :    
322 :     return @tuples;
323 :     }
324 :    
325 :     sub retrieve_project_data
326 :     {
327 :     my($self, $project) = @_;
328 :    
329 :     my $cached_file = $self->project_cache_dir() . "/$project.gbff";
330 :     if (my(@stat) = stat($cached_file))
331 :     {
332 :     my $last_mod = $stat[9];
333 :     if (time - $last_mod < $self->max_cache_age)
334 :     {
335 :     return $cached_file;
336 :     }
337 :     }
338 :     my $url = "http://www.ncbi.nlm.nih.gov/sites/entrez?Db=genomeprj&Cmd=Retrieve&list_uids=";
339 : olson 1.13 my $res = $self->url_get($url.$project);
340 : olson 1.4 if (!$res->is_success)
341 :     {
342 :     die "error retrieving project data: " . $res->status_line;
343 :     }
344 :     my $search_result = $res->content;
345 :    
346 :     my @lines = split ( "\n" , $search_result);
347 :    
348 :     my $nr_seq = 0;
349 :     my $nr_proj = 0;
350 :     my $url_seq = "";
351 :     my $url_proj = "";
352 :     my $genome_name = "";
353 :    
354 :     my $found_genome_information_table = 0;
355 :    
356 :     my $next = "";
357 :     my $id_list = "";
358 :     foreach my $line ( @lines )
359 :     {
360 :    
361 :     if ($line =~/Genome information:/){
362 :     $found_genome_information_table = 1;
363 :     next; # skip table line
364 :     };
365 :    
366 :     $found_genome_information_table = 0 if ( $found_genome_information_table and $line =~ /<\/table>/);
367 :     $id_list .= $line if ( $found_genome_information_table ); # collect id entries
368 :    
369 :     # print $line , "\n" if ( $found_genome_information_table );
370 :     }
371 :    
372 :     my @ids;
373 :     my @blocks = split "<\/tr>" , $id_list ;
374 :     foreach my $block (@blocks)
375 :     {
376 :     my @local_ids = $block =~/([^>]+)<\/a><\/td>/gc ;
377 :     # print join "\t" , @local_ids , "\n";
378 :     push @ids , $local_ids[0] if ($local_ids[0]);
379 :     }
380 :    
381 :     my $id_list = join(",", @ids);
382 :     my $query = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=nucleotide&id=" . $id_list . "&rettype=gb" ;
383 :     print STDERR $query , "\n";
384 : olson 1.13 my $resp = $self->url_get($query);
385 : olson 1.4 if ($resp->is_success())
386 :     {
387 :     open(F, ">", $cached_file) or die "Cannot open $cached_file for writing: $!";
388 :     print F $resp->content;
389 :     close(F);
390 :     return $cached_file;
391 :     }
392 :     else
393 :     {
394 :     die "Error retrieving data: " . $resp->status_line;
395 :     }
396 :     }
397 :    
398 :     sub retrieve_contig_data
399 :     {
400 :     my($self, $contig) = @_;
401 :    
402 :     my $cached_file = $self->contig_cache_dir() . "/$contig.gbff";
403 :     if (my(@stat) = stat($cached_file))
404 :     {
405 :     my $last_mod = $stat[9];
406 :     if (time - $last_mod < $self->max_cache_age)
407 :     {
408 :     return $cached_file;
409 :     }
410 :     }
411 :    
412 :     my $query = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=nucleotide&id=" . $contig . "&rettype=gb" ;
413 :     print STDERR $query , "\n";
414 : olson 1.13 my $resp = $self->url_get($query);
415 : olson 1.4 if ($resp->is_success())
416 :     {
417 :     open(F, ">", $cached_file) or die "Cannot open $cached_file for writing: $!";
418 :     print F $resp->content;
419 :     close(F);
420 :     return $cached_file;
421 :     }
422 :     else
423 :     {
424 :     die "Error retrieving data: " . $resp->status_line;
425 :     }
426 :     }
427 :    
428 : olson 1.7 =head3 submit_RAST_job
429 :    
430 :     Handle the actual job submission.
431 :    
432 :     Use JobUpload.pm to create a clean input file (fixing line endings,
433 :     etc) and to pull stats for the job.
434 :    
435 :     Use Job48::create_new_job to then create the job from the
436 :     data we brought in.
437 :    
438 :     =cut
439 : olson 1.4
440 : olson 1.1 sub submit_RAST_job
441 :     {
442 :     my($self, $params) = @_;
443 :    
444 : olson 1.7 my $filetype = lc($params->{-filetype});
445 :     my $tax_id = $params->{-taxonomyID};
446 : olson 1.8 my $domain = $params->{-domain};
447 : olson 1.7 my $organism = $params->{-organismName};
448 :     my $file = $params->{-file};
449 :     my $keep = $params->{-keepGeneCalls};
450 :     my $genetic_code = $params->{-geneticCode};
451 :     my $gene_caller = lc($params->{-geneCaller});
452 :    
453 :     my $work_dir = "$FIG_Config::temp/rast_submit_tmp.$$";
454 :     &FIG::verify_dir($work_dir);
455 :    
456 :     my $upload_job = new JobUpload($work_dir);
457 :     my $errs = [];
458 :    
459 :     my $fh;
460 :     if (!open($fh, "<", \$file))
461 :     {
462 :     my $er = $!;
463 :     my $len = length($file);
464 :     system("rm", "-r", $work_dir);
465 :     return { status => 'error', error_msg => "error creating filehandle from file data of length $len: $er" };
466 :     }
467 :    
468 :     if (!$upload_job->create_from_filehandle($fh, "rast_submission_file", $errs))
469 :     {
470 :     system("rm", "-r", $work_dir);
471 :     return { status => 'error', error_msg => join("\n", @$errs) };
472 :     }
473 :    
474 :     my $meta_obj = $upload_job->meta();
475 :    
476 :     #
477 :     # Pull the metadata into a hash, where it's easier to use
478 :     # and so that we can just return it to our caller if everything
479 :     # is good to go.
480 :     #
481 :    
482 :     my %meta = map { $_ => $meta_obj->get_metadata($_) } $meta_obj->get_metadata_keys();
483 :    
484 :     my $res = { upload_metadata => \%meta };
485 :    
486 :     #
487 :     # We have parsed the file. Let's do some error checking.
488 :     #
489 :    
490 :     if ($meta{upload_type} ne $filetype)
491 :     {
492 :     $res->{status} = 'error';
493 :     $res->{error_msg} = "Parsed filetype $meta{upload_type} not the expected $filetype";
494 :     system("rm", "-r", $work_dir);
495 :     return $res;
496 :     }
497 :    
498 :     #
499 :     # Do an NCBI lookup to pull the taxonomy string for the given tax id (if provided)
500 :     #
501 :    
502 :     my $taxonomy;
503 : olson 1.10 if ($tax_id && $tax_id ne '666666')
504 : olson 1.7 {
505 :     my $tdata = $self->get_taxonomy_data($tax_id);
506 :     if ($tdata)
507 :     {
508 :     $domain = $tdata->{domain} unless defined($domain);
509 :     $genetic_code = $tdata->{genetic_code} unless defined($genetic_code);
510 :     $taxonomy = $tdata->{taxonomy};
511 :     }
512 :     }
513 :     else
514 :     {
515 :     $tax_id = '666666';
516 : olson 1.8 $domain = ucfirst($domain);
517 : olson 1.7 $taxonomy = $domain;
518 :     }
519 :    
520 :     #
521 :     # That's all for now; we might add more later.
522 :     # Use Job48 to create the job. We create another slightly
523 :     # different parameter hash for this.
524 :     #
525 :    
526 :     #
527 :     # Find the file we're using.
528 :     #
529 :     my($clean_file, $clean_fh);
530 :     if ($meta{upload_type} eq 'genbank')
531 :     {
532 :     $clean_file = $meta{clean_genbank};
533 :     }
534 :     elsif ($meta{upload_type} eq 'fasta')
535 :     {
536 :     $clean_file = $meta{clean_fasta};
537 :     }
538 :     $clean_fh = new FileHandle($clean_file, "<");
539 :    
540 :     my $j48_data = {
541 :     genome => $organism,
542 :     project => $self->user_obj->login."_".$tax_id,
543 :     user => $self->user_obj->login,
544 :     taxonomy => $taxonomy ."; $organism",
545 :     taxonomy_id => $tax_id,
546 :     genetic_code => $genetic_code,
547 :     sequence_file => $clean_fh,
548 :     meta => {
549 :     source_file => $clean_file,
550 :     'genome.genetic_code' => $genetic_code,
551 :     'genome.sequencing_method' => 'unknown',
552 :     'genome.coverage' => 'unknown',
553 :     'genome.contigs' => 'unknown',
554 :     'genome.average_read_length' => 'unknown',
555 :     'genome.gc_content' => $meta{stats_contigs}->{gc},
556 :     'genome.bp_count' => $meta{stats_contigs}->{chars},
557 :     'genome.contig_count' => $meta{stats_contigs}->{seqs},
558 :     'genome.ambig_count' => 0,
559 :     'import.candidate' => 0,
560 :     'keep_genecalls' => $keep ? 1 : 0,
561 :     'use_glimmer' => $gene_caller eq 'glimmer3' ? 1 : 0,
562 :     'correction.automatic' => 1,
563 :     'correction.frameshifts' => 0,
564 :     'correction.backfill_gaps' => 1,
565 :     'env.debug' => 0,
566 :     'env.verbose' => 0,
567 :     upload_metadata => \%meta,
568 :     },
569 :     };
570 :    
571 :     my($job_id, $job_msg) = Job48->create_new_job($j48_data);
572 :     if ($job_id)
573 :     {
574 :     $res->{status} = 'ok';
575 :     $res->{job_id} = $job_id;
576 :    
577 :    
578 :     # sync job so it'll appear in the job listings on the website
579 :     my $sync;
580 :     eval { $sync = $self->rast_dbmaster->Job->init({ id => $job_id }); };
581 :     }
582 :     else
583 :     {
584 :     $res->{status} = 'error';
585 :     $res->{error_msg} = $job_msg;
586 :     }
587 :     close($clean_fh);
588 :     system("rm", "-r", $work_dir);
589 : olson 1.5 return $res;
590 : olson 1.1 }
591 :    
592 :     sub status_of_RAST_job
593 :     {
594 :     my($self, $params) = @_;
595 :    
596 : olson 1.2 my @job_nums;
597 :     my $job_num_param = $params->{-job};
598 :     if (ref($job_num_param) eq 'ARRAY')
599 : olson 1.1 {
600 : olson 1.2 @job_nums = @$job_num_param;
601 : olson 1.1 }
602 : olson 1.2 else
603 :     {
604 :     @job_nums = ($job_num_param);
605 :     }
606 :    
607 :     my $res = {};
608 :     for my $job_num (@job_nums)
609 :     {
610 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_num });
611 :     if (!ref($job))
612 :     {
613 :     $res->{$job_num} = { status => 'error', error_msg => 'Job not found'};
614 :     next;
615 :     }
616 :    
617 :     if (!$self->user_may_access_job($job))
618 :     {
619 :     $res->{$job_num} = { status => 'error', error_msg => 'Access denied' };
620 :     next;
621 :     }
622 :    
623 :     my $dir = $job->dir;
624 :     if (open(E, "<$dir/ERROR"))
625 :     {
626 :     local $/;
627 :     undef $/;
628 :     my $emsg = <E>;
629 :     close(E);
630 :     $res->{job_num} = { status => 'error', error_msg => $emsg };
631 :     next;
632 :     }
633 :    
634 :     #
635 :     # Retrieve status flags from the meta file (not the database,
636 :     # so that we can get the very latest state).
637 :     #
638 :    
639 :     #
640 :     # For now we only check status.export because that is what the
641 :     # bulk API cares about.
642 :     #
643 :    
644 :     my $status_list = [];
645 :     my $cur_stage;
646 :     my $stages = $job->stages();
647 :     my %status;
648 :     for my $stage (@$stages)
649 :     {
650 :     my $status = $job->metaxml->get_metadata($stage) || 'not_started';
651 :     $status{$stage} = $status;
652 :     push(@$status_list, [$stage => $status]);
653 :     if ($status ne 'complete')
654 :     {
655 :     $cur_stage = $stage;
656 :     }
657 :     }
658 :    
659 : olson 1.7 #
660 :     # If any stage is not in not_started, then the job is running.
661 :     #
662 :     my $exp_status = $status{'status.export'};
663 :     if ($exp_status ne 'complete')
664 :     {
665 :     if (grep { $status{$_} ne 'not_started' } keys %status)
666 :     {
667 :     $exp_status = 'running';
668 :     }
669 :     }
670 :    
671 :     $res->{$job_num} = { status => $exp_status, verbose_status => $status_list };
672 :     }
673 :     return $res;
674 :     }
675 :    
676 :     =head3 kill_RAST_job
677 :    
678 :     Mark the job as inactive, and qdel any stages that might be running.
679 :    
680 :     =cut
681 :     sub kill_RAST_job
682 :     {
683 :     my($self, $params) = @_;
684 :    
685 :     my @job_nums;
686 :     my $job_num_param = $params->{-job};
687 :     if (ref($job_num_param) eq 'ARRAY')
688 :     {
689 :     @job_nums = @$job_num_param;
690 :     }
691 :     else
692 :     {
693 :     @job_nums = ($job_num_param);
694 :     }
695 :    
696 :     my $res = {};
697 :     for my $job_num (@job_nums)
698 :     {
699 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_num });
700 :     if (!ref($job))
701 :     {
702 :     $res->{$job_num} = { status => 'error', error_msg => 'Job not found'};
703 :     next;
704 :     }
705 :    
706 : olson 1.9 if (!($self->user_may_access_job($job) && $self->user_owns_job($job)))
707 : olson 1.7 {
708 :     $res->{$job_num} = { status => 'error', error_msg => 'Access denied' };
709 :     next;
710 :     }
711 :    
712 :     my $messages = [];
713 :     my @ids;
714 :     for my $k ($job->metaxml->get_metadata_keys())
715 :     {
716 :     if ($k =~ /sge[^.]*id/)
717 :     {
718 :     my $id = $job->metaxml->get_metadata($k);
719 :     if (ref($id))
720 :     {
721 :     push(@ids, @$id);
722 :     }
723 :     else
724 :     {
725 :     push(@ids, $id);
726 :     }
727 :     }
728 :     }
729 :    
730 :     #
731 :     # sanity check.
732 :     #
733 :     @ids = grep { /^\d+$/ } @ids;
734 :    
735 :     if (@ids)
736 :     {
737 :     my $cmd = ". /vol/sge/default/common/settings.sh; qdel @ids";
738 :     if (open(my $p, "$cmd 2>&1 |"))
739 :     {
740 :     while (<$p>)
741 :     {
742 :     chomp;
743 :     push(@$messages, $_);
744 :     }
745 :    
746 :     my $rc = close($p);
747 :     if (!$rc)
748 :     {
749 :     push(@$messages, "'$cmd' returns status=$! $?");
750 :     }
751 :     else
752 :     {
753 :     push(@$messages, "'$cmd' returns status=0");
754 :     }
755 :     }
756 :     else
757 :     {
758 :     push(@$messages, "Cannot open pipe to $cmd: $!");
759 :     }
760 :     }
761 :     else
762 :     {
763 :     push(@$messages, "No sge tasks to kill");
764 :     }
765 :    
766 :     my $active = $job->dir . "/ACTIVE";
767 :     if (-f $active)
768 :     {
769 :     if (unlink($active))
770 :     {
771 :     push(@$messages, "unlinked $active");
772 :     }
773 :     else
774 :     {
775 :     push(@$messages, "error unlinking $active: $!");
776 :     }
777 :     }
778 :     else
779 :     {
780 :     push(@$messages, "no active file $active");
781 :     }
782 :     $res->{$job_num} = { status => 'ok', messages => $messages };
783 : olson 1.2 }
784 :     return $res;
785 :     }
786 : olson 1.1
787 : olson 1.7 =head3 delete_RAST_job
788 :    
789 :     Delete the given RAST jobs. This is a real delete, not a mark-the-flag delete.
790 :    
791 :     =cut
792 :     sub delete_RAST_job
793 :     {
794 :     my($self, $params) = @_;
795 :    
796 :     my @job_nums;
797 :     my $job_num_param = $params->{-job};
798 :     if (ref($job_num_param) eq 'ARRAY')
799 :     {
800 :     @job_nums = @$job_num_param;
801 :     }
802 :     else
803 :     {
804 :     @job_nums = ($job_num_param);
805 :     }
806 :    
807 :     my $res = {};
808 :     for my $job_num (@job_nums)
809 :     {
810 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_num });
811 :     if (!ref($job))
812 :     {
813 :     $res->{$job_num} = { status => 'error', error_msg => 'Job not found'};
814 :     next;
815 :     }
816 :    
817 : olson 1.9 if (!($self->user_may_access_job($job) && $self->user_owns_job($job)))
818 : olson 1.7 {
819 :     $res->{$job_num} = { status => 'error', error_msg => 'Access denied' };
820 :     next;
821 :     }
822 :    
823 :     my $dir = $job->dir;
824 :    
825 :     #
826 :     # Just make sure the dir ends in the job number, so an error
827 :     # doesn't wreak TOO much havoc.
828 :     #
829 :     if ($dir =~ /$job_num$/)
830 :     {
831 :     my $rc = system("rm", "-r", $dir);
832 :     if ($rc == 0)
833 :     {
834 :     $res->{$job_num} = { status => 'ok' }
835 :     }
836 :     else
837 :     {
838 :     $res->{$job_num} = { status => 'error', error_msg => "Remove of $dir died with status $rc" }
839 :     }
840 :     }
841 :     #
842 :     # Delete from the database too.
843 :     #
844 :     $job->delete();
845 :     }
846 :    
847 :     return $res;
848 :     }
849 :    
850 : olson 1.3 sub retrieve_RAST_job
851 :     {
852 :     my($self, $params) = @_;
853 :    
854 :     my $job_id = $params->{-job};
855 :     my $format = $params->{-format};
856 :    
857 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_id });
858 :    
859 :     if (!ref($job))
860 :     {
861 :     return { status => 'error', error_msg => 'Job not found'};
862 :     }
863 :    
864 :     if (!$self->user_may_access_job($job))
865 :     {
866 :     return { status => 'error', error_msg => 'Access denied' };
867 :     }
868 :    
869 :     #
870 :     # Map the given output format to a file.
871 :     #
872 :    
873 :     my %type_map = (genbank => "%s.gbk",
874 :     genbank_stripped => "%s.ec-stripped.gbk",
875 :     embl => "%s.embl",
876 :     embl_stripped => "%s.ec-stripped.embl",
877 :     gff3 => "%s.gff",
878 :     gff3_stripped => "%s.ec-stripped.gff",
879 :     gtf => "%s.gtf",
880 :     rast_tarball => "%s.tgz",
881 :     );
882 :    
883 :     my $file_pattern = $type_map{lc($format)};
884 :     if (!defined($file_pattern))
885 :     {
886 :     return { status => 'error', error_msg => "Format $format not found" };
887 :     }
888 :    
889 :     #
890 :     # Find the download file.
891 :     #
892 :    
893 :     my $dir = $job->download_dir();
894 :     my $file = sprintf($file_pattern, $job->genome_id);
895 :     my $path = "$dir/$file";
896 :    
897 : olson 1.8 return { status => 'ok', file => $path };
898 :    
899 :     # if (!open(F, "<", $path))
900 :     # {
901 :     # return { status => 'error', error_msg => "Cannot open download file $path"};
902 :     # }
903 :    
904 :     # local $/;
905 :     # undef $/;
906 :     # my $txt = <F>;
907 :     # return { status => 'ok', contents => $txt };
908 : olson 1.3 }
909 :    
910 : olson 1.11 sub get_job_metadata
911 :     {
912 :     my($self, $params) = @_;
913 :    
914 :     my $job_id = $params->{-job};
915 :    
916 :     $job_id =~ /^\d+$/ or return { status => 'error', error_msg => 'invalid job id'};
917 :    
918 :     my $res = {};
919 :     my $job = $self->get_job_for_reading($job_id, $res);
920 :     return $res if !$job;
921 :    
922 :     my $keys = $params->{-key};
923 :     $keys = [$keys] unless ref($keys);
924 :    
925 :     for my $key (@$keys)
926 :     {
927 :     $res->{metadata}->{$key} = $job->metaxml->get_metadata($key);
928 :     }
929 :     $res->{status} = 'ok';
930 :     return $res;
931 :     }
932 :    
933 :     sub get_job_for_reading
934 :     {
935 :     my($self, $job_id, $res) = @_;
936 :    
937 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_id });
938 :     if (!ref($job))
939 :     {
940 :     $res->{status} = 'error';
941 :     $res->{error_msg} = 'Job not found';
942 :     return;
943 :     }
944 :    
945 :     if (!$self->user_may_access_job($job))
946 :     {
947 :     $res->{status} = 'error';
948 :     $res->{error_msg} = 'Access denied';
949 :     return;
950 :     }
951 :     return $job;
952 :     }
953 :    
954 :     sub get_job_for_modification
955 :     {
956 :     my($self, $job_id, $res) = @_;
957 :    
958 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_id });
959 :     if (!ref($job))
960 :     {
961 :     $res->{status} = 'error';
962 :     $res->{error_msg} = 'Job not found';
963 :     return;
964 :     }
965 :    
966 :     if (!($self->user_may_access_job($job) && $self->user_owns_job($job)))
967 :     {
968 :     $res->{status} = 'error';
969 :     $res->{error_msg} = 'Access denied';
970 :     return;
971 :     }
972 :     return $job;
973 :     }
974 :    
975 : olson 1.2 sub user_may_access_job
976 :     {
977 : olson 1.9 my($self, $job) = @_;
978 : olson 1.1
979 : olson 1.9 return $self->user_obj->has_right(undef, 'view', 'genome', $job->genome_id);
980 :     }
981 :    
982 :     sub user_owns_job
983 :     {
984 :     my($self, $job) = @_;
985 :    
986 :     my $userid = $self->user_obj->login();
987 :    
988 :     return $job->owner->login() eq $userid;
989 : olson 1.1 }
990 :    
991 : olson 1.13 =head3 url_get
992 :    
993 :     Use the LWP::UserAgent in $self to make a GET request on the given URL. If the
994 :     request comes back with one of the transient error codes, retry.
995 :    
996 :     =cut
997 :    
998 :     sub url_get
999 :     {
1000 :     my($self, $url) = @_;
1001 :     my @retries = @{$self->{url_retries}};
1002 :    
1003 :     my $res;
1004 :     while (1)
1005 :     {
1006 :     my $now = time;
1007 :     if ($self->{last_url_request} > 0)
1008 :     {
1009 :     my $delay = $now - $self->{last_url_request};
1010 :     if ($delay < 3)
1011 :     {
1012 :     my $sleep = 3 - $delay;
1013 :     print STDERR "Sleeping $sleep to pace requests\n";
1014 :     sleep($sleep);
1015 :     }
1016 :     }
1017 :     $self->{last_url_request} = $now;
1018 :     $res = $self->ua->get($url);
1019 :     if ($res->is_success)
1020 :     {
1021 :     return $res;
1022 :     }
1023 :    
1024 :     my $code = $res->code;
1025 :     if (!$self->{codes_to_retry}->{$code})
1026 :     {
1027 :     return $res;
1028 :     }
1029 :    
1030 :     if (@retries == 0)
1031 :     {
1032 :     return $res;
1033 :     }
1034 :     my $retry_time = shift(@retries);
1035 :     print STDERR "Request failed with code=$code, sleeping $retry_time and retrying $url";
1036 :     sleep($retry_time);
1037 :     }
1038 :     return $res;
1039 :     }
1040 :    
1041 : olson 1.1
1042 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3