[Bio] / FigRelEngTools / install-seed.pl Repository:
ViewVC logotype

View of /FigRelEngTools/install-seed.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (download) (as text) (annotate)
Thu Nov 29 18:16:30 2007 UTC (11 years, 4 months ago) by olson
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +6 -1 lines
smallf ix

#!/usr/bin/env perl

use strict;

use File::Copy;
use File::Basename;

#
# Assemble a new FIGdisk from a code distribution. This script is assumed
# to be found in the same directory as the three tarfiles that make up a distribution:
#
#  env-XX.tgz		Compiled-code environment
#  code-YY.tgz		Lightweight code
#  BLASTMAT.tgz		Blast inputs
#
# Each of these is a tarfile. env-file extracts to a directory called "env".
# code-file is named code-<version>.tgz. It extracts to a directory <version>.
# blastmat-file extracts to a directory BLASTMAT.
#
# This script takes a single argument: the name of a directory that does not yet
# exist that will hold the new installation.
#

if (@ARGV != 2)
{
    die <<END;
Usage: $0 destination-dir arch-name

arch-name is currently "mac" or "linux-postgres".
END
}

my($dest_dir, $arch) = @ARGV;

#
# Lstat in case the destination is a symlink that points nowhere.
#
if (my @s = lstat($dest_dir))
{
    die "Error: Destination directory $dest_dir already exists\n";
}

my($env_file, $code_file, $blastmat_file);

$env_file = find_by_pattern("env-*.tgz");
$code_file = find_by_pattern("code-*.tgz");
$blastmat_file = File::Spec->rel2abs("BLASTMAT.tgz");

if (! -f $env_file)
{
    die "Environment file $env_file not found\n";
}
if (! -f $code_file)
{
    die "Code file $code_file not found\n";
}
if (! -f $blastmat_file)
{
    die "Blastmat file $blastmat_file not found\n";
}

#
# Determine the code release name. 
#

my $code_version;
{
    my $base = basename($code_file);
    if ($base =~ /code-(.*).tgz/)
    {
	$code_version = $1;
    }
    else
    {
	die "Invalid code release filename $code_file\n";
    }
}

#
# We're okay. Create and chdir to the destination, and unpack.
#

mkdir($dest_dir) or die "Error: cannot mkdir $dest_dir: $!\n";

chdir($dest_dir) or die "Error: cannot chdir $dest_dir: $!\n";


print "Unpacking environment from $env_file\n";

#
# Extract the tarfile into env-releases/tmp.timestamp so we can see exactly how it extracted.
#
# Determine the new name, and move it up a level into env-releases, assuming it's uniquely named.
# If it's not, give it a unique name when moving.
#
# Then determine if the env link at the toplevel is a dir or a symlink, moving if a directory,
# and symlink to the newly extracted environment dir.
#

mkdir("env-releases") or die "Error: cannot mkdir env-releases: $!\n";
chdir("env-releases") or die "Error: cannot chdir env-releases: $!\n";

my $tmp_env = "tmp." . time;
mkdir($tmp_env) or die "Error: cannot mkdir $tmp_env: $!\n";
chdir($tmp_env) or die "Error: cannot chdir $tmp_env: $!\n";

opendir(D, ".");
my @start_files = readdir(D);
closedir(D);
(system("tar zxf $env_file") == 0) or die "Extract of environment from $env_file failed: $!\n";

opendir(D, ".");
my @end_files = readdir(D);
closedir(D);

my %start_files;
map { $start_files{$_}++ } @start_files;
my $env_dir;
for my $d (@end_files)
{
    if (!$start_files{$d})
    {
	#
	# This might be it. See if it has env stuff in it.
	#

	if (-d "$d/linux-debian-i386")
	{

	    if ($env_dir ne "")
	    {
		warn "Warning: multiple environment directories found ($env_dir and $d). This should not happen\n";
	    }

	    $env_dir = $d;
	}
    }
}

if (!$env_dir)
{
    die "Did not find a valid env dir\n";
}


#
# back to env-releases
#
chdir("..") or die "Error: chdir .. failed: $!\n";

#
# Does the newly extracted release already exist here with that name?
#

if (-d $env_dir)
{
    my $new = "$env_dir." . time;
    rename($env_dir, $new) or die "Error: cannot rename $env_dir to $new: $!\n";
    warn "Renamed env-releases/$env_dir to env-releases/$new.\n";
}
rename("$tmp_env/$env_dir", $env_dir) or die "Error: error moving $tmp_env/$env_dir to $env_dir\n";
rmdir($tmp_env) or warn "Warning: rmdir $tmp_env failed: $!\n";

#
# And back to the top to fix up the env symlink.
#

chdir("..") or die "Error: chdir .. failed: $!\n";

if (-d "env")
{
    my $new_name = "env." . time;
    rename("env", $new_name) or die "Error: cannot rename env to $new_name\n";
    warn "Moved old env directory to $new_name\n";
}
elsif (-l "env")
{
    my $ptr = readlink("env");
    unlink("env") or die "Could not remove old env symlink: $!\n";
    warn "Removed old env symlink that pointed to $ptr\n";
}
symlink("env-releases/$env_dir", "env") or die "Cannot symlink $env_dir to env: $!\n";

print "Unpacking BLASTMAT from $blastmat_file\n";
(system("tar zxf $blastmat_file") == 0) or die "Extract of BLASTMAT from $blastmat_file failed: $!\n";

open(F, ">DEFAULT_RELEASE");
print F "$code_version\n";
close(F);

mkdir("FIG");
mkdir("FIG/Tmp");
chmod(0777, "FIG/Tmp");

mkdir("dist");
mkdir("dist/releases");

print "Unpacking code release $code_version\n";

(system("cd dist/releases; tar zxf $code_file") == 0) or die "Extract of code from $code_file failed: $!\n";

copy("dist/releases/$code_version/FigCommon/configure", "configure");
chmod(0755, "configure");

copy("dist/releases/$code_version/ReleaseTools/Makefile.top", "dist/releases/$code_version/Makefile");

#
# Everything is extracted, now run a configure.
#

system("./configure $arch");

#
# Find a file matching this pattern, and ensure that both it exists, and that
# it is unique.
#
sub find_by_pattern
{
    my($pat) = @_;

    my @r = glob($pat);

    if (@r == 1)
    {
	return File::Spec->rel2abs($r[0]);
    }
    elsif (@r == 0)
    {
	die "File matching pattern $pat not found.\n";
    }
    else
    {
	die "Multiple files found matching pattern $pat.\n";
    }
	
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3