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

View of /FigKernelPackages/P2Pupdate.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (download) (as text) (annotate)
Tue Dec 23 20:21:31 2003 UTC (16 years, 3 months ago) by efrank
Branch: MAIN
Changes since 1.11: +1 -1 lines
add who from on install_annotations

package P2Pupdate;

use FIG_Config;
use FIG;
use Carp;
use Data::Dumper;
use Cwd;

=pod

=head1 updating code

This routine packages what is needed to upgrade an older system to the 
current code.  Code releases are numered

     p1n1.p2n2.p3n3...

where "." is added at the point the code moved to another branch of
the tree.  FIG, who provided the initial release of the SEED, will
number all of their code releases as 

       FIGn  

where n is an integer. Suppose that between releases 13 and 14 a
second group (which we will term "Idiots" for convenience) took
release 13 and wished to branch the code tree.  At that point, they
would name their first release as

	FIG13.Idiots1

We are, of course, being both cavalier and nasty when we make such a
reference.  We do, however, wish to express the view that it will
benefit everyone to attempt to reconcile differences and maintain a
single code progression as long as possible.  There are often good
reasons to part ways, but we urge people to think carefully before
taking such a step.

Two code releases 

    i1.i2.i3...in
and j1.j2.j3...jm with m <= n

are compatible iff 

    ip == jp  for p < m, and
    jm and im have the same "source" and
    jm <= im

A new code release must have the property that it can bring any
"older" compatible release up to its release.

Note that there is an issue relating to the code to build/install packages.
Since a system may be radically restructured between releases of code, the
code to build a "package" and the code to "install" a package are radically 
separated.  For example, the code in P2Pupdate.pm for building an assignment
package and the code for installing an assignment package both apply to the
release of code current on the system containing P2Pupdate.pm.  In fact, the
code releases may be quite different on two synchronizing systems.

To make things work the following rules must be observed:

    1. a code release is a tar file containing VERSION, Packages,
       bin/ToolTemplates, and CGI/ToolTemplates.  The installing system needs
       to place these at the appropriate spots, and then run bring_system_up_to_date,
       which is supposed to do any required restructuring.

    2. an assignments package is a tar file containing a single directory.  The directory
       contains subdirectories -- one per genome.  Each genome subdirectory contains zero
       or more files.  The name of the file is the "user" and the contents will be the
       assignments made by that user.

    3. an annotations package is a tar file containing a single directory.  The files in 
       the directory are named by genome. They contain the annotations for the genome.

=cut

=pod

=head1 what_code_do_I_have

usage: &what_code_do_I_have($fig_base)

This just returns the current version of the code.

=cut

sub what_code_do_I_have {
    my($fig_base) = @_;

    my $version = `cat $fig_base/VERSION`;
    chop $version;
    return $version;
}

=pod

=head1 updatable_code

usage: &updatable_code_code($v1,$v2)

    This just returns true iff the two versions of code are compatible and $v1
    is "more recent".

=cut

