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

Annotation of /FigKernelPackages/RAST_submission.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.24 - (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 : olson 1.18 my $non_active = $params->{-nonActive};
582 : olson 1.7
583 :     my $work_dir = "$FIG_Config::temp/rast_submit_tmp.$$";
584 :     &FIG::verify_dir($work_dir);
585 :    
586 :     my $upload_job = new JobUpload($work_dir);
587 :     my $errs = [];
588 :    
589 :     my $fh;
590 :     if (!open($fh, "<", \$file))
591 :     {
592 :     my $er = $!;
593 :     my $len = length($file);
594 :     system("rm", "-r", $work_dir);
595 :     return { status => 'error', error_msg => "error creating filehandle from file data of length $len: $er" };
596 :     }
597 :    
598 :     if (!$upload_job->create_from_filehandle($fh, "rast_submission_file", $errs))
599 :     {
600 :     system("rm", "-r", $work_dir);
601 :     return { status => 'error', error_msg => join("\n", @$errs) };
602 :     }
603 :    
604 :     my $meta_obj = $upload_job->meta();
605 :    
606 :     #
607 :     # Pull the metadata into a hash, where it's easier to use
608 :     # and so that we can just return it to our caller if everything
609 :     # is good to go.
610 :     #
611 :    
612 :     my %meta = map { $_ => $meta_obj->get_metadata($_) } $meta_obj->get_metadata_keys();
613 :    
614 :     my $res = { upload_metadata => \%meta };
615 :    
616 :     #
617 :     # We have parsed the file. Let's do some error checking.
618 :     #
619 :    
620 :     if ($meta{upload_type} ne $filetype)
621 :     {
622 :     $res->{status} = 'error';
623 :     $res->{error_msg} = "Parsed filetype $meta{upload_type} not the expected $filetype";
624 :     system("rm", "-r", $work_dir);
625 :     return $res;
626 :     }
627 :    
628 :     #
629 :     # Do an NCBI lookup to pull the taxonomy string for the given tax id (if provided)
630 :     #
631 :    
632 :     my $taxonomy;
633 : olson 1.10 if ($tax_id && $tax_id ne '666666')
634 : olson 1.7 {
635 :     my $tdata = $self->get_taxonomy_data($tax_id);
636 :     if ($tdata)
637 :     {
638 :     $domain = $tdata->{domain} unless defined($domain);
639 :     $genetic_code = $tdata->{genetic_code} unless defined($genetic_code);
640 :     $taxonomy = $tdata->{taxonomy};
641 :     }
642 :     }
643 :     else
644 :     {
645 :     $tax_id = '666666';
646 : olson 1.8 $domain = ucfirst($domain);
647 : olson 1.7 $taxonomy = $domain;
648 :     }
649 :    
650 :     #
651 :     # That's all for now; we might add more later.
652 :     # Use Job48 to create the job. We create another slightly
653 :     # different parameter hash for this.
654 :     #
655 :    
656 :     #
657 :     # Find the file we're using.
658 :     #
659 :     my($clean_file, $clean_fh);
660 :     if ($meta{upload_type} eq 'genbank')
661 :     {
662 :     $clean_file = $meta{clean_genbank};
663 :     }
664 :     elsif ($meta{upload_type} eq 'fasta')
665 :     {
666 :     $clean_file = $meta{clean_fasta};
667 :     }
668 :     $clean_fh = new FileHandle($clean_file, "<");
669 :    
670 :     my $j48_data = {
671 :     genome => $organism,
672 :     project => $self->user_obj->login."_".$tax_id,
673 :     user => $self->user_obj->login,
674 :     taxonomy => $taxonomy ."; $organism",
675 :     taxonomy_id => $tax_id,
676 :     genetic_code => $genetic_code,
677 :     sequence_file => $clean_fh,
678 :     meta => {
679 :     source_file => $clean_file,
680 :     'genome.genetic_code' => $genetic_code,
681 :     'genome.sequencing_method' => 'unknown',
682 :     'genome.coverage' => 'unknown',
683 :     'genome.contigs' => 'unknown',
684 :     'genome.average_read_length' => 'unknown',
685 :     'genome.gc_content' => $meta{stats_contigs}->{gc},
686 :     'genome.bp_count' => $meta{stats_contigs}->{chars},
687 :     'genome.contig_count' => $meta{stats_contigs}->{seqs},
688 :     'genome.ambig_count' => 0,
689 :     'import.candidate' => 0,
690 :     'keep_genecalls' => $keep ? 1 : 0,
691 :     'use_glimmer' => $gene_caller eq 'glimmer3' ? 1 : 0,
692 :     'correction.automatic' => 1,
693 :     'correction.frameshifts' => 0,
694 :     'correction.backfill_gaps' => 1,
695 :     'env.debug' => 0,
696 :     'env.verbose' => 0,
697 :     upload_metadata => \%meta,
698 :     },
699 : olson 1.20 non_active => ($non_active ? 1 : 0),
700 : olson 1.7 };
701 :    
702 :     my($job_id, $job_msg) = Job48->create_new_job($j48_data);
703 :     if ($job_id)
704 :     {
705 :     $res->{status} = 'ok';
706 :     $res->{job_id} = $job_id;
707 :    
708 :    
709 :     # sync job so it'll appear in the job listings on the website
710 :     my $sync;
711 :     eval { $sync = $self->rast_dbmaster->Job->init({ id => $job_id }); };
712 :     }
713 :     else
714 :     {
715 :     $res->{status} = 'error';
716 :     $res->{error_msg} = $job_msg;
717 :     }
718 :     close($clean_fh);
719 :     system("rm", "-r", $work_dir);
720 : olson 1.5 return $res;
721 : olson 1.1 }
722 :    
723 :     sub status_of_RAST_job
724 :     {
725 :     my($self, $params) = @_;
726 :    
727 : olson 1.2 my @job_nums;
728 :     my $job_num_param = $params->{-job};
729 :     if (ref($job_num_param) eq 'ARRAY')
730 : olson 1.1 {
731 : olson 1.2 @job_nums = @$job_num_param;
732 : olson 1.1 }
733 : olson 1.2 else
734 :     {
735 :     @job_nums = ($job_num_param);
736 :     }
737 :    
738 :     my $res = {};
739 :     for my $job_num (@job_nums)
740 :     {
741 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_num });
742 :     if (!ref($job))
743 :     {
744 :     $res->{$job_num} = { status => 'error', error_msg => 'Job not found'};
745 :     next;
746 :     }
747 :    
748 :     if (!$self->user_may_access_job($job))
749 :     {
750 :     $res->{$job_num} = { status => 'error', error_msg => 'Access denied' };
751 :     next;
752 :     }
753 :    
754 :     my $dir = $job->dir;
755 :     if (open(E, "<$dir/ERROR"))
756 :     {
757 :     local $/;
758 :     undef $/;
759 :     my $emsg = <E>;
760 :     close(E);
761 :     $res->{job_num} = { status => 'error', error_msg => $emsg };
762 :     next;
763 :     }
764 :    
765 :     #
766 :     # Retrieve status flags from the meta file (not the database,
767 :     # so that we can get the very latest state).
768 :     #
769 :    
770 :     #
771 :     # For now we only check status.export because that is what the
772 :     # bulk API cares about.
773 :     #
774 :    
775 :     my $status_list = [];
776 :     my $cur_stage;
777 :     my $stages = $job->stages();
778 :     my %status;
779 :     for my $stage (@$stages)
780 :     {
781 :     my $status = $job->metaxml->get_metadata($stage) || 'not_started';
782 :     $status{$stage} = $status;
783 :     push(@$status_list, [$stage => $status]);
784 :     if ($status ne 'complete')
785 :     {
786 :     $cur_stage = $stage;
787 :     }
788 :     }
789 :    
790 : olson 1.7 #
791 :     # If any stage is not in not_started, then the job is running.
792 :     #
793 :     my $exp_status = $status{'status.export'};
794 :     if ($exp_status ne 'complete')
795 :     {
796 :     if (grep { $status{$_} ne 'not_started' } keys %status)
797 :     {
798 :     $exp_status = 'running';
799 :     }
800 :     }
801 :    
802 :     $res->{$job_num} = { status => $exp_status, verbose_status => $status_list };
803 :     }
804 :     return $res;
805 :     }
806 :    
807 :     =head3 kill_RAST_job
808 :    
809 :     Mark the job as inactive, and qdel any stages that might be running.
810 :    
811 :     =cut
812 :     sub kill_RAST_job
813 :     {
814 :     my($self, $params) = @_;
815 :    
816 :     my @job_nums;
817 :     my $job_num_param = $params->{-job};
818 :     if (ref($job_num_param) eq 'ARRAY')
819 :     {
820 :     @job_nums = @$job_num_param;
821 :     }
822 :     else
823 :     {
824 :     @job_nums = ($job_num_param);
825 :     }
826 :    
827 :     my $res = {};
828 :     for my $job_num (@job_nums)
829 :     {
830 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_num });
831 :     if (!ref($job))
832 :     {
833 :     $res->{$job_num} = { status => 'error', error_msg => 'Job not found'};
834 :     next;
835 :     }
836 :    
837 : olson 1.9 if (!($self->user_may_access_job($job) && $self->user_owns_job($job)))
838 : olson 1.7 {
839 :     $res->{$job_num} = { status => 'error', error_msg => 'Access denied' };
840 :     next;
841 :     }
842 :    
843 :     my $messages = [];
844 :     my @ids;
845 :     for my $k ($job->metaxml->get_metadata_keys())
846 :     {
847 :     if ($k =~ /sge[^.]*id/)
848 :     {
849 :     my $id = $job->metaxml->get_metadata($k);
850 :     if (ref($id))
851 :     {
852 :     push(@ids, @$id);
853 :     }
854 :     else
855 :     {
856 :     push(@ids, $id);
857 :     }
858 :     }
859 :     }
860 :    
861 :     #
862 :     # sanity check.
863 :     #
864 :     @ids = grep { /^\d+$/ } @ids;
865 :    
866 :     if (@ids)
867 :     {
868 :     my $cmd = ". /vol/sge/default/common/settings.sh; qdel @ids";
869 :     if (open(my $p, "$cmd 2>&1 |"))
870 :     {
871 :     while (<$p>)
872 :     {
873 :     chomp;
874 :     push(@$messages, $_);
875 :     }
876 :    
877 :     my $rc = close($p);
878 :     if (!$rc)
879 :     {
880 :     push(@$messages, "'$cmd' returns status=$! $?");
881 :     }
882 :     else
883 :     {
884 :     push(@$messages, "'$cmd' returns status=0");
885 :     }
886 :     }
887 :     else
888 :     {
889 :     push(@$messages, "Cannot open pipe to $cmd: $!");
890 :     }
891 :     }
892 :     else
893 :     {
894 :     push(@$messages, "No sge tasks to kill");
895 :     }
896 :    
897 :     my $active = $job->dir . "/ACTIVE";
898 :     if (-f $active)
899 :     {
900 :     if (unlink($active))
901 :     {
902 :     push(@$messages, "unlinked $active");
903 :     }
904 :     else
905 :     {
906 :     push(@$messages, "error unlinking $active: $!");
907 :     }
908 :     }
909 :     else
910 :     {
911 :     push(@$messages, "no active file $active");
912 :     }
913 :     $res->{$job_num} = { status => 'ok', messages => $messages };
914 : olson 1.2 }
915 :     return $res;
916 :     }
917 : olson 1.1
918 : olson 1.7 =head3 delete_RAST_job
919 :    
920 :     Delete the given RAST jobs. This is a real delete, not a mark-the-flag delete.
921 :    
922 :     =cut
923 :     sub delete_RAST_job
924 :     {
925 :     my($self, $params) = @_;
926 :    
927 :     my @job_nums;
928 :     my $job_num_param = $params->{-job};
929 :     if (ref($job_num_param) eq 'ARRAY')
930 :     {
931 :     @job_nums = @$job_num_param;
932 :     }
933 :     else
934 :     {
935 :     @job_nums = ($job_num_param);
936 :     }
937 :    
938 :     my $res = {};
939 :     for my $job_num (@job_nums)
940 :     {
941 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_num });
942 :     if (!ref($job))
943 :     {
944 :     $res->{$job_num} = { status => 'error', error_msg => 'Job not found'};
945 :     next;
946 :     }
947 :    
948 : olson 1.9 if (!($self->user_may_access_job($job) && $self->user_owns_job($job)))
949 : olson 1.7 {
950 :     $res->{$job_num} = { status => 'error', error_msg => 'Access denied' };
951 :     next;
952 :     }
953 :    
954 :     my $dir = $job->dir;
955 :    
956 :     #
957 :     # Just make sure the dir ends in the job number, so an error
958 :     # doesn't wreak TOO much havoc.
959 :     #
960 :     if ($dir =~ /$job_num$/)
961 :     {
962 :     my $rc = system("rm", "-r", $dir);
963 :     if ($rc == 0)
964 :     {
965 :     $res->{$job_num} = { status => 'ok' }
966 :     }
967 :     else
968 :     {
969 :     $res->{$job_num} = { status => 'error', error_msg => "Remove of $dir died with status $rc" }
970 :     }
971 :     }
972 :     #
973 :     # Delete from the database too.
974 :     #
975 :     $job->delete();
976 :     }
977 :    
978 :     return $res;
979 :     }
980 :    
981 : olson 1.3 sub retrieve_RAST_job
982 :     {
983 :     my($self, $params) = @_;
984 :    
985 :     my $job_id = $params->{-job};
986 :     my $format = $params->{-format};
987 :    
988 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_id });
989 :    
990 :     if (!ref($job))
991 :     {
992 :     return { status => 'error', error_msg => 'Job not found'};
993 :     }
994 :    
995 :     if (!$self->user_may_access_job($job))
996 :     {
997 :     return { status => 'error', error_msg => 'Access denied' };
998 :     }
999 :    
1000 :     #
1001 :     # Map the given output format to a file.
1002 :     #
1003 :    
1004 :     my %type_map = (genbank => "%s.gbk",
1005 :     genbank_stripped => "%s.ec-stripped.gbk",
1006 :     embl => "%s.embl",
1007 :     embl_stripped => "%s.ec-stripped.embl",
1008 :     gff3 => "%s.gff",
1009 :     gff3_stripped => "%s.ec-stripped.gff",
1010 :     gtf => "%s.gtf",
1011 :     rast_tarball => "%s.tgz",
1012 :     );
1013 :    
1014 :     my $file_pattern = $type_map{lc($format)};
1015 :     if (!defined($file_pattern))
1016 :     {
1017 :     return { status => 'error', error_msg => "Format $format not found" };
1018 :     }
1019 :    
1020 :     #
1021 :     # Find the download file.
1022 :     #
1023 :    
1024 :     my $dir = $job->download_dir();
1025 :     my $file = sprintf($file_pattern, $job->genome_id);
1026 :     my $path = "$dir/$file";
1027 :    
1028 : olson 1.8 return { status => 'ok', file => $path };
1029 :    
1030 :     # if (!open(F, "<", $path))
1031 :     # {
1032 :     # return { status => 'error', error_msg => "Cannot open download file $path"};
1033 :     # }
1034 :    
1035 :     # local $/;
1036 :     # undef $/;
1037 :     # my $txt = <F>;
1038 :     # return { status => 'ok', contents => $txt };
1039 : olson 1.3 }
1040 :    
1041 : olson 1.21 sub copy_to_RAST_dir
1042 :     {
1043 :     my($self, $params) = @_;
1044 :    
1045 :     my $job_id = $params->{-job};
1046 :     my $to = $params->{-to};
1047 :     my $to_name = $params->{-toName};
1048 :     my $from = $params->{-from};
1049 :     my $type = $params->{-type};
1050 : olson 1.23 my $chunk_num = $params->{-chunkNum};
1051 :     my $total_size = $params->{-totalSize};
1052 : olson 1.21
1053 :     if ($to_name eq '' || $to_name =~ m,/,)
1054 :     {
1055 :     return { status => 'error', error_msg => 'Invalid -toName'};
1056 :     }
1057 :    
1058 :    
1059 :     my $job;
1060 :     eval {
1061 :     $job = $self->rast_dbmaster->Job->init({ id => $job_id });
1062 :     };
1063 :    
1064 :     if (!ref($job))
1065 :     {
1066 :     warn "no job found\n";
1067 :     return { status => 'error', error_msg => 'Job not found'};
1068 :     }
1069 :    
1070 : olson 1.24 if (!($self->user_may_access_job($job)))
1071 : olson 1.21 {
1072 :     return { status => 'error', error_msg => 'Access denied'};
1073 :     }
1074 :    
1075 :     my $dest;
1076 :     if ($to eq '')
1077 :     {
1078 :     $dest = $job->dir . "/UserSpace";
1079 :     }
1080 :     else
1081 :     {
1082 :     #
1083 :     # if path starts with / or any component is ..
1084 :     # fail the attempt.
1085 :     #
1086 :    
1087 :     my @comps = split(/\//, $to);
1088 : olson 1.22 if ($to =~ m,^/, || (grep { $_ eq '..' } @comps))
1089 : olson 1.21 {
1090 :     return { status => 'error', error_msg => 'Invalid Path'};
1091 :     }
1092 :     $dest = $job->dir . "/UserSpace/$to";
1093 :     }
1094 :     &FIG::verify_dir($dest);
1095 :    
1096 : olson 1.23 my $spool_file;
1097 :     if ($type eq 'tar')
1098 : olson 1.21 {
1099 : olson 1.23 $spool_file = "$dest/$to_name.tar";
1100 :     }
1101 :     else
1102 :     {
1103 :     $spool_file = "$dest/$to_name";
1104 :     }
1105 :    
1106 :     if (defined($total_size))
1107 :     {
1108 :     my $spool_size = -s $spool_file;
1109 :     if ($spool_size != $total_size)
1110 :     {
1111 :     return { status => 'error', error_msg => "Size mismatch at end, $spool_size != $total_size" };
1112 :     }
1113 :    
1114 :     if ($type eq 'tar')
1115 : olson 1.21 {
1116 : olson 1.23 my $rc = system("tar", "-x", "-f", $spool_file, "-C", $dest);
1117 :     if ($rc == 0)
1118 :     {
1119 : olson 1.24 unlink($spool_file);
1120 : olson 1.23 return { status => 'ok' };
1121 :     }
1122 :     else
1123 :     {
1124 :     return { status => 'error', error_msg => "Untar failed with rc=$rc" };
1125 :     }
1126 : olson 1.21 }
1127 : olson 1.23 else
1128 :     {
1129 :     return { status => 'ok' };
1130 :     }
1131 :     }
1132 :    
1133 :     if ($chunk_num == 0)
1134 :     {
1135 :     open(F, ">", $spool_file);
1136 :     }
1137 :     else
1138 :     {
1139 :     open(F, ">>", $spool_file);
1140 :     }
1141 :    
1142 :     warn "Copying chunk $chunk_num to $dest/$to_name\n";
1143 :     if (ref($from))
1144 :     {
1145 : olson 1.21 my $buf;
1146 : olson 1.23 my $nread = 0;
1147 :     while (my $size = read($from, $buf, 4096))
1148 : olson 1.21 {
1149 :     print F $buf;
1150 : olson 1.23 $nread += $size;
1151 : olson 1.21 }
1152 : olson 1.23 warn "Read $nread\n";
1153 :     }
1154 :     else
1155 :     {
1156 :     my $s = length($from);
1157 :     warn "Read2 $s\n";
1158 :     print F $from;
1159 : olson 1.21 }
1160 : olson 1.23
1161 :     close(F);
1162 : olson 1.21
1163 :     return { status => 'ok' };
1164 :     }
1165 :    
1166 : olson 1.11 sub get_job_metadata
1167 :     {
1168 :     my($self, $params) = @_;
1169 :    
1170 :     my $job_id = $params->{-job};
1171 :    
1172 :     $job_id =~ /^\d+$/ or return { status => 'error', error_msg => 'invalid job id'};
1173 :    
1174 :     my $res = {};
1175 :     my $job = $self->get_job_for_reading($job_id, $res);
1176 :     return $res if !$job;
1177 :    
1178 :     my $keys = $params->{-key};
1179 :     $keys = [$keys] unless ref($keys);
1180 :    
1181 :     for my $key (@$keys)
1182 :     {
1183 :     $res->{metadata}->{$key} = $job->metaxml->get_metadata($key);
1184 :     }
1185 :     $res->{status} = 'ok';
1186 :     return $res;
1187 :     }
1188 :    
1189 :     sub get_job_for_reading
1190 :     {
1191 :     my($self, $job_id, $res) = @_;
1192 :    
1193 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_id });
1194 :     if (!ref($job))
1195 :     {
1196 :     $res->{status} = 'error';
1197 :     $res->{error_msg} = 'Job not found';
1198 :     return;
1199 :     }
1200 :    
1201 :     if (!$self->user_may_access_job($job))
1202 :     {
1203 :     $res->{status} = 'error';
1204 :     $res->{error_msg} = 'Access denied';
1205 :     return;
1206 :     }
1207 :     return $job;
1208 :     }
1209 :    
1210 :     sub get_job_for_modification
1211 :     {
1212 :     my($self, $job_id, $res) = @_;
1213 :    
1214 :     my $job = $self->rast_dbmaster->Job->init({ id => $job_id });
1215 :     if (!ref($job))
1216 :     {
1217 :     $res->{status} = 'error';
1218 :     $res->{error_msg} = 'Job not found';
1219 :     return;
1220 :     }
1221 :    
1222 :     if (!($self->user_may_access_job($job) && $self->user_owns_job($job)))
1223 :     {
1224 :     $res->{status} = 'error';
1225 :     $res->{error_msg} = 'Access denied';
1226 :     return;
1227 :     }
1228 :     return $job;
1229 :     }
1230 :    
1231 : olson 1.2 sub user_may_access_job
1232 :     {
1233 : olson 1.9 my($self, $job) = @_;
1234 : olson 1.1
1235 : olson 1.9 return $self->user_obj->has_right(undef, 'view', 'genome', $job->genome_id);
1236 :     }
1237 :    
1238 :     sub user_owns_job
1239 :     {
1240 :     my($self, $job) = @_;
1241 :    
1242 :     my $userid = $self->user_obj->login();
1243 :    
1244 :     return $job->owner->login() eq $userid;
1245 : olson 1.1 }
1246 :    
1247 : olson 1.13 =head3 url_get
1248 :    
1249 :     Use the LWP::UserAgent in $self to make a GET request on the given URL. If the
1250 :     request comes back with one of the transient error codes, retry.
1251 :    
1252 :     =cut
1253 :    
1254 :     sub url_get
1255 :     {
1256 :     my($self, $url) = @_;
1257 :     my @retries = @{$self->{url_retries}};
1258 :    
1259 :     my $res;
1260 :     while (1)
1261 :     {
1262 :     my $now = time;
1263 :     if ($self->{last_url_request} > 0)
1264 :     {
1265 :     my $delay = $now - $self->{last_url_request};
1266 :     if ($delay < 3)
1267 :     {
1268 :     my $sleep = 3 - $delay;
1269 :     print STDERR "Sleeping $sleep to pace requests\n";
1270 :     sleep($sleep);
1271 :     }
1272 :     }
1273 :     $self->{last_url_request} = $now;
1274 :     $res = $self->ua->get($url);
1275 : olson 1.14
1276 : olson 1.13 if ($res->is_success)
1277 :     {
1278 :     return $res;
1279 :     }
1280 :    
1281 :     my $code = $res->code;
1282 :     if (!$self->{codes_to_retry}->{$code})
1283 :     {
1284 :     return $res;
1285 :     }
1286 :    
1287 :     if (@retries == 0)
1288 :     {
1289 :     return $res;
1290 :     }
1291 :     my $retry_time = shift(@retries);
1292 : olson 1.14 print STDERR "Request failed with code=$code, sleeping $retry_time and retrying $url\n";
1293 : olson 1.13 sleep($retry_time);
1294 :     }
1295 :     return $res;
1296 :     }
1297 :    
1298 : olson 1.1
1299 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3