;Script to apply patches
;$VER: Patcher 5.06 (8.6.93)
;Copyright © 1992-1993 CONSULTRON.  All rights reserved
; Use of this script in commercial products is expressly forbidden without
; written permission.
;
; The program LPatch is provided by SAS Institute.  They retain all copyrights
; to that program.  It is available for commercial distribution only to those
; users who have purchased their SAS C Compiler and are registered with them.

;***************************************************************************

;Copy a new file to the product disk
;Input: newfile (path and name of new file)

(procedure copynew
	(
		(if
			(not PatchOnly)
			(
				(if
					(getsize
						("%ld/%s" version newfile)
					)
					(
						(if
							(not DeleteOnly)
							(
								(copyfiles
									(source
										("%ld/%s" version newfile)
									)
									(dest
										(pathonly
											("%s%s" prod newfile)
										)
									)
								)
							)
						)
					)
					(
						(delete
							("%s%s" prod newfile)
						)
					)
				)
			)
		)
	)
)

;***************************************************************************

;Perform an LPatch
;Input: file (path and file to patch)

(procedure patch
	(
		(if
			(and
				(not DeleteOnly)
				(not CopyOnly)
			)
			(
				(set patchfile
					("%ld/%s" version file)
				)
				(set prodfile
					("%s%s" prod file)
				)
				(set prodfile
					(substr prodfile 0
						(-
							(strlen prodfile)
							4
						)
					)
				)

				(set tempdir "ram:")
				(set temp ("%s%s" tempdir (fileonly prodfile)))
				(run
					("%s -o%s -p%s %s" lpatch temp patchfile prodfile)
				)

				;Replace original file with temp file
				(if
					(>
						(getsize temp)
						10
					)
					(
						;Clone protection bits
						(protect temp
							(protect patchfile)
						)
						(copyfiles
							(source temp)
							(dest
								(pathonly prodfile)
							)
							(newname
								(fileonly prodfile)
							)
						)
					)
				)

				;Delete temporary file
				(delete temp)
			)
		)
	)
)


;Apply the LPatch stuff
;Set DeleteOnly for delete phase

(procedure DoPatch
	(
		(while
			(exists
				("%ld" version)
			)
			(
				(foreach
					("%ld" version)
					"#?"
					(
;						(debug @each-name)
						(if
							(< @each-type 0)	;check for file
							(
								(if
									(= ".pch"
										(substr @each-name
											(-
												(strlen @each-name)
												4
											)
										)
									)
									(
										;Apply patches with LPatch
										(set file @each-name)
										(patch)
									)
									(
										;Copy the file directly
										(set newfile @each-name)
										(copynew)
									)
								)
							)
							(
								;@each-name is a directory
								(set dir @each-name)

								(foreach
									("%ld/%s" version dir)
									"#?"
									(
										(if
											(< @each-type 0)	;check for file
											(
												(if
													(= ".pch"
														(substr @each-name
															(-
																(strlen @each-name)
																4
															)
														)
													)
													(
														;Apply patches with LPatch
														(set file
															(tackon dir @each-name)
														)
														(patch)
													)
													(
														;Copy the file directly
														(set newfile
															(tackon dir @each-name)
														)
														(copynew)
													)
												)
											)
											(
												;@each-name is a directory
												(set dir2
													(tackon dir @each-name)
												)

												(foreach
													("%ld/%s" version dir2)
													"#?"
													(
														(if
															(< @each-type 0)	;check for file
															(
																(if
																	(= ".pch"
																		(substr @each-name
																			(-
																				(strlen @each-name)
																				4
																			)
																		)
																	)
																	(
																		;Apply patches with LPatch
																		(set file
																			(tackon dir2 @each-name)
																		)
																		(patch)
																	)
																	(
																		;Copy the file directly
																		(set newfile
																			(tackon dir2 @each-name)
																		)
																		(copynew)
																	)
																)
															)
														)
													)
												)
											)
										)
									)
								)
							)
						)
					)
				)

				(set version
					(+ version 1)
				)
			)
		)
	)
)

;***************************************************************************
;***************************** MAIN ****************************************
;***************************************************************************

;This can be replaced by checks for "copy of CrossDOS_Plus" etc.
(set prod "CrossDOS_Plus:")

;Starting version number
(set startversion 506)

;Force user level to 1 or 2. This is unfortuntely required because otherwise
;we can't present a menu of choices to the user.
(if
	(= @user-level 0)
	(
		(user 1)
		(set @user-level 0)
	)
)

; Test to see if the first patch directory exists.  If not, it may be that the
; archive was not unarc'd with full path names preserved.
(if
	(not
		(= 2
			(exists
				("%ld" startversion)	; check for directory
			)
		)
	)
	(
		((message "Could not find directory '" version "'.  Make sure you unarc "
				"the archive with the option to preserve directories.\n"
				"[Example: LHARC -x <archivename>]"
		)
		(exit (quiet)))
	)
)


; Put diag/LPatch into ram:.  Since this program is to be used quite frequently
(set lpatch "ram:LPatch")
(copyfiles
	(source ("%sdiag/LPatch" prod))
	(dest
		(pathonly lpatch)
	)
	(newname
		(fileonly lpatch)
	)
)

;Delete phase
(set version startversion)
(set DeleteOnly 1)
(set PatchOnly 0)
(set CopyOnly 0)
(DoPatch)

;Patch phase
(set version startversion)
(set DeleteOnly 0)
(set PatchOnly 1)
(set CopyOnly 0)
(DoPatch)

;Copy phase
(set version startversion)
(set DeleteOnly 0)
(set PatchOnly 0)
(set CopyOnly 1)
(DoPatch)

(set version
	(- version 1)
)

;Delete temporary LPatch file
(delete lpatch)

(message
	("Your CrossDOS Plus disk has been updated to version 5.%s." (substr ("%ld" version) 1))
)

(exit
	(quiet)
)