tldm-universe/CMS/BP.CUSTOM/DICT.UPDATE
2024-09-10 15:25:06 -04:00

127 lines
2.7 KiB
Plaintext
Executable File

* DICT.UPDATE - UPDATE DICTIONARY FILES BETWEEN ACCOUNTS
*
$INCLUDE BP.MASTER GEN.COM2
*
CRT "Enter ACCOUNT to compare file with:":
GET(ARG.,1) ACCOUNT THEN
CRT " ":ACCOUNT
END ELSE
ACCOUNT=''; INPUT ACCOUNT
END
*CRT "Enter FILE NAME to compare:":
*GET(ARG.,2) FNAME THEN
*CRT " ":FNAME
*END ELSE
*FNAME=''; INPUT FNAME
*END
FNAME='*'
FNAME<2>='QFILE'
ACCOUNT<2>=@WHO
PRINTER ON
IF FNAME<1>='*' THEN
OPEN 'VOC' TO VOC ELSE ABORT 201,'VOC'
EOV=0
LIST1=1
SELECT VOC TO LIST1
LOOP
READNEXT ID FROM LIST1 ELSE EOV=1
UNTIL EOV DO
BEGIN CASE
CASE ID[1,1]='&'
CLEARDATA
CONTINUE ;* skip universe files
CASE ID[1,2]='UV'
CLEARDATA
CONTINUE
CASE ID[1,3]='SYS'
CLEARDATA
CONTINUE
CASE ID[1,8]='UNIVERSE'
CLEARDATA
CONTINUE
CASE 1
READV TYPE FROM VOC,ID,1 ELSE VREC=''
IF TYPE[1,1]='F' THEN
FNAME=ID
CRT "Current File: DICT ":FNAME
GOSUB 1000
END
END CASE
REPEAT
END ELSE
GOSUB 1000
END
GO 9999
*
1000 *
CLEARDATA
DATA \QFILE\
EXECUTE \SET-FILE \:ACCOUNT<1>:\ \:FNAME
OPEN "DICT ":FNAME TO FVAR ELSE
PRINT "DICT ":FNAME:" DOES NOT EXIST IN ":@WHO:" ACCOUNT"
PRINT
RETURN
END
OPEN 'DICT QFILE' TO QFILE ELSE
PRINT "DICT ":FNAME:" DOES NOT EXIST IN ":ACCOUNT<1>:" ACCOUNT"
PRINT
RETURN
END
*
PRINT "DICT update run on ":@WHO:" account, using DICT ":FNAME<1>:", against ":ACCOUNT<1>:" account."
PRINT
T=0 ; T<2>=0
TOK=0 ; TOK<2>=0
TNEW=0 ; TNEW<2>=0
TDIFF=0 ; TDIFF<2>=0
OUTPUT=''
FOR XX=1 TO 2
PASS1=XX
IF XX=1 THEN
F1=FVAR ; F2=QFILE
DATA \NSELECT DICT \:FNAME<2>
END ELSE
F1=QFILE ; F2=FVAR
* ALREADY PROCESSED THE ITEMS IN FNAME<1> SO CAN SKIP THEM.
DATA \NSELECT DICT \:FNAME<1>
END
100 *
EXECUTE \SSELECT DICT \:FNAME<XX> CAPTURING JUNK
EOF=0
LOOP
READNEXT KEY ELSE EOF=1
UNTIL EOF DO
READ SOURCE FROM F1,KEY THEN
IF PASS1 ELSE T<XX>=T<XX>+1
READ QSOURCE FROM F2,KEY THEN
IF SOURCE = QSOURCE THEN
IF PASS1 ELSE TOK<XX>=TOK<XX>+1
END ELSE
IF PASS1 ELSE
WRITE SOURCE ON F2,KEY
TDIFF<XX>=TDIFF<XX>+1
PRINT 'Item different: ':KEY
END
END
END ELSE
IF PASS1 THEN
IF PASS1=1 THEN WRITE SOURCE ON F2,KEY
TNEW<XX>=TNEW<XX>+1
PRINT 'Item missing in ':ACCOUNT<XX>:': ':KEY
END
END
END
REPEAT
IF PASS1=1 THEN PASS1=0 ; GO 100
NEXT XX
* CRT FNAME:' records checked: ':T:' OK=':TOK:' New=':TNEW:' Diff: ':TDIFF
PRINT
PRINT FNAME<1>:' records checked: ':T<1>:' OK=':TOK<1>:' New=':TNEW<1>:' Diff: ':TDIFF<1>:' Missing: ':TNEW<2>
PRINT ; PRINT
RETURN
*
9999 *
PRINTER OFF
PRINTER CLOSE
STOP