|
1
|
DEFINE TEMP-TABLE tt NO-UNDO
|
|
2
|
NAMESPACE-URI "http://goldencode.com/testNamespace"
|
|
3
|
NAMESPACE-PREFIX "fwdPrefix"
|
|
4
|
FIELD achar AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute'
|
|
5
|
FIELD aint AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE 'attribute'
|
|
6
|
FIELD fchar AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
|
|
7
|
FIELD fcharcs AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs"
|
|
8
|
FIELD fcharext AS CHAR EXTENT 8 INITIAL '99ee' CASE-SENSITIVE LABEL "char-ext" XML-NODE-NAME 'extent-node'
|
|
9
|
FIELD fdecimal AS DECIMAL FORMAT "->>,>>9.99" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
|
|
10
|
FIELD fint AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int"
|
|
11
|
FIELD fint1 AS INT INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden'
|
|
12
|
FIELD fint64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'
|
|
13
|
FIELD fbool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
|
|
14
|
FIELD fdate AS DATE INITIAL TODAY LABEL "date"
|
|
15
|
FIELD fdatetime AS DATETIME INITIAL NOW LABEL "datetime"
|
|
16
|
FIELD fdatetime-tz AS DATETIME-TZ INITIAL NOW LABEL "datetime-tz"
|
|
17
|
FIELD fdatetime-tz1 AS DATETIME-TZ INITIAL "10/17/2022 13:47:48.426+03:00" LABEL "datetime-tz1"
|
|
18
|
FIELD fblob AS BLOB LABEL "blob" COLUMN-LABEL "blob-column"
|
|
19
|
FIELD fclob1 AS CLOB LABEL "clob1" TTCODEPAGE XML-NODE-TYPE 'hidden'
|
|
20
|
FIELD fclob2 AS CLOB LABEL "clob2" COLUMN-CODEPAGE 'ibm850'
|
|
21
|
FIELD frecid AS RECID LABEL "recid"
|
|
22
|
FIELD fhandle AS HANDLE LABEL "handle"
|
|
23
|
FIELD fcom-handle AS COM-HANDLE LABEL "com-handle"
|
|
24
|
FIELD fraw AS RAW
|
|
25
|
FIELD frowid AS ROWID
|
|
26
|
FIELD aint1 AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-NODE-TYPE 'attribute'
|
|
27
|
INDEX idx1 fchar
|
|
28
|
INDEX idx2 achar
|
|
29
|
INDEX idx3 AS UNIQUE fint
|
|
30
|
.
|
|
31
|
|
|
32
|
DEF VAR tth AS HANDLE NO-UNDO.
|
|
33
|
DEF VAR hServer AS HANDLE NO-UNDO.
|
|
34
|
DEF VAR lRet AS LOGICAL NO-UNDO.
|
|
35
|
DEF VAR nmsg AS INTEGER NO-UNDO.
|
|
36
|
|
|
37
|
OUTPUT TO 'marshal-test/tt-marshal.txt'.
|
|
38
|
|
|
39
|
CREATE tt. tt.fchar = '1111'. tt.fint = 1.
|
|
40
|
CREATE TT. tt.fchar = '2222'. tt.fint = 2.
|
|
41
|
|
|
42
|
tth = TEMP-TABLE tt:HANDLE.
|
|
43
|
lRet = tth:WRITE-XMLSCHEMA('file', 'marshal-test/tt.xsd', TRUE, 'UTF-8', FALSE, FALSE).
|
|
44
|
MESSAGE 'tth:WRITE-XMLSCHEMA' lRet.
|
|
45
|
lRet = tth:WRITE-XML('file', 'marshal-test/tt.xml', TRUE, 'UTF-8', 'marshal-test/tt.xsd', FALSE, FALSE, ?, FALSE).
|
|
46
|
MESSAGE 'tth:WRITE-XML' lRet.
|
|
47
|
|
|
48
|
|
|
49
|
/*hServer = SESSION.*/
|
|
50
|
|
|
51
|
CREATE SERVER hServer.
|
|
52
|
lRet = hServer:CONNECT("-AppService ias -H localhost -S 5162") NO-ERROR.
|
|
53
|
RUN show-error("CONNECT").
|
|
54
|
MESSAGE "Connecting? " lRet VIEW-AS ALERT-BOX.
|
|
55
|
IF lRet THEN
|
|
56
|
DO:
|
|
57
|
tth:SCHEMA-MARSHAL = 'FULL'.
|
|
58
|
MESSAGE 'tth:SCHEMA-MARSHAL' tth:SCHEMA-MARSHAL.
|
|
59
|
//RUN accept(tth, tth:SCHEMA-MARSHAL) NO-ERROR.
|
|
60
|
RUN tt-marshal-accept.p ON hServer(INPUT tth, INPUT tth:SCHEMA-MARSHAL) NO-ERROR.
|
|
61
|
RUN show-error('after RPC-FULL').
|
|
62
|
|
|
63
|
tth:SCHEMA-MARSHAL = 'MIN'.
|
|
64
|
MESSAGE 'tth:SCHEMA-MARSHAL' tth:SCHEMA-MARSHAL.
|
|
65
|
//RUN accept(tth, tth:SCHEMA-MARSHAL) NO-ERROR.
|
|
66
|
RUN tt-marshal-accept.p ON hServer(INPUT tth, INPUT tth:SCHEMA-MARSHAL) NO-ERROR.
|
|
67
|
RUN show-error('after RPC-MIN').
|
|
68
|
|
|
69
|
tth:SCHEMA-MARSHAL = 'NONE'.
|
|
70
|
MESSAGE 'tth:SCHEMA-MARSHAL' tth:SCHEMA-MARSHAL.
|
|
71
|
//RUN accept(tth, tth:SCHEMA-MARSHAL) NO-ERROR.
|
|
72
|
RUN tt-marshal-accept.p ON hServer(INPUT tth, INPUT tth:SCHEMA-MARSHAL) NO-ERROR.
|
|
73
|
RUN show-error('after RPC-NONE').
|
|
74
|
|
|
75
|
hServer:DISCONNECT().
|
|
76
|
END.
|
|
77
|
|
|
78
|
|
|
79
|
DELETE OBJECT hServer.
|
|
80
|
OUTPUT CLOSE.
|
|
81
|
|
|
82
|
PROCEDURE show-error:
|
|
83
|
DEF INPUT PARAM action AS CHAR.
|
|
84
|
|
|
85
|
MESSAGE "After" action ": error =" ERROR-STATUS:ERROR
|
|
86
|
"num-messages =" ERROR-STATUS:NUM-MESSAGES
|
|
87
|
"type =" ERROR-STATUS:TYPE
|
|
88
|
.
|
|
89
|
IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
|
|
90
|
DO nmsg = 1 TO ERROR-STATUS:NUM-MESSAGES:
|
|
91
|
MESSAGE "***" ERROR-STATUS:GET-NUMBER(nmsg) ':' ERROR-STATUS:GET-MESSAGE(nmsg).
|
|
92
|
END.
|
|
93
|
END.
|
|
94
|
END.
|