[Bio] / FigCommon / SwitchRelease.pm Repository:
ViewVC logotype

View of /FigCommon/SwitchRelease.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (download) (as text) (annotate)
Mon Oct 17 21:32:01 2011 UTC (8 years, 1 month ago) by olson
Branch: MAIN
CVS Tags: rast_rel_2014_0912, mgrast_version_3_2, mgrast_dev_12152011, help, rast_rel_2014_0729, lwc, mgrast_release_3_1_2, mgrast_dev_10262011, HEAD
Changes since 1.16: +11 -7 lines
move setting of CURRENT_RELEASE until after all work is done

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

package FigCommon::SwitchRelease;
#
# switch_to_release <release_number>
#
# Change the currently-running release to <release_number>
#
# Check to be sure that $fig_disk/dist/releases/<release_number> exists
#
# Update $fig_disk/CURRENT_RELEASE with the new release number.
#
# Swing the symlinks $fig_disk/FIG/bin and $fig_disk/FIG/CGI to the right place
#
# Create the symlink $fig_disk/disk/releases/current to point to <release_number>
#
# Create a symlink $fig_disk/dist/releases/last to point to the pre-switch release.
#
# Expand the environment-specific tool headers from $fig_disk/config/base_tool_hdr
# to include the release-specific directories. Place the output in
# dist/releases/<release_number>/<arch>.
#

use strict;

