[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.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 95  Line 122 
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)
# Line 107  Line 145 
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 125  Line 164 
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      #      #
# Line 180  Line 221 
221      # If we need to finalize, make the call.      # If we need to finalize, make the call.
222      if (@finalize_req)      if (@finalize_req)
223      {      {
224          print Dumper(\@finalize_req);          # print Dumper(\@finalize_req);
225          $ret = $peer->finalize_pegs($session, \@finalize_req);          $ret = $peer->finalize_pegs($session, \@finalize_req);
226    
227          if (!$ret or ref($ret) ne "ARRAY")          if (!$ret or ref($ret) ne "ARRAY")
# Line 193  Line 234 
234          # sequence data. Attempt to finish up the mapping.          # sequence data. Attempt to finish up the mapping.
235          #          #
236    
237            my(%sought, %sought_seq);
238    
239    
240          my $dbh = $fig->db_handle();          my $dbh = $fig->db_handle();
241          for my $entry (@$ret)          for my $entry (@$ret)
# Line 201  Line 244 
244    
245              if ($what eq "peg_loc")              if ($what eq "peg_loc")
246              {              {
247                  my($strand, $start, $end, $cksum) = @rest;                  my($strand, $start, $end, $cksum, $seq) = @rest;
248    
249                  #                  #
250                  # We have a contig location. Try to find a matching contig                  # We have a contig location. Try to find a matching contig
# Line 229  Line 272 
272                          my(@ids) = map { $_->[0] } @$res;                          my(@ids) = map { $_->[0] } @$res;
273                          my $id = $ids[0];                          my $id = $ids[0];
274                          $peg_mapping{$peg} = $id;                          $peg_mapping{$peg} = $id;
275                            $peg_cache{$peg} = $id;
276                          print "Mapped $peg to $id via contigs\n";                          print "Mapped $peg to $id via contigs\n";
277                          if (@$res > 1)                          if (@$res > 1)
278                          {                          {
# Line 238  Line 282 
282                      else                      else
283                      {                      {
284                          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";
285                            $sought{$peg}++;
286                            $sought_seq{$peg} = $seq;
287                      }                      }
288                  }                  }
289                  else                  else
290                  {                  {
291                      print "Mapping failed for $my_genome checksum $cksum\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 389  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 402  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 430  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 474  Line 747 
747      return $self->call("finalize_pegs", $session_id, $request);      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 554  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 567  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 590  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 607  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.
970          #          #
# Line 643  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 652  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 664  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 801  Line 1183 
1183              #              #
1184              # Return the location and contig checksum for this peg.              # 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);              my $loc = $fig->feature_location($peg);
1190              my $contig = $fig->contig_of($loc);              my $contig = $fig->contig_of($loc);
1191              my $cksum = $fig->contig_checksum($fig->genome_of($peg), $contig);              my $cksum = $fig->contig_checksum($fig->genome_of($peg), $contig);
1192              warn "Checksum for '$loc' '$contig' is $cksum\n";              my $seq = $fig->get_translation($peg);
1193    
1194              push(@$out, ['peg_loc', $peg,              push(@$out, ['peg_loc', $peg,
1195                          $fig->strand_of($loc),                          $fig->strand_of($peg),
1196                          $fig->beg_of($loc), $fig->end_of($loc),                          $fig->beg_of($loc), $fig->end_of($loc),
1197                          $cksum]);                          $cksum, $seq]);
1198    
1199          }          }
1200          elsif ($what eq "peg_unknown")          elsif ($what eq "peg_unknown")
# Line 822  Line 1206 
1206      return $out;      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.12  
changed lines
  Added in v.1.19

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3