[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.22, Fri Jan 7 19:24:39 2005 UTC revision 1.24, Mon Jan 10 13:15:00 2005 UTC
# Line 18  Line 18 
18    
19  use FIG_Config;  use FIG_Config;
20    
21  use DB_File;  use AnyDBM_File;
22  use Fcntl;  use Fcntl;
23    
24  use strict;  use strict;
# Line 39  Line 39 
39  my $peg_batch_size = 1000;  my $peg_batch_size = 1000;
40  my $anno_batch_size = 1000;  my $anno_batch_size = 1000;
41  my $assign_batch_size = 1000;  my $assign_batch_size = 1000;
42    my $fin_batch_size = 1000;
43    
44  my $log_fh;  my $log_fh;
45    my $html_fh;
46    
47  =pod  =pod
48    
# Line 58  Line 60 
60    
61  sub perform_update  sub perform_update
62  {  {
63      my($fig, $peer, $last_update, $skip_tough_search, $update_thru, $log_file) = @_;      my($fig, $peer, $last_update, $skip_tough_search, $update_thru, $log_file, $html_file) = @_;
64    
65      $log_file = "/dev/null" unless $log_file ne "";      $log_file = "/dev/null" unless $log_file ne "";
66      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";
67      $log_fh->autoflush(1);      $log_fh->autoflush(1);
68    
69      print $log_fh "Beginning P2P update at " . localtime() . "\n";      $html_file = "/dev/null" unless $html_file ne "";
70        open($html_fh, ">$html_file") or die "Cannot open htmlfile $html_file: $!\n";
71        $html_fh->autoflush(1);
72    
73        my $now = localtime();
74        my $last_str = localtime($last_update);
75        print $html_fh <<END;
76    <h1>P2P Update at $now</h1>
77    Peer URL $peer->{url}<br>
78    Update from: $last_str<br>
79    END
80    
81        print $log_fh "Beginning P2P update at $now\n";
82      print $log_fh "  Peer URL: $peer->{url}\n";      print $log_fh "  Peer URL: $peer->{url}\n";
83      print $log_fh "  Update from: " . localtime($last_update) . "\n";      print $log_fh "  Update from: $last_str\n";
84      print $log_fh "\n";      print $log_fh "\n";
85    
86      my $ret = $peer->request_update($last_update, $update_thru);      my $ret = $peer->request_update($last_update, $update_thru);
# Line 91  Line 105 
105      print $log_fh "$num_assignments assignments\n";      print $log_fh "$num_assignments assignments\n";
106      print $log_fh "$num_pegs pegs\n";      print $log_fh "$num_pegs pegs\n";
107    
108        print $html_fh "Session id = $session<br>\n";
109        print $html_fh "Target release information: <br>\n\t", join("<br>\n\t", @$target_release), "<br>\n";
110        print $html_fh "My release information: <br>\n\t", join("<br>\n\t", @my_release), "<br>\n";
111        print $html_fh "$num_annos annotations<br>\n";
112        print $html_fh "$num_assignments assignments<br>\n";
113        print $html_fh "$num_pegs pegs<br>\n";
114    
115      #      #
116      # We now know the data release for our peer.      # We now know the data release for our peer.
117      #      #
118      # Open up the peg translation cache database (a DB_File) tied      # Open up the peg translation cache database (a AnyDBM_File) tied
119      # to %peg_cache. We needn't worry about keeping it in a directory      # to %peg_cache. We needn't worry about keeping it in a directory
120      # based on our current release, as it the cache directory is kept *in*      # based on our current release, as it the cache directory is kept *in*
121      # the current data release directory.      # the current data release directory.
# Line 108  Line 129 
129          my $cache_dir = "$FIG_Config::data/P2PQueue";          my $cache_dir = "$FIG_Config::data/P2PQueue";
130          $fig->verify_dir($cache_dir);          $fig->verify_dir($cache_dir);
131    
132          $cache_handle = tie(%peg_cache, "DB_File", "$cache_dir/$cache_file",          $cache_handle = tie(%peg_cache, "AnyDBM_File", "$cache_dir/$cache_file",
133                              O_CREAT | O_RDWR, 0666, $DB_HASH);                              O_CREAT | O_RDWR, 0666);
134          $cache_handle or warn "Could not tie peg_cache to $cache_dir/$cache_file: $!\n";          $cache_handle or warn "Could not tie peg_cache to $cache_dir/$cache_file: $!\n";
135      }      }
136    
# Line 127  Line 148 
148      _compute_peg_mapping($fig, $peer, $session, $num_pegs, \%peg_mapping, \%peg_cache, $cache_handle,      _compute_peg_mapping($fig, $peer, $session, $num_pegs, \%peg_mapping, \%peg_cache, $cache_handle,
149                           $skip_tough_search);                           $skip_tough_search);
150    
151      $cache_handle->sync();      eval { $cache_handle->sync();};
152      untie %peg_cache;      untie %peg_cache;
153    
154      #      #
# Line 243  Line 264 
264          # Rename the annotations file to a new name based on the current time.          # Rename the annotations file to a new name based on the current time.
265          #          #
266    
267            my $gs = $fig->genus_species($genome);
268            print $html_fh "<h1>Updates for $genome ($gs)</h1>\n";
269    
270          if (-f $anno_file)          if (-f $anno_file)
271          {          {
272              rename($anno_file, $anno_bak) or die "Cannot rename $anno_file to $anno_bak: $!";              rename($anno_file, $anno_bak) or die "Cannot rename $anno_file to $anno_bak: $!";
# Line 287  Line 311 
311          # Determine if we are going to install an assignment.          # Determine if we are going to install an assignment.
312          #          #
313    
314            my $cgi_url = &FIG::cgi_url();
315            print $html_fh "<h2>Assignments made</h2>\n";
316            print $html_fh "<table>\n";
317            print $html_fh "<tr><th>PEG</th><th>Old assignment</th><th>New assignment</th><tr>\n";
318    
319          for my $peg (keys %$assignments)          for my $peg (keys %$assignments)
320          {          {
321              my(undef, $ts, $author, $func) = @{$assignments->{$peg}};              my(undef, $ts, $author, $func) = @{$assignments->{$peg}};
# Line 344  Line 373 
373    
374                  if ($old ne $func)                  if ($old ne $func)
375                  {                  {
376                        my $l = "$cgi_url/protein.cgi?prot=$peg";
377                        print $html_fh "<tr><td><a href=\"$l\">$peg</a></td><td>$old</td><td>$func</td></tr>\n";
378    
379                      print "Assign $peg $func\n";                      print "Assign $peg $func\n";
380                      print $log_fh "Assign $peg $func\n";                      print $log_fh "Assign $peg $func\n";
381                      print $log_fh "   was $old\n";                      print $log_fh "   was $old\n";
382                      $fig->assign_function($peg, 'master', $func);                      $fig->assign_function($peg, 'master', $func);
383    
384                  }                  }
385              }              }
386          }          }
387    
388            print $html_fh "</table>\n";
389    
390            print $html_fh "<h2>Annotations added</h2>\n";
391            print $html_fh "<table>\n";
392            print $html_fh "<tr><th>PEG</th><th>Time</th><th>Author</th><th>Annotation</th></tr>\n";
393    
394          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";
395    
396          my $last;          my $last;
# Line 368  Line 407 
407              chomp $txt;              chomp $txt;
408              if ($txt ne $last)              if ($txt ne $last)
409              {              {
410                    my $peg = $ann->[0];
411                    my $l = "$cgi_url/protein.cgi?prot=$peg";
412                    print $html_fh "<tr>" . join("\n", map { "<td>$_</td>" }
413                                                 "<a href=\"$l\">$peg</a>",
414                                                 scalar(localtime($ann->[1])), $ann->[2], $ann->[3])
415                        . "</tr>\n";
416    
417                  print $outfh "$txt\n//\n";                  print $outfh "$txt\n//\n";
418                  $last = $txt;                  $last = $txt;
419                  # print "Inst $ann->[0] $ann->[1] $ann->[2]\n";                  # print "Inst $ann->[0] $ann->[1] $ann->[2]\n";
# Line 379  Line 425 
425                  $dup++;                  $dup++;
426              }              }
427          }          }
428            print $html_fh "</table>\n";
429          close($outfh);          close($outfh);
430          chmod(0666, $anno_file) or warn "Cannot chmod 0666 $anno_file: $!\n";          chmod(0666, $anno_file) or warn "Cannot chmod 0666 $anno_file: $!\n";
431          print "Wrote $anno_file. $new_count new annos, $inst installed, $dup duplicates\n";          print "Wrote $anno_file. $new_count new annos, $inst installed, $dup duplicates\n";
432          print $log_fh "Wrote $anno_file. $new_count new annos, $inst installed, $dup duplicates\n";          print $log_fh "Wrote $anno_file. $new_count new annos, $inst installed, $dup duplicates\n";
433      }      }
434        close($html_fh);
435  }  }
436    
437  #  #
# Line 394  Line 442 
442  # $session      P2P session ID  # $session      P2P session ID
443  # $peg_mapping  Hash ref for the remote -> local PEG mapping  # $peg_mapping  Hash ref for the remote -> local PEG mapping
444  # $peg_cache    Hash ref for the persistent remote -> local PEG mapping cache db.  # $peg_cache    Hash ref for the persistent remote -> local PEG mapping cache db.
445  # $cache_handle DB_File handle corresponding to $peg_cache.  # $cache_handle AnyDBM_File handle corresponding to $peg_cache.
446  #  #
447  sub _compute_peg_mapping  sub _compute_peg_mapping
448  {  {
# Line 617  Line 665 
665      #      #
666      # Flush the cache to write out any computed mappings.      # Flush the cache to write out any computed mappings.
667      #      #
668      $cache_handle->sync();      eval { $cache_handle->sync();};
669    
670  }  }
671    
# Line 631  Line 679 
679      #      #
680      return unless ref($finalize_req) and @$finalize_req > 0;      return unless ref($finalize_req) and @$finalize_req > 0;
681    
     my $fin_batch_size = 50;  
   
