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

Annotation of /FigKernelPackages/RAST_submission.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3