sub updatable_code {
    my($v1,$v2) = @_;
    my($i,$v1p,$v1n,$v2p,$v2n);

    my @v1 = split(/\./,$v1);
    my @v2 = split(/\./,$v2);
    if (@v1 < @v2) { return 0 }

    for ($i=0; ($i < $#v2) && ($v1[$i] eq $v2[$i]); $i++) {}
    if ($i == $#v2)
    {
	$v1[$i] =~ /^(.*[^\d])(\d+)$/;
	$v1p = $1;
	$v1n = $2;

	$v2[$i] =~ /^(.*[^\d])(\d+)$/;
	$v2p = $1;
	$v2n = $2;

	return (($v2p eq $v1p) && ($v2n < $v1n));
    }
    return 0;
}

=pod

=head1 package_code

usage: &package_code($fig_disk,$file)

$fig_base must be an absolute filename (begins with "/") giving the FIG from which
   the updated code release will be taken.

$file must be an absolute filename where the "code package" will be built.

=cut

sub package_code {
    my($fig_disk,$file) = @_;

    &force_absolute($fig_disk);
    &force_absolute($file);
    my @tmp = `cat $fig_disk/CURRENT_RELEASE`;
    my $current_release = $tmp[0];
    chop $current_release;

    &FIG::run("cd $fig_disk/dist/releases; tar czf $file $current_release");
}

sub force_absolute {
    my($file) = @_;

    if (substr($file,0,1) ne "/")
    {
	print "Error: Please use absolute file names (i.e., /Users/fig/... or /home/fig/...)\n";
	exit;
    }
}

=pod

=head1 install_code

usage: &install_code($fig_disk,$package)

$fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.

$package must be an absolute filename where the "code package" from which to make
    the update exists.

Note that this routine does not check that the updated code is compatible, or even less
current.  It is assumed that upper level logic is doing that.

=cut

sub install_code {
    my($fig_disk,$package) = @_;
    my $fig_base = "$fig_disk/FIG";
    &force_absolute($fig_base);
    &force_absolute($package);

    if (getcwd() !~ /FIGdisk$/) { print die "Sorry, you must run this while in $FIG_Config::fig_disk" }
	
    
    (! -d "$fig_disk/BackupCode") || &FIG::run("rm -rf $fig_disk/BackupCode");
    mkdir("$fig_disk/BackupCode",0777) || die "Could not make the BackupCode directory";
    (! -d "$fig_disk/BackupEnv") || &FIG::run("rm -rf $fig_disk/BackupEnv");
    mkdir("$fig_disk/BackupEnv",0777) || die "Could not make the BackupEnv directory";

    my $version = &what_code_do_I_have($fig_base);
    &FIG::run("cd $fig_disk; mv README install lib man env src $fig_disk/BackupEnv");
    &FIG::run("cd $fig_base; mv VERSION Packages CGI $fig_disk/BackupCode");
    print STDERR "made backups\n";

    &FIG::run("cd $fig_disk; tar xzf $package");
    print STDERR "untarred new code\n";

    &fix_config("$fig_base/Packages/FIG_Config.pm","$fig_disk/BackupCode/Packages/FIG_Config.pm");
    &FIG::run("cd $fig_base/bin; touch ToolTemplates/*/*; make all");
    &FIG::run("cd $fig_base/CGI; touch ToolTemplates/*/*; make all");
    print STDERR "installed new bin and CGI\n";

    &FIG::run("bring_system_up_to_date $version");
}

=pod

=head1 package_lightweight_code

usage: &package_lightweight_code($fig_disk,$file)

$fig_base must be an absolute filename (begins with "/") giving the FIG from which
   the updated code release will be taken.

$file must be an absolute filename where the "code package" will be built.

=cut

sub package_lightweight_code {
    my($fig_disk,$file) = @_;

    &force_absolute($fig_disk);
    &force_absolute($file);
    my @tmp = `cat $fig_disk/CURRENT_RELEASE`;
    my $current_release = $tmp[0];
    chop $current_release;

    &FIG::run("cd $fig_disk/dist/releases; tar czf $file $current_release");
}

=pod

=head1 install_lightweight_code

usage: &install_lightweight_code($fig_disk,$package)

$fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.

$package must be an absolute filename where the "code package" from which to make
    the update exists.

Note that this routine does not check that the updated code is compatible, or even less
current.  It is assumed that upper level logic is doing that.

=cut

sub install_lightweight_code {
    my($fig_disk,$package) = @_;
    my $fig_base = "$fig_disk/FIG";
    &force_absolute($fig_base);
    &force_absolute($package);

    if (! mkdir("$fig_disk/Tmp$$",0777))
    {
	print "Error: could not make $fig_disk/Tmp$$\n";
	exit;
    }

    &FIG::run("cd $fig_disk/Tmp$$; tar xzf $package");
    if (! opendir(TMP,"$fig_disk/Tmp$$"))
    {
	print "Error: could not open $fig_disk/Tmp$$\n";
	exit;
    }

    my @rels = grep { $_ !~ /^\./ } readdir(TMP);
    closedir(TMP);
    if (@rels != 1)
    {
	print "Error: Bad code package: $package\n";
	exit;
    }

    my $new_release = $rels[0];
    if (-d "$fig_disk/dist/releases/$new_release")
    {
	print "Error: $new_release already exists; we are doing nothing\n";
	exit;
    }

    &FIG::run("mv $fig_disk/Tmp$$/$new_release $fig_disk/dist/releases");
    &FIG::run("rm -rf $fig_disk/Tmp$$");
    &FIG::run("$FIG_Config::bin/switch_to_release $new_release");
}

    
sub fix_config {
    my($new,$old) = @_;
    my($line,$i);

    my @new = `cat $new`;
    foreach $line (`cat $old`)
    {
	if ($line =~ /^(\S+)\s+\=/)
	{
	    $var = $1;
	    $varQ = quotemeta $var;

	    for ($i=0; ($i < $#new) && ($new[$i] !~ /^$varQ\s+\=/); $i++) {}
	    if ($i == $#new)
	    {
		splice(@new,$i,0,$line);
	    }
	    else
	    {
		splice(@new,$i,1,$line);
	    }
	}
    }
    open(NEW,">$new") || confess "could not overwrite $new";
    foreach $line (@new)
    {
	print NEW $line;
    }
    close(NEW);
}

=pod

=head1 what_genomes_will_I_sync 

usage: &what_genomes_will_I_sync($fig_base,$who)

This routine returns the list of genome IDs that you are willing to sync with $who.

=cut

sub what_genomes_will_I_sync {
    my($fig_base,$who) = @_;

# This is the promiscuous version - it will sync all genomes with anyone.

    opendir(GENOMES,"$fig_base/Data/Organisms") || die "could not open $fig_base/Data/Organisms";
    my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(GENOMES);
    closedir(GENOMES);
    return @genomes;
}

=pod

=head1 package_annotations

usage: &package_annotations($fig_base,$genomes,$file)

$fig_base must be an absolute filename (begins with "/") giving the FIG from which
   the updated code release will be taken.

$genomes is a pointer to a list of genome IDs that will be exchanged.

$file must be an absolute filename where the "annotation package" will be built.

=cut

sub package_annotations {
    my($fig_base,$genomes,$file) = @_;

    &force_absolute($fig_base);
    &force_absolute($file);
    if (-d "$fig_base/Tmp/Annotations") { system "rm -rf $fig_base/Tmp/Annotations" }
    mkdir("$fig_base/Tmp/Annotations",0777) || die "could not make $fig_base/Tmp/Annotations";
    foreach $genome (@$genomes)
    {
	if (-s "$fig_base/Data/Organisms/$genome/annotations")
	{
	    &FIG::run("cp $fig_base/Data/Organisms/$genome/annotations $fig_base/Tmp/Annotations/$genome");
	}
    }
    &FIG::run("chmod -R 777 $fig_base/Tmp/Annotations");
    &FIG::run("cd $fig_base/Tmp/Annotations; tar czf $file *");
    system "rm -rf $fig_base/Tmp/Annotations";
}

=pod

=head1 install_annotations

usage: &install_annotations($fig_disk,$package)

$fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.

$package must be an absolute filename where the "annotations package" from which to make
    the update exists.

=cut

sub install_annotations {
    my($fig_disk,$from,$package) = @_;
    my($genome);

    &force_absolute($fig_disk);
    &force_absolute($package);
    if (-d "$fig_disk/BackupAnnotations") { system "rm -rf $fig_disk/BackupAnnotations" }
    mkdir("$fig_disk/BackupAnnotations",0777);
    mkdir("$fig_disk/BackupAnnotations/New",0777);
    &FIG::run("cd $fig_disk/BackupAnnotations/New; tar xzf $package");
    opendir(TMP,"$fig_disk/BackupAnnotations/New") || die "could not open $fig_disk/BackupAnnotations/New";
    my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(TMP);
    closedir(TMP);
    foreach $genome (@genomes)
    {
	print STDERR "installing $fig_disk/FIG/Data/Organisms/$genome/annotations\n";
	if (-s "$fig_disk/FIG/Data/Organisms/$genome/annotations")
	{
	    &FIG::run("cp -p $fig_disk/FIG/Data/Organisms/$genome/annotations $fig_disk/BackupAnnotations/$genome");
	    &FIG::run("$FIG_Config::bin/merge_annotations $fig_disk/BackupAnnotations/$genome $fig_disk/BackupAnnotations/New/$genome > $fig_disk/FIG/Data/Organisms/$genome/annotations");
	}
	else
	{
	    &FIG::run("cp $fig_disk/BackupAnnotations/New/$genome $fig_disk/FIG/Data/Organisms/$genome/annotations");
	}
	chmod 0777,"$fig_disk/FIG/Data/Organisms/$genome/annotations";
    }
    &FIG::run("$FIG_Config::bin/index_annotations");
}

=pod

=head1 restore_annotations

usage: &restore_annotations($fig_disk);

$fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.

=cut

sub restore_annotations {
    my($fig_disk) = @_;

    &force_absolute($fig_disk);
    (-d "$fig_disk/BackupAnnotations") || die "could not find an active backup";
    opendir(TMP,"$fig_disk/BackupAnnotations") || die "could not open $fig_disk/BackupAnnotations";
    my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(TMP);
    closedir(TMP);
    foreach $genome (@genomes)
    {
	unlink("$fig_disk/FIG/Data/Organisms/$genome/annotations");
	&FIG::run("cp $fig_disk/BackupAnnotations/$genome $fig_disk/FIG/Data/Organisms/$genome/annotations");
	system "chmod 777 $fig_disk/FIG/Data/Organisms/$genome/annotations";
    }
    &FIG::run("$FIG_Config::bin/index_annotations");
}

=pod

=head1 package_aassignments

usage: &package_assignments($fig_base,$who,$date,$genomes,$file)

$fig_base must be an absolute filename (begins with "/") giving the FIG from which
   the updated code release will be taken.

$who designates whose assignments you want (defaults to "master")

$date if given indicates a point in time (get assignments after that point)

$genomes is a pointer to a list of genome IDs that will be exchanged.

$file must be an absolute filename where the "assignment package" will be built.

=cut

sub package_assignments {
    my($fig_base,$who,$date,$genomes,$file) = @_;
    my($genome,$x);

    $who   = $who ? $who : "master";
    $date  = $date ? $date : 0;
    &force_absolute($fig_base);
    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 $genome (@$genomes)
    {
	print STDERR "packaging $genome\n";
	my @possible = ();
	mkdir("$fig_base/Tmp/Assignments/$genome",0777) || die "could not make $fig_base/Tmp/Assignments/$genome";

	if (($who eq "master") && (-s "$fig_base/Data/Organisms/$genome/assigned_functions"))
	{
	    my %seen;
	    my($assignment,$id);
	    foreach $assignment (reverse `cat $fig_base/Data/Organisms/$genome/assigned_functions`)
	    {
		if (($assignment =~ /^(\S+)\t(\S.*\S)/) && (! $seen{$1}))
		{
		    $seen{$1} = 1;
		    push(@possible,[$1,$2]);
		}
	    }
	}

	if (($who ne "master") && (-s "$fig_base/Data/Organisms/$genome/UserModels/$who/assigned_functions"))
	{
	    my %seen;
	    my($assignment,$id);
	    foreach $assignment (reverse `cat $fig_base/Data/Organisms/$genome/UserModels/$who/assigned_functions`)
	    {
		if (($assignment =~ /^(\S+)\t(\S.*\S)/) && (! $seen{$1}))
		{
		    $seen{$1} = 1;
		    push(@possible,[$1,$2]);
		}
	    }
	}

	if (open(TMP,">$fig_base/Tmp/Assignments/$genome/$who"))
	{
	    if (@possible > 0)
	    {
		my %poss = map { $_->[0] => $_->[1] } @possible;
		if (open(ANN,"<$FIG_Config::organisms/$genome/annotations"))
		{
		    $/ = "\n//\n";
		    my $ann;
		    while (defined($ann = <ANN>))
		    {
			if (($ann =~ /^(fig\|\d+\.\d+\.peg\.\d+)\n(\d+)\n(\S+)\nSet ([^\n]*)function[^\n]*\n(\S[^\n]+\S)/s) &&
			    (($who eq $3) || (($4 eq "master ") && ($who eq "master"))) && 
			    ($x = $poss{$1}) && 
			    ($2 >= $date) && 
			    ($5 eq $x))
			{
			    print TMP "$1\t$5\n";
			}
		    }
		    $/ = "\n";
		    close(ANN);
		}
	    }
	    close(TMP);
	}
    }
    &FIG::run("cd $fig_base/Tmp; tar czf $file Assignments; rm -rf Assignments");
}

=pod

=head1 install_assignments

usage: &install_assignments($fig_bdisk,$package,$who_from,$logfile)

$fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.

$package must be an absolute filename where the "assignments package" from which to make
    the update exists.

=cut

sub install_assignments {
    my($fig,$fig_disk,$package,$who_from,$logfile) = @_;
    my($genome);

    &force_absolute($fig_disk);
    open(LOG,">>$logfile") || die "failed to open $logfile\n";

    if (-d "$fig_disk/BackupAssignments") { system "rm -rf $fig_disk/BackupAssignments" }
    mkdir("$fig_disk/BackupAssignments",0777);
    mkdir("$fig_disk/BackupAssignments/New",0777);
    &FIG::run("cd $fig_disk/BackupAssignments/New; tar xzf $package");
    &FIG::run("cd $fig_disk/FIG/Data/Organisms; tar czf $fig_disk/BackupAssignments/before_update.tgz */assigned_functions */UserModels");

    opendir(TMP,"$fig_disk/BackupAssignments/New/Assignments") || die "could not open $fig_disk/BackupAssignments/New/Assignments";
    my @genomes = grep { $_ =~ /^\d+\.\d+$/ } readdir(TMP);
    closedir(TMP);

    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)
    {
	@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;
	    my($func,$conf) = split(/\t/,$func_and_conf);
	    $conf = defined($conf) ? $conf : "";
	    $fig->assign_function($peg,$user,$func,$conf);
	    $fig->add_annotation($peg,"master","Imported function from $who_from: $func\n");
	    print LOG "accepted\t$peg\t$time_made\t$who_from\t$user\t$func\t$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);
}

=pod

=head1 package_translation_rules

usage: &package_translation_rules($fig_base,$file)

$fig_base must be an absolute filename (begins with "/") giving the FIG from which
   the updated code release will be taken.

$file must be an absolute filename where the "translation_rules package" will be built.

=cut

sub package_translation_rules {
    my($fig_base,$file) = @_;

    &force_absolute($fig_base);
    &force_absolute($file);
    &FIG::run("cp $fig_base/Data/Global/function.synonyms $file");
}

=pod

=head1 install_translation_rules

usage: &install_translation_rules($fig_disk,$from,$package)

$fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.

$package must be an absolute filename where the "translation_rules package" from which to make
    the update exists.

=cut

sub install_translation_rules {
    my($fig_disk,$from,$package) = @_;

    my $file = "$fig_disk/FIG/Data/Global/function.synonyms";
    &force_absolute($fig_disk);
    if (-d "$fig_disk/BackupTranslation_Rules") { system "rm -rf $fig_disk/BackupTranslation_Rules" }
    mkdir("$fig_disk/BackupTranslation_Rules",0777);
    chmod 0777,"$fig_disk/BackupTranslation_Rules";
    if (-s $file)
    {
	&FIG::run("cp $file $fig_disk/BackupTranslation_Rules");
    }
    &FIG::run("$FIG_Config::bin/merge_translation_rules $fig_disk/BackupTranslation_Rules/function.synonyms $package $from > $file");
    chmod 0777,$file;
}

=pod

=head1 restore_translation_rules

usage: &restore_translation_rules($fig_disk);

$fig_disk must be an absolute filename (begins with "/") giving the FIG to be updated.

=cut

sub restore_translation_rules {
    my($fig_disk) = @_;

    &force_absolute($fig_disk);

    my $file = "$fig_disk/FIG/Data/Global/function.synonyms";
    (-s "$fig_disk/BackupTranslation_Rules/function.synonyms") || die "could not find an active backup";
    if (-s "$fig_disk/BackupTranslation_Rules/function.synonyms")
    {
	&FIG::run("cp $fig_disk/BackupTranslation_Rules/function.synonyms $file");
	chmod 0777, $file;
    }
}

1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3