682      while (@$finalize_req > 0)      while (@$finalize_req > 0)
683      {      {
684          my @req = splice(@$finalize_req, 0, $fin_batch_size);          my @req = splice(@$finalize_req, 0, $fin_batch_size);
# Line 701  Line 747 
747                      {                      {
748                          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";
749                          print $log_fh "failed: $peg  $my_genome and contig $local_contig start=$start end=$end strand=$strand\n";                          print $log_fh "failed: $peg  $my_genome and contig $local_contig start=$start end=$end strand=$strand\n";
750                            print $html_fh "Contig match failed: $peg $my_genome contig $local_contig start $start end $end strand $strand<br>\n";
751                          $sought{$peg}++;                          $sought{$peg}++;
752                          $sought_seq{$peg} = $seq;                          $sought_seq{$peg} = $seq;
753                      }                      }
# Line 709  Line 756 
756                  {                  {
757                      print "Mapping failed for $my_genome checksum $cksum\n";                      print "Mapping failed for $my_genome checksum $cksum\n";
758                      print $log_fh "Mapping failed for $my_genome checksum $cksum\n";                      print $log_fh "Mapping failed for $my_genome checksum $cksum\n";
759                        print $html_fh "Mapping failed for $my_genome checksum $cksum<br>\n";
760                      $sought{$peg}++;                      $sought{$peg}++;
761                      $sought_seq{$peg} = $seq;                      $sought_seq{$peg} = $seq;
762                  }                  }
# Line 766  Line 814 
814  {  {
815      my($class, $url) = @_;      my($class, $url) = @_;
816    
817      my $proxy = SOAP::Lite->uri($P2P::ns_relay)->proxy($url);      my $creds = ['seed-linux-2.uchicago.edu:80',
818                     'SEED User',
819                     annotator => 'anno4all'];
820    
821        my $proxy = SOAP::Lite->uri($P2P::ns_relay)->proxy([$url,
822                                                            credentials => $creds]);
823    
824      my $self = {      my $self = {
825          url => $url,          url => $url,
# Line 900  Line 953 
953    
954  sub new  sub new
955  {  {
956      my($class, $fig, $url, $peer_id, $relay) = @_;      my($class, $fig, $url, $peer_id, $relay, $credentials) = @_;
957    
958        $credentials = [] unless ref($credentials);
959    
960      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url, timeout => 3600);      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url, timeout => 3600,
961                                                    credentials => $credentials);
962    
963      my $self = {      my $self = {
964          fig => $fig,          fig => $fig,

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3