[Bio] / FigKernelPackages / P2Pupdate.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/P2Pupdate.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19, Wed Jan 7 03:34:13 2004 UTC revision 1.20, Wed Jan 21 18:27:29 2004 UTC
# Line 466  Line 466 
466    
467  =head1 package_aassignments  =head1 package_aassignments
468    
469  usage: &package_assignments($fig_base,$who,$date,$genomes,$file)  usage: package_assignments($fig,$user,$who,$date,$genomes,$file)
470    
471  $fig_base must be an absolute filename (begins with "/") giving the FIG from which  $user designates the user wishing to get the assignments
    the updated code release will be taken.  
472    
473  $who designates whose assignments you want (defaults to "master")  $who designates whose assignments you want (defaults to "master")
474    
# Line 482  Line 481 
481  =cut  =cut
482    
483  sub package_assignments {  sub package_assignments {
484      my($fig,$fig_base,$who,$date,$genomes,$file) = @_;      my($fig,$user,$who,$date,$genomes,$file) = @_;
485      my($genome,$x,$org,$curr);      my($genome,$x,$org,$curr);
   
486      $who   = $who ? $who : "master";      $who   = $who ? $who : "master";
487      $date  = $date ? $date : 0;      $date  = $date ? $date : 0;
488      &force_absolute($fig_base);      if (open(ASSIGNMENTS,">$file"))
     if (-d "$fig_base/Tmp/Assignments") { system "rm -rf $fig_base/Tmp/Assignments" }  
     mkdir("$fig_base/Tmp/Assignments",0777) || die "could not make $fig_base/Tmp/Assignments";  
     foreach $x (sort { $a->[0] cmp $b->[0] } $fig->assignments_made($genomes,$who,$date))  
489      {      {
490          if ($x->[0] =~ /^fig\|(\d+\.\d+)/)          print ASSIGNMENTS "$user\t$who\t$date\n";
491          {          foreach $x (sort { $a->[0] cmp $b->[0] } $fig->assignments_made($genomes,$who,$date))
             $org = $1;  
             if (! defined($curr))  
             {  
                 mkdir("$fig_base/Tmp/Assignments/$org",0777) || die "could not make $fig_base/Tmp/Assignments/$org";  
                 open(ASS,">$fig_base/Tmp/Assignments/$org/$who") || die "could not open $fig_base/Tmp/Assignments/$org/$who";  
                 $curr = $org;  
             }  
             elsif ($curr ne $org)  
492              {              {
493                  close(ASS);              print ASSIGNMENTS join("\t",@$x),"\n";
                 mkdir("$fig_base/Tmp/Assignments/$org",0777) || die "could not make $fig_base/Tmp/Assignments/$org";  
                 open(ASS,">$fig_base/Tmp/Assignments/$org/$who") || die "could not open $fig_base/Tmp/Assignments/$org/$who";  
                 $curr = $org;  
             }  
             print ASS join("\t",@$x),"\n";  
494          }          }
495      }      }
496      close(ASS);      close(ASSIGNMENTS);
     &FIG::run("cd $fig_base/Tmp; tar czf $file Assignments; rm -rf Assignments");  
497  }  }
498    
499  =pod  =pod
500    
501  =head1 install_assignments  =head1 install_assignments
502    
503  usage: &install_assignments($fig_bdisk,$package,$who_from,$logfile)  usage: &install_assignments($package)
504    
505  $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.  $package must be a filename where the "assignments package" from which to make
506        the assignment set exists
 $package must be an absolute filename where the "assignments package" from which to make  
     the update exists.  
