#!/bin/sh

S_IN_QINSTALL=yes
export S_IN_QINSTALL

# @(#) $RCSfile: METAINSTALL,v $: $Revision: #29 $, $Date: 2008/07/08 $ 
# @(#) Copyright (c), 1987, 2000 StatSci, Inc.  All rights reserved.

# Syntax: METAINSTALL destdir files ...

# This file takes a list of 'files' containing S expressions which create
# objects on search position 1, and the name of a directory to install the
# objects in.  It prepares a file of Splus commands and gives that to Splus;
# the files are read in to S from stdin and the objects assigned under
# position 1 ($swork1, a temporarily created directory). S is then
# restarted, with $swork1 now mounted at the end of the search list, and a
# new scratch directory $swork2 at the head of the search list. The objects
# are assigned from $swork1 to "destdir" with assign(). (An explanation for
# all this juggling is given in a comment later on.) The exit status of
# this script is nonzero if all went well. The error option in S is set to
# make S exit 1 on any kind of error [which triggers evaluation of the error 
# option]. There are also places where we tell S to q(1) explicitly. In
# either case, QINSTALL catches a nonzero exit from S, does cleanup, and exits 
# 1.

# 'files' typically contain '<-' type assignments, though they may contain
# those of type 'data.restore("dumpfile")' as well. Anything that creates 
# the objects on position 1 should work.

# If the environment variable SYSGEN_UPDATE is set, and if the file
# $SHOME/touches/sysgen exists, then only those QFILES ($2 onwards) which 
# are newer than $SHOME/touches/sysgen are installed. 
echo "entering program"
prog=$SHOME/cmd/METAINSTALL
# Do not write to .Audit file (waste of disk space)
S_NOAUDIT=yes
export S_NOAUDIT

: ${SHOME?"must be set for $prog"}

platform=`$SHOME/cmd/PLATFORM`
if [ $platform = DOS386 -o $platform = WIN386 ]
then
	SEP=";"
else
	SEP=":"
fi
PATH="$SHOME/cmd${SEP}$PATH"
export PATH
echo "path exported"
. $SHOME/cmd/DIRNAMES
INITFILE=.First
if [ -f $SHOME/BUILDDOS_STEP_FILE -a -f $SHOME/SCMD_FILE ]
then
	tmpdir=$SHOME/tmp
else
	tmpdir=${S_TMP:-$SHOME/tmp}
fi
swork1=$tmpdir/1_$$_Data
swork2=$tmpdir/2_$$_Data
S_CMDS_FILE=commands.q
echo "variables set"
case $# in
	0) echo "Usage: $prog dest_directory files ..." >&2
	   exit 1
	   ;;
	1) exit 0 	# macro QFILES in Smakefile is empty.
	   ;;
	*) DEST=$1
	   shift
	   QFILES=$*
	   ;;
esac
echo "checked argument list"
echo $DEST
export DEST
[ -d $DEST ] || { echo "$prog : no directory $DEST" >&2 ; exit 1 ; }
[ -w $DEST ] || { echo "$prog : no write permission for $DEST" >&2 ; exit 1 ; }

# Check first that we can read all files.

for i in $QFILES
do
	[ -r $i ] || { echo "$prog : can't read $i" >&2 ; exit 1 ; }
done

# If this is a sysgen-update, install only qfiles which changed since last time.
#if test x$SYSGEN_UPDATE != x && test -r $SHOME/touches/sysgen; then	
#	QFILES=`find $QFILES -newer $SHOME/touches/sysgen -print`
#	if test x"$QFILES" = x; then exit 0; fi
#fi

# If anything goes wrong, clean up, print a message, and exit 1. User can 
# also ^C the process to get the same result.

sigs="0 2"	# any exit, SIGINT (^C)

trap 'rm -rf $S_CMDS_FILE $swork1 $swork2 ;
	echo "$prog : aborted" >&2 ;
	exit 1' $sigs

