-
Notifications
You must be signed in to change notification settings - Fork 0
/
GET.DICTS
300 lines (285 loc) · 11.7 KB
/
GET.DICTS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
program GET.DICTS
$Copyright Copyleft 2020 SBCS/Stuboydl
* example unibasic program to find changes in hashed files and dictionaries and update source controled folders (git)
* !!! NO RESPONSIBILITY OR LIABILITY IS ACCEPTED FOR YOUR USE OF THIS PROGRAM !!!
* NB This program has not been compiled or tested and is intended as an example ONLY.
* NB Define any required criteria in your select statments below. They will not work as-is.
* NB be aware U2 doesn't play well with some Windows names restrictions/conventions when moving from hashed files to OS folders (type 19).
* - "myitem." will have the trailing dot stripped when writing to windows, wheras "myItem*" will be converted to "myItem%A".
* - items starting with "aux.", "con.", etc. will fail in type 19 files. eg an item called PRN.LABEL cannot be saved as a windows item!
* See GetWinSafeName and GetUVSafeName gosubs below for examples on handling.
! CREATE.FILEI SOURCE.DICTS 19
! INSERT INTO DICT SOURCE.DICTS USING DICT DICT.DICT (FIELD,CODE,FUNC,NAME,FORMAT,SM) VALUES ('ACCOUNT','I','@ID["=",1,1]','Account','10L','S');
! INSERT INTO DICT SOURCE.DICTS USING DICT DICT.DICT (FIELD,CODE,FUNC,NAME,FORMAT,SM) VALUES ('FILENAME','I','@ID["=",2,1]','Filename','16L','S');
! INSERT INTO DICT SOURCE.DICTS USING DICT DICT.DICT (FIELD,CODE,FUNC,NAME,FORMAT,SM) VALUES ('ITEMNAME','I','@ID["=",3,1]','Itemname','24L','S');
! CREATE.FILEI SOURCE.VOC 19
! INSERT INTO DICT SOURCE.VOC USING DICT DICT.DICT (FIELD,CODE,FUNC,NAME,FORMAT,SM) VALUES ('ACCOUNT','I','@ID["=",1,1]','Account','10L','S');
! INSERT INTO DICT SOURCE.VOC USING DICT DICT.DICT (FIELD,CODE,FUNC,NAME,FORMAT,SM) VALUES ('FILENAME','I','@ID["=",2,1]','Filename','16L','S');
! INSERT INTO DICT SOURCE.VOC USING DICT DICT.DICT (FIELD,CODE,FUNC,NAME,FORMAT,SM) VALUES ('ITEMNAME','I','@ID["=",3,1]','Itemname','24L','S');
thisAcnt = downcase(@who)
get(arg.) isLive else isLive = @false
gosub OpenFiles
crt @(-1):'- Checking dictionaries and VOC for changes, mode:':if isLive then '**LIVE**' else 'Check only'
crt '-----------------------------------------'
prtRow = 0
recCnt = 0
totCnt = 0
upList = ''
gosub CheckDictOrphans:
gosub CheckDictChanges:
gosub CheckVocChanges:
writelist upList ON '$UPLIST'
crt 'changes saved in &SAVEDLISTS&,$UPLIST'
stop
OpenFiles:
open 'SOURCE.DICTS' to sourceDicts else stop ;* opens a type 19 file under git control
open 'SOURCE.VOC' to sourceVoc else stop ;* opens a type 19 file under git control
open 'VOC' to voc else stop
return
CheckDictOrphans:
lstFnm = ''
prtRow += 2
crt @(0,prtRow):'- Checking orphans for removal from ':thisAcnt
prtRow += 2
exec 'SSELECT SOURCE.DICTS IF ACCOUNT = ':quote(thisAcnt) capturing cap
loop while readnext @id do
recordId = @id
fileName = recordId['=',2,1]
fileId = recordId['=',3,9]
if fileName # lstFnm then
open 'dict',fileName to dictFile then lstFnm = fileName else dictFile = ''
end
if fileinfo(dictFile,0) then
readv z from dictFile,fileId,0 else
recCnt += 1
crt @(0,prtRow):@(-4):recCnt,fileName:
crt @(0,prtRow+1):@(-4):recCnt,fileId:
upList<-1> = 'dif=>':@id:',':fileId
if isLive then delete sourceDicts,@id
end
end else
crt @(0,prtRow):@(-4):recCnt,fileName:
crt @(0,prtRow+1):@(-4):recCnt,fileId:
upList<-1> = 'din=>':@id:',':fileId
if isLive then delete sourceDicts,@id
end
repeat
if recCnt then prtRow += 2
totCnt += recCnt
crt @(0,prtRow):recCnt:' orphan records removed'
return
CheckDictChanges:
prtRow += 2
crt @(0,prtRow):'- Checking changes for add/update'
prtRow += 2
recCnt = 0
* add criteria to select files you are interested in and exclude those you are not interested in
exec 'SSELECT VOC IF F1 LIKE "F..." AND any other required criteria' rtnlist listA capturing cap
loop while readnext fileName from listA do
open 'dict',fileName to dictFile then
crt @(0,prtRow):@(-4):' checking ':fileName:
gosub CheckDictionary:
end
repeat
totCnt += recCnt
crt @(0,prtRow):recCnt:' records updated':
return
CheckDictionary:
select dictFile to listB
loop while readnext dictId from listB do
begin case
case fileName[7] = 'CONTROL' and dictId[1,1] = '$' ;* ignr
case dictId match '0X"FP"1N':@vm:'0X"FP"1N".GUI"':@vm:'0X"FP"1N".TXT"':@vm:'0X"FP"1N".XUI"':@vm:'0X"FP"1N".XAML"':@vm:'"$DUMMY"0X' ;* ignr
case dictId = '@EMPTY.NULL' ;* ignr
case @false ;*any other ignore criteria
case @true
read dr from dictFile,dictId then
sourceId = thisAcnt:'=':fileName:'=':dictId ;* check for GetWinSafeName
read tdr from sourceDicts,sourceId else tdr = '!!-!!'
if dr<1,1>[' ',1,1] = 'I' then dr = dr[@am,1,9]
* if tdr<1,1>[' ',1,1] = 'I' then tdr = tdr[@am,1,9]
if tdr # dr then
recCnt += 1
crt @(0,prtRow+1):@(-4):recCnt,sourceId:
crt recCnt,sourceId
if tdr = '!!-!!' then upList<-1> = 'new=>':sourceId:',':dictId else upList<-1> = 'upd=>':sourceId:',':dictId
if isLive then write dr on sourceDicts,sourceId
end
end
end case
repeat
* crt @(0,prtRow+2):recCnt:' records updated'
return
CheckVocChanges:
prtRow += 2
crt @(0,prtRow):'- Checking VOC for orphans':
recCnt = 0
exec 'SSELECT SOURCE.VOC IF ACCOUNT = "':thisAcnt:'"' capturing cap
loop while readnext @id do
recordId = @id ;* check for GetUVSafeName
fileName = recordId['=',2,1]
fileId = recordId['=',3,9]
readv z from voc,fileId,0 else
recCnt += 1
crt @(0,prtRow+1):@(-4):recCnt,fileId:
upList<-1> = 'dvo=>':@id:',':fileId
if isLive then delete sourceVoc,@id
end
repeat
prtRow += 2
totCnt += recCnt
crt @(0,prtRow):recCnt:' orphans removed'
prtRow += 2
crt @(0,prtRow):'- Checking VOC for changes':
recCnt = 0
* add criteria for VOC item selection
exec 'SELECT VOC IF @ID # "RELLEVEL" AND @ID UNLIKE "QF..." any other criteria ' capturing cap
loop while readnext vid do
read vocRec from voc,vid then
sourceId = thisAcnt:'=VOC=':vid ;* GetWinSafeName
read srcRec from sourceVoc,sourceId else srcRec = '!!-!!'
if vocRec # srcRec then
recCnt += 1
crt @(0,prtRow+1):@(-4):recCnt,@id:
if srcRec = '!!-!!' then upList<-1> = 'voc=>':sourceId:',':vid
if isLive then write vocRec on sourceVoc,sourceId
end
end
repeat
prtRow += 2
totCnt += recCnt
crt @(0,prtRow):recCnt:' records updated'
return
GetUVSafeName:
* edge cases not automagically transliterated by UV
* fix win names (EG picked up from git list) to UV safe.
* | This character... |Maps to...
* -------------------------------------------
* | empty filename |%
* | % |%%
* | * |%A
* | \ |%B
* | : |%C
* | " |%D
* | > |%G
* | < |%L
* | ? |%Q
* | / |%S
* | | (vertical bar) |%V
* | ^(caret) |^^
* | ASCII 1 through ASCII 26 |^A through ^Z
* | ASCII 27 through ASCII 31 |^1 through ^5
rv = @id
if params[',',2,1] then ;* only do these conversion for special cases (eg reading a git log)
if rv = '%' then rv = '' else
if index(rv, '%', 1) then
if index(rv,'%A',1) then rv = change(rv,'%A','*')
if index(rv,'%B',1) then rv = change(rv,'%B','\')
if index(rv,'%C',1) then rv = change(rv,'%C',':')
if index(rv,'%D',1) then rv = change(rv,'%D','"')
if index(rv,'%G',1) then rv = change(rv,'%G','>')
if index(rv,'%L',1) then rv = change(rv,'%L','<')
if index(rv,'%Q',1) then rv = change(rv,'%Q','?')
if index(rv,'%S',1) then rv = change(rv,'%S','/')
if index(rv,'%V',1) then rv = change(rv,'%V','|')
if index(rv,'%%',1) then rv = change(rv,'%%','%')
end
if index(rv,'^',1) then
if rv match '0X^1A0X' then
clean = @false
o = rv
rv = ''
max = len(o)
for i = 1 to max until clean
if o match '^1A0X' then
z = matchfield(o,'^1A0X',2)
z = seq(z)
if z > 64 and z < 91 then
rv := char(z-64)
end else
rv := o[1,2]
end
o = o[3,999]
end else
rv := o[1,1]
o = o[2,999]
end
if o match '0X^1A0X' else
rv := o
clean = @true
end
next i
end
if rv match '0X^1N0X' then
clean = @false
o = rv
rv = ''
max = len(o)
for i = 1 to max until clean
if o match '^1N0X' then
z = matchfield(o,'^1N0X',2)
z = seq(z)
if z > 48 and z < 54 then
rv := char(z-22)
end else
rv := o[1,2]
end
o = o[3,999]
end else
rv := o[1,1]
o = o[2,999]
end
if o match '0X^1N0X' else
rv := o
clean = @true
end
next i
end
if rv match '0X^^0X' then rv = change(rv,'^^','^')
end
end
end
if index(rv,'$',1) then
if rv match '0X.$':@vm:'0X $' then
* trailing dot/space strip issue
rv = rv[1,len(rv)-1]
if rv match '$AUX':@vm:'$CON':@vm:'$NUL':@vm:'$PRN':@vm:'$AUX.0X':@vm:'$CON.0X':@vm:'$NUL.0X':@vm:'$PRN.0X':@vm:'$COM1N':@vm:'$COM1N.0X':@vm:'$LPT1N':@vm:'$LPT1N.0X' then
* Win reserved names
rv = rv[2,99]
end
end
return
GetWinSafeName:
* edge cases not automagically transliterated by uv
rv = @id
if params[',',2,1] then
if rv = '' then rv = '%' else
if index(rv,'%',1) then rv = change(rv,'%','%%')
if index(rv,'*',1) then rv = change(rv,'*','%A')
if index(rv,'\',1) then rv = change(rv,'\','%B')
if index(rv,':',1) then rv = change(rv,':','%C')
if index(rv,'"',1) then rv = change(rv,'"','%D')
if index(rv,'>',1) then rv = change(rv,'>','%G')
if index(rv,'<',1) then rv = change(rv,'<','%L')
if index(rv,'?',1) then rv = change(rv,'?','%Q')
if index(rv,'/',1) then rv = change(rv,'/','%S')
if index(rv,'|',1) then rv = change(rv,'|','%V')
end
for i = 1 to 26 ;* change char to ^A-Z
if index(rv,char(i),1) then rv = change(rv,char(i),'^':char(i+64))
next i
for i = 27 to 31 ;* change char to ^1-5
if index(rv,char(i),1) then rv = change(rv,char(i),'^':char(i+22))
next i
if index(rv,'^',1) then rv = change(rv,'^','^^')
end
if rv match '0X.':@vm:'0X ' then
* trailing dot/space strip issue
rv := '$'
end
if rv match 'AUX':@vm:'CON':@vm:'NUL':@vm:'PRN':@vm:'AUX.0X':@vm:'CON.0X':@vm:'NUL.0X':@vm:'PRN.0X':@vm:'COM1N':@vm:'COM1N.0X':@vm:'LPT1N':@vm:'LPT1N.0X' then
* Win reserved names
rv = '$':rv
end
return
end