sub switch_to_release
{
    my($fig_disk, $arch, $release_number) = @_;

    my $release_dir = "$fig_disk/dist/releases/$release_number";


    if (! -d $release_dir)
    {
	die "Release directory $release_dir does not exist";
    }

    #
    # Don't allow a switch to a release dir that is a symlink.
    # That's likely to be a bad thing (like "switch_to_release current").
    #

    if (-l $release_dir)
    {
	die "You may not switch to a release that is a symbolic link ($release_dir)";
    }

    #
    # Okay, go for it.
    #
    
    #
    # Set up the arch-specific directory in the release directory
    # if it's not already there.
    #

    if (! -d "$release_dir/$arch")
    {
	print "Creating $release_dir/$arch\n";
	mkdir("$release_dir/$arch");
    }

    #
    # Symlinks.
    #

    my $bindir = "$fig_disk/FIG/bin";
    my $cgidir = "$fig_disk/FIG/CGI";

    #
    # See if bin and/or CGI are directories; they are if this is an old-style
    # FIG setup. Rename them and do the symlink.
    #

    if (-d $bindir && ! -l $bindir)
    {
	my $bak = "$bindir." . time();
	warn "Renaming $bindir to $bak\n";
	rename($bindir, $bak);
    }
    if (-d $cgidir && ! -l $cgidir)
    {
	my $bak = "$cgidir." . time();
	warn "Renaming $cgidir to $bak\n";
	rename($cgidir, $bak);
    }
    
    unlink("$fig_disk/FIG/bin");
    symlink("../dist/releases/$release_number/$arch/bin", "$fig_disk/FIG/bin") ;
    unlink("$fig_disk/FIG/CGI");
    symlink("../dist/releases/$release_number/$arch/CGI", "$fig_disk/FIG/CGI");
    unlink("$fig_disk/FIG/Tutorial");
    symlink("../dist/releases/$release_number/$arch/Tutorial", "$fig_disk/FIG/Tutorial");

    #
    # Read the current symlink, and make last point to it.
    #

    my $current_link = "$fig_disk/dist/releases/current";
    my $last_link = "$fig_disk/dist/releases/last";

    if (-l $last_link)
    {
	unlink($last_link);
    }
    elsif (-e $last_link)
    {
	#
	# It's a non-synmlink file or dir that exists; this shouldn't be. Rename it out of the way.
	#

	rename($last_link, "$last_link." . time);
    }

    if (-l $current_link)
    {
	my $last_targ = readlink($current_link);

	if (-e $last_link)
	{
	    warn "$last_link still exists after attempts to remove. Permissions problems?\n";
	}
	else
	{
	    symlink($last_targ, $last_link);
	}
    }

    unlink("$fig_disk/dist/releases/current");
    symlink($release_number, "$fig_disk/dist/releases/current");

    #
    # Expand the tool headers. We only do this if we see that we
    # are building a release that doesn't have the new (5/05)
    # ReleaseTools/makeScriptHeaders script.
    #

    if (! -f "$fig_disk/dist/releases/current/ReleaseTools/makeScriptHeaders")
    {
	#
	# We force the ext_bin and bin directories to the front of the path.
	#

	expand_header("$fig_disk/config/base_tool_hdr",
		      "$release_dir/$arch/tool_hdr",
		      <<END);
use lib '$release_dir/$arch/lib';
use lib '$release_dir/$arch/lib/FigKernelPackages';
use lib '$release_dir/$arch/lib/PPO';
use lib '$release_dir/$arch/lib/WebApplication';
use lib '$release_dir/$arch/lib/FortyEight';
\$ENV{PATH} = "$fig_disk/FIG/bin:$fig_disk/env/$arch/bin:\$ENV{PATH}";
\$ENV{BLASTMAT} = "$fig_disk/BLASTMAT";
END
    
	expand_header("$fig_disk/config/base_tool_hdr_py",
		      "$release_dir/$arch/tool_hdr_py",
		      <<END);
import os
os.environ["PATH"] = "$fig_disk/FIG/bin:$fig_disk/env/$arch/bin:" + os.environ["PATH"];
os.environ["PERL5LIB"] = ":".join([os.getenv("PERL5LIB", ""), '$release_dir/$arch/lib', '$release_dir/$arch/lib/FigKernelPackages'])
os.environ["BLASTMAT"] = "$fig_disk/BLASTMAT";
sys.path.append('$release_dir/$arch/lib')
END

    }

    #
    # If there is not an RTConfig file in the config dir, build one based
    # on the information in the tool_hdr_base files.
    #

    my $rtconfig = "$fig_disk/config/RTConfig";

    if (! -f $rtconfig)
    {
	warn "Building new $rtconfig file\n";
	build_rtconfig($fig_disk, $rtconfig);
    }

    &run_make($fig_disk, $arch, $release_number, $release_dir);

    my $rc = system("$fig_disk/FIG/bin/lwc_postprocess");
    if ($rc != 0)
    {
	warn "$fig_disk/FIG/bin/lwc_postprocess returns nonzero rc=$rc";
    }

    #
    # Fix up permissions so we can do things as a different user later.
    #

    chmod(0777, $fig_disk);
    chmod(0777, "$fig_disk/FIG");
    chmod(0777, "$fig_disk/FIG/bin");
    chmod(0777, "$fig_disk/FIG/CGI");

    #
    # Do this last so we can use it as a sentinel by
    # systems that want to do something when the release changes
    #
    if (!open(FH, ">", "$fig_disk/CURRENT_RELEASE"))
    {
	warn "Cannot write to $fig_disk/CURRENT_RELEASE";
    }
    print FH "$release_number\n";
    close(FH);
    
    system("chmod ugo+w $fig_disk");
    system("chmod ugo+w $fig_disk/CURRENT_RELEASE");
    system("chmod ugo+w $fig_disk/FIG");
    system("chmod ugo+w $fig_disk/FIG/bin");
    system("chmod ugo+w $fig_disk/FIG/CGI");
    system("chmod ugo+w $fig_disk/dist/releases");
    system("chmod  -R ugo+w $release_dir");

    return 0;
}

#
# Build an RTConfig file.
#
# From $fig_disk/config/base_tool_hdr, extract the perl path and perl
# executable name.
#
# From $fig_disk/config/base_tool_hdr_py, extract the python path. We don't
# need the python lib path since it builds it from the location of the executable.
#

