! Copy procedure for SOFT programs
! It is assumed that the source software is located an an Alpha DEC-machine
! Currently that is CASS01.
! When installing to a non-Alpha VAX check the following:
! > MKD.COM	disable the call to LIBARG, use internal subroutine instead
! > iSetSymbol (in $LIB:FORVAX (VAXCALLS)):
!		make sure that GETDESCR gets called
!
$	INS__QUIET    = %x10000000		! Inhibit display (bit 28)
$	INS__SUCCESS  = INS__QUIET + %x0001	! Severity 1 (success)
$	INS__FATAL    = INS__QUIET + %x0004	! Severity 4 (fatal error)
$	INS__CONTROLY = INS__FATAL
$	on warning   then exit INS__QUIET .or. $STATUS
$	on control_y then exit INS__CONTROLY
$	if f$type(INS__QUIET) .eqs. "" then exit %x10000000
!
! ******	Auxilliary symbols
!
$	say		= "write SYS$OUTPUT"
$	excl		= "/exclude=(*.dir)"
$	cleardir	= "delete/log"+excl
$	createdir	= "create/directory/log"
$	copy		= "copy/log/prot=(S:RWED,O:RWED,G:RWED,W:RWED)"
$	inquire		= "inquire/nopunc"
!
! ******	Check DCL version
!
$	VERS = f$extract(0,4,f$getsyi("VERSION"))
$	say ""
$	say " DCL version ",VERS
$	if VERS .lts. "V5.4" then say " INSTALL needs V5.4 or higher"
$!	if VERS .lts. "V5.4" then exit
!
!
$	if P1 .eqs. "BUILD_ONLY"
$	then
$		F77_GENERAL_INSTALLED = 1
$		IDL_GENERAL_INSTALLED = 1
$		HELIOS_INSTALLED = 0
$		HXIS_INSTALLED = 0
$		WING_INSTALLED = 0
$		MAP_INSTALLED  = 1
$		IPS_INSTALLED  = 1
$		call F77_COMPILE
$		exit INS__SUCCESS
$	endif
!
! ******	Check installation directory
!
$	CURDIR = f$environment("default")
$	say " "
$	say " Installation will proceed in directory ",CURDIR
$	say " "
$	inquire ANS " Is this the right directory (YES/NO) ? [NO]"
$	ANS = f$extract(0,1, f$edit(ANS,"COLLAPSE,UPCASE"))
$	if ANS .nes. "Y" then exit
!
! ******	Get password of host account (if necessary).
!		Set host directory symbol GET
!
$	say ""
$	VAXNODE		= f$getsyi("NODENAME")
$	GET		= "UD1:[PHICK.SOFT."	! On CASS01
$	SPAN_COPY	= 1			! Default is straight copy
!
$	if VAXNODE .nes. "CASS01"
$	then
$		inquire ANS " Use FTP or SPAN for file transfer (FTP/SPAN) ? [SPAN]"
$		ANS = f$extract(0,1, f$edit(ANS,"COLLAPSE,UPCASE"))
$		SPAN_COPY = ANS .nes. "F"
!
$		VAXUSER	= "PHICK"
$		inquire VAXPASS " ''VAXUSER' password (RETURN if no password needed) ? "
!
$		if SPAN_COPY
$		then
$			inquire VAXNODE " Path of nodes to CASS01 ? [CASS01]"
$			if VAXNODE .eqs. "" then VAXNODE = "CASS01"
$			if VAXPASS .eqs. ""
$			then
$				GET = VAXNODE+"::"+GET
$			else
$				QUO = """
$				GET = VAXNODE+QUO+VAXUSER+" "+VAXPASS+QUO+"::"+GET
$			endif
$		else
$			VAXNODE  = "CASS01.UCSD.EDU"
$		endif
$	endif
!
$	call DO_TRANSFER 'get'aux]template.for [] ASCII
$	if .not. $STATUS
$	then
$		say ""
$		say "  Copying of test file to ''CURDIR' failed"
$		exit INS__FATAL
$	endif
$	delete template.for;
$	say ""
$	say "  Test file successfully copied"
!
! ******	Set destination directory symbol PUT
!
! The directory PUTDIR is created in the working directory, if it doesn't exist
! already. All files are put in the directory branch with PUTDIR at the top
!
$	PUTNAME = CURDIR	+"SOFT.DIR"
$	PUTDIR  = CURDIR-"]"	+".SOFT]"
$	PUT     = PUTDIR-"]"+"."
!
$	say " "
$	say " Source      >> ",GET,"]"
$	say " Destination >> ",PUT,"]"
$	say " "
!
! ******	Create or clear all subdirectory tree
!
$	if f$search(PUTNAME) .eqs. ""		! Top directory PUTDIR does not
$	then					! exist. Create directory tree.
!
$		createdir 'putdir'		! Create top directory
$		DoPurge = 0
$	else					! Top directory PUTDIR exist.
!						! Ask permission to continue.
$		say ""
$		say " !!!! WARNING !!!!"
$		say "  The directory ",PUTDIR," exists already"
$		say " !!!!!!!!!!!!!!!!!"
$		inquire ANS "  Do yo want to continue (YES/NO) ? [NO]"
$		ANS = f$extract(0,1,f$edit(ANS,"COLLAPSE,UPCASE"))
$		if ANS .nes. "Y" then exit
!
$		say ""
$		say "  If you say so ..."
$		say ""
!
$		say " !!!! NOTE !!!!!!!"
$		say "  Do you want to:"
$		say "  1 - Delete the previous INSTALL before making the new INSTALL, or"
$		say "  2 - Purge the previous INSTALL after making the new INSTALL"
$		say " !!!!!!!!!!!!!!!!!"
$		say ""
$		inquire ANS "  Choose option 1 or 2 ? [2]"
$		ANS = f$extract(0,1,f$edit(ANS,"COLLAPSE,UPCASE"))
$		DoPurge = ANS .nes. "1"
!
$		say ""
$		say "  Here we go ..."
$		say ""
!
$		cleardir 'putdir*.*;*		! Clear top directory
$	endif
!
! ******	Create subdirectories if they do not exist. Delete all files
!		if they already exist.
!
$	DIRLIST = "AUX,COM,EXE,EXE.FOR,EXE.PAS,EXE.C,EXE.C.H,PRO,LIB,DAT,SAM,YOH"
$	TYPLIST = "ASCII,ASCII,BINARY,ASCII,ASCII,ASCII,ASCII,ASCII,BINARY,BINARY,ASCII,BINARY"
$	RMDLIST = "AUX,COM,EXE,EXE.FOR,EXE.PAS,EXE.C.H,EXE.C,PRO,LIB,DAT,YOH"
$	I = -1
$ NEXT_DIR_CHECK:
$	I = I+1
$	SPEC = f$elements(I,",",DIRLIST)
$	if SPEC .nes. ","
$	then
$		SPEC = PUT+SPEC+"]"
$		if f$parse(SPEC) .eqs. ""
$		then
$			createdir 'SPEC
$		else
$			if .not. DoPurge
$			then
$				set noon
$				cleardir 'SPEC*.*;*
$				set on
$			endif
$		endif
$		goto NEXT_DIR_CHECK
$	endif
!
$ TRY_AGAIN:
!
$	say ""
$	say "	Options:"
$	say "		A. Copy all files"
$	say "		B. Copy selection of files"
$	inquire ANS "	Your choice (A/B) ?"
$	ANS = f$edit(ANS,"COLLAPSE,UPCASE")
$	if ANS .nes. "A" .and. ANS .nes. "B" then goto TRY_AGAIN
$	if ANS .eqs. "B" then goto SELECT
!
!
! ******	OPTION 1: Copy the whole works from GET downward
!
$	set noon		! Switch off error handler
$	aft = "*.*"
$	I = -1
$ TRANSFER_NEXT_DIR:
$	I = I+1
$	SPEC = f$element(I,",",DIRLIST)
$	if SPEC .nes. ","
$	then
$		FROMDIR = get+SPEC+"]"+aft
$		TODIR	= put+SPEC+"]"
$		TRANSFER_TYPE = f$element(I,",",TYPLIST)
$		call do_transfer 'FROMDIR 'TODIR 'TRANSFER_TYPE
$		goto TRANSFER_NEXT_DIR
$	endif
$	set on			! Switch error handler back on
!
$	call ACTIVATE_COMMAND
!
$	goto INSTALL_EXIT
!
!
! ******	OPTION B: Select software packages
!
$ SELECT:
$	say " "
$	say "  Copying command procedures into ",PUT,"COM]"
$	say " "
$	set noon
$	call do_transfer  'get'com]*.*	'put'com]	ASCII
$	set on
$!
$	call ACTIVATE_COMMAND		! Activate command procedures
!
$	say " "
$	say "  Copying selection of auxilliary files to ",PUT,"AUX]"
$	say " "
!
$	set noon
$	call do_transfer	'get'aux]*.play		'put'aux]	BINARY
$	call do_transfer	'get'aux]sacpeak.*	'put'aux]	ASCII
$	call do_transfer	'get'aux]template.*	'put'aux]	ASCII
$	call do_transfer	'get'aux]error.handler	'put'aux]	ASCII
$	call do_transfer	'get'aux]edt*.*		'put'aux]	ASCII
$	set on
$!
$	F77_GENERAL_INSTALLED = 0
$	IDL_GENERAL_INSTALLED = 0
$	HELIOS_INSTALLED = 0
$	HXIS_INSTALLED = 0
$	WING_INSTALLED = 0
$	MAP_INSTALLED  = 0
$	IPS_INSTALLED  = 0
!
! ******	HELIOS SOFTWARE
!
$	echo LIB__ANS B "  Install HELIOS F77 programs (YES/NO) ?" NO S
!
$	set noon
$	if LIB__ANS
$	then
$		gosub F77_GENERAL
!
$		GROUP = "HERDISK," 	+ -
			"SHPLT,"	+ -
			"PRINTALL,"	+ -
			"NODAT,"	+ -
			"CONNECT,"	+ -
			"TIME_FILTER,"	+ -
			"UNIV"
$		call get_executables 'GROUP
$		call check_and_copy lib FORHOS.TLB BINARY
$		call check_and_copy lib FORPLA.TLB BINARY
$		HELIOS_INSTALLED = 1
$	else
$		delete	'put'aux]HELIOS.PLAY;*
$		delete	'put'com]HISDISK.COM;*
$	endif
$	set on
!
!
! *******	IDL software
!
$ 	echo LIB__ANS B "  Install IDL software (YES/NO) ? " NO S
!
$	set noon
$	if LIB__ANS
$	then
$		gosub IDL_GENERAL
$ 	endif
$	set on
!
! *******	Yohkoh IDL support
!
$ 	echo LIB__ANS B "  Install Yohkoh IDL support (YES/NO) ? " NO S
!
$	set noon
$	if LIB__ANS
$	then
$		gosub IDL_GENERAL
$	else
$		delete	'put'com]YOHKOH.COM;*
$ 	endif
$	set on
!
!
! *******	HXIS Tape handling and raw data processing
!
!
$	echo LIB__ANS B "  Install HXIS raw data processing programs (YES/NO) ?" NO S
!
$	set noon
$	if LIB__ANS
$	then
$		gosub F77_GENERAL
!
$		call get_executables HAXIM,HIMSEL,HXISLIB
$		call check_and_copy lib HXIS.INDEX	BINARY
$		call check_and_copy lib FORHXIS.ARC	BINARY
$		call check_and_copy lib HXIS.HLB	BINARY
$		HXIS_INSTALLED = 1
$ 	else
$		delete	'put'aux]HIMSEL.LIB;*
$		delete	'put'com]HXIS.COM;*
$		delete	'put'aux]HXIS.PLAY;*
$	endif
$	set on
!
!
! *******	MODL package
!
!
$	echo LIB__ANS B "  Install MODL package (YES/NO) ?" NO S
!
$	set noon
$	if LIB__ANS
$	then
$		call do_transfer  'get'aux]*.MODL	 'put'aux]	BINARY
$	else
$		delete	'put'com]MODL.COM;*	! Delete MODL.COM
$	endif
$	set on
!
! *******	WING package
!
!
$	echo LIB__ANS B "  Install WING package (YES/NO) ?" NO S
!
$	set noon
$	if LIB__ANS
$	then
$		gosub F77_GENERAL
!
$		call get_executables WING
$		call check_and_copy lib FORWING.ARC BINARY
$		WING_INSTALLED = 1
$	else
$		delete	'put'com]WING.COM;*
$	endif
$	set on
!
!
! ******	MAP software
!
$	echo LIB__ANS B "  Install MAP programs (YES/NO) ?" NO S
!
$	set noon
$	if LIB__ANS
$	then
$		gosub F77_GENERAL
$		call check_and_copy lib FORMAP.ARC	BINARY
$		call check_and_copy sam MAP_INFO.TXT	ASCII
$		call get_executables MAP
$		MAP_INSTALLED = 1
$	endif
$	set on
!
! ******	IPS SOFTWARE
!
$	echo LIB__ANS B "  Install IPS programs (YES/NO) ?" NO S
!
$	set noon
$	if LIB__ANS
$	then
$		gosub F77_GENERAL
$		gosub IDL_GENERAL
$		call get_executables EGIPSY,IPSV
$		IPS_INSTALLED = 1
$	endif
$	set on
!
!
!=======	Clean up some stuff
!
$	set noon
$	delete	'put'aux]MARLAR.PLAY;*
$	delete	'put'aux]BCK.PLAY;*
$	delete	'put'com]INSTALL.COM;*
$	if .not. IDL_GENERAL_INSTALLED
$	then
$		delete	'put'com]IDLEXE.COM;*
$	endif
$	set on
!
$ INSTALL_EXIT:
$	set noon
$	if DoPurge
$	then
$		say " "
$		say "  Purging previous INSTALL"
$		say " "
$		vpur 'putdir'
!
$		I = -1
$ NEXT_DIR_PURGE:
$		I = I+1
$		SPEC = f$elements(I,",",DIRLIST)
$		if SPEC .nes. ","
$		then
$			SPEC = PUT+SPEC+"]"
$			vpur 'SPEC
$			goto NEXT_DIR_PURGE
$		endif
$	endif
$!
$	say " "
$	say "  Deleting empty subdirectories"
$	say " "
$	rmdir 'putdir'
$!
$	I = -1
$ NEXT_DIR_RMDIR:
$	I = I+1
$	SPEC = f$elements(I,",",RMDLIST)
$	if SPEC .nes. ","
$	then
$		SPEC = PUT+SPEC+"]"
$		rmdir 'SPEC
$		goto NEXT_DIR_RMDIR
$	endif
$	set on				! Activate error handler again
!
$	call F77_COMPILE
!
$	say "  Installation successfully completed"
$	say ""
$	say "  The whole package is activated with the command :"
$	say "    @",f$search("$com:libinit.com")
$	say "  You may want to add this to your LOGIN.COM file"
$	say ""
$	exit INS__SUCCESS
!
$ F77_GENERAL:
$	if F77_GENERAL_INSTALLED then return
$	say ""
$	say "  Copying general F77 executables and libraries"
$	say ""
$	if LIB__AXP
$	then
		GROUP = "ARC,"		+ -
			"LIBSD,"	+ -
			"PANDORA,"	+ -
			"SPRINT,"	+ -
			"CLOCK,"	+ -
			"LIBARG"
$		call get_executables 'GROUP NOPROMPT
$	else
$		call check_and_copy exe ARC_VAX.EXE	BINARY
$		rename/log $EXE:ARC_VAX.EXE ARC.EXE
$	endif
!
$	GROUP = "FORMAIN.ARC,"	+ -
		"FORGEN.TLB,"	+ -
		"FORPLT.ARC,"	+ -
		"FORBYTES.ARC,"	+ -
		"FORVAX.ARC,"	+ -
		"FORSTR.ARC,"	+ -
		"HHH.TLB"
$	call get_group_of_files lib "''group'" ""	BINARY
$	call check_and_copy exe.for POLEWARP.FOR	ASCII
$	call check_and_copy exe.c.h FORTRAN.H		ASCII
$	call check_and_copy lib     XLIB.OPT		ASCII
$	F77_GENERAL_INSTALLED = 1
$	return
$	exit INS__SUCCESS
!
$ IDL_GENERAL:
$	if IDL_GENERAL_INSTALLED then return
$	say ""
$	say "  Copying general IDL libraries and startup file"
$	say ""
$	if LIB__AXP then call check_and_copy exe EXEIDL.EXE BINARY
$	call check_and_copy aux IDL_STARTUP.PRO	ASCII
$	call check_and_copy aux IDLEXE.TXT	ASCII
$	call check_and_copy lib PROAST.TLB	BINARY
$	call check_and_copy lib PROCME.TLB	BINARY
$	call check_and_copy lib PROVAR.TLB	BINARY
$	IDL_GENERAL_INSTALLED = 1
$	return
$	exit INS__SUCCESS
!
!
$ ACTIVATE_COMMAND:
$	subroutine
$	Xcom = f$trnlnm("$COM")
$	if Xcom .eqs. ""
$	then
$		say " "
$		say "  Activate command procedures: FOREIGN LOGIN"
$		say " "
$		set noon
$		@'put'com]libinit
$		set on
$	endif
$	exit INS__SUCCESS
$	endsubroutine
!
$ F77_COMPILE:
$	subroutine
$	on warning   then exit INS__QUIET .or. $STATUS
$	on control_y then exit INS__CONTROLY
!
$	if f$type(F77_GENERAL_INSTALLED) .nes. "INTEGER" then exit INS__SUCCESS
$	if .not. F77_GENERAL_INSTALLED then exit INS__SUCCESS
!
$	ARC_THERE = f$search("$EXE:ARC.EXE") .nes. ""
$	if ARC_THERE
$	then
$		set noon
$		run $EXE:ARC
$		STATUS = $STATUS
$		set on
$		ARC_THERE = $STATUS
$		if .not. ARC_THERE
$		then
$			signal F77_COMPILE W NOARC -
				"archiver ARC.EXE does not run properly"
$			exit INS__SUCCESS
$		endif
$	endif
$	say ""
$	say "  The archive $EXE:ARC.EXE works properly.
$	say ""
!
$	create SYS$LOGIN:INSTALL_DUMMY.FOR
	program DUMMY
	I = 0
	end
$
$	set noon
$	fortran/object=SYS$LOGIN:INSTALL_DUMMY.OBJ SYS$LOGIN:INSTALL_DUMMY.FOR
$	STATUS = $STATUS
$	delete SYS$LOGIN:INSTALL_DUMMY.FOR;*
$	delete SYS$LOGIN:INSTALL_DUMMY.OBJ;*
$	set on
$	if .not. STATUS
$	then
$		signal F77_COMPILE W NOF77 "Fortran compiler appears to be missing"
$		exit INS__SUCCESS
$	endif
$	say ""
$	say "  Fortran compiler detected"
$	say ""
!
$	create SYS$LOGIN:INSTALL_DUMMY.C
int main ()
{
    return 0 ;
}
$
$	set noon
$	cc/object=SYS$LOGIN:INSTALL_DUMMY.OBJ SYS$LOGIN:INSTALL_DUMMY.C
$	STATUS = $STATUS
$	delete SYS$LOGIN:INSTALL_DUMMY.C;*
$	delete SYS$LOGIN:INSTALL_DUMMY.OBJ;*
$	set on
$	XLIB_THERE = 0
$	if .not. STATUS
$	then
$		signal F77_COMPILE W NOF77 "C compiler appears to be missing" -
			"X-windows programs will not compile"
$	else
$		say "  C compiler detected"
$		say ""
$		XLIB_THERE = f$search("DECW$INCLUDE:XLIB.H") .nes. ""
$		if .not. XLIB_THERE
$		then
$			signal F77COMPILE W NOXLIB "XLIB.H not found. XLIB not available?" -
				"X-windows programs will not compile"
$		endif
$	endif
$	say ""
$	say "  Set up MKD utility (answer YES at next prompt)"
$	say ""
$	mkd/fresh
!
$	echo LIB__ANS B "  Create object libraries and executables (YES/NO)?" NO S
$	if .not. LIB__ANS then exit INS__SUCCESS
$	say ""
$	say "  OK. Get some coffee. This will take a while"
$	say ""
$ 	call CREATE_OBJECT_LIB FORGEN.TLB
$ 	call CREATE_OBJECT_LIB FORPLT.ARC
$ 	call CREATE_OBJECT_LIB FORVAX.ARC
!
$	if .not. ARC_THERE then exit INS__SUCCESS
!
$ 	call CREATE_OBJECT_LIB FORBYTES.ARC
$ 	call CREATE_OBJECT_LIB FORSTR.ARC
!
$	call MAKE_EXECUTABLE LIBSD
$	call MAKE_EXECUTABLE SPRINT
$	call MAKE_EXECUTABLE CLOCK
$	call MAKE_EXECUTABLE LIBARG
!
$	if HELIOS_INSTALLED
$	then
$		call CREATE_OBJECT_LIB FORHOS.TLB
$		call CREATE_OBJECT_LIB FORPLA.TLB
$		call MAKE_EXECUTABLE PANDORA $LIB:FORHOS/LIB $LIB:FORBYTES/LIB
$	endif
!
$	if HXIS_INSTALLED
$	then
$		call CREATE_OBJECT_LIB FORHXIS.ARC
$	endif
!
$	if WING_INSTALLED
$	then
$		call CREATE_OBJECT_LIB FORWING.ARC
$		call MAKE_EXECUTABLE WING $LIB:FORWING/LIB
$	endif
!
$	if MAP_INSTALLED .and. XLIB_THERE
$	then
$		call CREATE_OBJECT_LIB FORMAP.ARC
$		call MAKE_EXECUTABLE MAP POLEWARP,$LIB:FORMAP/LIB -
					 $LIB:FORBYTES/LIB,$LIB:XLIB/OPT
$	endif
!
$	if IPS_INSTALLED .and. XLIB_THERE
$	then
$		call MAKE_EXECUTABLE EGIPSY POLEWARP,$LIB:FORMAP/LIB -
					 $LIB:FORBYTES/LIB,$LIB:XLIB/OPT
$		call MAKE_EXECUTABLE IPSV POLEWARP,$LIB:FORMAP/LIB -
					 $LIB:FORBYTES/LIB,$LIB:XLIB/OPT
$	endif
!
$	if IDL_GENERAL_INSTALLED
$	then
$		@$COM:IDLEXE YES
$	endif
!
$	exit INS__SUCCESS
$	endsubroutine
!
$ MAKE_EXECUTABLE:
$	subroutine
$	on warning   then exit INS__QUIET .or. $STATUS
$	on control_y then exit INS__CONTROLY
!
$	if f$search("$EXE:"+P1+".EXE") .nes. "" then exit INS__SUCCESS
!
$	LIB__OLB = "$LIB:FORPLT/lib,$LIB:FORGEN/lib,$LIB:FORVAX/lib,$LIB:FORSTR/lib"
$	if P2 .nes. "" then LIB__OLB = P2+","+LIB__OLB
$	if P3 .nes. "" then LIB__OLB = LIB__OLB+","+P3
$	THISDIR  = f$environment("default")
!
$	@$COM:TLB GET FORMAIN 'P1
$	set noon
$	POLE =	f$locate("POLEWARP",P2) .nes. f$length(P2) .or. -
		f$locate("POLEWARP",P3) .nes. f$length(P3)
$	if POLE
$	then
$		copy $FOR:POLEWARP.FOR []
$		@$COM:MKD MKD /GO/NOEXE/OBJ=[] POLEWARP
$		delete POLEWARP.FOR;*
$	endif
$	@$COM:MKD MKD /go/obj='THISDIR'/exe=$EXE 'P1
$	if .not. $STATUS then delete $EXE:'P1'.EXE;*
$	cd 'THISDIR
$	delete 'P1'.FOR;*
$	delete 'P1'.OBJ;*
$	if POLE then delete POLEWARP.OBJ;*
$	set on
$	exit INS__SUCCESS
$	endsubroutine
!
$ GET_EXECUTABLES:
$	subroutine
$	on warning   then exit INS__QUIET .or. $STATUS
$	on control_y then exit INS__CONTROLY
!
$	if .not. LIB__AXP then exit INS__SUCCESS
$	if P2 .eqs. ""
$	then
$		echo LIB__ANS B "  Do you need the executables (YES/NO) ?" NO S
$		if .not. LIB__ANS then exit INS__SUCCESS
$	endif
!
$	call get_group_of_files exe 'P1 .EXE BINARY
!
$	exit INS__SUCCESS
$	endsubroutine
!
$ GET_GROUP_OF_FILES:
$	subroutine
$	on warning   then exit INS__QUIET .or. $STATUS
$	on control_y then exit INS__CONTROLY
!
$	I = -1
$ NEXT_FILE_IN_GROUP:
$	I = I+1
$	SPEC = f$elements(I,",",P2)
$	if SPEC .nes. ","
$	then
$		SPEC = SPEC+P3
$		set noon
$		call check_and_copy 'P1 'SPEC 'P4
$		set on
$		goto NEXT_FILE_IN_GROUP
$	endif
!
$	exit INS__SUCCESS
$	endsubroutine
!
$ CHECK_AND_COPY:
$	subroutine
$	on warning   then exit INS__QUIET .or. $STATUS
$	on control_y then exit INS__CONTROLY
$	File  = get+P1+"]"+P2
$	if SPAN_COPY
$	then
$		FileS = f$search(File)		! Source file
$		if FileS .eqs. ""
$		then
$			signal CHECK_AND_COPY W NOFILE "source file does not exist ''File'"
$			exit INS__SUCCESS
$		endif
$		File  = put+P1+"]"+P2
$		FileD = f$search(File)		! Destination file
$		if FileD .nes. ""		! Destination exists
$		then
$			if f$file_attributes(FileS,"CDT") .eqs. f$file_attributes(FileD,"CDT")
$			then
$				signal CHECK_AND_COPY W NOTCOPIED -
					"source file ''FileS'" -
					"destination with the same time stamp already exists"
$				exit INS__SUCCESS
$			endif
$			signal CHECK_AND_COPY W NEWVERSION -
				"source file ''FileS'" "new version copied for ''FileD'"
$		endif
$	endif
!
$	FileS = get+P1+"]"+P2
$	FileD = put+P1+"]"
$	call do_transfer  'FileS	'FileD	'P3
$	LIB__ANS == "File transferred from source to destination"
$	exit INS__SUCCESS
$	endsubroutine
!
$ CREATE_OBJECT_LIB:
$	subroutine
$	on warning   then exit INS__QUIET .or. $STATUS
$	on control_y then exit INS__CONTROLY
!
$	if LIB__AXP
$	then
$		OLB = f$parse(P1,,,,"NAME","SYNTAX_ONLY")+".OLB"
$		call check_and_copy lib 'OLB BINARY
$		if LIB__ANS .eqs. "File transferred from source to destination" then exit INS__SUCCESS
$	endif
$	if f$search("$LIB:"+P1) .nes. "" then @$COM:TLB OCREATE 'P1
$	exit INS__SUCCESS
$	endsubroutine
!
$ DO_TRANSFER:
$	subroutine
$	on warning   then goto TRANSFER_ERROR
$	on control_y then goto TRANSFER_ERROR
$	F = "FTP_TRANSFER.TXT"			! Don't move
$	if SPAN_COPY				! Straight copy
$	then
$		DO = "copy"+excl+" "+P1+" "+P2
$		write SYS$OUTPUT DO
$		'DO
$	else					! Use ftp
$		create 'F			! Creates regular text file
$		open/append FILE 'F		! Open file
$		write FILE P3
$		write FILE "cd "+f$parse(P1,,,"NODE")+f$parse(P1,,,"DEVICE")+-
				 f$parse(P1,,,"DIRECTORY")
$		write FILE "lcd "+P2
$		write FILE "mget "+f$parse(P1,,,"NAME")+f$parse(P1,,,"TYPE")
$		close FILE
$		DO = "ftp/user="+VAXUSER+"/pass="+VAXPASS+" "+VAXNODE+" TAKE "+F
$		write SYS$OUTPUT DO
$		'DO
$		delete 'F
$	endif
$	exit INS__SUCCESS
$ TRANSFER_ERROR:
$	STATUS = $STATUS
$	if f$search(F) .nes. "" then delete 'F;*
$	exit INS__QUIET .or. $STATUS
$	endsubroutine
! ftp/user=jackson/pass=berniej stevs4.stelab.nagoya-u.ac.jp take try.ftp