/**/
parse arg args
if args = '?' then do
say 'CHKMIG - Version 2.12'
say '(c) Copyright International Business Machines Corporation 1994.'
say 'All rights Reserved'
say
say 'CHKMIG - This program migrates a CHKSTORE 2.0x database to a CHKSTORE'
say '         2.1x database. This program must be placed in the database'
say '         directory (normally the LOGON alias) and run with that'
say '         directory as the working directory'
say '         There are NO parameters'
exit 0
end
db20x = 'chkstore.out'
dblock = 'chkstore.lck'
db2xx = 'chkstore.dbf'
db_location = 'logon'
new_level = '2.10'
if stream(dblock,'c','query exists') <> '' then do
say 'Database is locked, either chkstore is still running or a problem occurred'
say 'which has left the database in a locked state.'
say ''
say 'either wait for chkstore to complete, then stop chkstore from being'
say 'executed again, and re-run the migration.'
say 'or determine what the problem was, and remove the file' dblock 'and'
say 'attempt migration again.'
exit 0
end
call migrate20x
say 'return code was' rc
exit
migrate20x:
if stream(db20x,'c','query exists') = '' then do
say 'No old database file' db20x 'exists. Migration is not possible.'
say 'chkstore will create a new file from scratch, but any revoked users'
say 'will not get registered as revoked....'
return -1
end
rc = stream(db20x,'c','open read')
if rc <> 'READY:' then do
say 'error' rc 'occured trying to open' db20x 'migration cannot continue'
return 1
end
if stream(db2xx,'c','query exists') <> '' then do
'@ERASE' db2xx '>NUL 2>&1'
if rc <> 0 then do
say 'unable to remove' db2xx 'migration cannot continue'
return 1
end
end
rc = stream(db2xx,'c','open')
if rc <> 'READY:' then do
say 'error' rc 'occured trying to open' db2xx 'migration cannot continue'
return 1
end
call create_new_header
dummy = linein(db20x)
dummy = linein(db20x)
dummy = linein(db20x)
do while lines(db20x) = 1
oldline = linein(db20x)
status = left(oldline,1)
userid = substr(oldline,11,8)
allowed = substr(oldline,21,7)
used = substr(oldline,33,7)
if status = 'R' then savedaccess = 'RWCDXAP'
else savedaccess = ''
call addentry userid used allowed status savedaccess
end
rc = stream(db2xx,'c','close')
rc = stream(db20x,'c','close')
return 0
create_new_header:
header = left(new_level,8)||date() time()
rc = lineout(db2xx,header)
return rc
addentry: procedure expose db2xx
arg userid used allowed status access
out = left(userid,8)||left(used,8)||left(allowed,8)||left(status,1)||left(access,7)
rc = lineout(db2xx,out)
return rc