sub build_rtconfig
{
    my($fig_disk, $rtconfig) = @_;

    open(my $rt, ">$rtconfig") or die "Cannot write $rtconfig: $!\n";

    #
    # Parse perl tool_hdr.
    #

    open(my $hdr, "<$fig_disk/config/base_tool_hdr") or die "Cannot open $fig_disk/config/base_tool_hdr: $!";

    my @perl_path = ();
    my $perl;

    $_ = <$hdr>;
    if (s/^\#!//)
    {
	my @words = split(/\s+/);
	my @perl = grep /\/perl/, @words;
	if (@perl == 1)
	{
	    $perl = $perl[0];
	}
	elsif (@perl == 0)
	{
	    warn "Did not find perl exec!\n";
	}
	else
	{
	    warn "Ambiguous perl @perl, using last one.\n";
	    $perl = $perl[$#perl];
	}
    }

    while (<$hdr>)
    {
	if (/INC = qw/)
	{
	    while (<$hdr>)
	    {
		last if /^\)/;
		chomp;
		s/^\s*//;
		s/\s*$//;
		push(@perl_path, $_);
	    }
	    last;
	}
    }

    push(@perl_path, "$fig_disk/config");

    close($hdr);


    #
    # Strip duplicates from perl path.
    #

    my @new;
    my %seen;

    for (@perl_path)
    {
	next if $seen{$_};
	push(@new, $_);
	$seen{$_}++;
    }

    @perl_path = @new;

    #
    # Parse python tool_hdr.
    #

    open(my $hdr, "<$fig_disk/config/base_tool_hdr_py") or die "Cannot open $fig_disk/config/base_tool_hdr_py: $!";

    my $python;
    my @python_path;
    
    $_ = <$hdr>;
    if (s/^\#!//)
    {
	my @words = split(/\s+/);
	my @python = grep /\/python/, @words;
	if (@python == 1)
	{
	    $python = $python[0];
	}
	elsif (@python == 0)
	{
	    warn "Did not find python exec!\n";
	}
	else
	{
	    warn "Ambiguous python @python, using last one.\n";
	    $python = $python[$#python];
	}
    }

    push(@python_path, "$fig_disk/config");

    close($hdr);

    print $rt "RTPYTHON=$python\n";
    print $rt "RTPERL=$perl\n";
    print $rt "RTPYTHONPATH=" . join(":", @python_path) . "\n";
    print $rt "RTPERL5LIB=" . join(":", @perl_path) . "\n";
    print $rt "RTPYTHONIMPORTS=FIG_Config\n";
    print $rt "RTPERLIMPORTS=FIG_Config\n";
    print $rt "RTSETENV=BLASTMAT=$fig_disk/BLASTMAT\n";
    print $rt "RTSETENV=FIG_HOME=$fig_disk\n";
    close($rt);
}


#
#
# Run a make in the release.
#
# This sets up the local environment to properly do the make.
#

sub run_make
{
    my($fig_disk, $arch, $release_number, $release_dir) = @_;

    my %save_env = %ENV;

    $ENV{RTCURRENT} = $release_number;
    $ENV{RTROOT} = $fig_disk;
    $ENV{FIG_HOME} = $fig_disk;
    $ENV{RTDIST} = "$fig_disk/dist";
    $ENV{RTARCH} = $arch;
    $ENV{RTSITECONFIGDIR} = "$fig_disk/config";

    #
    # Run the make in a pipe so we can save the output and provide a link to it.
    #

    my $output_file = "make." . time;
    my $output = "$fig_disk/FIG/Tmp/$output_file";

    open(my $out, ">$output") or die "Cannot open make output file $output\n";

    my $cmd = "(cd $release_dir; make clean; make ) 2>&1";

    my $pipe;

    if (!open($pipe, "$cmd|"))
    {
	die "Cannot run make command $cmd: $!\n";
    }

    while (<$pipe>)
    {
	print $out $_;
	print;
    }

    if (!close($pipe))
    {
	my $err;
	if ($!)
	{
	    $err = "Error closing make pipe: $!";
	}
	else
	{
	    $err = "Make returns nonzero exit status $?";
	}
	print $out "\n\n$err\n";
	close($out);
	die $err;
    }

    print $out "\n\nMake completes successfully\n";

    print "\n\nMake completes successfully\n";
    print "Output is in $output_file\n";

    %ENV = %save_env;
}

sub expand_header
{
    my($input, $output, $text) = @_;

    my($fh_in, $fh_out);

    open($fh_in, "<$input") or
	die "expand_header: cannot open $input: $!";
    open($fh_out, ">$output") or
	die "expand_header: cannot open $output: $!";
    for (<$fh_in>)
    {
	if (/^#BEGIN switch_to_release generated code/)
	{
	    print $fh_out $_;
	    while (<$fh_in>)
	    {
		if (/^#END switch_to_release generated code/)
		{
		    print $fh_out $_;
		    last;
		}
	    }
	    print $fh_out $text;
	}
	else
	{
	    print $fh_out $_;
	}
    }
    close($fh_in);
    close($fh_out);
}




1;
	

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3