|
1
|
DEFINE TEMP-TABLE tt-1 NO-UNDO
|
|
2
|
NAMESPACE-URI "http://goldencode.com/testNamespace5"
|
|
3
|
// NAMESPACE-PREFIX "fwdPrefix1"
|
|
4
|
FIELD a1char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute'
|
|
5
|
FIELD a1int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE 'attribute'
|
|
6
|
FIELD f1char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
|
|
7
|
FIELD f1charcs AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs"
|
|
8
|
FIELD f1decimal AS DECIMAL FORMAT "->>,>>9.99" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
|
|
9
|
FIELD f1int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int"
|
|
10
|
FIELD f1int1 AS INT INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden'
|
|
11
|
FIELD f1int64 AS INT64 FORMAT "99999" EXTENT 4 INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'
|
|
12
|
FIELD f1bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
|
|
13
|
FIELD f1date AS DATE INITIAL TODAY LABEL "date"
|
|
14
|
FIELD f1datetime AS DATETIME INITIAL NOW LABEL "datetime"
|
|
15
|
FIELD f1datetime-tz AS DATETIME-TZ INITIAL NOW LABEL "datetime-tz"
|
|
16
|
// FIELD f1datetime-tz1 AS DATETIME-TZ INITIAL "10/17/2022 13:47:48.426+03:00" LABEL "datetime-tz1"
|
|
17
|
FIELD f1blob AS BLOB LABEL "blob" COLUMN-LABEL "blob-column"
|
|
18
|
FIELD f1clob1 AS CLOB LABEL "clob1" TTCODEPAGE XML-NODE-TYPE 'hidden'
|
|
19
|
FIELD f1clob2 AS CLOB LABEL "clob2" COLUMN-CODEPAGE 'ibm850'
|
|
20
|
FIELD f1recid AS RECID LABEL "recid" FORMAT "->,>>>,>>9"
|
|
21
|
FIELD f1handle AS HANDLE LABEL "handle" FORMAT ">>>>>>9"
|
|
22
|
FIELD f1com-handle AS COM-HANDLE LABEL "com-handle" FORMAT ">>>>>>9"
|
|
23
|
FIELD f1raw AS RAW
|
|
24
|
FIELD f1rowid AS ROWID
|
|
25
|
FIELD a1int1 AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-NODE-TYPE 'attribute'
|
|
26
|
FIELD f1d4 AS DEC DECIMALS 4
|
|
27
|
INDEX i1dx1 f1char
|
|
28
|
INDEX i1dx2 a1char DESC f1char DESC
|
|
29
|
INDEX i1dx3 AS UNIQUE f1int
|
|
30
|
.
|
|
31
|
|
|
32
|
DEFINE TEMP-TABLE tt2 NO-UNDO
|
|
33
|
NAMESPACE-URI "http://goldencode.com/testNamespace2"
|
|
34
|
// NAMESPACE-PREFIX "fwdPrefix2"
|
|
35
|
FIELD a2char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute'
|
|
36
|
FIELD a2int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE 'attribute'
|
|
37
|
FIELD f2char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
|
|
38
|
FIELD f2charcs AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs"
|
|
39
|
FIELD f2decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
|
|
40
|
FIELD f2int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int"
|
|
41
|
FIELD f2int1 AS INT INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden'
|
|
42
|
FIELD f2int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'
|
|
43
|
FIELD f2bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
|
|
44
|
INDEX i2dx1 f2char
|
|
45
|
INDEX i2dx2 a2char DESC f2char DESC
|
|
46
|
INDEX i2dx3 AS UNIQUE f2int
|
|
47
|
.
|
|
48
|
|
|
49
|
DEFINE TEMP-TABLE tt3 NO-UNDO
|
|
50
|
NAMESPACE-URI "http://goldencode.com/testNamespace2"
|
|
51
|
NAMESPACE-PREFIX "fwdPrefix3"
|
|
52
|
FIELD a3char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute'
|
|
53
|
FIELD a3int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE 'attribute'
|
|
54
|
FIELD f3char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
|
|
55
|
FIELD f3charcs AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs"
|
|
56
|
FIELD f3decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
|
|
57
|
FIELD f3int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int"
|
|
58
|
FIELD f3int1 AS INT INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden'
|
|
59
|
FIELD f3int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'
|
|
60
|
FIELD f3bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
|
|
61
|
INDEX i3dx1 f3char
|
|
62
|
INDEX i3dx2 a3char DESC f3char DESC
|
|
63
|
INDEX i3dx3 AS UNIQUE f3int
|
|
64
|
.
|
|
65
|
|
|
66
|
DEFINE TEMP-TABLE tt4 NO-UNDO
|
|
67
|
NAMESPACE-URI "http://goldencode.com/testNamespace5"
|
|
68
|
// NAMESPACE-PREFIX "fwdPrefix4"
|
|
69
|
FIELD a4char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute'
|
|
70
|
FIELD a4int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE 'attribute'
|
|
71
|
FIELD f4char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
|
|
72
|
FIELD f4charcs AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs"
|
|
73
|
FIELD f4decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
|
|
74
|
FIELD f4int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int"
|
|
75
|
FIELD f4int1 AS INT INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden'
|
|
76
|
FIELD f4int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'
|
|
77
|
FIELD f4bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
|
|
78
|
INDEX i4dx1 f4char
|
|
79
|
INDEX i4dx2 a4char DESC f4char DESC
|
|
80
|
INDEX i4dx3 AS UNIQUE f4int
|
|
81
|
.
|
|
82
|
|
|
83
|
DEFINE TEMP-TABLE tt5 NO-UNDO
|
|
84
|
NAMESPACE-URI "http://goldencode.com/testNamespace5"
|
|
85
|
NAMESPACE-PREFIX "fwdPrefix5"
|
|
86
|
FIELD a5char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute'
|
|
87
|
FIELD a5int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE 'attribute'
|
|
88
|
FIELD f5char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
|
|
89
|
FIELD f5charcs AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs"
|
|
90
|
FIELD f5decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
|
|
91
|
FIELD f5int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int"
|
|
92
|
FIELD f5int1 AS INT INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden'
|
|
93
|
FIELD f5int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'
|
|
94
|
FIELD f5bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
|
|
95
|
INDEX i5dx1 f5char
|
|
96
|
INDEX i5dx2 a5char DESC f5char DESC
|
|
97
|
INDEX i5dx3 AS UNIQUE f5int
|
|
98
|
.
|
|
99
|
|
|
100
|
DEFINE DATASET ds
|
|
101
|
NAMESPACE-URI "http://goldencode.com/testNamespace"
|
|
102
|
NAMESPACE-PREFIX "fwdPrefix"
|
|
103
|
FOR tt-1, tt2, tt3, tt4, tt5
|
|
104
|
DATA-RELATION rel12 FOR tt-1, tt2 RELATION-FIELDS(f1int, f2int) NESTED FOREIGN-KEY-HIDDEN
|
|
105
|
DATA-RELATION rel13 FOR tt-1, tt3 RELATION-FIELDS(f1int, f3int) NESTED FOREIGN-KEY-HIDDEN
|
|
106
|
DATA-RELATION rel34 FOR tt3, tt4 RELATION-FIELDS(f3int, f4int) NESTED FOREIGN-KEY-HIDDEN
|
|
107
|
DATA-RELATION rel51 FOR tt5, tt-1 RELATION-FIELDS(f5int, f1int) NESTED FOREIGN-KEY-HIDDEN
|
|
108
|
.
|
|
109
|
|
|
110
|
DEF VAR dsh AS HANDLE NO-UNDO.
|
|
111
|
DEF VAR hds AS HANDLE NO-UNDO.
|
|
112
|
DEF VAR hds1 AS HANDLE NO-UNDO.
|
|
113
|
DEF VAR hdss AS HANDLE NO-UNDO.
|
|
114
|
DEF VAR tth1 AS HANDLE NO-UNDO.
|
|
115
|
DEF VAR tth2 AS HANDLE NO-UNDO.
|
|
116
|
DEF VAR ttdh AS HANDLE NO-UNDO.
|
|
117
|
DEF VAR lRet AS LOGICAL NO-UNDO.
|
|
118
|
DEF VAR nmsg AS INTEGER NO-UNDO.
|
|
119
|
DEF VAR n AS INTEGER NO-UNDO.
|
|
120
|
|
|
121
|
OUTPUT TO 'json-test/json-marshal.txt'.
|
|
122
|
|
|
123
|
CREATE tt-1. tt-1.f1char = '1.1111'. tt-1.f1int = 11. tt-1.f1decimal = 3.1465. tt-1.f1d4 = 1234.5678.
|
|
124
|
CREATE tt-1. tt-1.f1char = '1.2222'. tt-1.f1int = 12. tt-1.f1decimal = 3.1415926.
|
|
125
|
CREATE tt-1. tt-1.f1char = '1.3333'. tt-1.f1int = 60. tt-1.f1decimal = 3.1415926.
|
|
126
|
|
|
127
|
CREATE tt2. tt2.f2char = '2.1111'. tt2.f2int = 11. tt2.f2decimal = 3.1415.
|
|
128
|
CREATE tt2. tt2.f2char = '2.2222'. tt2.f2int = 22. tt2.f2decimal = 3.141515926.
|
|
129
|
|
|
130
|
CREATE tt3. tt3.f3char = '3.1111'. tt3.f3int = 11. tt3.f3decimal = 3.1415.
|
|
131
|
CREATE tt3. tt3.f3char = '3.2222'. tt3.f3int = 32. tt3.f3decimal = 3.141515926.
|
|
132
|
|
|
133
|
CREATE tt4. tt4.f4char = '4.1111'. tt4.f4int = 11. tt4.f4decimal = 3.1415.
|
|
134
|
CREATE tt4. tt4.f4char = '4.2222'. tt4.f4int = 42. tt4.f4decimal = 3.141515926.
|
|
135
|
|
|
136
|
CREATE tt5. tt5.f5char = '5.1111'. tt5.f5int = 11. tt5.f5decimal = 3.1415.
|
|
137
|
CREATE tt5. tt5.f5char = '5.2222'. tt5.f5int = 52. tt5.f5decimal = 3.141515926.
|
|
138
|
CREATE tt5. tt5.f5char = '5.3333'. tt5.f5int = 60. tt5.f5decimal = 3.141515926.
|
|
139
|
|
|
140
|
DEFINE STREAM json.
|
|
141
|
DEF VAR json-ptr AS MEMPTR NO-UNDO.
|
|
142
|
DEF VAR json-lc AS LONGCHAR NO-UNDO.
|
|
143
|
|
|
144
|
CREATE DATASET hds.
|
|
145
|
CREATE DATASET hds1.
|
|
146
|
CREATE DATASET hdss.
|
|
147
|
CREATE TEMP-TABLE ttdh.
|
|
148
|
|
|
149
|
dsh = DATASET ds:HANDLE.
|
|
150
|
|
|
151
|
tth1 = TEMP-TABLE tt-1:HANDLE.
|
|
152
|
tth2 = TEMP-TABLE tt2:HANDLE.
|
|
153
|
|
|
154
|
// FILE
|
|
155
|
lRet = tth1:WRITE-JSON('file', 'json-test/tth1.json', TRUE, ?, FALSE, FALSE) NO-ERROR.
|
|
156
|
RUN show-error('tth1:WRITE-JSON to FILE').
|
|
157
|
MESSAGE 'tth1:WRITE-JSON' lRet.
|
|
158
|
|
|
159
|
lRet = ttdh:READ-JSON('file', 'json-test/tth1.json', 'empty') NO-ERROR.
|
|
160
|
RUN show-error('ttdh:READ-JSON from FILE').
|
|
161
|
MESSAGE 'ttdh:READ-JSON' lRet.
|
|
162
|
|
|
163
|
IF lRet THEN DO:
|
|
164
|
lRet = ttdh:WRITE-JSON('file', 'json-test/ttdh.json', TRUE, ?, FALSE, FALSE).
|
|
165
|
MESSAGE 'ttdh:WRITE-JSON' lRet.
|
|
166
|
END.
|
|
167
|
|
|
168
|
// MEMPTR
|
|
169
|
lRet = tth1:WRITE-JSON('memptr', json-ptr, TRUE, ?, FALSE, FALSE) NO-ERROR.
|
|
170
|
RUN show-error('tth1:WRITE-JSON to MEMPTR').
|
|
171
|
MESSAGE 'tth1:WRITE-JSON to MEMPTR' lRet.
|
|
172
|
|
|
173
|
CREATE TEMP-TABLE ttdh.
|
|
174
|
lRet = ttdh:READ-JSON('memptr', json-ptr, 'empty') NO-ERROR.
|
|
175
|
RUN show-error('ttdh:READ-JSON from MEMPTR').
|
|
176
|
MESSAGE 'ttdh:READ-JSON from MEMPTR' lRet.
|
|
177
|
|
|
178
|
IF lRet THEN DO:
|
|
179
|
lRet = ttdh:WRITE-JSON('file', 'json-test/ttdh-ptr.json', TRUE, ?, FALSE, FALSE).
|
|
180
|
MESSAGE 'ttdh:WRITE-JSON.ptr' lRet.
|
|
181
|
END.
|
|
182
|
|
|
183
|
SET-SIZE(json-ptr) = 0.
|
|
184
|
|
|
185
|
// LONGCHAR
|
|
186
|
lRet = tth1:WRITE-JSON('longchar', json-lc, TRUE, ?, FALSE, FALSE) NO-ERROR.
|
|
187
|
RUN show-error('tth1:WRITE-JSON to LONGCHAR').
|
|
188
|
MESSAGE 'tth1:WRITE-JSON to LONGCHAR' lRet.
|
|
189
|
|
|
190
|
CREATE TEMP-TABLE ttdh.
|
|
191
|
lRet = ttdh:READ-JSON('longchar', json-lc, 'empty') NO-ERROR.
|
|
192
|
RUN show-error('ttdh:READ-JSON from LONGCHAR').
|
|
193
|
MESSAGE 'ttdh:READ-JSON from LONGCHAR' lRet.
|
|
194
|
|
|
195
|
IF lRet THEN DO:
|
|
196
|
lRet = ttdh:WRITE-JSON('file', 'json-test/ttdh-lc.json', TRUE, ?, FALSE, FALSE).
|
|
197
|
MESSAGE 'ttdh:WRITE-JSON.lc' lRet.
|
|
198
|
lRet = ttdh:WRITE-XMLSCHEMA('file', 'json-test/ttdh-lc.xsd', TRUE, 'UTF-8', FALSE, FALSE).
|
|
199
|
MESSAGE 'ttdh:WRITE-XMLSCHEMA' lRet.
|
|
200
|
END.
|
|
201
|
|
|
202
|
// STREAM
|
|
203
|
OUTPUT STREAM json TO 'json-test/tth1-stream.json'.
|
|
204
|
lRet = tth1:WRITE-JSON('stream', 'json', TRUE, ?, FALSE, FALSE) NO-ERROR.
|
|
205
|
RUN show-error('tth1:WRITE-JSON to STREAM').
|
|
206
|
MESSAGE 'tth1:WRITE-JSON to STREAM' lRet.
|
|
207
|
OUTPUT STREAM json CLOSE.
|
|
208
|
|
|
209
|
CREATE TEMP-TABLE ttdh.
|
|
210
|
INPUT STREAM json FROM 'json-test/tth1-stream.json'.
|
|
211
|
lRet = ttdh:READ-JSON('stream', 'json', 'empty') NO-ERROR.
|
|
212
|
RUN show-error('ttdh:READ-JSON from STREAM').
|
|
213
|
MESSAGE 'ttdh:READ-JSON from STREAM' lRet.
|
|
214
|
INPUT STREAM json CLOSE.
|
|
215
|
|
|
216
|
IF lRet THEN DO:
|
|
217
|
lRet = ttdh:WRITE-JSON('file', 'json-test/ttdh-stream.json', TRUE, ?, FALSE, FALSE).
|
|
218
|
MESSAGE 'ttdh:WRITE-JSON' lRet.
|
|
219
|
END.
|
|
220
|
|
|
221
|
// --------------------------
|
|
222
|
|
|
223
|
lRet = dsh:WRITE-JSON('file', 'json-test/ds.json', TRUE, ?, FALSE, FALSE).
|
|
224
|
MESSAGE 'dsh:WRITE-JSON' lRet.
|
|
225
|
|
|
226
|
lRet = hdss:READ-JSON('file', 'json-test/ds.json', 'empty') NO-ERROR.
|
|
227
|
RUN show-error('hdss:READ-JSON').
|
|
228
|
MESSAGE 'hdss:READ-JSON' lRet.
|
|
229
|
|
|
230
|
lRet = hdss:WRITE-XMLSCHEMA('file', 'json-test/hdss.xsd', TRUE, 'UTF-8', FALSE, FALSE).
|
|
231
|
MESSAGE 'hdss:WRITE-XMLSCHEMA' lRet.
|
|
232
|
|
|
233
|
lRet = hdss:WRITE-XML('file', 'json-test/hdss.xml', TRUE, 'UTF-8', ?, FALSE, FALSE, ?, FALSE).
|
|
234
|
MESSAGE 'hdss:WRITE-XMLSCHEMA' lRet.
|
|
235
|
|
|
236
|
lRet = hdss:WRITE-JSON('file', 'json-test/hdss.json', TRUE, ?, FALSE, FALSE).
|
|
237
|
MESSAGE 'hdss:WRITE-JSON' lRet.
|
|
238
|
|
|
239
|
DEF VAR htt AS HANDLE NO-UNDO.
|
|
240
|
n = 1.
|
|
241
|
DO WHILE n <= hdss:NUM-BUFFERS.
|
|
242
|
htt = hdss:GET-BUFFER-HANDLE(n).
|
|
243
|
lRet = htt:WRITE-JSON('file', 'json-test/hdss:.1-' + STRING(n) + '.json', TRUE, ?, FALSE, FALSE).
|
|
244
|
MESSAGE 'hdss:' + STRING(n) + ':WRITE-JSON.1' lRet.
|
|
245
|
n = n + 1.
|
|
246
|
END.
|
|
247
|
|
|
248
|
MESSAGE "hdss:NUM-RELATIONS:" hdss:NUM-RELATIONS "hdss:NUM-BUFFERS:" hdss:NUM-BUFFERS "hdss:NUM-TOP-BUFFERS:" hdss:NUM-TOP-BUFFERS.
|
|
249
|
|
|
250
|
DEF VAR hb AS HANDLE NO-UNDO.
|
|
251
|
DEF VAR hf AS HANDLE NO-UNDO.
|
|
252
|
DEF VAR nf AS INTEGER NO-UNDO.
|
|
253
|
n = 1.
|
|
254
|
DO WHILE n <= hdss:NUM-TOP-BUFFERS.
|
|
255
|
hb = hdss:GET-TOP-BUFFER(n).
|
|
256
|
MESSAGE n "NAME:" hb:NAME "NUM-FIELDS:" hb:NUM-FIELDS.
|
|
257
|
nf = 1.
|
|
258
|
DO WHILE nf <= hb:NUM-FIELDS.
|
|
259
|
hf = hb:BUFFER-FIELD(nf).
|
|
260
|
MESSAGE nf "NAME:" hf:NAME "TYPE:" "SERIALIZE-HIDDEN:" hf:SERIALIZE-HIDDEN.
|
|
261
|
nf = nf + 1.
|
|
262
|
END.
|
|
263
|
n = n + 1.
|
|
264
|
END.
|
|
265
|
|
|
266
|
DEF VAR hr AS HANDLE NO-UNDO.
|
|
267
|
n = 1.
|
|
268
|
DO WHILE n <= hdss:NUM-RELATIONS.
|
|
269
|
hr = hdss:GET-RELATION(n).
|
|
270
|
MESSAGE hr:NAME "NESTED:" "hr:REPOSITION:" hr:REPOSITION hr:NESTED "PARENT-ID-RELATION:" hr:PARENT-ID-RELATION "RELATION-FIELDS: [" + hr:RELATION-FIELDS + "]".
|
|
271
|
n = n + 1.
|
|
272
|
END.
|
|
273
|
|
|
274
|
dsh:EMPTY-DATASET().
|
|
275
|
MESSAGE 'dsh:EMPTY-DATASET' lRet.
|
|
276
|
|
|
277
|
lRet = dsh:READ-JSON('file', 'json-test/ds.json', 'empty') NO-ERROR.
|
|
278
|
RUN show-error('dsh:READ-JSON').
|
|
279
|
MESSAGE 'dsh:READ-JSON.1' lRet.
|
|
280
|
|
|
281
|
lRet = dsh:WRITE-JSON('file', 'json-test/ds.1.json', TRUE, ?, FALSE, FALSE).
|
|
282
|
MESSAGE 'dsh:WRITE-JSON.1' lRet.
|
|
283
|
|
|
284
|
n = 1.
|
|
285
|
DO WHILE n <= dsh:NUM-BUFFERS.
|
|
286
|
htt = dsh:GET-BUFFER-HANDLE(n).
|
|
287
|
lRet = htt:WRITE-JSON('file', 'json-test/ds.1-' + STRING(n) + '.json', TRUE, ?, FALSE, FALSE).
|
|
288
|
MESSAGE 'dsh' + STRING(n) + ':WRITE-JSON.1' lRet.
|
|
289
|
n = n + 1.
|
|
290
|
END.
|
|
291
|
|
|
292
|
OUTPUT CLOSE.
|
|
293
|
|
|
294
|
PROCEDURE show-error:
|
|
295
|
DEF INPUT PARAM action AS CHAR.
|
|
296
|
|
|
297
|
MESSAGE "After" action ": error =" ERROR-STATUS:ERROR
|
|
298
|
"num-messages =" ERROR-STATUS:NUM-MESSAGES
|
|
299
|
"type =" ERROR-STATUS:TYPE
|
|
300
|
.
|
|
301
|
IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
|
|
302
|
DO nmsg = 1 TO ERROR-STATUS:NUM-MESSAGES:
|
|
303
|
MESSAGE "***" ERROR-STATUS:GET-NUMBER(nmsg) ':' ERROR-STATUS:GET-MESSAGE(nmsg).
|
|
304
|
END.
|
|
305
|
END.
|
|
306
|
END.
|