/**********************************************************************/
/* SOFTUNPK: UNPACK software for distribution */
/* use SOFTPACK O N L Y to PACK it !! */
/* syntax: SOFTUNPK SOFTPACK-file;control-file;PURGE */
/* (c) Th. Schneider, 1994 */
/* attention: SOFTUNPK must not use CMS OR (!) in german! */
/* vs. 7: incorporate filetype-change for Windows95 Object REXX */
/* 28.08.2001: vs 8 : allow new path as second parameter */
/**********************************************************************/
opt_purge=0
parse source processor .
date_time_stamp=DTS()
banner='/*<>*<>*<>*<>*!! SOFTUNPK: ' date_time_stamp '!!*<>*<>*<>*<>*/'
parse arg parm
if parm='' then do
say 'expected softpack-file-name;new-path-name;options'
exit 99
end
parse var parm softpack_file';'new_fp';'option
control_fx=parsefid(softpack_file)
control_fn=word(control_fx,1)
control_fp=word(control_fx,3)
control_file=fileid(control_fn,'FILELIST',new_fp)
call open softpack_file
x=linein(softpack_file)
parse var x 'SOFTPACK: (c) Th. Schneider, 1994'
x=linein(softpack_file)
parse var x ' control file: 'control_file_1
x=linein(softpack_file)
parse var x ' DTS: 'date_time_stamp_1
x=linein(softpack_file)
parse var x ' SOFTPACK file: 'softpack_file_1
call info '*******************************************************'
call info '* SOFTUNPK: UNPACK SOFTWARE distribution *'
call info '* (c) Th. Schneider, 1994 *'
call info '*******************************************************'
call info 'orig. SOFTPACK file: 'softpack_file_1
call info 'orig. control file: 'control_file_1
call info 'SOFT DTS: 'date_time_stamp_1
call info '*******************************************************'
call scratch control_file
n_files=0
if (option='PURGE') then opt_purge=1
banner_line=linein(softpack_file)
do while lines(softpack_file) > 0
control_line_1=linein(softpack_file)
parse var control_line_1 '/* 'control_line' */'
call lineout control_file,control_line
parse var control_line fn ft fp . /* filename, file-type, file-path */
file_1=fn ft fp /* file in CMS-syntax */
fp_soft=new_fp /* new file path !! */
file=fileid(fn,ft,fp_soft)/* fileid in new host environment */
call info '... unpacking file: 'file ' (origin: 'file_1 ')'
call scratch file
n_files=n_files+1
do while lines(softpack_file) > 0
line =linein(softpack_file)
if (line=banner_line) then leave /* banner indicates EOF */
call lineout file,line
end
call close file
end /* next file */
call lineout softpack_file,banner
call close softpack_file
call close control_file
call info '*******************************************************'
call info n_files ' files SOFT-unpacked from: 'softpack_file
call info '*******************************************************'
return
info: procedure
parse arg say_line
say say_line
return
/* SCRATCH: scratch file */
/* where scratch means: */
/* OPEN for write FILE */
/* if file does exist then empty it */
/* if it does NOT exist, CREATE it */
/* SCRATCH is a SYNONYM to 'REWRITE'*/
scratch: procedure
parse arg fileid
/*xxx=DOSCREAT(fileid) rewrite/scratch file ** PC VERSION ** */
/* in CMS. use STREAM command */
'ERASE 'fileid /* erase OLD version of file in any case */
xop = STREAM(fileid,'C','OPEN WRITE')
parse var xop status ':' reason
if (status <> 'READY' ) then do
call abort 'unable to SCRATCH file 'fileid 'STATUS='status
end
return 0
/* OPEN: OPEN a file (FOR READ, must exist) */
/* CMS-version, uses STREAM-command */
open: procedure /* OPEN an INPUT file (must exist) */
parse arg fileid
xop=STREAM(fileid,'COMMAND','OPEN READ')
/* say 'OPEN 'fileid ' xop(STREAM) = 'xop */
parse var xop status ':' etc
if (status = 'ERROR') then do /* file does not exist */
say "INPUT file: "fileid" MUST EXIST ...!!!"
say "*** PROGRAM ABORTED ***"
return -99
end
else do
return 0 /* ok, file does exist */
end
/* close: close file */
/* (c) Th. Schneider, 1993 */
/* functionally equivalent to CMS FINIS, but close is the */
/* preferred name (TRANSFORM 'FINIS x' -> close x) */
close: procedure
parse arg fileid
if(fileid="") then return /* do not want not to close the SCREEN */
xop=stream(fileid,'C','CLOSE') /* CMS */
parse var xop status ':' reason
if (status <> 'READY') then do
say 'CANNOT CLOSE file: ' fileid ', reason code:'reason
exit 99
end
return
/* DTS: build DATE TIME STAMP */
DTS: procedure
return date('O') time()
/* abort: abort program with message */
abort: procedure
parse arg message
say message
say "*** Program aborted ***"
return -99
/****************************************************************/
/************************************************************/
/* parsefid: parse file id (according to OPSYS conventions) */
/* returns: fn ft fp */
/* (c) Th. Schneider, 1994 */
/************************************************************/
parsefid: procedure
parse source processor .
if processor='CMS' then do
parse arg fn ft fp . /* CMS version */
end
else if (processor='MVS') then do
parse arg fp'('fn')'
ipoint=lastpos('.',fp)
if (ipoint>0) then do
ft=substr(fp,ipoint+1) /* file type is last comp. of PDS name */
fp=substr(fp,1,ipoint-1)
end
else do
ft='' /* no file type given */
end
end
else do /* DOS conventions used */
parse arg fp'.'ft /* ft is type is extension */
iback=lastpos('\',fp)
if (iback>0) then do
fn=substr(fp,iback+1) /* file type is last comp. of PDS name */
fp=substr(fp,1,iback-1)
end
else do
fn=fp
fp='' /* no file path given */
end
end
/* say 'in parsefid: fn='fn 'ft='ft 'fp='fp */
return fn ft fp
/* fileid: Build File-ID according conventions of OPSYS*/
/* general version */
/* (cc) Th. Schneider, 1994 */
fileid: procedure
parse source processor .
parse arg fn,ft,fp
/* say 'in fileid: fn='fn' ft='ft ' fp='fp */
if processor ='CMS' then do
if(fp=" " ) then fp="A" /* default to current disk */
file =fn ft fp /* CMS convention */
end
else if processor='MVS' then do
if (ft<>'') then file=fp'.'ft'('fn')'
else file=fp'('fn')'
end
else do /* DOS convention used */
/* change CMS file types, when necessary */
if (processor='OS/2' & ft='EXEC') then ft='cmd'
if (processor='Windows95' & ft='EXEC') then ft='rexx'
if (processor='Java' & ft='EXEC') then ft='rexx'
fn=lower(fn)
ft=lower(ft)
fp=lower(fp)
if (processor = 'PC-DOS' & length(ft) > 3)
then ft=substr(ft,1,3) /* truncate (DOS)*/
if (ft<>'') then file=fn'.'ft /* current directory used anyway*/
else file=fn
end
/* say 'in fileid: processor='processor' file='file */
return file
lower: /* translate to lowercase letters */
parse arg string
return translate(string,'abcdefghijklmnopqrstuvwxyz',,
'ABCDEFGHIJKLMNOPQRSTUVWXYZ')