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

Annotation of /FigKernelPackages/P2Pupdate.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.14 - (view) (download) (as text)

1 : efrank 1.1 package P2Pupdate;
2 :    
3 :     use FIG_Config;
4 :     use FIG;
5 :     use Carp;
6 :     use Data::Dumper;
7 :     use Cwd;
8 :    
9 :     =pod
10 :    
11 :     =head1 updating code
12 :    
13 :     This routine packages what is needed to upgrade an older system to the
14 :     current code. Code releases are numered
15 :    
16 :     p1n1.p2n2.p3n3...
17 :    
18 :     where "." is added at the point the code moved to another branch of
19 :     the tree. FIG, who provided the initial release of the SEED, will
20 :     number all of their code releases as
21 :    
22 :     FIGn
23 :    
24 :     where n is an integer. Suppose that between releases 13 and 14 a
25 :     second group (which we will term "Idiots" for convenience) took
26 :     release 13 and wished to branch the code tree. At that point, they
27 :     would name their first release as
28 :    
29 :     FIG13.Idiots1
30 :    
31 :     We are, of course, being both cavalier and nasty when we make such a
32 :     reference. We do, however, wish to express the view that it will
33 :     benefit everyone to attempt to reconcile differences and maintain a
34 :     single code progression as long as possible. There are often good
35 :     reasons to part ways, but we urge people to think carefully before
36 :     taking such a step.
37 :    
38 :     Two code releases
39 :    
40 :     i1.i2.i3...in
41 :     and j1.j2.j3...jm with m <= n
42 :    
43 :     are compatible iff
44 :    
45 :     ip == jp for p < m, and
46 :     jm and im have the same "source" and
47 :     jm <= im
48 :    
49 :     A new code release must have the property that it can bring any
50 :     "older" compatible release up to its release.
51 :    
52 :     Note that there is an issue relating to the code to build/install packages.
53 :     Since a system may be radically restructured between releases of code, the
54 :     code to build a "package" and the code to "install" a package are radically
55 :     separated. For example, the code in P2Pupdate.pm for building an assignment
56 :     package and the code for installing an assignment package both apply to the
57 :     release of code current on the system containing P2Pupdate.pm. In fact, the
58 :     code releases may be quite different on two synchronizing systems.
59 :    
60 :     To make things work the following rules must be observed:
61 :    
62 :     1. a code release is a tar file containing VERSION, Packages,
63 :     bin/ToolTemplates, and CGI/ToolTemplates. The installing system needs
64 :     to place these at the appropriate spots, and then run bring_system_up_to_date,
65 :     which is supposed to do any required restructuring.
66 :    
67 :     2. an assignments package is a tar file containing a single directory. The directory
68 :     contains subdirectories -- one per genome. Each genome subdirectory contains zero
69 :     or more files. The name of the file is the "user" and the contents will be the
70 :     assignments made by that user.
71 :    
72 :     3. an annotations package is a tar file containing a single directory. The files in
73 :     the directory are named by genome. They contain the annotations for the genome.
74 :    
75 :     =cut
76 :    
77 :     =pod
78 :    
79 :     =head1 what_code_do_I_have
80 :    
81 :     usage: &what_code_do_I_have($fig_base)
82 :    
83 :     This just returns the current version of the code.
84 :    
85 :     =cut
86 :    
87 :     sub what_code_do_I_have {
88 :     my($fig_base) = @_;
89 :    
90 :     my $version = `cat $fig_base/VERSION`;
91 :     chop $version;
92 :     return $version;
93 :     }
94 :    
95 :     =pod
96 :    
97 :     =head1 updatable_code
98 :    
99 :     usage: &updatable_code_code($v1,$v2)
100 :    
101 :     This just returns true iff the two versions of code are compatible and $v1
102 :     is "more recent".
103 :    
104 :     =cut
105 :    
106 :     sub updatable_code {
107 :     my($v1,$v2) = @_;
108 :     my($i,$v1p,$v1n,$v2p,$v2n);
109 :    
110 :     my @v1 = split(/\./,$v1);
111 :     my @v2 = split(/\./,$v2);
112 :     if (@v1 < @v2) { return 0 }
113 :    
114 :     for ($i=0; ($i < $#v2) && ($v1[$i] eq $v2[$i]); $i++) {}
115 :     if ($i == $#v2)
116 :     {
117 :     $v1[$i] =~ /^(.*[^\d])(\d+)$/;
118 :     $v1p = $1;
119 :     $v1n = $2;
120 :    
121 :     $v2[$i] =~ /^(.*[^\d])(\d+)$/;
122 :     $v2p = $1;
123 :     $v2n = $2;
124 :    
125 :     return (($v2p eq $v1p) && ($v2n < $v1n));
126 :     }
127 :     return 0;
128 :     }
129 :    
130 :     =pod
131 :    
132 :     =head1 package_code
133 :    
134 :     usage: &package_code($fig_disk,$file)
135 :    
136 :     $fig_base must be an absolute filename (begins with "/") giving the FIG from which
137 :     the updated code release will be taken.
138 :    
139 :     $file must be an absolute filename where the "code package" will be built.
140 :    
141 :     =cut
142 :    
143 :     sub package_code {
144 :     my($fig_disk,$file) = @_;
145 :    
146 :     &force_absolute($fig_disk);
147 :     &force_absolute($file);
148 : overbeek 1.2 my @tmp = `cat $fig_disk/CURRENT_RELEASE`;
149 :     my $current_release = $tmp[0];
150 :     chop $current_release;
151 :    
152 :     &FIG::run("cd $fig_disk/dist/releases; tar czf $file $current_release");
153 : efrank 1.1 }
154 :    
155 :     sub force_absolute {
156 :     my($file) = @_;
157 :    
158 :     if (substr($file,0,1) ne "/")
159 :     {
160 : overbeek 1.2 print "Error: Please use absolute file names (i.e., /Users/fig/... or /home/fig/...)\n";
161 :     exit;
162 : efrank 1.1 }
163 :     }
164 :    
165 :     =pod
166 :    
167 :     =head1 install_code
168 :    
169 :     usage: &install_code($fig_disk,$package)
170 :    
171 :     $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.
172 :    
173 :     $package must be an absolute filename where the "code package" from which to make
174 :     the update exists.
175 :    
176 :     Note that this routine does not check that the updated code is compatible, or even less
177 :     current. It is assumed that upper level logic is doing that.
178 :    
179 :     =cut
180 :    
181 :     sub install_code {
182 :     my($fig_disk,$package) = @_;
183 :     my $fig_base = "$fig_disk/FIG";
184 :     &force_absolute($fig_base);
185 :     &force_absolute($package);
186 :    
187 :     if (getcwd() !~ /FIGdisk$/) { print die "Sorry, you must run this while in $FIG_Config::fig_disk" }
188 :    
189 :    
190 :     (! -d "$fig_disk/BackupCode") || &FIG::run("rm -rf $fig_disk/BackupCode");
191 :     mkdir("$fig_disk/BackupCode",0777) || die "Could not make the BackupCode directory";
192 :     (! -d "$fig_disk/BackupEnv") || &FIG::run("rm -rf $fig_disk/BackupEnv");
193 :     mkdir("$fig_disk/BackupEnv",0777) || die "Could not make the BackupEnv directory";
194 :    
195 :     my $version = &what_code_do_I_have($fig_base);
196 :     &FIG::run("cd $fig_disk; mv README install lib man env src $fig_disk/BackupEnv");
197 :     &FIG::run("cd $fig_base; mv VERSION Packages CGI $fig_disk/BackupCode");
198 :     print STDERR "made backups\n";
199 :    
200 :     &FIG::run("cd $fig_disk; tar xzf $package");
201 :     print STDERR "untarred new code\n";
202 :    
203 :     &fix_config("$fig_base/Packages/FIG_Config.pm","$fig_disk/BackupCode/Packages/FIG_Config.pm");
204 :     &FIG::run("cd $fig_base/bin; touch ToolTemplates/*/*; make all");
205 :     &FIG::run("cd $fig_base/CGI; touch ToolTemplates/*/*; make all");
206 :     print STDERR "installed new bin and CGI\n";
207 :    
208 :     &FIG::run("bring_system_up_to_date $version");
209 :     }
210 :    
211 :     =pod
212 :    
213 :     =head1 package_lightweight_code
214 :    
215 :     usage: &package_lightweight_code($fig_disk,$file)
216 :    
217 :     $fig_base must be an absolute filename (begins with "/") giving the FIG from which
218 :     the updated code release will be taken.
219 :    
220 :     $file must be an absolute filename where the "code package" will be built.
221 :    
222 :     =cut
223 :    
224 :     sub package_lightweight_code {
225 :     my($fig_disk,$file) = @_;
226 :    
227 :     &force_absolute($fig_disk);
228 :     &force_absolute($file);
229 : overbeek 1.2 my @tmp = `cat $fig_disk/CURRENT_RELEASE`;
230 :     my $current_release = $tmp[0];
231 :     chop $current_release;
232 :    
233 :     &FIG::run("cd $fig_disk/dist/releases; tar czf $file $current_release");
234 : efrank 1.1 }
235 :    
236 :     =pod
237 :    
238 :     =head1 install_lightweight_code
239 :    
240 :     usage: &install_lightweight_code($fig_disk,$package)
241 :    
242 :     $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.
243 :    
244 :     $package must be an absolute filename where the "code package" from which to make
245 :     the update exists.
246 :    
247 :     Note that this routine does not check that the updated code is compatible, or even less
248 :     current. It is assumed that upper level logic is doing that.
249 :    
250 :     =cut
251 :    
252 :     sub install_lightweight_code {
253 :     my($fig_disk,$package) = @_;
254 :     my $fig_base = "$fig_disk/FIG";
255 :     &force_absolute($fig_base);
256 :     &force_absolute($package);
257 :    
258 : overbeek 1.2 if (! mkdir("$fig_disk/Tmp$$",0777))
259 :     {
260 :     print "Error: could not make $fig_disk/Tmp$$\n";
261 :     exit;
262 :     }
263 : efrank 1.1
264 : overbeek 1.2 &FIG::run("cd $fig_disk/Tmp$$; tar xzf $package");
265 :     if (! opendir(TMP,"$fig_disk/Tmp$$"))
266 :     {
267 :     print "Error: could not open $fig_disk/Tmp$$\n";
268 :     exit;
269 :     }
270 : efrank 1.1
271 : overbeek 1.2 my @rels = grep { $_ !~ /^\./ } readdir(TMP);
272 :     closedir(TMP);
273 :     if (@rels != 1)
274 :     {
275 :     print "Error: Bad code package: $package\n";
276 :     exit;
277 :     }
278 : efrank 1.1
279 : overbeek 1.2 my $new_release = $rels[0];
280 :     if (-d "$fig_disk/dist/releases/$new_release")
281 :     {
282 :     print "Error: $new_release already exists; we are doing nothing\n";
283 :     exit;
284 :     }
285 : efrank 1.1
286 : efrank 1.3 &FIG::run("mv $fig_disk/Tmp$$/$new_release $fig_disk/dist/releases");
287 :     &FIG::run("rm -rf $fig_disk/Tmp$$");
288 : efrank 1.9 &FIG::run("$FIG_Config::bin/switch_to_release $new_release");
289 : efrank 1.1 }
290 :    
291 :    
292 :     sub fix_config {
293 :     my($new,$old) = @_;
294 :     my($line,$i);
295 :    
296 :     my @new = `cat $new`;
297 :     foreach $line (`cat $old`)
298 :     {
299 :     if ($line =~ /^(\S+)\s+\=/)
300 :     {
301 :     $var = $1;
302 :     $varQ = quotemeta $var;
303 :    
304 :     for ($i=0; ($i < $#new) && ($new[$i] !~ /^$varQ\s+\=/); $i++) {}
305 :     if ($i == $#new)
306 :     {
307 :     splice(@new,$i,0,$line);
308 :     }
309 :     else
310 :     {
311 :     splice(@new,$i,1,$line);
312 :     }
313 :     }
314 :     }
315 :     open(NEW,">$new") || confess "could not overwrite $new";
316 :     foreach $line (@new)
317 :     {
318 :     print NEW $line;
319 :     }
320 :     close(NEW);
321 :     }
322 :    
323 :     =pod
324 :    
325 :     =head1 what_genomes_will_I_sync
326 :    
327 :     usage: &what_genomes_will_I_sync($fig_base,$who)
328 :    
329 :     This routine returns the list of genome IDs that you are willing to sync with $who.
330 :    
331 :     =cut
332 :    
333 :     sub what_genomes_will_I_sync {
334 :     my($fig_base,$who) = @_;
335 :    
336 :     # This is the promiscuous version - it will sync all genomes with anyone.
337 :    
338 :     opendir(GENOMES,"$fig_base/Data/Organisms") || die "could not open $fig_base/Data/Organisms";
339 :     my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(GENOMES);
340 :     closedir(GENOMES);
341 :     return @genomes;
342 :     }
343 :    
344 :     =pod
345 :    
346 :     =head1 package_annotations
347 :    
348 :     usage: &package_annotations($fig_base,$genomes,$file)
349 :    
350 :     $fig_base must be an absolute filename (begins with "/") giving the FIG from which
351 :     the updated code release will be taken.
352 :    
353 :     $genomes is a pointer to a list of genome IDs that will be exchanged.
354 :    
355 :     $file must be an absolute filename where the "annotation package" will be built.
356 :    
357 :     =cut
358 :    
359 :     sub package_annotations {
360 :     my($fig_base,$genomes,$file) = @_;
361 :    
362 :     &force_absolute($fig_base);
363 :     &force_absolute($file);
364 :     if (-d "$fig_base/Tmp/Annotations") { system "rm -rf $fig_base/Tmp/Annotations" }
365 :     mkdir("$fig_base/Tmp/Annotations",0777) || die "could not make $fig_base/Tmp/Annotations";
366 :     foreach $genome (@$genomes)
367 :     {
368 :     if (-s "$fig_base/Data/Organisms/$genome/annotations")
369 :     {
370 :     &FIG::run("cp $fig_base/Data/Organisms/$genome/annotations $fig_base/Tmp/Annotations/$genome");
371 :     }
372 :     }
373 :     &FIG::run("chmod -R 777 $fig_base/Tmp/Annotations");
374 :     &FIG::run("cd $fig_base/Tmp/Annotations; tar czf $file *");
375 :     system "rm -rf $fig_base/Tmp/Annotations";
376 :     }
377 :    
378 :     =pod
379 :    
380 :     =head1 install_annotations
381 :    
382 :     usage: &install_annotations($fig_disk,$package)
383 :    
384 :     $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.
385 :    
386 :     $package must be an absolute filename where the "annotations package" from which to make
387 :     the update exists.
388 :    
389 :     =cut
390 :    
391 :     sub install_annotations {
392 : efrank 1.12 my($fig_disk,$from,$package) = @_;
393 : efrank 1.1 my($genome);
394 :    
395 :     &force_absolute($fig_disk);
396 :     &force_absolute($package);
397 :     if (-d "$fig_disk/BackupAnnotations") { system "rm -rf $fig_disk/BackupAnnotations" }
398 :     mkdir("$fig_disk/BackupAnnotations",0777);
399 :     mkdir("$fig_disk/BackupAnnotations/New",0777);
400 :     &FIG::run("cd $fig_disk/BackupAnnotations/New; tar xzf $package");
401 :     opendir(TMP,"$fig_disk/BackupAnnotations/New") || die "could not open $fig_disk/BackupAnnotations/New";
402 :     my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(TMP);
403 :     closedir(TMP);
404 :     foreach $genome (@genomes)
405 :     {
406 : efrank 1.14 next if (! -d "$fig_disk/FIG/Data/organisms/$genome");
407 : efrank 1.13
408 : efrank 1.1 print STDERR "installing $fig_disk/FIG/Data/Organisms/$genome/annotations\n";
409 :     if (-s "$fig_disk/FIG/Data/Organisms/$genome/annotations")
410 :     {
411 :     &FIG::run("cp -p $fig_disk/FIG/Data/Organisms/$genome/annotations $fig_disk/BackupAnnotations/$genome");
412 : efrank 1.9 &FIG::run("$FIG_Config::bin/merge_annotations $fig_disk/BackupAnnotations/$genome $fig_disk/BackupAnnotations/New/$genome > $fig_disk/FIG/Data/Organisms/$genome/annotations");
413 : efrank 1.1 }
414 :     else
415 :     {
416 :     &FIG::run("cp $fig_disk/BackupAnnotations/New/$genome $fig_disk/FIG/Data/Organisms/$genome/annotations");
417 :     }
418 :     chmod 0777,"$fig_disk/FIG/Data/Organisms/$genome/annotations";
419 :     }
420 : efrank 1.9 &FIG::run("$FIG_Config::bin/index_annotations");
421 : efrank 1.1 }
422 :    
423 :     =pod
424 :    
425 :     =head1 restore_annotations
426 :    
427 :     usage: &restore_annotations($fig_disk);
428 :    
429 :     $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.
430 :    
431 :     =cut
432 :    
433 :     sub restore_annotations {
434 :     my($fig_disk) = @_;
435 :    
436 :     &force_absolute($fig_disk);
437 :     (-d "$fig_disk/BackupAnnotations") || die "could not find an active backup";
438 :     opendir(TMP,"$fig_disk/BackupAnnotations") || die "could not open $fig_disk/BackupAnnotations";
439 :     my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(TMP);
440 :     closedir(TMP);
441 :     foreach $genome (@genomes)
442 :     {
443 :     unlink("$fig_disk/FIG/Data/Organisms/$genome/annotations");
444 :     &FIG::run("cp $fig_disk/BackupAnnotations/$genome $fig_disk/FIG/Data/Organisms/$genome/annotations");
445 :     system "chmod 777 $fig_disk/FIG/Data/Organisms/$genome/annotations";
446 :     }
447 : efrank 1.9 &FIG::run("$FIG_Config::bin/index_annotations");
448 : efrank 1.1 }
449 :    
450 :     =pod
451 :    
452 :     =head1 package_aassignments
453 :    
454 : overbeek 1.5 usage: &package_assignments($fig_base,$who,$date,$genomes,$file)
455 : efrank 1.1
456 :     $fig_base must be an absolute filename (begins with "/") giving the FIG from which
457 :     the updated code release will be taken.
458 :    
459 : overbeek 1.5 $who designates whose assignments you want (defaults to "master")
460 :    
461 :     $date if given indicates a point in time (get assignments after that point)
462 :    
463 : efrank 1.1 $genomes is a pointer to a list of genome IDs that will be exchanged.
464 :    
465 :     $file must be an absolute filename where the "assignment package" will be built.
466 :    
467 :     =cut
468 :    
469 :     sub package_assignments {
470 : overbeek 1.4 my($fig_base,$who,$date,$genomes,$file) = @_;
471 : overbeek 1.6 my($genome,$x);
472 : efrank 1.1
473 : overbeek 1.4 $who = $who ? $who : "master";
474 : overbeek 1.7 $date = $date ? $date : 0;
475 : efrank 1.1 &force_absolute($fig_base);
476 :     if (-d "$fig_base/Tmp/Assignments") { system "rm -rf $fig_base/Tmp/Assignments" }
477 :     mkdir("$fig_base/Tmp/Assignments",0777) || die "could not make $fig_base/Tmp/Assignments";
478 :     foreach $genome (@$genomes)
479 :     {
480 :     print STDERR "packaging $genome\n";
481 : overbeek 1.4 my @possible = ();
482 : efrank 1.1 mkdir("$fig_base/Tmp/Assignments/$genome",0777) || die "could not make $fig_base/Tmp/Assignments/$genome";
483 :    
484 : overbeek 1.4 if (($who eq "master") && (-s "$fig_base/Data/Organisms/$genome/assigned_functions"))
485 : efrank 1.1 {
486 :     my %seen;
487 :     my($assignment,$id);
488 :     foreach $assignment (reverse `cat $fig_base/Data/Organisms/$genome/assigned_functions`)
489 :     {
490 : overbeek 1.4 if (($assignment =~ /^(\S+)\t(\S.*\S)/) && (! $seen{$1}))
491 : efrank 1.1 {
492 :     $seen{$1} = 1;
493 : overbeek 1.5 push(@possible,[$1,$2]);
494 : efrank 1.1 }
495 :     }
496 :     }
497 :    
498 : overbeek 1.4 if (($who ne "master") && (-s "$fig_base/Data/Organisms/$genome/UserModels/$who/assigned_functions"))
499 : efrank 1.1 {
500 : overbeek 1.4 my %seen;
501 :     my($assignment,$id);
502 :     foreach $assignment (reverse `cat $fig_base/Data/Organisms/$genome/UserModels/$who/assigned_functions`)
503 : efrank 1.1 {
504 : overbeek 1.4 if (($assignment =~ /^(\S+)\t(\S.*\S)/) && (! $seen{$1}))
505 : efrank 1.1 {
506 : overbeek 1.4 $seen{$1} = 1;
507 : overbeek 1.5 push(@possible,[$1,$2]);
508 : efrank 1.1 }
509 :     }
510 :     }
511 : overbeek 1.7
512 : overbeek 1.5 if (open(TMP,">$fig_base/Tmp/Assignments/$genome/$who"))
513 : overbeek 1.4 {
514 : overbeek 1.5 if (@possible > 0)
515 : overbeek 1.4 {
516 : overbeek 1.7 my %poss = map { $_->[0] => $_->[1] } @possible;
517 :     if (open(ANN,"<$FIG_Config::organisms/$genome/annotations"))
518 : overbeek 1.5 {
519 : overbeek 1.7 $/ = "\n//\n";
520 :     my $ann;
521 :     while (defined($ann = <ANN>))
522 : overbeek 1.5 {
523 : overbeek 1.7 if (($ann =~ /^(fig\|\d+\.\d+\.peg\.\d+)\n(\d+)\n(\S+)\nSet ([^\n]*)function[^\n]*\n(\S[^\n]+\S)/s) &&
524 :     (($who eq $3) || (($4 eq "master ") && ($who eq "master"))) &&
525 :     ($x = $poss{$1}) &&
526 :     ($2 >= $date) &&
527 :     ($5 eq $x))
528 : overbeek 1.5 {
529 : overbeek 1.7 print TMP "$1\t$5\n";
530 : overbeek 1.5 }
531 : overbeek 1.6 }
532 : overbeek 1.7 $/ = "\n";
533 :     close(ANN);
534 : overbeek 1.6 }
535 : overbeek 1.4 }
536 : overbeek 1.5 close(TMP);
537 : overbeek 1.4 }
538 : efrank 1.1 }
539 :     &FIG::run("cd $fig_base/Tmp; tar czf $file Assignments; rm -rf Assignments");
540 :     }
541 :    
542 :     =pod
543 :    
544 :     =head1 install_assignments
545 :    
546 : overbeek 1.8 usage: &install_assignments($fig_bdisk,$package,$who_from,$logfile)
547 : efrank 1.1
548 :     $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.
549 :    
550 :     $package must be an absolute filename where the "assignments package" from which to make
551 :     the update exists.
552 :    
553 :     =cut
554 :    
555 :     sub install_assignments {
556 : overbeek 1.8 my($fig,$fig_disk,$package,$who_from,$logfile) = @_;
557 : efrank 1.1 my($genome);
558 :    
559 :     &force_absolute($fig_disk);
560 : overbeek 1.8 open(LOG,">>$logfile") || die "failed to open $logfile\n";
561 : efrank 1.1
562 :     if (-d "$fig_disk/BackupAssignments") { system "rm -rf $fig_disk/BackupAssignments" }
563 :     mkdir("$fig_disk/BackupAssignments",0777);
564 :     mkdir("$fig_disk/BackupAssignments/New",0777);
565 :     &FIG::run("cd $fig_disk/BackupAssignments/New; tar xzf $package");
566 :     &FIG::run("cd $fig_disk/FIG/Data/Organisms; tar czf $fig_disk/BackupAssignments/before_update.tgz */assigned_functions */UserModels");
567 :    
568 :     opendir(TMP,"$fig_disk/BackupAssignments/New/Assignments") || die "could not open $fig_disk/BackupAssignments/New/Assignments";
569 :     my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(TMP);
570 :     closedir(TMP);
571 :    
572 :     my @rules = ();
573 :     if (-s "$fig_disk/FIG/Data/Global/assignment.merging.rules")
574 :     {
575 :     push(@rules,`cat $fig_disk/FIG/Data/Global/assignment.merging.rules`);
576 :     }
577 :     push(@rules,"*\t*\toverride_hypo");
578 :    
579 : overbeek 1.8 my $time_made = time;
580 : efrank 1.1 foreach $genome (@genomes)
581 :     {
582 : efrank 1.13 next if (! -d "$fig_disk/FIG/Data/Organisms/$genome)");
583 :    
584 : overbeek 1.8 @updates = &get_assignments_for_genome("$fig_disk/FIG/Data/Organisms",$genome,$who_from,"$fig_disk/BackupAssignments/New/Assignments/$genome",\@rules,\*LOG);
585 : efrank 1.1 my $tuple;
586 :     foreach $tuple (@updates)
587 :     {
588 :     my($peg,$func_and_conf,$user) = @$tuple;
589 :     my($func,$conf) = split(/\t/,$func_and_conf);
590 :     $conf = defined($conf) ? $conf : "";
591 :     $fig->assign_function($peg,$user,$func,$conf);
592 :     $fig->add_annotation($peg,"master","Imported function from $who_from: $func\n");
593 : overbeek 1.8 print LOG "accepted\t$peg\t$time_made\t$who_from\t$user\t$func\t$conf\n";
594 : efrank 1.1 }
595 :     }
596 : overbeek 1.8 close(LOG);
597 : efrank 1.1 }
598 :    
599 :     sub restore_assignments {
600 :     my($fig_disk) = @_;
601 :    
602 :     &force_absolute($fig_disk);
603 :     (-s "$fig_disk/BackupAssignments/before_update.tgz") || die "could not find an active backup";
604 :     &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");
605 :     }
606 :    
607 :     sub get_assignments_for_genome {
608 : overbeek 1.8 my($organisms,$genome,$who_from,$from_dir,$rules,$fh_log) = @_;
609 : efrank 1.1 my(@updates) = ();
610 :    
611 : overbeek 1.8 my $time_made = time;
612 : efrank 1.1 if (opendir(FROM,$from_dir))
613 :     {
614 :     @users = grep { ($_ !~ /^\./) && (-s "$from_dir/$_") } readdir(FROM);
615 :     closedir(FROM);
616 :    
617 :     $rule = &what_merge_rules($rules,$genome,$who_from);
618 :     foreach $user (@users)
619 :     {
620 :     next if ($rule eq "ignore");
621 :     undef %existing;
622 :     $file = ($user eq "master") ? "$organisms/$genome/assigned_functions" :
623 :     "$organisms/$genome/UserModels/$merge_with/assigned_functions";
624 :     if (-s $file)
625 :     {
626 :     foreach $x (`cat $file`)
627 :     {
628 :     if ($x =~ /^(\S+)\t(\S.*\S)/)
629 :     {
630 :     $existing{$1} = $2;
631 :     }
632 :     }
633 :     }
634 :     elsif ($file =~ /^(.*)\/[^\/]+$/)
635 :     {
636 :     &FIG::verify_dir($1);
637 :     }
638 :    
639 :     my %possible;
640 :     undef %possible;
641 :     foreach $x (`cat $from_dir/$user`)
642 :     {
643 :     if ($x =~ /^(\S+)\t(\S.*\S)/)
644 :     {
645 :     $peg = $1;
646 :     $func = $2;
647 :     next if ((! $possible{$peg}) && ($existing{$peg} && ($existing{$peg} eq $func)));
648 :     $possible{$peg} = $func;
649 :     }
650 :     }
651 :    
652 :     foreach $peg (keys(%possible))
653 :     {
654 :     $func = $possible{$peg};
655 :     next if ($existing{$peg} && ($existing{$peg} eq $func));
656 :     if ((! $existing{$peg}) ||
657 :     ($rule eq "override") ||
658 :     (($rule eq "override_hypo") && &FIG::hypo($existing{$peg})))
659 :     {
660 :     # print &Dumper([$peg,$existing{$peg},$func,$rule,$user]); die "aborted";
661 :     $existing{$peg} = $func;
662 :     push(@updates,[$peg,$func,$user]);
663 : overbeek 1.8 }
664 :     else
665 :     {
666 :     print $fh_log "rejected\t$peg\t$time_made\t$who_from\t$user\t$func\n";
667 : efrank 1.1 }
668 :     }
669 :     }
670 :     }
671 :     return @updates;
672 :     }
673 :    
674 :     # merge rules are a set of tab-separated, 3-column fields:
675 :     #
676 :     # Genome Who Rule
677 :     #
678 :     # Genome can be an exact genome, *, {g1,g2,...}, ! genome, or ! {g1,g2,...}
679 :     # Who can be an exact who, *, {w1,w2,...}, ! who, or ! {w1,w2,...}
680 :     # Rule can be
681 :     #
682 :     # override
683 :     # override_hypo
684 :     # ignore
685 :     #
686 :    
687 :     sub what_merge_rules {
688 :     my($rules,$genome,$who) = @_;
689 :     my($i,$rule,$merge_with);
690 :    
691 :     for ($i=0,$rule = ""; ($i < @$rules) && (! $rule); $i++)
692 :     {
693 :     $rule = &effective_rule($rules->[$i],$genome,$who);
694 :     }
695 :     if (! $rule)
696 :     {
697 :     $rule = "override_hypo";
698 :     }
699 :     return $rule;
700 :     }
701 :    
702 :     sub effective_rule {
703 :     my($rule,$genome,$who) = @_;
704 :    
705 :     my($g,$w,$r) = split(/\s+/,$rule);
706 :     if (&matches($g,$genome) && &matches($w,$who))
707 :     {
708 :     return $r;
709 :     }
710 :     return "";
711 :     }
712 :    
713 :     sub matches {
714 :     my($pat,$val) = @_;
715 :    
716 :     return (($val eq $pat) || ($pat eq "*") ||
717 :     (($pat =~ /^\{(.*)\}/) && (@pats = split(/,/,$1)) && &inL($val,\@pats)) ||
718 :     (($pat =~ /^\!\s*\{(.*)\}/) && (@pats = split(/,/,$1)) && (! &inL($val,\@pats))));
719 :     }
720 :    
721 :     sub inL {
722 :     my($x,$xL) = @_;
723 :     my $i;
724 :    
725 :     for ($i=0; ($i < @$xL) && ($x ne $xL->[$i]); $i++) {}
726 :     return ($i < @$xL);
727 :     }
728 :    
729 :     =pod
730 :    
731 :     =head1 package_translation_rules
732 :    
733 :     usage: &package_translation_rules($fig_base,$file)
734 :    
735 :     $fig_base must be an absolute filename (begins with "/") giving the FIG from which
736 :     the updated code release will be taken.
737 :    
738 :     $file must be an absolute filename where the "translation_rules package" will be built.
739 :    
740 :     =cut
741 :    
742 :     sub package_translation_rules {
743 :     my($fig_base,$file) = @_;
744 :    
745 :     &force_absolute($fig_base);
746 :     &force_absolute($file);
747 :     &FIG::run("cp $fig_base/Data/Global/function.synonyms $file");
748 :     }
749 :    
750 :     =pod
751 :    
752 :     =head1 install_translation_rules
753 :    
754 : efrank 1.10 usage: &install_translation_rules($fig_disk,$from,$package)
755 : efrank 1.1
756 :     $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.
757 :    
758 :     $package must be an absolute filename where the "translation_rules package" from which to make
759 :     the update exists.
760 :    
761 :     =cut
762 :    
763 :     sub install_translation_rules {
764 : efrank 1.10 my($fig_disk,$from,$package) = @_;
765 : efrank 1.1
766 :     my $file = "$fig_disk/FIG/Data/Global/function.synonyms";
767 :     &force_absolute($fig_disk);
768 :     if (-d "$fig_disk/BackupTranslation_Rules") { system "rm -rf $fig_disk/BackupTranslation_Rules" }
769 :     mkdir("$fig_disk/BackupTranslation_Rules",0777);
770 : efrank 1.11 chmod 0777,"$fig_disk/BackupTranslation_Rules";
771 : efrank 1.1 if (-s $file)
772 :     {
773 :     &FIG::run("cp $file $fig_disk/BackupTranslation_Rules");
774 :     }
775 : efrank 1.10 &FIG::run("$FIG_Config::bin/merge_translation_rules $fig_disk/BackupTranslation_Rules/function.synonyms $package $from > $file");
776 : efrank 1.1 chmod 0777,$file;
777 :     }
778 :    
779 :     =pod
780 :    
781 :     =head1 restore_translation_rules
782 :    
783 :     usage: &restore_translation_rules($fig_disk);
784 :    
785 :     $fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.
786 :    
787 :     =cut
788 :    
789 :     sub restore_translation_rules {
790 :     my($fig_disk) = @_;
791 :    
792 :     &force_absolute($fig_disk);
793 :    
794 :     my $file = "$fig_disk/FIG/Data/Global/function.synonyms";
795 :     (-s "$fig_disk/BackupTranslation_Rules/function.synonyms") || die "could not find an active backup";
796 :     if (-s "$fig_disk/BackupTranslation_Rules/function.synonyms")
797 :     {
798 :     &FIG::run("cp $fig_disk/BackupTranslation_Rules/function.synonyms $file");
799 :     chmod 0777, $file;
800 :     }
801 :     }
802 :    
803 :     1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3