#!/bin/sh
#set -x

S_IN_QINSTALL=yes
export S_IN_QINSTALL

# @(#)QINSTALL version 3.45 created 07/12/96
# @(#)Copyright (c), 1987, 1996 StatSci, Inc.  All rights reserved.

# Syntax: QINSTALL 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. 

prog=$SHOME/cmd/QINSTALL

# No need for .Audit file
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
. "$SHOME"/cmd/DIRNAMES
INITFILE=.S.init
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
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
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" "$INITFILE";
	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  
swork1=${tmpdir}/S$$
mkdir "$swork1"
mkdir "$swork1"/.Data
mkdir "$swork1"/.Data/__Meta
S_WORK=$swork1
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=\"$S_WORK\" S_CWD=\"$CWD\""
else
	SCMD="\"$SHOME\"/cmd/Splus EXEC Sqpe"
	[ -r "$SHOME"/cmd/dSqpe ] && SCMD="\"$SHOME\"/cmd/Splus EXEC dSqpe"
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() { cat("S exiting because of error.\n") ; traceback() ; q(1) })'
export S_FIRST

#Currently use line below b/c S_FIRST does not work in Splus - known bug.

echo $S_FIRST > "$INITFILE"
for i in $QFILES
do
    cat $i ; echo "" 
done | eval $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 | $SCMD 1>&2  || exit 1


#/ 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

# 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.
              search.paths <- character(length(search()))
              # database.path will always put the .Data on the end (if it is there)
              # searchPaths sometimes did, sometimes didn't
              XXX.database.path <- function(where,meta=0).Internal(database.name(where, meta), "S_dictionary", T, 10)
              for(i in 1:length(search.paths))
                      search.paths[i] <- XXX.database.path(i)
              Match(database, search.paths, 0)
	}

	XXX.where.dest.dir <- XXX.attached.where(XXX.dest.dir)
      if(XXX.where.dest.dir == 0)  {
              cat("Attaching", XXX.dest.dir, "in position 100\n")
		attach(XXX.dest.dir, pos = 100)
      } else {
              # cat("No need to attach", XXX.dest.dir, "in position 100\n")
      }

	# 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", ".Random.seed")

	XXX.what <- objects(where=1)

	for(i in XXX.exclude)
		XXX.what <- XXX.what[XXX.what != 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)
		
	}
#	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"


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

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

# in case there is one from before.

exit 0