rm -rf $S_CMDS_FILE $swork1 $swork2
#mkdir swork1 swork2
#S_WORK=swork1

S_DEFAULT_PATH="$SHOME/library/splus/.Data${SEP}$SHOME/library/models/.Data${SEP}$SHOME/library/main/.Data"

#export S_WORK 
if [ -f $SHOME/BUILDDOS_STEP_FILE -a -f $SHOME/SCMD_FILE ]
then
	SCMD=`cat $SHOME/SCMD_FILE`
elif [ $platform = WIN386 ]; then
	CWD=`pwd`
	SCMD="$SHOME/cmd/Sqpe S_HOME=$SHOME S_WORK=.Data S_CWD=$CWD"
else
	SCMD="$SHOME/cmd/Splus EXEC Sqpe"
	[ -r $SHOME/cmd/dSqpe ] && SCMD="$SHOME/cmd/Splus EXEC dSqpe"
fi
if [ $platform = DOS386 -o $platform = WIN386 ]
then
	mkdir -p .Data/__Meta
else
	$SHOME/cmd/S CHAPTER
fi
# Create the objects on $swork1 in a separate invocation of S. Besides keeping 
# memory usage down, this ensures that there are no syntax errors in the 
# assignment expressions before we start writing to the system directory.

S_FIRST='options(conflicts.ok=T, error=function() { traceback(); cat("S exiting because of error.\n") ; q(1) })'
export S_FIRST
echo $S_FIRST > $INITFILE

( echo 'attach( "DESTDIR" ); invisible(setDBStatus("DESTDIR",T))' 
for i in $QFILES
do
    cat $i ; echo "" 
done ) | sed -e "s,DESTDIR,${DEST},g" | $SCMD 1>&2  || exit 1
# Replace the following line with each file terminated with a CR to prevent the problem 
# of missing CR at the end of the file.
#cat - $QFILES << EOF2 | sed -e "s,DESTDIR,${DEST},g" | $SCMD 1>&2  || exit 1
#attach( "DESTDIR" )
#EOF2

#/ Now we have assigned the objects to be installed on $swork1, a scratch
# directory. Next we start S again, with $swork2 attached on position [1] this
# time, and $swork1 at the end of the search list. We use assign() to copy
# them over to $DEST from $swork1. Putting the new objects last on the search
# list avoids the risk of S finding them in function calls (we make use of
# search(), attach(), cat(), q(), objects(), assign(), exists(), remove(), get()
# and all functions they call, in the assignment); thus the definitions of these
# objects need not be consistent with the rest of the S used to do the
# installing. This was formerly a problem. (Also, there is little chance that
# S will find them on $DEST immediately after an assignment to there, since 
# assigning there is the last thing S does.) Finally, this is not foolproof:
# it will fail if you try to install any functions called implicitly through 
# evaluation of .Last, if the new definitions of these are incompatible with
# the S used for installing them. exists() is one of these.

#S_WORK=swork2
#export S_WORK

echo $SP
# Below we make a file of S commands, and we need cat(..., "\n") as one of
# them. If we put this literally inside the 'cat << EOF1', this is ok on unix
# since /bin/sh doesn't process the " or \ in there, but the shell on DOS does
# process the \n, leaving us with an 'n'. So use a shell variable $newline
# to get "\n" in there; both shells do variable substitution inside <<'s as
# long as the delimiter word isn't quoted.

newline='"\n"'

cat << EOF1 > $S_CMDS_FILE || exit 1

	options(warn=0)
        options(conflicts.ok=T)
	XXX.dest.dir <- "$DEST"

