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

Annotation of /FigKernelPackages/RAST_submission.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3