651 lines
14 KiB
Plaintext
Executable File
651 lines
14 KiB
Plaintext
Executable File
******************************************************************************
|
|
*
|
|
* Program to provide a means of dumping uniVerse files to tape
|
|
* and loading these files on a Pick or Information system
|
|
*
|
|
* ACCT.DUMP Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
******************************************************************************
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
|
*
|
|
******************************************************************************
|
|
$OPTIONS DEFAULT
|
|
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
|
|
|
|
MAX.NAME = 12
|
|
|
|
DATA.START = MAX.NAME - 3
|
|
DATA.LIMIT = MAX.NAME
|
|
|
|
open '','VOC' to voc.file else print 'Cannot open VOC file'; stop
|
|
savemod = inmat()
|
|
savetype = status()
|
|
open '','NEWACC' to newacc.file else print 'Cannot open NEWACC file'; stop
|
|
open '','VOCLIB' to voclib.file else print 'Cannot open VOCLIB file'; stop
|
|
|
|
x = 0
|
|
flavors = ''
|
|
pick.dict = 0
|
|
pick.flag = 0
|
|
part.voc = 0
|
|
dfnames = ''
|
|
fmods = ''
|
|
ftypes = ''
|
|
lfnames = ''
|
|
pathnames = ''
|
|
fno = 0
|
|
lno = 0
|
|
|
|
* look for format keyword *
|
|
|
|
acct.format = 0
|
|
dim line(6)
|
|
matparse line from trim(@sentence),' '
|
|
i = 2
|
|
loop
|
|
until line(i) = '' or i = 6 do
|
|
keyword = upcase(line(i))
|
|
read item from voc.file,keyword then
|
|
if item<1> = 'K' then
|
|
begin case
|
|
case item<2> = 205
|
|
if acct.format = 0 then
|
|
acct.format = 1; * REALITY.FORMAT *
|
|
dump.format = keyword
|
|
|
|
end else
|
|
print 'Account format keyword previously specified'
|
|
stop
|
|
end
|
|
case item<2> = 206
|
|
if acct.format = 0 then
|
|
acct.format = 2; * INFORMATION.FORMAT *
|
|
dump.format = keyword
|
|
end else
|
|
print 'Account format keyword previously specified'
|
|
stop
|
|
end
|
|
case item<2> = 211
|
|
if acct.format = 0 then
|
|
acct.format = 3; * PICK.FORMAT *
|
|
dump.format = keyword
|
|
end else
|
|
print 'Account format keyword previously specified'
|
|
stop
|
|
end
|
|
end case
|
|
end
|
|
end
|
|
i += 1
|
|
repeat
|
|
|
|
* get valid account types *
|
|
|
|
openpath UV.NEWACC to file then
|
|
sselect file to 1
|
|
10*
|
|
readnext fid from 1 else goto 20
|
|
x += 1
|
|
flavors<x> = fid
|
|
goto 10
|
|
end else
|
|
print 'Unable to open ':UV.NEWACC:' file'
|
|
stop
|
|
end
|
|
|
|
20*
|
|
|
|
|
|
* get account type *
|
|
|
|
readv uv.type from voc.file,'RELLEVEL',3 else uv.type = ''
|
|
if uv.type = '' then
|
|
30*
|
|
msg = 'Enter uniVerse account type '
|
|
print msg:
|
|
input uv.type
|
|
uv.type = upcase(uv.type)
|
|
if uv.type = '' or uv.type = 'QUIT' then print 'ACCT.DUMP aborted!'; stop
|
|
if uv.type = 'IDEAL' then uv.type = 'NEWACC'
|
|
end
|
|
|
|
fnd = 0
|
|
for i = 1 to x while fnd = 0
|
|
if trim(uv.type) = flavors<i> then fnd = 1
|
|
next x
|
|
40*
|
|
if fnd = 0 then
|
|
print 'Type "':uv.type:'"':' is not a valid uniVerse account type'
|
|
print
|
|
print 'Valid account types are: '
|
|
for i = 1 to 32 until flavors<i> = ''
|
|
print flavors<i>
|
|
next i
|
|
goto 30
|
|
end
|
|
|
|
* default to current account type, if format keyword is not specified *
|
|
|
|
if acct.format = 0 then
|
|
if uv.type = 'PICK' then
|
|
acct.format = 3; dump.format = 'PICK.FORMAT'
|
|
end else
|
|
if uv.type = 'REALITY' then
|
|
acct.format = 1; dump.format = 'REALITY.FORMAT'
|
|
end else
|
|
acct.format = 2; dump.format = 'INFORMATION.FORMAT'
|
|
end
|
|
end
|
|
end
|
|
|
|
print
|
|
|
|
* prompt for voc file handling *
|
|
|
|
msg = "Do you want to dump 'ALL' VOC entries or just those 'NOT' in NEWACC? (A/N)"
|
|
50*
|
|
print msg:
|
|
input ans
|
|
ans = upcase(ans)
|
|
if ans = 'QUIT' then print 'ACCT.DUMP aborted!'; stop
|
|
if ans # 'A' and ans # 'N' then goto 50
|
|
if ans # 'A' then part.voc = 1
|
|
|
|
* prompt for dictionary file handling *
|
|
|
|
if acct.format # 2 then
|
|
60*
|
|
msg = "Do you want to dump the 'DICT' or the 'PDICT' files? (D/P)"
|
|
print msg:
|
|
input ans
|
|
ans = upcase(ans)
|
|
if ans = 'QUIT' then print 'ACCT.DUMP aborted!'; stop
|
|
if ans # 'D' and ans # 'P' then goto 60
|
|
if ans = 'P' then pick.dict = 1
|
|
end
|
|
|
|
* check VOCLIB file for ACCT.DUMP *
|
|
|
|
print
|
|
|
|
dump.name = 'ACCT.DUMP'
|
|
read item from voclib.file,dump.name then
|
|
70*
|
|
msg = dump.name:' exists in VOCLIB file. OK to overwrite? (Y/N)'
|
|
print msg:
|
|
input ans
|
|
ans = upcase(ans)
|
|
if ans = 'QUIT' then print 'ACCT.DUMP aborted!'; stop
|
|
if ans # 'Y' and ans # 'N' then goto 70
|
|
if ans # 'Y' then print 'ACCT.DUMP aborted!'; stop
|
|
end
|
|
|
|
* check VOC file for ACCT.DUMP *
|
|
|
|
read item from voc.file,dump.name then
|
|
80*
|
|
msg = dump.name:' exists in VOC file. OK to overwrite? (Y/N)'
|
|
print msg:
|
|
input ans
|
|
ans = upcase(ans)
|
|
if ans = 'QUIT' then print 'ACCT.DUMP aborted!'; stop
|
|
if ans # 'Y' and ans # 'N' then goto 80
|
|
if ans # 'Y' then print 'ACCT.DUMP aborted!'; stop
|
|
end
|
|
|
|
* check VOCLIB file for ACCT.LOAD *
|
|
|
|
load.name = 'ACCT.LOAD'
|
|
read item from voclib.file,load.name then
|
|
90*
|
|
msg = load.name:' exists in VOCLIB file. OK to overwrite? (Y/N)'
|
|
print msg:
|
|
input ans
|
|
ans = upcase(ans)
|
|
if ans = 'QUIT' then print 'ACCT.DUMP aborted!'; stop
|
|
if ans # 'Y' and ans # 'N' then goto 90
|
|
if ans # 'Y' then print 'ACCT.DUMP aborted!'; stop
|
|
end
|
|
|
|
* get VOC entries to dump *
|
|
|
|
voc.list = '&&ACCT.DUMP':@USERNO
|
|
if part.voc = 0 then
|
|
perform 'SSELECT VOC'
|
|
stmt = 'SAVE.LIST ':voc.list
|
|
perform stmt
|
|
end else
|
|
perform 'SSELECT VOC'
|
|
perform 'NSELECT NEWACC'
|
|
stmt = 'SAVE.LIST ':voc.list
|
|
perform stmt
|
|
end
|
|
|
|
* handle VOC file *
|
|
|
|
read rec from voc.file,'VOC' else
|
|
print "Cannot read VOC record 'VOC'"
|
|
stop
|
|
end
|
|
path = rec<3>
|
|
if path # '' then ins path before pathnames<-1>
|
|
mod = 1
|
|
type = 3
|
|
fno += 1
|
|
lfnames<fno> = 'DICT UV.VOC'
|
|
dfnames<fno> = ''
|
|
fmods<fno> = mod
|
|
ftypes<fno> = type
|
|
path = rec<2>
|
|
if path # '' then ins path before pathnames<-1>
|
|
mod = savemod
|
|
type = savetype
|
|
fno += 1
|
|
lfnames<fno> = 'DATA UV.VOC'
|
|
dfnames<fno> = ''
|
|
fmods<fno> = mod
|
|
ftypes<fno> = type
|
|
|
|
|
|
* get filenames to dump *
|
|
|
|
stmt = \SSELECT VOC BY F3 WITH TYPE EQ "F" AND F2 NOT.MATCHING ".../..."\
|
|
stmt := ' AND F2 NOT.MATCHING "...\..."'
|
|
stmt := \ AND F2 NE "."\
|
|
stmt := \ AND @ID NOT.MATCHING "...'.O'"\
|
|
stmt := \ AND @ID NE "VOC"\
|
|
stmt := \ TO 1\
|
|
perform stmt
|
|
|
|
100*
|
|
readnext id from 1 else goto 200
|
|
read rec from voc.file,id else
|
|
print 'Warning - Cannot read VOC record ':id
|
|
goto 100
|
|
end
|
|
|
|
* get DICT filename *
|
|
|
|
no.pdict = 0
|
|
path = rec<3>
|
|
dictword = 'DICT '
|
|
if pick.dict then
|
|
if rec<5> # '' then path = rec<5>; dictword = 'PDICT ' else no.pdict = 1
|
|
end
|
|
if path # '' then
|
|
* ignore remote dict files *
|
|
if path matches ".../..." or path matches "...\..." then goto 105
|
|
* ignore null file names - query will not handle *
|
|
if path = "D_?" or path = "P_?" then goto 105
|
|
gosub eftoif
|
|
savepath = path
|
|
path = path[3,999]
|
|
gosub matchid
|
|
path = savepath
|
|
if match.flag then
|
|
fnd = 1
|
|
locate path in pathnames setting val else fnd = 0
|
|
if fnd = 0 then
|
|
open dictword,id then
|
|
mod = inmat()
|
|
type = status()
|
|
ins path before pathnames<-1>
|
|
name = dictword:id
|
|
if type = 1 and acct.format # 2 then gosub type.chk
|
|
fno += 1
|
|
if no.pdict then dfnames<fno> = '' else dfnames<fno> = name
|
|
lfnames<fno> = 'DICT ':id
|
|
fmods<fno> = mod
|
|
ftypes<fno> = type
|
|
close file
|
|
end else
|
|
name = dictword:id
|
|
print 'WARNING - Unable to open ':name
|
|
end
|
|
end else
|
|
*** must be a dict qpointer ***
|
|
end
|
|
end else
|
|
*** must be a dict qpointer ***
|
|
end
|
|
end
|
|
|
|
105*
|
|
|
|
* get DATA filename(s) *
|
|
|
|
path = rec<2>
|
|
if path # '' and path # rec<3> then
|
|
* ignore null filename - query will not handle *
|
|
if path = "?" then goto 120
|
|
gosub eftoif
|
|
gosub matchid
|
|
* handle multi-level data files *
|
|
if upcase(rec<4>[1,1]) = 'M' then
|
|
if match.flag then
|
|
fnd = 1
|
|
locate path in pathnames setting val else fnd = 0
|
|
if fnd = 0 then
|
|
if rec<3> = '' then
|
|
print 'WARNING - Ignoring file ':id:' - data file without a dictionary file'
|
|
goto 120
|
|
end
|
|
ins path before pathnames<-1>
|
|
openpath path to file then
|
|
sselect file to 2
|
|
110*
|
|
readnext fid from 2 else goto 120
|
|
open '',id:',':fid to file then
|
|
if acct.format = 2 then
|
|
print 'WARNING - ':id:',':fid:' is not a valid name on Prime Information'
|
|
end
|
|
mod = inmat()
|
|
type = status()
|
|
name = 'DATA ':id:',':fid
|
|
if type = 1 and acct.format # 2 then gosub type.chk
|
|
fno += 1
|
|
dfnames<fno> = name
|
|
lfnames<fno> = name
|
|
fmods<fno> = mod
|
|
ftypes<fno> = type
|
|
close file
|
|
end else
|
|
name = 'DATA ':id:',':fid
|
|
print 'WARNING - Unable to open ':name
|
|
end
|
|
goto 110
|
|
end else
|
|
print 'WARNING - Unable to open path ':path
|
|
end
|
|
end else
|
|
*** must be a multi level qpointer ***
|
|
end
|
|
end
|
|
end else
|
|
* handle regular data files *
|
|
if match.flag then
|
|
fnd = 1
|
|
locate path in pathnames setting val else fnd = 0
|
|
if fnd = 0 then
|
|
if rec<3> = '' then
|
|
print 'WARNING - Ignoring file ':id:' - data file without a dictionary file'
|
|
goto 120
|
|
end
|
|
open '',id to file then
|
|
mod = inmat()
|
|
type = status()
|
|
ins path before pathnames<-1>
|
|
name = 'DATA ':id
|
|
if type = 1 and acct.format # 2 then gosub type.chk
|
|
fno += 1
|
|
dfnames<fno> = name
|
|
lfnames<fno> = name
|
|
fmods<fno> = mod
|
|
ftypes<fno> = type
|
|
close file
|
|
end else
|
|
name = 'DATA ':id
|
|
print 'WARNING - Unable to open ':name
|
|
end
|
|
end else
|
|
*** must be a data qpointer ***
|
|
end
|
|
end else
|
|
** must be a data qpointer ***
|
|
end
|
|
end
|
|
end
|
|
|
|
120*
|
|
|
|
goto 100
|
|
|
|
200*
|
|
|
|
print
|
|
print 'The following files will dumped to tape:'
|
|
print
|
|
for j = 1 to fno
|
|
if dfnames<j> # '' then print dfnames<j>
|
|
next j
|
|
|
|
210*
|
|
|
|
msg = "OK to continue? (Y/N)"
|
|
print msg:
|
|
input ans
|
|
ans = upcase(ans)
|
|
if ans = 'QUIT' then print 'ACCT.DUMP aborted!'; stop
|
|
if ans # 'Y' and ans # 'N' then goto 210
|
|
if ans # 'Y' then print 'ACCT.DUMP aborted!'; stop
|
|
|
|
* setup ACCT.LOAD *
|
|
|
|
sep = 1
|
|
if acct.format = 2 then sep = 4
|
|
dfnames<2> = 'DATA UV.VOC'
|
|
|
|
pa = ''
|
|
lno = 0
|
|
if acct.format = 2 then
|
|
lno += 1
|
|
pa<lno> = 'PA'
|
|
lno += 1
|
|
pa<lno> = 'T.ATT'
|
|
lno += 1
|
|
pa<lno> = 'T.REW'
|
|
lno += 1
|
|
pa<lno> = 'T.FWD'
|
|
end else
|
|
lno += 1
|
|
pa<lno> = 'PQ'
|
|
lno += 1
|
|
pa<lno> = 'H T-ATT (8192)'
|
|
lno += 1
|
|
pa<lno> = 'P'
|
|
lno += 1
|
|
pa<lno> = 'H T-REW'
|
|
lno += 1
|
|
pa<lno> = 'P'
|
|
lno += 1
|
|
pa<lno> = 'H T-FWD'
|
|
lno += 1
|
|
pa<lno> = 'P'
|
|
end
|
|
|
|
for j = 1 to fno
|
|
if acct.format = 2 then
|
|
cmd = 'CREATE.FILE '
|
|
cmd := lfnames<j>
|
|
cmd := ' '
|
|
cmd := ftypes<j>
|
|
if ftypes<j> # 1 then
|
|
cmd := ' '
|
|
cmd := fmods<j>
|
|
cmd := ' '
|
|
cmd := sep
|
|
end
|
|
lno += 1
|
|
pa<lno> = cmd
|
|
if dfnames<j> # '' then
|
|
name = lfnames<j>
|
|
if name[1,4] = 'DATA' then name = name[6,999999]
|
|
cmd = 'T.LOAD '
|
|
cmd := name
|
|
lno += 1
|
|
pa<lno> = cmd
|
|
end
|
|
end else
|
|
cmd = 'H CREATE-FILE ('
|
|
cmd := lfnames<j>
|
|
cmd := ' '
|
|
cmd := fmods<j>
|
|
cmd := ','
|
|
cmd := sep
|
|
lno += 1
|
|
pa<lno> = cmd
|
|
lno += 1
|
|
pa<lno> = 'P'
|
|
if dfnames<j> # '' then
|
|
name = lfnames<j>
|
|
if name[1,4] = 'DATA' then name = name[6,999999]
|
|
cmd = 'H T-LOAD '
|
|
cmd := name
|
|
lno += 1
|
|
pa<lno> = cmd
|
|
lno += 1
|
|
pa<lno> = 'P'
|
|
end
|
|
end
|
|
next j
|
|
|
|
if acct.format = 2 then
|
|
cmd = 'T.DET'
|
|
lno += 1
|
|
pa<lno> = cmd
|
|
end else
|
|
cmd = 'H T-DET'
|
|
lno += 1
|
|
pa<lno> = cmd
|
|
cmd = 'P'
|
|
lno += 1
|
|
pa<lno> = cmd
|
|
end
|
|
write pa on voclib.file,load.name
|
|
|
|
* setup ACCT.DUMP *
|
|
|
|
dfnames<2> = ''
|
|
|
|
pa = ''
|
|
lno = 0
|
|
lno += 1
|
|
pa<lno> = 'PA'
|
|
lno += 1
|
|
pa<lno> = 'T.ATT'
|
|
if acct.format # 2 then pa<lno> = pa<lno>:' BLK 8192'
|
|
lno += 1
|
|
pa<lno> = "T.DUMP VOCLIB '":load.name:"' ":dump.format
|
|
lno += 1
|
|
pa<lno> = 'GET.LIST ':voc.list
|
|
lno += 1
|
|
pa<lno> = 'T.DUMP VOC ':dump.format
|
|
|
|
for j = 1 to fno
|
|
name = dfnames<j>
|
|
if name # '' then
|
|
if name[1,4] = 'DATA' then name = name[6,999999]
|
|
lno += 1
|
|
pa<lno> = 'T.DUMP ':name:' ':dump.format
|
|
end
|
|
next j
|
|
lno += 1
|
|
pa<lno> = 'T.DET'
|
|
write pa on voclib.file,dump.name
|
|
|
|
pa = ''
|
|
pa<1> = 'R'
|
|
pa<2> = 'VOCLIB'
|
|
pa<3> = dump.name
|
|
write pa on voc.file,dump.name
|
|
|
|
* now ready to dump files *
|
|
|
|
perform dump.name
|
|
|
|
print "ACCT.DUMP completed"
|
|
stop
|
|
|
|
* subroutine to calc modulo for type 1 files *
|
|
|
|
type.chk:
|
|
|
|
cmd = 'COUNT '
|
|
if name[1,4] = 'DATA' then
|
|
cmd := name[6,999999]
|
|
end else
|
|
cmd := name
|
|
end
|
|
perform cmd
|
|
mod = @SYSTEM.RETURN.CODE
|
|
if mod = 0 then mod = 1 else gosub prime.chk
|
|
|
|
return
|
|
|
|
|
|
* subroutine to make modulo a prime number *
|
|
|
|
prime.chk:
|
|
|
|
pno = mod
|
|
if pno < 0 then pno = 1
|
|
if (pno > 2 and mod(pno,2) = 0) then pno += 1
|
|
ptest:
|
|
limit = sqrt(pno + 0.0) + .5
|
|
for test = 3 to limit
|
|
if mod(pno,test) = 0 then
|
|
pno += 2
|
|
goto ptest
|
|
end
|
|
next test
|
|
mod = pno
|
|
|
|
return
|
|
|
|
* subroutine to see if pathname matches record id *
|
|
|
|
matchid:
|
|
|
|
match.flag = 0
|
|
|
|
if uid = path then
|
|
match.flag = 1
|
|
end else
|
|
if len(uid) > MAX.NAME then
|
|
if uid[1,DATA.START] = path[1,DATA.START] then
|
|
if num(path[DATA.START+1,DATA.LIMIT-DATA.START]) then
|
|
match.flag = 1
|
|
end
|
|
end
|
|
end
|
|
end
|
|
|
|
return
|
|
|
|
* subroutine to convert record id to unix filename *
|
|
|
|
eftoif:
|
|
|
|
if id = '' then
|
|
uid = '?'
|
|
end else
|
|
if id[1,1] = '.' then
|
|
uid = '?.'; m = 2
|
|
end else
|
|
uid = ''; m = 1
|
|
end
|
|
l = len(id)
|
|
for j = m to l
|
|
c = id[j,1]
|
|
begin case
|
|
case c = '?'; uid := '??'
|
|
case c = '/'; uid := '?\'
|
|
case c = '\'; uid := '?\'
|
|
case c = char(0); uid := '?0'
|
|
case 1; uid := c
|
|
end case
|
|
next j
|
|
end
|
|
|
|
return
|
|
|
|
end
|
|
|