# If $DEST is on the search list, find its position. If not, try to
# attach it, and then find its position. If the attach fails, abort everything.

	assign("Match",
		function(x, table, nomatch = NA)
		{
			# Special version of match() that conforms to Splus 
			# S_match C code, without the extra baggage to support 
			# 'incomparables' [that baggage depends on other Splus 
			# functions being installed]. Always use this function 
			# in QINSTALL so things don't depend on whether we're 
			# far enough along in sysgen to have installed Splus 
			# match().
			# 
			# Don't ever pass special values in 'x' or 'table'.

		.Internal(match(x, table, nomatch, F), "S_match", T, 0)
		}
		, where = 0)

	"XXX.attached.where"<-
	function(database)
	{
	# return the position on the search list where 'thing' is
	# attached, or zero if it isn't. Note the thing must match
	# exactly, e.g. if search()[1] is "./.Data", then
	# XXX.attached.where(".Data") won't return 1.

		Match(database, searchPaths(), 0)
	}

	XXX.where.dest.dir <- XXX.attached.where(XXX.dest.dir)
	if(XXX.where.dest.dir == 0) 
		attach(XXX.dest.dir, pos = 100)

	# S must quit if the attach() failed. If it fails, evaluation of that
	# expression stops, so the expression containing q() must not be part
	# of it.

	XXX.where.dest.dir <- XXX.attached.where(XXX.dest.dir)

#	if(XXX.where.dest.dir == 0) {
#		cat("Couldn't attach", XXX.dest.dir, $newline )
#		cat("Nothing installed.", $newline )
#		q(1)
#	}

	# now get rid of .Last.value and last.dump from $DEST
	# in case these got there somehow before. We cannot create them
	# here, since $DEST is not S_WORK.

	if (exists(".Last.value", where=XXX.where.dest.dir))
		remove(".Last.value", where=XXX.where.dest.dir)
	if (exists("last.dump", where=XXX.where.dest.dir))
		remove("last.dump", where=XXX.where.dest.dir)


	XXX.exclude <- c( ".Last.value", "last.dump","XXX.where.dest.dir",
             "XXX.dest.dir","XXX.exclude","XXX.what","XXX.attached.where",
             "XXX.where.temp.dir","Classes","Generics","Groups","oldClasses",
             ".Random.seed")

	XXX.what <- objects(where=1)
        XXX.mwhat <- objects(where=1,meta=1)
	for(i in XXX.exclude)
		XXX.what <- XXX.what[XXX.what != i]
	for(i in XXX.exclude)
		XXX.mwhat <- XXX.mwhat[XXX.mwhat != i]
	# assigning new objects to $DEST is the LAST thing we do, to guard
	# against these objects being incompatible with the rest of S right
	# now, and S accidentally finding them after the assign. For the
	# same reason, make copies on search()[1] of functions used in the 
	# assignment loop, in case we happen to be assigning new versions of
	# those functions.

