[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.24, Mon Jan 10 13:15:00 2005 UTC revision 1.26, Tue Jan 11 14:06:18 2005 UTC
# Line 46  Line 46 
46    
47  =pod  =pod
48    
49  =head1 perform_update($peer)  =head1 perform_update($peer, $last_update, $skip_tough_search, $update_thru, $log_file, $html_file, $assignment_policy))
50    
51  Perform a peer-to-peer update with the given peer. $peer is an instance of  Perform a peer-to-peer update with the given peer. $peer is an instance of
52  P2P::Requestor which can connect to the peer. It is expected that the  P2P::Requestor which can connect to the peer. It is expected that the
# Line 56  Line 56 
56  This code executes the high-level protocol, maintaining state between  This code executes the high-level protocol, maintaining state between
57  calls to the peer to exchange the actual information.  calls to the peer to exchange the actual information.
58    
59        $last_update: Search for updates since this time.
60        $skip_tough_search: Do not use the time-consuming $fig->tough_search method as a last resort for peg mapping.
61        $update_thru: Search for updates until this time. Undef means to search for all since $last_update.
62        $log_file: Write logging information to this file.
63        $html_file: Write a HTML summary to this file.
64        $assignment_policy: If a list reference, contains the list of users from which we will accept assignments. If a code ref, a predicate that is passed ($peg, $timestamp, $author, $function) and returns true if the assignment should be made.
65    
66  =cut  =cut
67    
68  sub perform_update  sub perform_update
69  {  {
70      my($fig, $peer, $last_update, $skip_tough_search, $update_thru, $log_file, $html_file) = @_;      my($fig, $peer, $last_update, $skip_tough_search, $update_thru, $log_file, $html_file,
71           $assignment_policy) = @_;
72    
73        my $allow_assignment;
74    
75      $log_file = "/dev/null" unless $log_file ne "";      $log_file = "/dev/null" unless $log_file ne "";
76      open($log_fh, ">>$log_file") or die "Cannot open logfile $log_file: $!\n";      open($log_fh, ">>$log_file") or die "Cannot open logfile $log_file: $!\n";
# Line 70  Line 80 
80      open($html_fh, ">$html_file") or die "Cannot open htmlfile $html_file: $!\n";      open($html_fh, ">$html_file") or die "Cannot open htmlfile $html_file: $!\n";
81      $html_fh->autoflush(1);      $html_fh->autoflush(1);
82    
83        if (ref($assignment_policy) eq "CODE")
84        {
85            $allow_assignment = $assignment_policy;
86        }
87        elsif (ref($assignment_policy) eq "ARRAY")
88        {
89            my $ahash = {};
90            map { $ahash->{$_}++; } @$assignment_policy;
91            $allow_assignment = sub {
92                return $ahash->{$_[2]};
93            };
94        }
95        elsif (ref($assignment_policy) eq "HASH")
96        {
97            $allow_assignment = sub {
98                return $assignment_policy->{$_[2]};
99            };
100        }
101        else
102        {
103            print $log_fh "Invalid assignment policy $assignment_policy\n";
104            die "Invalid assignment policy $assignment_policy\n";
105        }
106    
107      my $now = localtime();      my $now = localtime();
108      my $last_str = localtime($last_update);      my $last_str = localtime($last_update);
109      print $html_fh <<END;      print $html_fh <<END;
# Line 290  Line 324 
324    
325                  if ($peg =~ /^fig\|/ and $ts =~ /^\d+$/)                  if ($peg =~ /^fig\|/ and $ts =~ /^\d+$/)
326                  {                  {
327                      my $ent = [$peg, $ts, $author, $anno];                      #
328                        # The last field marks this as an "old" annotation, so we don't
329                        # log its installation later.
330                        #
331                        my $ent = [$peg, $ts, $author, $anno, 1];
332                      push(@annos, $ent);                      push(@annos, $ent);
333    
334                      if (defined($assignments->{$peg}))                      if (defined($assignments->{$peg}))
# Line 313  Line 351 
351    
352          my $cgi_url = &FIG::cgi_url();          my $cgi_url = &FIG::cgi_url();
353          print $html_fh "<h2>Assignments made</h2>\n";          print $html_fh "<h2>Assignments made</h2>\n";
354          print $html_fh "<table>\n";          print $html_fh "<table border=\"1\">\n";
355          print $html_fh "<tr><th>PEG</th><th>Old assignment</th><th>New assignment</th><tr>\n";          print $html_fh "<tr><th>PEG</th><th>Old assignment</th><th>New assignment</th><tr>\n";
356    
357          for my $peg (keys %$assignments)          for my $peg (keys %$assignments)
# Line 323  Line 361 
361              #              #
362              # Sort the existing annotations for this peg by date.              # Sort the existing annotations for this peg by date.
363              #              #
364              # Recall that this list has entries [$peg, $timestamp, $author, $anno]              # Recall that this list has entries [$peg, $timestamp, $author, $anno, $old_flag]
365              #              #
366    
367              my @eannos;              my @eannos;
# Line 371  Line 409 
409    
410                  my $old = $fig->function_of($peg, 'master');                  my $old = $fig->function_of($peg, 'master');
411    
412                  if ($old ne $func)                  if ($old ne $func and &$allow_assignment($peg, $ts, $author, $func))
413                  {                  {
414                      my $l = "$cgi_url/protein.cgi?prot=$peg";                      my $l = "$cgi_url/protein.cgi?prot=$peg";
415                      print $html_fh "<tr><td><a href=\"$l\">$peg</a></td><td>$old</td><td>$func</td></tr>\n";                      print $html_fh "<tr><td><a href=\"$l\">$peg</a></td><td>$old</td><td>$func</td></tr>\n";
# Line 388  Line 426 
426          print $html_fh "</table>\n";          print $html_fh "</table>\n";
427    
428          print $html_fh "<h2>Annotations added</h2>\n";          print $html_fh "<h2>Annotations added</h2>\n";
429          print $html_fh "<table>\n";          print $html_fh "<table border=\"1\">\n";
430          print $html_fh "<tr><th>PEG</th><th>Time</th><th>Author</th><th>Annotation</th></tr>\n";          print $html_fh "<tr><th>PEG</th><th>Time</th><th>Author</th><th>Annotation</th></tr>\n";
431    
432          open(my $outfh, ">$anno_file") or die "Cannot open new annotation file $anno_file: $!\n";          open(my $outfh, ">$anno_file") or die "Cannot open new annotation file $anno_file: $!\n";
# Line 409  Line 447 
447              {              {
448                  my $peg = $ann->[0];                  my $peg = $ann->[0];
449                  my $l = "$cgi_url/protein.cgi?prot=$peg";                  my $l = "$cgi_url/protein.cgi?prot=$peg";
450                    if (!$ann->[4])
451                    {
452                  print $html_fh "<tr>" . join("\n", map { "<td>$_</td>" }                  print $html_fh "<tr>" . join("\n", map { "<td>$_</td>" }
453                                               "<a href=\"$l\">$peg</a>",                                               "<a href=\"$l\">$peg</a>",
454                                               scalar(localtime($ann->[1])), $ann->[2], $ann->[3])                                               scalar(localtime($ann->[1])), $ann->[2], $ann->[3])
455                      . "</tr>\n";                      . "</tr>\n";
456                    }
457    
458                  print $outfh "$txt\n//\n";                  print $outfh "$txt\n//\n";
459                  $last = $txt;                  $last = $txt;
# Line 814  Line 855 
855  {  {
856      my($class, $url) = @_;      my($class, $url) = @_;
857    
858      my $creds = ['seed-linux-2.uchicago.edu:80',      my $creds = [];
                  'SEED User',  
                  annotator => 'anno4all'];  
859    
860      my $proxy = SOAP::Lite->uri($P2P::ns_relay)->proxy([$url,      my $proxy = SOAP::Lite->uri($P2P::ns_relay)->proxy([$url,
861                                                          credentials => $creds]);                                                          credentials => $creds]);
# Line 1162  Line 1201 
1201      my $assign_fh;      my $assign_fh;
1202      open($assign_fh, ">$spool_dir/assignments");      open($assign_fh, ">$spool_dir/assignments");
1203    
1204        #
1205        # We originally used a query to get the PEGs that needed to have annotations
1206        # sent. Unfortunately, this performed very poorly due to all of the resultant
1207        # seeking around in the annotations files.
1208        #
1209        # The code below just runs through all of the anno files looking for annos.
1210        #
1211        # A better way to do this would be to do a query to retrieve the genome id's for
1212        # genomes that have updates. The problem here is that the annotation_seeks
1213        # table doesn't have an explicit genome field.
1214        #
1215        # Surprisingly, to me anyway, the following query appers to run quickly, in both
1216        # postgres and mysql:
1217        #
1218        # SELECT distinct(substring(fid from 5 for position('.peg.' in fid) - 5))
1219        # FROM annotation_seeks
1220        # WHERE dateof > some-date.
1221        #
1222        # The output of that can be parsed to get the genome id and just those
1223        # annotations files searched.
1224        #
1225    
1226      for my $genome (@$all_genomes)      for my $genome (@$all_genomes)
1227      {      {
1228          my $num_annos_for_genome = 0;          my $num_annos_for_genome = 0;

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.26

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3