[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.25, Mon Jan 10 22:56:49 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 313  Line 347 
347    
348          my $cgi_url = &FIG::cgi_url();          my $cgi_url = &FIG::cgi_url();
349          print $html_fh "<h2>Assignments made</h2>\n";          print $html_fh "<h2>Assignments made</h2>\n";
350          print $html_fh "<table>\n";          print $html_fh "<table border=\"1\">\n";
351          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";
352    
353          for my $peg (keys %$assignments)          for my $peg (keys %$assignments)
# Line 371  Line 405 
405    
406                  my $old = $fig->function_of($peg, 'master');                  my $old = $fig->function_of($peg, 'master');
407    
408                  if ($old ne $func)                  if ($old ne $func and &$allow_assignment($peg, $ts, $author, $func))
409                  {                  {
410                      my $l = "$cgi_url/protein.cgi?prot=$peg";                      my $l = "$cgi_url/protein.cgi?prot=$peg";
411                      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 422 
422          print $html_fh "</table>\n";          print $html_fh "</table>\n";
423    
424          print $html_fh "<h2>Annotations added</h2>\n";          print $html_fh "<h2>Annotations added</h2>\n";
425          print $html_fh "<table>\n";          print $html_fh "<table border=\"1\">\n";
426          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";
427    
428          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 814  Line 848 
848  {  {
849      my($class, $url) = @_;      my($class, $url) = @_;
850    
851      my $creds = ['seed-linux-2.uchicago.edu:80',      my $creds = [];
                  'SEED User',  
                  annotator => 'anno4all'];  
852    
853      my $proxy = SOAP::Lite->uri($P2P::ns_relay)->proxy([$url,      my $proxy = SOAP::Lite->uri($P2P::ns_relay)->proxy([$url,
854                                                          credentials => $creds]);                                                          credentials => $creds]);
# Line 1162  Line 1194 
1194      my $assign_fh;      my $assign_fh;
1195      open($assign_fh, ">$spool_dir/assignments");      open($assign_fh, ">$spool_dir/assignments");
1196    
1197        #
1198        # We originally used a query to get the PEGs that needed to have annotations
1199        # sent. Unfortunately, this performed very poorly due to all of the resultant
1200        # seeking around in the annotations files.
1201        #
1202        # The code below just runs through all of the anno files looking for annos.
1203        #
1204        # A better way to do this would be to do a query to retrieve the genome id's for
1205        # genomes that have updates. The problem here is that the annotation_seeks
1206        # table doesn't have an explicit genome field.
1207        #
1208        # Surprisingly, to me anyway, the following query appers to run quickly, in both
1209        # postgres and mysql:
1210        #
1211        # SELECT distinct(substring(fid from 5 for position('.peg.' in fid) - 5))
1212        # FROM annotation_seeks
1213        # WHERE dateof > some-date.
1214        #
1215        # The output of that can be parsed to get the genome id and just those
1216        # annotations files searched.
1217        #
1218    
1219      for my $genome (@$all_genomes)      for my $genome (@$all_genomes)
1220      {      {
1221          my $num_annos_for_genome = 0;          my $num_annos_for_genome = 0;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3