******************************************************************************
*
*	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