127 lines
2.7 KiB
Plaintext
127 lines
2.7 KiB
Plaintext
|
* 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
|