MACD 4/MACD4.iso/Patch/Programs/CROSSDOS606.LHA/Patcher

Text File | 1996-08-15 | 8.5 KB | 313 lines

;Script to apply patches
;$VER: Patcher 6.01 (17.10.95)
;Copyright © 1992-1994 CONSULTRON.  All rights reserved
; Use of this script in commercial products is expressly forbidden without
; written permission.
;
; The program spatch 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" wversion newfile) )
                    (    (if (not DeleteOnly)
                            (    (copyfiles
                                    (source ("%ld/%s" wversion newfile) )
                                    (dest (pathonly ("%s%s" prod newfile) ) )
                                )
                            )
                        )
                    )
                    (    (delete ("%s%s" prod newfile) ) )
                )
;                (if    (> wversion currentver )
;                    (set currentver wversion)
;                )
            )
        )
    )
)

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

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

(procedure patch
    (    (if (and (not DeleteOnly) (not CopyOnly) )
            (    (set patchfile ("%ld/%s" wversion file) )
                (set prodfile ("%s%s" prod file) )
                (set prodfile (substr prodfile 0 (- (strlen prodfile) 1 ) ) )
                (set tempdir "T:")
                (set temp ("%s%s" tempdir (fileonly prodfile)))
                (if    (= 0 (run ("%s -o%s -p%s %s" spatch temp patchfile prodfile) ))
;                    (if    (> wversion currentver )
;                        (set currentver wversion)
;                    )
                )
                ;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 spatch stuff
;Set DeleteOnly for delete phase

;**************************************************************************
(procedure DoPatch
    (    (while (exists ("%ld" wversion) (noreq) )
            (    (foreach ("%ld" wversion) "#?"
                    (    (if (< @each-type 0)    ;check for file
                            (    (if (= "@" (substr @each-name (- (strlen @each-name) 1 )))
                                    (    ;Apply patches with spatch
                                        (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" wversion dir) "#?"
                                    (    (if (< @each-type 0)    ;check for file
                                            (    (if (= "@" (substr @each-name (- (strlen @each-name) 1 )))
                                                    (    ;Apply patches with spatch
                                                        (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" wversion dir2) "#?"
                                                    (    (if (< @each-type 0)    ;check for file
                                                            (    (if (= "@" (substr @each-name (- (strlen @each-name) 1)))
                                                                    (    ;Apply patches with spatch
                                                                        (set file (tackon dir2 @each-name))
                                                                        (patch)
                                                                    )
                                                                    (    ;Copy the file directly
                                                                        (set newfile (tackon dir2 @each-name))
                                                                        (copynew)
                                                                    )
                                                                )
                                                            )
                                                        )
                                                    )
                                                )
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                )

                (set wversion (+ wversion 1) )
            )
        )
    )
)


;***************************************************************************
;Preserve CIN
(procedure preserveCIN
; Save the CIN to a CIN file on the disk
    (run ("serfile %s >%s" (tackon prod "READ.ME") (tackon prod "CIN")))
; set the CIN temporarily to XXXX-YYYY
    (run ("serfile %s CIN: %s" (tackon prod "READ.ME") "XXXX-YYYY"))
    (set CINsaved 1)
)

;***************************************************************************
;Restore Old State
(procedure restoreCIN
;restore product assignment
    (if    (= newassign 1)
        (    (makeassign ("%s" prodname) ("C%s:" prodname))
            (makeassign ("C%s" prodname))
        )
    )
; reset the CIN back to the customer's CIN
    (if (= CINsaved 1)
        (run ("serfile %s CIN: `type %s`" (tackon prod "READ.ME") (tackon prod "CIN")))
    )
)

;***************************************************************************
; Get the version number from a file
(procedure getVersion_File
    (set version (getversion verfile))
    (if (= 0 version)
        (set version defver)
        (    (set ver (/ version 65536))
            (set version ("%ld" (+ (* 100 ver) (BITAND version $FFFF))) )
        )
    )
)


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

;This can be replaced by checks for "copy of <product>" etc.
(set prodname "CrossDOS")
(set prod ("%s:" prodname))
(set defverbeg "600")
(set defverend "602")


;Starting version number
(set verfile (tackon prod "Read.ME"))
(set defver defverbeg)
(getVersion_File)    ; return in 'version"
(set startversion version)

;(exit (quiet))

(set @abort-button "Abort Update")
(onerror (restoreCIN) )

;Check if the <product>: being referenced is the assignment or the disk
(askdisk
    (prompt ("Please insert %s in any drive" prod))
    (help "To update, you must use a copy of the latest release of "
            ("the %s product disk you have.  " prodname)
            ("In addition, the volume MUST BE named `%s'.  " prodname)
            ("If the disk you have is labeled `Copy_of_%s', " prodname)
            "relabel it using the Workbench menu selection `Icons/Rename...'." )
    (dest ("%s" prodname))
)

(if (<> prod (expandpath prod))
    (    (makeassign ("C%s" prodname) prod)    ;temp reassign product assignment
        (set newassign 1)
        (makeassign prodname)        ;clear the product assignment
    )
)

;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  startversion  (noreq) ) ) )
    (    (message "Could not find directory '" startversion "'.  Make sure you unarc "
            "the archive with the option to preserve directories.\n"
            "[Example: LHA x -x <archivename>]\n"
            "OR\n"
            "This archive of patch files does not update the release "
            "you currently have."
        )
        (exit (quiet))
    )
)

(set currentver startversion)

; Put diag/spatch into ram:.  Since this program is to be used quite frequently
(set spatch "ram:SPatch")
(set spatchsrc (tackon prod "diag/SPatch"))
(if (exists "SPatch" (noreq) )    ; a new SPatch exists in the current directory. Use it instead
    (    (delete (tackon prod "diag/lpatch"))    ;delete the old lpatch
        (copyfiles (source "SPatch") (dest (pathonly spatchsrc)))
    )
)
(copyfiles (source spatchsrc) (dest (pathonly spatch) ) )


(preserveCIN)

(set wversion "S")

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

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

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

(set wversion (+ -1 wversion))

(set verfile (tackon prod "Read.ME"))
(set defver defverend)
(getVersion_File)    ; return in 'version'
(set currentver version)

(set wversion ("%ld" wversion))

(if    (= startversion wversion)
    (    (message ("Your %s disk is already at release %s.%s" prodname (substr wversion 0 1) (substr wversion 1)))
    )
    (if    (> startversion wversion)
        (    (message ("Your %s disk is already updated past the releases in this archive" prodname))
        )
        (if    (< currentver wversion)
            (    (message ("Your %s disk COULD NOT be updated to release %s.%s\n" prodname (substr wversion 0 1) (substr wversion 1))
                        ("It appears to be at release %s.%s\n" (substr currentver 0 1) (substr currentver 1))
                        ("Make sure you patch a GOOD copy of the %s product disk ONLY!" prodname)
                )
            )
            (if    (= currentver wversion)
                (    (message ("Your %s disk has been updated to release %s.%s" prodname (substr currentver 0 1) (substr currentver 1))
                    )
                )
            )
        )
    )
)

(restoreCIN)

(exit (quiet))