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

Diff of /FigKernelPackages/P2P.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2, Wed Sep 22 19:33:35 2004 UTC revision 1.19, Wed Jan 5 22:10:06 2005 UTC
# Line 18  Line 18 
18    
19  use FIG_Config;  use FIG_Config;
20    
21    use DB_File;
22    use Fcntl;
23    
24  use strict;  use strict;
25  use Exporter;  use Exporter;
26  use base qw(Exporter);  use base qw(Exporter);
27    
28    use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
29    
30  use Data::Dumper;  use Data::Dumper;
31    
32  use vars qw(@EXPORT @EXPORT_OK);  use vars qw(@EXPORT @EXPORT_OK);
# Line 47  Line 52 
52    
53  sub perform_update  sub perform_update
54  {  {
55      my($fig, $peer, $last_update) = @_;      my($fig, $peer, $last_update, $skip_tough_search) = @_;
56    
57      my $ret = $peer->request_update($last_update);      my $ret = $peer->request_update($last_update);
58    
59      if (!$ret or ref($ret) ne "ARRAY")      if (!$ret or ref($ret) ne "ARRAY")
60      {      {
61          die "perform_update: request_updated failed\n";          die "perform_update: request_update failed\n";
62      }      }
63    
64      my($session, $target_release, $num_annos, $num_pegs, $num_genomes,      my($session, $target_release, $num_assignments, $num_annos, $num_pegs, $num_genomes,
65         $target_time, $compatible) = @$ret;         $target_time, $compatible) = @$ret;
66    
67      print "perform_update: session=$session target=$target_release num_annos=$num_annos\n";      print "perform_update: session=$session target=@$target_release num_annos=$num_annos\n";
68      print "                num_pegs=$num_pegs num_genomes=$num_genomes target_time=$target_time compat=$compatible\n";      print "                num_pegs=$num_pegs num_genomes=$num_genomes target_time=$target_time compat=$compatible\n";
69    
70      #      #
71        # We now know the data release for our peer.
72        #
73        # Open up the peg translation cache database (a DB_File) tied
74        # to %peg_cache. We needn't worry about keeping it in a directory
75        # based on our current release, as it the cache directory is kept *in*
76        # the current data release directory.
77        #
78    
79        my $cache_handle;
80        my %peg_cache;
81        if ($target_release->[1] ne "")
82        {
83            my $cache_file = "pegcache.$target_release->[1].db";
84            my $cache_dir = "$FIG_Config::data/P2PQueue";
85            $fig->verify_dir($cache_dir);
86    
87            $cache_handle = tie(%peg_cache, "DB_File", "$cache_dir/$cache_file",
88                                O_CREAT | O_RDWR, 0666, $DB_HASH);
89            $cache_handle or warn "Could not tie peg_cache to $cache_dir/$cache_file: $!\n";
90        }
91    
92        #
93      # We have  the information now to begin the update process. Retrieve the pegs.      # We have  the information now to begin the update process. Retrieve the pegs.
94      #      #
95    
# Line 90  Line 117 
117              #              #
118              # Peg id is directly usable.              # Peg id is directly usable.
119              #              #
120                $peg_mapping{$peg} = $peg;
121          }          }
122          elsif ($key eq 'peg_info')          elsif ($key eq 'peg_info')
123          {          {
124              #              #
125              # Peg id not directly usable.              # Peg id not directly usable. See if we have it in the cache.
126                #
127    
128                if ((my $cached = $peg_cache{$peg}) ne "")
129                {
130                    #
131                    # Cool, we've cached the result. Use it.
132              #              #
133    
134                    $peg_mapping{$peg} = $cached;
135                    warn "Found cached mapping $peg => $cached\n";
136                    next;
137                }
138    
139              my($alias_list, $genome_id) = @rest;              my($alias_list, $genome_id) = @rest;
140    
141              for my $alias (@$alias_list)              for my $alias (@$alias_list)
142              {              {
143                  my $mapped = $fig->by_alias($alias);                  my $mapped = $fig->by_alias($alias);
144                  if ($mapped && $peg !~ /5$/)                  if ($mapped)
145                  {                  {
146                      print "$peg maps to $mapped via $alias\n";                      print "$peg maps to $mapped via $alias\n";
147                      $peg_mapping{$peg}= $mapped;                      $peg_mapping{$peg}= $mapped;
148                        $peg_cache{$peg} = $mapped;
149                      last;                      last;
150                  }                  }
151              }              }
# Line 119  Line 159 
159              if (!defined($peg_mapping{$peg}))              if (!defined($peg_mapping{$peg}))
160              {              {
161                  push(@{$genome_map{$genome_id}}, $peg);                  push(@{$genome_map{$genome_id}}, $peg);
162                    print "$peg did not map\n";
163              }              }
164          }          }
165      }      }
166    
167        $cache_handle->sync();
168    
169      #      #
170      # finished first pass. Now go over the per-genome mappings that need to be made.      # finished first pass. Now go over the per-genome mappings that need to be made.
171      #      #
172        # $genome_map{$genome_id} is a list of pegs that reside on that genome.
173        # the pegs and genome id are both target-based identifiers.
174        #
175    
176        my @finalize_req = ();
177        my %local_genome;
178    
179      for my $genome_info (@$genome_list)      for my $genome_info (@$genome_list)
180      {      {
181          my($genome, $n_contigs, $n_nucs, $cksum) = @$genome_info;          my($genome, $n_contigs, $n_nucs, $cksum) = @$genome_info;
182    
183          next unless $genome_map{$genome};          next unless defined($genome_map{$genome});
184    
185            #
186            # Determine if we have a local genome installed that matches precisely the
187            # genome on the target side.
188            #
189          my $my_genome = $fig->find_genome_by_content($genome, $n_contigs, $n_nucs, $cksum);          my $my_genome = $fig->find_genome_by_content($genome, $n_contigs, $n_nucs, $cksum);
190    
191            my $pegs = $genome_map{$genome};
192    
193          if ($my_genome)          if ($my_genome)
194          {          {
195              #              #
196              # Found a match.              # We do have such a local genome. Generate a peg_genome request to
197                # get the location information from the target side.
198                #
199                # Also remember the local genome mapping for this peg.
200                #
201    
202                print "$genome mapped to $my_genome\n";
203                for my $peg (@$pegs)
204                {
205                    push(@finalize_req, ['peg_genome', $peg]);
206                    $local_genome{$peg} = $my_genome;
207                }
208    
209            }
210            else
211            {
212                #
213                # We don't have such a genome. We need to retrieve the
214                # sequence data in order to finish mapping.
215                #
216                push(@finalize_req, map { ['peg_unknown', $_] } @$pegs);
217            }
218        }
219    
220        #
221        # If we need to finalize, make the call.
222        if (@finalize_req)
223        {
224            # print Dumper(\@finalize_req);
225            $ret = $peer->finalize_pegs($session, \@finalize_req);
226    
227            if (!$ret or ref($ret) ne "ARRAY")
228            {
229                die "perform_update: finalize_pegs failed\n";
230            }
231    
232            #
233            # The return is a list of either location entries or
234            # sequence data. Attempt to finish up the mapping.
235            #
236    
237            my(%sought, %sought_seq);
238    
239    
240            my $dbh = $fig->db_handle();
241            for my $entry (@$ret)
242            {
243                my($what, $peg, @rest) = @$entry;
244    
245                if ($what eq "peg_loc")
246                {
247                    my($strand, $start, $end, $cksum, $seq) = @rest;
248    
249                    #
250                    # We have a contig location. Try to find a matching contig
251                    # here, and see if it maps to something.
252                    #
253    
254                    my $my_genome = $local_genome{$peg};
255                    my $local_contig = $fig->find_contig_with_checksum($my_genome, $cksum);
256                    if ($local_contig)
257                    {
258                        #
259                        # Now look up the local peg. We match on the end location; depending on the strand
260                        # the feature is on, we want to look at either minloc or maxloc.
261              #              #
             print "Genome $genome maps to $my_genome locally\n";  
262    
263                        my $whichloc = $strand eq '-' ? "minloc" : "maxloc";
264    
265                        my $res = $dbh->SQL(qq!SELECT id from features
266                                               WHERE $whichloc = $end and genome = '$my_genome' and
267                                               contig = '$local_contig'
268                                            !);
269    
270                        if ($res and @$res > 0)
271                        {
272                            my(@ids) = map { $_->[0] } @$res;
273                            my $id = $ids[0];
274                            $peg_mapping{$peg} = $id;
275                            $peg_cache{$peg} = $id;
276                            print "Mapped $peg to $id via contigs\n";
277                            if (@$res > 1)
278                            {
279                                warn "Multiple mappings found for $peg: @ids\n";
280                            }
281                        }
282                        else
283                        {
284                            print "failed: $peg  $my_genome and contig $local_contig start=$start end=$end strand=$strand\n";
285                            $sought{$peg}++;
286                            $sought_seq{$peg} = $seq;
287                        }
288          }          }
289          else          else
290          {          {
291              print "No mapping for $genome\n";                      print "Mapping failed for $my_genome checksum $cksum\n";
292                        $sought{$peg}++;
293                        $sought_seq{$peg} = $seq;
294                    }
295                }
296                elsif ($what eq "peg_seq")
297                {
298                    my($seq) = @rest;
299    
300                    $sought{$peg}++;
301                    $sought_seq{$peg} = $seq;
302                }
303            }
304    
305            #
306            # Now see if we need to do a tough search.
307            #
308    
309            if (keys(%sought) > 0 and !$skip_tough_search)
310            {
311                my %trans;
312    
313                print "Starting tough search\n";
314    
315                $fig->tough_search(undef, \%sought_seq, \%trans, \%sought);
316                print "Tough search translated: \n";
317                while (my($tpeg, $ttrans) = each(%trans))
318                {
319                    print "  $tpeg -> $ttrans\n";
320                    $peg_mapping{$tpeg} = $ttrans;
321                    $peg_cache{$tpeg} = $ttrans;
322          }          }
323      }      }
324  }  }
325        $cache_handle->sync();
326        untie %peg_cache;
327    
328        #
329        # Retrieve the assignments.
330        #
331    
332        my $assignments = $peer->get_assignments($session, 0, $num_assignments);
333    
334        #
335        # Retrieve the annotations, and generate a list of mapped annotations.
336        #
337    
338        my $annos = $peer->get_annotations($session, 0, $num_annos);
339    
340        #
341        # Create a list of locally-mapped annotations on a per-genome
342        # basis.
343        #
344    
345        my %genome_annos;
346    
347        #
348        # %genome_assignments is a hash mapping from genome to a hashref
349        # that maps  peg to function (since assignments are unique).
350        #
351        # (Hm. Unless two remote pegs map to the same local peg; unclear what to do
352        # then. Punt for now).
353        #
354        my %genome_assignments;
355    
356        for my $anno (@$annos)
357        {
358            my($his_id, $ts, $author, $anno) = @$anno;
359    
360            my $my_id = $peg_mapping{$his_id};
361            next unless $my_id;
362    
363            my $genome = $fig->genome_of($my_id);
364    
365            push(@{$genome_annos{$genome}}, [$my_id, $ts, $author, $anno]);
366        }
367    
368        #
369        # Do the same for the assignments
370        #
371    
372        for my $assign (@$assignments)
373        {
374            my($his_id, $ts, $author, $func) = @$assign;
375    
376            my $my_id = $peg_mapping{$his_id};
377            next unless $my_id;
378    
379            my $genome = $fig->genome_of($my_id);
380    
381            $genome_assignments{$genome}->{$my_id} =  [$my_id, $ts, $author, $func];
382    
383    
384        }
385    
386        # print Dumper(\%genome_annos);
387    
388        #
389        # Now install annotations.
390        #
391    
392        for my $genome (keys(%genome_annos))
393        {
394            #
395            # Plan:  Apply the merge_annotations.pl logic. Read the annotations
396            # from the per-org annotations file, add the new ones here, sort, and remove duplicates.
397            # Write the results to the annotations file.
398            #
399            # When we are all done, rerun the index_annotations script.
400            #
401            # Why not do that incrementally? Partly because the annotation_seeks table doesn't
402            # have a column for the genome id, so a removal of old data would require a
403            # string-match query; since a complete reindex of the annotations is pretty
404            # fast (60 sec on a G4 laptop on a firewire disk), it's not clear whether the incremental
405            # update would actually be a win.
406            #
407    
408            my @annos = @{$genome_annos{$genome}};
409            my $assignments = $genome_assignments{$genome};
410            #
411            # %assignment_annos is a hash from peg to the list
412            # of annotations for that peg.
413            #
414            my %assignment_annos;
415    
416            my $dir = "$FIG_Config::organisms/$genome";
417            my $anno_file = "$dir/annotations";
418            my $anno_bak = "$dir/annotations." . time;
419    
420            my $new_count = @annos;
421    
422            #
423            # Rename the annotations file to a new name based on the current time.
424            #
425    
426            if (-f $anno_file)
427            {
428                rename($anno_file, $anno_bak) or die "Cannot rename $anno_file to $anno_bak: $!";
429            }
430    
431            if (open(my $fh, "<$anno_bak"))
432            {
433                #
434                # While we are scanning here, we look for the latest local assignment
435                # for any peg for which we are installing an assignment.
436                #
437                local($/) = "\n//\n";
438    
439                my($chunk, $peg, $ts, $author, $anno);
440    
441                while (defined($chunk = <$fh>))
442                {
443                    chomp $chunk;
444                    ($peg, $ts, $author, $anno) = split(/\n/, $chunk, 4);
445    
446                    if ($peg =~ /^fig\|/ and $ts =~ /^\d+$/)
447                    {
448                        my $ent = [$peg, $ts, $author, $anno];
449                        push(@annos, $ent);
450    
451                        if (defined($assignments->{$peg}))
452                        {
453                            #
454                            # We have an incoming assignment for this peg.
455                            # Don't parse anything yet, but push the annotation
456                            # on a list so we can sort by date.
457                            #
458                            push(@{$assignment_annos{$peg}}, $ent);
459                        }
460                    }
461                }
462                close($fh);
463            }
464    
465            #
466            # Determine if we are going to install an assignment.
467            #
468    
469            for my $peg (keys %$assignments)
470            {
471                my(undef, $ts, $author, $func) = $assignments->{$peg};
472    
473                #
474                # Sort the existing annotations for this peg by date.#
475                #
476    
477                my @eannos = sort { $b->[1] <=> $a->[1] } @{$assignment_annos{$peg}};
478    
479                print "Assignment annos for $peg: ", Dumper(\@eannos);
480    
481            }
482    
483            open(my $outfh, ">$anno_file") or die "Cannot open new annotation file $anno_file: $!\n";
484    
485            my $last;
486            my @sorted = sort { ($a->[0] cmp $b->[0]) or ($a->[1] <=> $b->[1]) } @annos;
487            my $inst = 0;
488            my $dup = 0;
489            foreach my $ann (@sorted)
490            {
491                my $txt = join("\n", @$ann);
492                #
493                # Drop the trailing \n if there is one; we  will add it back when we print and
494                # want to ensure the file format remains sane.
495                #
496                chomp $txt;
497                if ($txt ne $last)
498                {
499                    print $outfh "$txt\n//\n";
500                    $last = $txt;
501                    print "Inst $ann->[0] $ann->[1] $ann->[2]\n";
502                    $inst++;
503                }
504                else
505                {
506                    print "Dup $ann->[0] $ann->[1] $ann->[2]\n";
507                    $dup++;
508                }
509            }
510            close($outfh);
511            chmod(0666, $anno_file) or warn "Cannot chmod 0666 $anno_file: $!\n";
512            print "Wrote $anno_file. $new_count new annos, $inst installed, $dup duplicates\n";
513    
514            #
515            # _install_genome_annos($fig, $genome, $genome_annos{$genome});
516        }
517    }
518    
519    
520    
521  #############  #############
# Line 290  Line 657 
657  use strict;  use strict;
658    
659  use Data::Dumper;  use Data::Dumper;
660    use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
661    
662  use SOAP::Lite;  use SOAP::Lite;
663    
664    #use SOAP::Lite +trace => [qw(transport dispatch result debug)];
665  use P2P;  use P2P;
666    
667  #  #
# Line 303  Line 673 
673  {  {
674      my($class, $fig, $url, $peer_id, $relay) = @_;      my($class, $fig, $url, $peer_id, $relay) = @_;
675    
676      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url);      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url, timeout => 3600);
677    
678      my $self = {      my $self = {
679          fig => $fig,          fig => $fig,
# Line 331  Line 701 
701  {  {
702      my($self, $last_update) = @_;      my($self, $last_update) = @_;
703    
704      my $rel = $self->{fig}->get_release_info();      my $rel = [$self->{fig}->get_release_info()];
705    
706      if (!defined($last_update))      if (!defined($last_update))
707      {      {
708          $last_update = $self->{fig}->get_peer_last_update($self->{peer_id});          $last_update = $self->{fig}->get_peer_last_update($self->{peer_id});
709      }      }
710    
711        print "Requesting update via $self->{proxy}\n";
712      my $reply = $self->{proxy}->request_update($rel, $last_update);      my $reply = $self->{proxy}->request_update($rel, $last_update);
713        print "Got reply ", Dumper($reply);
714    
715      if ($self->{relay})      if ($self->{relay})
716      {      {
# Line 368  Line 740 
740      return $self->call("get_pegs", $session_id, $start, $length);      return $self->call("get_pegs", $session_id, $start, $length);
741  }  }
742    
743    sub finalize_pegs
744    {
745        my($self, $session_id, $request) = @_;
746    
747        return $self->call("finalize_pegs", $session_id, $request);
748    }
749    
750    sub get_annotations
751    {
752        my($self, $session_id, $start, $length) = @_;
753    
754        return $self->call("get_annotations", $session_id, $start, $length);
755    }
756    
757    sub get_assignments
758    {
759        my($self, $session_id, $start, $length) = @_;
760    
761        return $self->call("get_assignments", $session_id, $start, $length);
762    }
763    
764  sub call  sub call
765  {  {
766      my($self, $func, @args) = @_;      my($self, $func, @args) = @_;
767    
768        my $t0 = [gettimeofday()];
769        print "Calling $func\n";
770      my $reply = $self->{proxy}->$func(@args);      my $reply = $self->{proxy}->$func(@args);
771        my $t1 = [gettimeofday()];
772    
773        my $elap = tv_interval($t0, $t1);
774        print "Call to $func took $elap\n";
775    
776      if ($self->{relay})      if ($self->{relay})
777      {      {
# Line 448  Line 847 
847    
848      my %pegs;      my %pegs;
849    
850        #
851        # We keep track of usernames that have been seen, so that
852        # we can both update our local user database and
853        # we can report them to our peer.
854        #
855    
856        my %users;
857    
858      my $num_annos = 0;      my $num_annos = 0;
859      my $num_genomes = 0;      my $num_genomes = 0;
860      my $num_pegs = 0;      my $num_pegs = 0;
861        my $num_assignments = 0;
862    
863      my $anno_fh;      my $anno_fh;
864      open($anno_fh, ">$spool_dir/annos");      open($anno_fh, ">$spool_dir/annos");
# Line 461  Line 869 
869      my $genome_fh;      my $genome_fh;
870      open($genome_fh, ">$spool_dir/genomes");      open($genome_fh, ">$spool_dir/genomes");
871    
872        my $assign_fh;
873        open($assign_fh, ">$spool_dir/assignments");
874    
875      for my $genome (@$all_genomes)      for my $genome (@$all_genomes)
876      {      {
877          my $num_annos_for_genome = 0;          my $num_annos_for_genome = 0;
878            my %assignment;
879    
880          my $genome_dir = "$FIG_Config::organisms/$genome";          my $genome_dir = "$FIG_Config::organisms/$genome";
881          next unless -d $genome_dir;          next unless -d $genome_dir;
# Line 484  Line 896 
896    
897                  {                  {
898                      #                      #
899                        # Update users list.
900                        #
901    
902                        $users{$who}++;
903    
904                        #
905                      # Look up aliases if we haven't seen this fid before.                      # Look up aliases if we haven't seen this fid before.
906                      #                      #
907    
# Line 501  Line 919 
919    
920                      $num_annos_for_genome++;                      $num_annos_for_genome++;
921                      $num_annos++;                      $num_annos++;
922    
923                        #
924                        # While we're here, see if this is an assignment. We check in the
925                        # %assignment hash, which is keyed on fid, to see if we already
926                        # saw an assignment for this fid. If we have, we keep this one only if
927                        # the assignment time on it is later than the one we saw already.
928                        #
929                        # We are only looking at master assignments for now. We will need
930                        # to return to this issue and reexamine it, but in order to move
931                        # forward I am only matching master assignments.
932                        #
933    
934                        if ($anno_text =~ /Set master function to\n(\S[^\n]+\S)/)
935                        {
936                            my $func = $1;
937    
938                            my $other = $assignment{$fid};
939    
940                            #
941                            # If we haven't seen an assignment for this fid,
942                            # or if it the other assignment has a timestamp that
943                            # is earlier than this one, set the assignment.
944                            #
945    
946                            if (!defined($other) or
947                                ($other->[1] < $anno_time))
948                            {
949                                $assignment{$fid} = [$fid, $anno_time, $who, $func];
950                            }
951                        }
952                  }                  }
953              }              }
954              close($afh);              close($afh);
955    
956                #
957                # Write out the assignments that remain.
958                #
959    
960                for my $fid (sort keys(%assignment))
961                {
962                    print $assign_fh join("\t", @{$assignment{$fid}}), "\n";
963                    $num_assignments++;
964          }          }
965            }
966    
967    
968          #          #
969          # Determine genome information if we have annotations for this one.          # Determine genome information if we have annotations for this one.
# Line 537  Line 996 
996      close($anno_fh);      close($anno_fh);
997      close($peg_fh);      close($peg_fh);
998      close($genome_fh);      close($genome_fh);
999        close($assign_fh);
1000    
1001      print "Pegs: $num_pegs\n";      print "Pegs: $num_pegs\n";
1002      print "Genomes: $num_genomes\n";      print "Genomes: $num_genomes\n";
# Line 546  Line 1006 
1006      # Check compatibility.      # Check compatibility.
1007      #      #
1008    
1009      my $my_release = $fig->get_release_info();      my $my_release = [$fig->get_release_info()];
1010      my $compatible = (defined($my_release) && ($my_release == $his_release)) ? 1 : 0;  
1011        #
1012        # Release id is $my_release->[1].
1013        #
1014    
1015        my $compatible;
1016        if ($my_release->[1] ne "" and $his_release->[1] ne "")
1017        {
1018            #
1019            # Both releases must be defined for them to be compatible.
1020            #
1021            # At some point we need to consider the derived-release issue.
1022            #
1023    
1024            $compatible = $my_release->[1] eq $his_release->[1];
1025        }
1026        else
1027        {
1028            $compatible = 0;
1029        }
1030    
1031      open(my $fh, ">$spool_dir/INFO");      open(my $fh, ">$spool_dir/INFO");
1032      print $fh "requestor_release\t$his_release\n";      print $fh "requestor_release\t$his_release\n";
# Line 558  Line 1037 
1037      print $fh "num_pegs\t$num_pegs\n";      print $fh "num_pegs\t$num_pegs\n";
1038      print $fh "num_genomes\t$num_genomes\n";      print $fh "num_genomes\t$num_genomes\n";
1039      print $fh "num_annos\t$num_annos\n";      print $fh "num_annos\t$num_annos\n";
1040        print $fh "num_assignments\t$num_assignments\n";
1041      close($fh);      close($fh);
1042    
1043      return [$session_id, $my_release, $num_annos, $num_pegs, $num_genomes, $now, $compatible];      #
1044        # Construct list of users, and pdate local user database.
1045        #
1046    
1047        my @users = keys(%users);
1048        # $fig->ensure_users(\@users);
1049    
1050        return [$session_id, $my_release, $num_assignments, $num_annos, $num_pegs, $num_genomes,
1051                $now, $compatible, \@users];
1052  }  }
1053    
1054    
# Line 673  Line 1161 
1161    
1162      return [$peg_output, $genome_output];      return [$peg_output, $genome_output];
1163  }  }
1164    
1165    sub finalize_pegs
1166    {
1167        my($self, $session, $request) = @_;
1168        my($out);
1169    
1170        my $fig = new FIG;
1171    
1172        #
1173        # Walk the request handling appropriately. This is fairly easy, as it
1174        # is just a matter of pulling either sequence or location/contig data.
1175        #
1176    
1177        for my $item (@$request)
1178        {
1179            my($what, $peg) = @$item;
1180    
1181            if ($what eq "peg_genome")
1182            {
1183                #
1184                # Return the location and contig checksum for this peg.
1185                #
1186                # We also include the sequence in case the contig mapping doesn't work.
1187                #
1188    
1189                my $loc = $fig->feature_location($peg);
1190                my $contig = $fig->contig_of($loc);
1191                my $cksum = $fig->contig_checksum($fig->genome_of($peg), $contig);
1192                my $seq = $fig->get_translation($peg);
1193    
1194                push(@$out, ['peg_loc', $peg,
1195                            $fig->strand_of($peg),
1196                            $fig->beg_of($loc), $fig->end_of($loc),
1197                            $cksum, $seq]);
1198    
1199            }
1200            elsif ($what eq "peg_unknown")
1201            {
1202                my $seq = $fig->get_translation($peg);
1203                push(@$out, ['peg_seq', $peg, $seq]);
1204            }
1205        }
1206        return $out;
1207    }
1208    
1209    
1210    sub get_annotations
1211    {
1212        my($self, $session_id, $start, $len) = @_;
1213    
1214        #
1215        # This is now easy; just run thru the saved annotations and return.
1216        #
1217    
1218        my(%session_info);
1219    
1220        my $spool_dir = "$FIG_Config::temp/p2p_spool/$session_id";
1221    
1222        -d $spool_dir or die "Invalid session id $session_id";
1223    
1224        #
1225        # Read in the cached information for this session.
1226        #
1227    
1228        open(my $info_fh, "<$spool_dir/INFO") or die "Cannot open INFO file: $!";
1229        while (<$info_fh>)
1230        {
1231            chomp;
1232            my($var, $val) = split(/\t/, $_, 2);
1233            $session_info{$var} = $val;
1234        }
1235        close($info_fh);
1236    
1237        #
1238        # Sanity check start and length.
1239        #
1240    
1241        if ($start < 0 or $start >= $session_info{num_annos})
1242        {
1243            die "Invalid start position $start";
1244        }
1245    
1246        if ($len < 0 or ($start + $len - 1) >= $session_info{num_annos})
1247        {
1248            die "Invalid length $len";
1249        }
1250    
1251        #
1252        # Open file, spin to the starting line, then start reading.
1253        #
1254    
1255        open(my $anno_fh, "<$spool_dir/annos") or die "Cannot open annos file: $!";
1256    
1257        my $anno_output = [];
1258    
1259        my $anno_num = 0;
1260    
1261        local $/ = "//\n";
1262        while (<$anno_fh>)
1263        {
1264            next if ($anno_num < $start);
1265    
1266            last if ($anno_num > ($start + $len));
1267    
1268            chomp;
1269    
1270            my($id, $date, $author, $anno) = split(/\n/, $_, 4);
1271    
1272            push(@$anno_output, [$id, $date, $author, $anno]);
1273        }
1274        continue
1275        {
1276            $anno_num++;
1277        }
1278    
1279        return $anno_output;
1280    }
1281    
1282    sub get_assignments
1283    {
1284        my($self, $session_id, $start, $len) = @_;
1285    
1286        #
1287        # This is now easy; just run thru the saved assignments and return.
1288        #
1289    
1290        my(%session_info);
1291    
1292        my $spool_dir = "$FIG_Config::temp/p2p_spool/$session_id";
1293    
1294        -d $spool_dir or die "Invalid session id $session_id";
1295    
1296        #
1297        # Read in the cached information for this session.
1298        #
1299    
1300        open(my $info_fh, "<$spool_dir/INFO") or die "Cannot open INFO file: $!";
1301        while (<$info_fh>)
1302        {
1303            chomp;
1304            my($var, $val) = split(/\t/, $_, 2);
1305            $session_info{$var} = $val;
1306        }
1307        close($info_fh);
1308    
1309        #
1310        # Sanity check start and length.
1311        #
1312    
1313        if ($start < 0 or $start >= $session_info{num_assignments})
1314        {
1315            die "Invalid start position $start";
1316        }
1317    
1318        if ($len < 0 or ($start + $len - 1) >= $session_info{num_assignments})
1319        {
1320            die "Invalid length $len";
1321        }
1322    
1323        #
1324        # Open file, spin to the starting line, then start reading.
1325        #
1326    
1327        open(my $assign_fh, "<$spool_dir/assignments") or die "Cannot open assignments file: $!";
1328    
1329        my $assign_output = [];
1330    
1331        my $assign_num = 0;
1332    
1333        while (<$assign_fh>)
1334        {
1335            next if ($assign_num < $start);
1336    
1337            last if ($assign_num > ($start + $len));
1338    
1339            chomp;
1340    
1341            my($id, $date, $author, $func) = split(/\t/, $_, 4);
1342    
1343            push(@$assign_output, [$id, $date, $author, $func]);
1344        }
1345        continue
1346        {
1347            $assign_num++;
1348        }
1349    
1350        return $assign_output;
1351    }
1352    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.19

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3