[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.12, Fri Sep 24 19:52:25 2004 UTC revision 1.17, Mon Dec 6 18:26:25 2004 UTC
# Line 22  Line 22 
22  use Exporter;  use Exporter;
23  use base qw(Exporter);  use base qw(Exporter);
24    
25    use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
26    
27  use Data::Dumper;  use Data::Dumper;
28    
29  use vars qw(@EXPORT @EXPORT_OK);  use vars qw(@EXPORT @EXPORT_OK);
# Line 56  Line 58 
58          die "perform_update: request_updated failed\n";          die "perform_update: request_updated failed\n";
59      }      }
60    
61      my($session, $target_release, $num_annos, $num_pegs, $num_genomes,      my($session, $target_release, $num_assignments, $num_annos, $num_pegs, $num_genomes,
62         $target_time, $compatible) = @$ret;         $target_time, $compatible) = @$ret;
63    
64      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";
# Line 193  Line 195 
195          # sequence data. Attempt to finish up the mapping.          # sequence data. Attempt to finish up the mapping.
196          #          #
197    
198            my(%sought, %sought_seq);
199    
200    
201          my $dbh = $fig->db_handle();          my $dbh = $fig->db_handle();
202          for my $entry (@$ret)          for my $entry (@$ret)
# Line 201  Line 205 
205    
206              if ($what eq "peg_loc")              if ($what eq "peg_loc")
207              {              {
208                  my($strand, $start, $end, $cksum) = @rest;                  my($strand, $start, $end, $cksum, $seq) = @rest;
209    
210                  #                  #
211                  # We have a contig location. Try to find a matching contig                  # We have a contig location. Try to find a matching contig
# Line 238  Line 242 
242                      else                      else
243                      {                      {
244                          print "failed: $peg  $my_genome and contig $local_contig start=$start end=$end strand=$strand\n";                          print "failed: $peg  $my_genome and contig $local_contig start=$start end=$end strand=$strand\n";
245                            $sought{$peg}++;
246                            $sought_seq{$peg} = $seq;
247                      }                      }
248                  }                  }
249                  else                  else
250                  {                  {
251                      print "Mapping failed for $my_genome checksum $cksum\n";                      print "Mapping failed for $my_genome checksum $cksum\n";
252                        $sought{$peg}++;
253                        $sought_seq{$peg} = $seq;
254                    }
255                  }                  }
256                elsif ($what eq "peg_seq")
257                {
258                    my($seq) = @rest;
259    
260                    $sought{$peg}++;
261                    $sought_seq{$peg} = $seq;
262              }              }
263          }          }
264    
265            #
266            # Now see if we need to do a tough search.
267            #
268    
269            if (keys(%sought) > 0)
270            {
271                my %trans;
272    
273                print "Starting tough search\n";
274    
275                $fig->tough_search(undef, \%sought_seq, \%trans, \%sought);
276                print "Tough search translated: \n";
277                while (my($tpeg, $ttrans) = each(%trans))
278                {
279                    print "  $tpeg -> $ttrans\n";
280                    $peg_mapping{$tpeg} = $ttrans;
281                }
282      }      }
283  }  }
284    
285        #
286        # Retrieve the annotations, and generate a list of mapped annotations.
287        #
288    
289        my $annos = $peer->get_annotations($session, 0, $num_annos > 10 ? 10 : $num_annos);
290    
291        #
292        # Create a list of locally-mapped annotations on a per-genome
293        # basis.
294        #
295    
296        my %genome_annos;
297    
298        for my $anno (@$annos)
299        {
300            my($his_id, $ts, $author, $anno) = @$anno;
301    
302            my $my_id = $peg_mapping{$his_id};
303            next unless $my_id;
304    
305            my $genome = $fig->genome_of($my_id);
306    
307            push(@{$genome_annos{$genome}}, [$my_id, $ts, $author, $anno]);
308        }
309    
310        print Dumper(\%genome_annos);
311    
312        #
313        # Now install annotations.
314        #
315    
316        for my $genome (keys(%genome_annos))
317        {
318            # _install_genome_annos($fig, $genome, $genome_annos{$genome});
319        }
320    }
321    
322    
323    
324  #############  #############
325  #  #
# Line 389  Line 460 
460  use strict;  use strict;
461    
462  use Data::Dumper;  use Data::Dumper;
463    use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
464    
465  use SOAP::Lite;  use SOAP::Lite;
466    
467    #use SOAP::Lite +trace => [qw(transport dispatch result debug)];
468  use P2P;  use P2P;
469    
470  #  #
# Line 402  Line 476 
476  {  {
477      my($class, $fig, $url, $peer_id, $relay) = @_;      my($class, $fig, $url, $peer_id, $relay) = @_;
478    
479      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url);      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url, timeout => 3600);
480    
481      my $self = {      my $self = {
482          fig => $fig,          fig => $fig,
# Line 437  Line 511 
511          $last_update = $self->{fig}->get_peer_last_update($self->{peer_id});          $last_update = $self->{fig}->get_peer_last_update($self->{peer_id});
512      }      }
513    
514        print "Requesting update via $self->{proxy}\n";
515      my $reply = $self->{proxy}->request_update($rel, $last_update);      my $reply = $self->{proxy}->request_update($rel, $last_update);
516        print "Got reply ", Dumper($reply);
517    
518      if ($self->{relay})      if ($self->{relay})
519      {      {
# Line 474  Line 550 
550      return $self->call("finalize_pegs", $session_id, $request);      return $self->call("finalize_pegs", $session_id, $request);
551  }  }
552    
553    sub get_annotations
554    {
555        my($self, $session_id, $start, $length) = @_;
556    
557        return $self->call("get_annotations", $session_id, $start, $length);
558    }
559    
560  sub call  sub call
561  {  {
562      my($self, $func, @args) = @_;      my($self, $func, @args) = @_;
563    
564        my $t0 = [gettimeofday()];
565        print "Calling $func\n";
566      my $reply = $self->{proxy}->$func(@args);      my $reply = $self->{proxy}->$func(@args);
567        my $t1 = [gettimeofday()];
568    
569        my $elap = tv_interval($t0, $t1);
570        print "Call to $func took $elap\n";
571    
572      if ($self->{relay})      if ($self->{relay})
573      {      {
# Line 554  Line 643 
643    
644      my %pegs;      my %pegs;
645    
646        #
647        # We keep track of usernames that have been seen, so that
648        # we can both update our local user database and
649        # we can report them to our peer.
650        #
651    
652        my %users;
653    
654      my $num_annos = 0;      my $num_annos = 0;
655      my $num_genomes = 0;      my $num_genomes = 0;
656      my $num_pegs = 0;      my $num_pegs = 0;
657        my $num_assignments = 0;
658    
659      my $anno_fh;      my $anno_fh;
660      open($anno_fh, ">$spool_dir/annos");      open($anno_fh, ">$spool_dir/annos");
# Line 567  Line 665 
665      my $genome_fh;      my $genome_fh;
666      open($genome_fh, ">$spool_dir/genomes");      open($genome_fh, ">$spool_dir/genomes");
667    
668        my $assign_fh;
669        open($assign_fh, ">$spool_dir/assignments");
670    
671      for my $genome (@$all_genomes)      for my $genome (@$all_genomes)
672      {      {
673          my $num_annos_for_genome = 0;          my $num_annos_for_genome = 0;
674            my %assignment;
675    
676          my $genome_dir = "$FIG_Config::organisms/$genome";          my $genome_dir = "$FIG_Config::organisms/$genome";
677          next unless -d $genome_dir;          next unless -d $genome_dir;
# Line 590  Line 692 
692    
693                  {                  {
694                      #                      #
695                        # Update users list.
696                        #
697    
698                        $users{$who}++;
699    
700                        #
701                      # Look up aliases if we haven't seen this fid before.                      # Look up aliases if we haven't seen this fid before.
702                      #                      #
703    
# Line 607  Line 715 
715    
716                      $num_annos_for_genome++;                      $num_annos_for_genome++;
717                      $num_annos++;                      $num_annos++;
718    
719                        #
720                        # While we're here, see if this is an assignment. We check in the
721                        # %assignment hash, which is keyed on fid, to see if we already
722                        # saw an assignment for this fid. If we have, we keep this one only if
723                        # the assignment time on it is later than the one we saw already.
724                        #
725                        # We are only looking at master assignments for now. We will need
726                        # to return to this issue and reexamine it, but in order to move
727                        # forward I am only matching master assignments.
728                        #
729    
730                        if ($anno_text =~ /Set master function to\n(\S[^\n]+\S)/)
731                        {
732                            my $func = $1;
733    
734                            my $other = $assignment{$fid};
735    
736                            #
737                            # If we haven't seen an assignment for this fid,
738                            # or if it the other assignment has a timestamp that
739                            # is earlier than this one, set the assignment.
740                            #
741    
742                            if (!defined($other) or
743                                ($other->[1] < $anno_time))
744                            {
745                                $assignment{$fid} = [$fid, $anno_time, $who, $func];
746                            }
747                        }
748                  }                  }
749              }              }
750              close($afh);              close($afh);
751    
752                #
753                # Write out the assignments that remain.
754                #
755    
756                for my $fid (sort keys(%assignment))
757                {
758                    print $assign_fh join("\t", @{$assignment{$fid}}), "\n";
759                    $num_assignments++;
760          }          }
761            }
762    
763    
764          #          #
765          # Determine genome information if we have annotations for this one.          # Determine genome information if we have annotations for this one.
# Line 643  Line 792 
792      close($anno_fh);      close($anno_fh);
793      close($peg_fh);      close($peg_fh);
794      close($genome_fh);      close($genome_fh);
795        close($assign_fh);
796    
797      print "Pegs: $num_pegs\n";      print "Pegs: $num_pegs\n";
798      print "Genomes: $num_genomes\n";      print "Genomes: $num_genomes\n";
# Line 664  Line 814 
814      print $fh "num_pegs\t$num_pegs\n";      print $fh "num_pegs\t$num_pegs\n";
815      print $fh "num_genomes\t$num_genomes\n";      print $fh "num_genomes\t$num_genomes\n";
816      print $fh "num_annos\t$num_annos\n";      print $fh "num_annos\t$num_annos\n";
817        print $fh "num_assignments\t$num_assignments\n";
818      close($fh);      close($fh);
819    
820      return [$session_id, $my_release, $num_annos, $num_pegs, $num_genomes, $now, $compatible];      #
821        # Construct list of users, and pdate local user database.
822        #
823    
824        my @users = keys(%users);
825        # $fig->ensure_users(\@users);
826    
827        return [$session_id, $my_release, $num_assignments, $num_annos, $num_pegs, $num_genomes,
828                $now, $compatible, \@users];
829  }  }
830    
831    
# Line 801  Line 960 
960              #              #
961              # Return the location and contig checksum for this peg.              # Return the location and contig checksum for this peg.
962              #              #
963                # We also include the sequence in case the contig mapping doesn't work.
964                #
965    
966              my $loc = $fig->feature_location($peg);              my $loc = $fig->feature_location($peg);
967              my $contig = $fig->contig_of($loc);              my $contig = $fig->contig_of($loc);
968              my $cksum = $fig->contig_checksum($fig->genome_of($peg), $contig);              my $cksum = $fig->contig_checksum($fig->genome_of($peg), $contig);
969              warn "Checksum for '$loc' '$contig' is $cksum\n";              my $seq = $fig->get_translation($peg);
970    
971              push(@$out, ['peg_loc', $peg,              push(@$out, ['peg_loc', $peg,
972                          $fig->strand_of($loc),                          $fig->strand_of($peg),
973                          $fig->beg_of($loc), $fig->end_of($loc),                          $fig->beg_of($loc), $fig->end_of($loc),
974                          $cksum]);                          $cksum, $seq]);
975    
976          }          }
977          elsif ($what eq "peg_unknown")          elsif ($what eq "peg_unknown")
# Line 822  Line 983 
983      return $out;      return $out;
984  }  }
985    
986    
987    sub get_annotations
988    {
989        my($self, $session_id, $start, $len) = @_;
990    
991        #
992        # This is now easy; just run thru the saved annotations and return.
993        #
994    
995        my(%session_info);
996    
997        my $spool_dir = "$FIG_Config::temp/p2p_spool/$session_id";
998    
999        -d $spool_dir or die "Invalid session id $session_id";
1000    
1001        #
1002        # Read in the cached information for this session.
1003        #
1004    
1005        open(my $info_fh, "<$spool_dir/INFO") or die "Cannot open INFO file: $!";
1006        while (<$info_fh>)
1007        {
1008            chomp;
1009            my($var, $val) = split(/\t/, $_, 2);
1010            $session_info{$var} = $val;
1011        }
1012        close($info_fh);
1013    
1014        #
1015        # Sanity check start and length.
1016        #
1017    
1018        if ($start < 0 or $start >= $session_info{num_annos})
1019        {
1020            die "Invalid start position $start";
1021        }
1022    
1023        if ($len < 0 or ($start + $len - 1) >= $session_info{num_annos})
1024        {
1025            die "Invalid length $len";
1026        }
1027    
1028        #
1029        # Open file, spin to the starting line, then start reading.
1030        #
1031    
1032        open(my $anno_fh, "<$spool_dir/annos") or die "Cannot open annos file: $!";
1033    
1034        my $anno_output = [];
1035    
1036        my $anno_num = 0;
1037    
1038        local $/ = "//\n";
1039        while (<$anno_fh>)
1040        {
1041            next if ($anno_num < $start);
1042    
1043            last if ($anno_num > ($start + $len));
1044    
1045            chomp;
1046    
1047            my($id, $date, $author, $anno) = split(/\n/, $_, 4);
1048    
1049            push(@$anno_output, [$id, $date, $author, $anno]);
1050        }
1051        continue
1052        {
1053            $anno_num++;
1054        }
1055    
1056        return $anno_output;
1057    }

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.17

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3