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

Annotation of /FigKernelPackages/RAST_submission.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3