#	cat <- cat
#	assign <- assign
#	get <- get

	invisible(setDBStatus(XXX.dest.dir, T))

	for(i in XXX.what) {
		cat(">>> Installing", i, "to", XXX.dest.dir, $newline )
#		assign(i, get(i, where = XXX.where.temp.dir), 
		assign(i, get(i, where=1), 
			where = XXX.dest.dir)
        }
	for(i in XXX.mwhat) 
        {
	  if( exists( i, XXX.dest.dir, meta=1 ))
	    warning( paste( i, "already exists in metadata of", 
			   XXX.dest.dir ))
	    else
	    {	  
	      cat(">>> Installing", i, "to metadata in ", 
		  XXX.dest.dir, $newline )
	      assign(i, get(i, where=1,meta=1), 
		     where = XXX.dest.dir,meta=1)
	    }
	}

	if(exists("Classes",where=1,meta=1))
        {
	  cl <- get("Classes",where=1,meta=1)
	  if( exists("Classes",where=XXX.dest.dir,meta=1) &&
	      length(cl) )
	  {
	    cat(">>> Combining Classes with metadata in ", 
		XXX.dest.dir, $newline )	        
	    assign("Classes",sort(unique(c(
		     get("Classes",where=XXX.dest.dir,meta=1), cl ))),
		   where=XXX.dest.dir,meta=1)
	  } else if( !exists("Classes",where=XXX.dest.dir,meta=1))
	  {
	   cat(">>> Installing Classes to metadata in ", 
	       XXX.dest.dir, $newline )	        	 
	   assign("Classes",cl,where=XXX.dest.dir,meta=1)
	 }
	}

	if(exists("Groups",where=1,meta=1))
        {
	  cl <- get("Groups",where=1,meta=1)
	  if( exists("Groups",where=XXX.dest.dir,meta=1) &&
	      length(cl) )
	  {
	    cat(">>> Combining Groups with metadata in ", 
		XXX.dest.dir, $newline )
	    # code sort of follows code in setGroupMembers for 
	    # merging groups objects
	    clold <- get( "Groups",where=XXX.dest.dir,meta=1)
	    dups <- match( cl[,1], clold[,1], nomatch=0)
	    if( any( dups ))
	      clold <- clold[-dups,]
	    cl <- rbind( clold, cl )

	    assign("Groups",cl, where=XXX.dest.dir,meta=1)
	  } else if( !exists("Groups",where=XXX.dest.dir,meta=1))
	  {
	   cat(">>> Installing Groups to metadata in ", 
	       XXX.dest.dir, $newline )
	   assign("Groups",cl,where=XXX.dest.dir,meta=1)
	 }
	}

	if(exists("Generics",where=1,meta=1))
        {
	  cl <- get("Generics",where=1,meta=1)
	  if( exists("Generics",where=XXX.dest.dir,meta=1) &&
	      length(cl) )
	  {
	    cat(">>> Combining Generics with metadata in ", 
		XXX.dest.dir, $newline )	        
	    assign("Generics",sort(unique(c(
		     get("Generics",where=XXX.dest.dir,meta=1), cl ))),
		   where=XXX.dest.dir,meta=1)
	  } else if( !exists("Generics",where=XXX.dest.dir,meta=1))
	  {
	   cat(">>> Installing Generics to metadata in ", 
	       XXX.dest.dir, $newline )	        	 
	   assign("Generics",cl,where=XXX.dest.dir,meta=1)
	 }
	}

	if(exists("oldClasses",where=1,meta=1))
        {
	  cl <- get("oldClasses",where=1,meta=1)
	  if( exists("oldClasses",where=XXX.dest.dir,meta=1) &&
	      length(cl) )
	  {
	    cat(">>> Combining oldClasses with metadata in ", 
		XXX.dest.dir, $newline )	        
	    assign("oldClasses",sort(unique(c(
		     get("oldClasses",where=XXX.dest.dir,meta=1), cl ))),
		   where=XXX.dest.dir,meta=1)
	  } else if( !exists("oldClasses",where=XXX.dest.dir,meta=1))
	  {
	   cat(">>> Installing oldClasses to metadata in ", 
	       XXX.dest.dir, $newline )	        	 
	   assign("oldClasses",cl,where=XXX.dest.dir,meta=1)
	 }
	}
        
#	remove("get",where=XXX.where.dest.dir)
#	remove("assign",where=XXX.where.dest.dir)
#	remove("cat",where=XXX.where.dest.dir)
#	remove("XXX.attached.where",where=XXX.where.dest.dir)
#	remove("XXX.dest.dir",where=XXX.where.dest.dir)
#	remove("XXX.exclude",where=XXX.where.dest.dir)
#	remove("XXX.where.dest.dir",where=XXX.where.dest.dir)
#	remove("XXX.what",where=XXX.where.dest.dir)
#	remove("get")
#	remove("assign")
#	remove("cat")

EOF1

# so far we haven't written anything on $DEST.

echo $prog ": installing to $DEST $S_CMDS_FILE"


	$SCMD < $S_CMDS_FILE 1>&2 || exit 1

trap "" $sigs
rm -rf $S_CMDS_FILE swork1 swork2 $INITFILE
rm -rf .Data
rm -f ${DEST}/${AUDIT_FILE}

# in case there is one from before.

exit 0