507    
508  =cut  =cut
509    
510  sub install_assignments {  sub install_assignments {
511      my($fig,$fig_disk,$package,$who_from) = @_;      my($package) = @_;
512      my($genome);      my($genome);
513    
514      &force_absolute($fig_disk);      open(IN,"<$package") || die "could not open $package";
515        my $line = <IN>;
516      &FIG::verify_dir("$FIG_Config::data/Assignments");      chop $line;
517      my $file = &FIG::epoch_to_readable(time);      ($user,$who,$date) = split(/\t/,$line);
518      open(LOG,">$FIG_Config::data/Assignments/$file") || return;      &FIG::verify_dir("$FIG_Config::data/Assignments/$user");
519        my $file = "$who-$date";
520      if (-d "$fig_disk/BackupAssignments") { system "rm -rf $fig_disk/BackupAssignments" }      $file =~ s/\//-/g;
521      mkdir("$fig_disk/BackupAssignments",0777);      open(OUT,">$FIG_Config::data/Assignments/$user/$file")
522      mkdir("$fig_disk/BackupAssignments/New",0777);          || die "could not open $FIG_Config::data/Assignments/$user/$file";
523      &FIG::run("cd $fig_disk/BackupAssignments/New; tar xzf $package");      while (defined($line = <IN>))
524      &FIG::run("cd $fig_disk/FIG/Data/Organisms; tar czf $fig_disk/BackupAssignments/before_update.tgz */assigned_functions */UserModels");      {
525            print OUT $line;
526      opendir(TMP,"$fig_disk/BackupAssignments/New/Assignments") || die "could not open $fig_disk/BackupAssignments/New/Assignments";      }
527      my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(TMP);      close(IN);
528      closedir(TMP);      close(OUT);
529        if (! -s "$FIG_Config::data/Assignments/$user/$file") { unlink("$FIG_Config::data/Assignments/$user/$file") }
     my @rules = ();  
     if (-s "$fig_disk/FIG/Data/Global/assignment.merging.rules")  
     {  
         push(@rules,`cat $fig_disk/FIG/Data/Global/assignment.merging.rules`);  
     }  
     push(@rules,"*\t*\toverride_hypo");  
   
     my $time_made = time;  
     foreach $genome (@genomes)  
     {  
         next if (! -d "$fig_disk/FIG/Data/Organisms/$genome)");  
   
         @updates = &get_assignments_for_genome("$fig_disk/FIG/Data/Organisms",$genome,$who_from,"$fig_disk/BackupAssignments/New/Assignments/$genome",\@rules,\*LOG);  
         my $tuple;  
         foreach $tuple (@updates)  
         {  
             my($peg,$func_and_conf,$user) = @$tuple;  
             print LOG "$peg\t$func_and_conf\n";  
         }  
     }  
     close(LOG);  
 }  
   
 sub restore_assignments {  
     my($fig_disk) = @_;  
   
     &force_absolute($fig_disk);  
     (-s "$fig_disk/BackupAssignments/before_update.tgz") || die "could not find an active backup";  
     &FIG::run("cd $fig_disk/FIG/Data/Organisms; rm -rf */assigned_functions */UserModels; tar xzf $fig_disk/BackupAssignments/before_update.tgz; cd $fig_disk/FIG/bin; add_assertions_of_function");  
 }  
   
 sub get_assignments_for_genome {  
     my($organisms,$genome,$who_from,$from_dir,$rules,$fh_log) = @_;  
     my(@updates) = ();  
   
     my $time_made = time;  
     if (opendir(FROM,$from_dir))  
     {  
         @users = grep { ($_ !~ /^\./) && (-s "$from_dir/$_") } readdir(FROM);  
         closedir(FROM);  
   
         $rule = &what_merge_rules($rules,$genome,$who_from);  
         foreach $user (@users)  
         {  
             next if ($rule eq "ignore");  
             undef %existing;  
             $file = ($user eq "master")       ? "$organisms/$genome/assigned_functions" :  
                                                 "$organisms/$genome/UserModels/$merge_with/assigned_functions";  
             if (-s $file)  
             {  
                 foreach $x (`cat $file`)  
                 {  
                     if ($x =~ /^(\S+)\t(\S.*\S)/)  
                     {  
                         $existing{$1} = $2;  
                     }  
                 }  
             }  
             elsif ($file =~ /^(.*)\/[^\/]+$/)  
             {  
                 &FIG::verify_dir($1);  
             }  
   
             my %possible;  
             undef %possible;  
             foreach $x (`cat $from_dir/$user`)  
             {  
                 if ($x =~ /^(\S+)\t(\S.*\S)/)  
                 {  
                     $peg = $1;  
                     $func = $2;  
                     next if ((! $possible{$peg}) && ($existing{$peg} && ($existing{$peg} eq $func)));  
                     $possible{$peg} = $func;  
                 }  
             }  
   
             foreach $peg (keys(%possible))  
             {  
                 $func = $possible{$peg};  
                 next if ($existing{$peg} && ($existing{$peg} eq $func));  
                 if ((! $existing{$peg}) ||  
                     ($rule eq "override") ||  
                     (($rule eq "override_hypo") && &FIG::hypo($existing{$peg})))  
                 {  
 #                   print &Dumper([$peg,$existing{$peg},$func,$rule,$user]); die "aborted";  
                     $existing{$peg} = $func;  
                     push(@updates,[$peg,$func,$user]);  
                 }  
                 else  
                 {  
                     print $fh_log "rejected\t$peg\t$time_made\t$who_from\t$user\t$func\n";  
                 }  
             }  
         }  
     }  
     return @updates;  
 }  
   
 # merge rules are a set of tab-separated, 3-column fields:  
 #  
 #     Genome Who Rule  
 #  
 #    Genome can be an exact genome, *, {g1,g2,...}, ! genome, or ! {g1,g2,...}  
 #    Who can be an exact who, *, {w1,w2,...}, ! who, or ! {w1,w2,...}  
 #    Rule can be  
 #  
 #               override  
 #               override_hypo  
 #               ignore  
 #  
   
 sub what_merge_rules {  
     my($rules,$genome,$who) = @_;  
     my($i,$rule,$merge_with);  
   
     for ($i=0,$rule = ""; ($i < @$rules) && (! $rule); $i++)  
     {  
         $rule  = &effective_rule($rules->[$i],$genome,$who);  
     }  
     if (! $rule)  
     {  
         $rule = "override_hypo";  
     }  
     return $rule;  
 }  
   
 sub effective_rule {  
     my($rule,$genome,$who) = @_;  
   
     my($g,$w,$r) = split(/\s+/,$rule);  
     if (&matches($g,$genome) && &matches($w,$who))  
     {  
         return $r;  
     }  
     return "";  
 }  
   
 sub matches {  
     my($pat,$val) = @_;  
   
     return (($val eq $pat) || ($pat eq "*") ||  
             (($pat =~ /^\{(.*)\}/) && (@pats = split(/,/,$1)) && &inL($val,\@pats)) ||  
             (($pat =~ /^\!\s*\{(.*)\}/) && (@pats = split(/,/,$1)) && (! &inL($val,\@pats))));  
 }  
   
 sub inL {  
     my($x,$xL) = @_;  
     my $i;  
   
     for ($i=0; ($i < @$xL) && ($x ne $xL->[$i]); $i++) {}  
     return ($i < @$xL);  
530  }  }
531    
532  =pod  =pod

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3