/**********************************************************************/
/* SOFTPACK: Pack software for distribution */
/* use SOFTUNPK O N L Y to unpack it !! */
/* syntax: SOFTPACK control-file;SOFTPACK-file;PURGE */
/* (c) Th. Schneider, 1994 */
/**********************************************************************/
/* 11.04.2001: softpack INCLUDED (COPY) files automatically */
/* 29.10.2002: option INCL to force includes */
/* : workdisk is now disk M (for space problems) */
/* 01.12.2002: ignore RUN-TIME package routines */
/**********************************************************************/
work_disk='E1' /* enter YOUR CMS WORK minis disk here !!*/
call init_info 'SOFTPACK','NEW'
fp_copy='' /* search in all linked disks */
/* Donauland release 93: search TST1COPY before KOOPCOPY */
cobol_copy_libs='COPY TST1COPY KOOPCOPY PRODCOPY'
rexx_copy_libs='REXXINCL REXX EXEC'
run_time_package='INFO FILEIO REXXMSG REXXFILE STRFUN WORDLIST'
opt_include=1 /* 1 = automatically include nested copies/include files*/
opt_purge=0
date_time_stamp=DTS()
banner='/*<>*<>*<>*<>*!! SOFTPACK: ' date_time_stamp '!!*<>*<>*<>*<>*/'
parse arg parm
if parm='' then do
say '============================================================='
say 'SOFTPACK packs a given FILELIST into a single SOFTPACK file'
say 'parameter required. parameters are:'
say 'control-file;softpack-file;options'
say 'at least the name of the control-file must be given'
say 'the control-file should contain a list of file-names which'
say 'should be soft-packed for distribution'
say '============================================================='
exit 99
end
parse var parm control_file';'softpack_file';'options
control_fn=word(parsefid(control_file),1)
if (softpack_file='')
then softpack_file=fileid(control_fn,'SOFTPACK',work_disk)
call open control_file
call scratch softpack_file
/********************************************************************/
call control 'SOFTPACK: (c) Th. Schneider, 1994'
call control ' control file: 'control_file
call control ' DTS: 'date_time_stamp
call control ' SOFTPACK file: 'softpack_file
/********************************************************************/
n_files=0; n_queued=0; queue.=''
if is_member('PURGE',options) then opt_purge=1
if is_member('COPIES',options) then opt_include=1
if is_member('NOCOPIES',options) then opt_include=0
if is_member('INCL',options) then opt_include=1
if is_member('NOINCL',options) then opt_include=0
/* pack members of control-file */
do while lines(control_file) > 0
control_line=linein(control_file)
if substr(control_line,1,1)='*' then iterate /* skip comments */
file1=parsefid(control_line)
call soft_packer file1
end
/* and queued include files (copy-books), too */
i_queued=1
do while i_queued <= n_queued
file1=queue.i_queued
control_line=parsefid(file1)
call soft_packer file1
i_queued=i_queued+1
end
call lineout softpack_file,banner
call close softpack_file
call close control_file
call closelog
say n_files ' files SOFT-packed to: 'softpack_file
return
soft_packer:
arg s_file /* converts to uppercase */
s_filetype=word(s_file,2)
tx=translate(s_filetype) /* need uppercase for wordpos */
select
when wordpos(tx,'COBOL COBOL2 COPY KOOPCOPY PRODCOPY ')>0 then do
language='COBOL'
copy_libs=cobol_copy_libs
end
when wordpos(tx,'REXX REXXINCL EXEC')>0 then do
language='REXX'
copy_libs=rexx_copy_libs
end
otherwise do
language='unknown'
copy_libs='COPY'
end
end
if exists(s_file) = 0 then do
call info 'file:' s_file 'does not exist, entry ignored ...'
return /* ignore missing files ! */
end
n_files=n_files+1
call lineout softpack_file,banner
call lineout softpack_file,'/* 'control_line' */'
if ispacked(s_file) then do
say 'file:' s_file 'is packed'
x_file=parsefid(s_file)
parse var x_file fn ft fm
file1=fileid(fn,ft,A1)
call unpack s_file,file1
say 'file:' s_file 'unpacked to:' file1
say '... SOFT-packing file: 'file1
call append_file file1,softpack_file
if (file1 <> s_file) then call purge file1
end
else do
say '... SOFT-packing file: 's_file
call append_file s_file,softpack_file
end
return
control:
parse arg x_line
say x_line
call lineout softpack_file,x_line
return
/* append_file: append single file */
append_file:
parse arg a_file1,toa_file1
call extend a_file1
do while lines(a_file1) > 0
line=linein(a_file1)
if opt_include then call queue_includes
call lineout toa_file1,line
end
call close a_file1
/* tofile is NOT call closed !! */
return
queue_includes:
x1=strip(line)
if language='COBOL' & word(x1,1)='COPY' then do
name2=strip(strip(word(x1,2),'T','.'))
call queue_name name2
end
if language='REXX' & word(x1,1)='/*%INCLUDE' then do
w2=word(x1,2);
if pos('*/',w2)>0 then w2=substr(w2,1,pos('*/',w2)-1)
name2=strip(w2)
call queue_name name2
end
return
queue_name:
arg name3 /* use uppercase */
if wordpos(name3,run_time_package) > 0 then do
call info 'Module:' name3 'is part of RUN-time-package, ignored'
return
end
do iw=1 to words(copy_libs)
/* must determine corresponding file name! */
ft3=word(copy_libs,iw)
file3=fileid(name3,ft3,fp_copy)
if exists(file3) then do
call queue_file(file3)
return
end
end
call info 'copy name:' name3 'is not found in: 'copy_libs
call info 'copy name:' name3 'ignored'
n_ignored=n_ignored+1
return
queue_file:
arg file4
do iq=1 to n_queued
if queue.iq=file4 then return /* already queued */
end
n_queued=n_queued+1
iq=n_queued
queue.iq=file4
call info ' include file:' file4 'queued'
return
/*%INCLUDE RexxFile*/
/*%INCLUDE RexxMsg*/
/*%INCLUDE strfun*/