FWD » Core Development » Base Language

DEFINE TEMP-TABLE tt-1 NO-UNDO

    NAMESPACE-URI "http://goldencode.com/testNamespace5" 

//    NAMESPACE-PREFIX "fwdPrefix1"  

    FIELD a1char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 

    FIELD a1int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'

    FIELD f1char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'

    FIELD f1charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 

    FIELD f1decimal AS DECIMAL FORMAT "->>,>>9.99" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"

    FIELD f1int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 

    FIELD f1int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 

    FIELD f1int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  

    FIELD f1bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'

    INDEX i1dx1 f1char

    INDEX i1dx2 a1char DESC f1char DESC

    INDEX i1dx3 AS UNIQUE f1int 

.

DEFINE TEMP-TABLE tt2 NO-UNDO

    NAMESPACE-URI "http://goldencode.com/testNamespace2"

//    NAMESPACE-PREFIX "fwdPrefix2"

    FIELD a2char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 

    FIELD a2int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'

    FIELD f2char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'

    FIELD f2charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 

    FIELD f2decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"

    FIELD f2int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 

    FIELD f2int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 

    FIELD f2int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  

    FIELD f2bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'

    INDEX i2dx1 f2char

    INDEX i2dx2 a2char DESC f2char DESC

    INDEX i2dx3 AS UNIQUE f2int 

.

DEFINE TEMP-TABLE tt3 NO-UNDO

    NAMESPACE-URI "http://goldencode.com/testNamespace2"

    NAMESPACE-PREFIX "fwdPrefix3"

    FIELD a3char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 

    FIELD a3int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'

    FIELD f3char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'

    FIELD f3charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 

    FIELD f3decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"

    FIELD f3int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 

    FIELD f3int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 

    FIELD f3int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  

    FIELD f3bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'

    INDEX i3dx1 f3char

    INDEX i3dx2 a3char DESC f3char DESC

    INDEX i3dx3 AS UNIQUE f3int 

.

DEFINE TEMP-TABLE tt4 NO-UNDO

    NAMESPACE-URI "http://goldencode.com/testNamespace5"

//    NAMESPACE-PREFIX "fwdPrefix4"

    FIELD a4char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 

    FIELD a4int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'

    FIELD f4char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'

    FIELD f4charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 

    FIELD f4decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"

    FIELD f4int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 

    FIELD f4int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 

    FIELD f4int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  

    FIELD f4bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'

    INDEX i4dx1 f4char

    INDEX i4dx2 a4char DESC f4char DESC

    INDEX i4dx3 AS UNIQUE f4int 

.

DEFINE TEMP-TABLE tt5 NO-UNDO

    NAMESPACE-URI "http://goldencode.com/testNamespace5"

    NAMESPACE-PREFIX "fwdPrefix5"

    FIELD a5char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 

    FIELD a5int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'

    FIELD f5char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'

    FIELD f5charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 

    FIELD f5decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"

    FIELD f5int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 

    FIELD f5int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 

    FIELD f5int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  

    FIELD f5bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'

    INDEX i5dx1 f5char

    INDEX i5dx2 a5char DESC f5char DESC

    INDEX i5dx3 AS UNIQUE f5int 

.

DEFINE DATASET ds

    NAMESPACE-URI "http://goldencode.com/testNamespace" 

    NAMESPACE-PREFIX "fwdPrefix"

    FOR tt-1, tt2, tt3, tt4, tt5

    DATA-RELATION rel12 FOR tt-1, tt2 RELATION-FIELDS(f1int, f2int) NESTED

    DATA-RELATION rel13 FOR tt-1, tt3 RELATION-FIELDS(f1int, f3int) NESTED

    DATA-RELATION rel34 FOR tt3, tt4 RELATION-FIELDS(f3int, f4int) NESTED

    DATA-RELATION rel51 FOR tt5, tt-1 RELATION-FIELDS(f5int, f1int) NESTED

.

DEF VAR dsh AS HANDLE NO-UNDO.

DEF VAR hds AS HANDLE NO-UNDO.

DEF VAR hds1 AS HANDLE NO-UNDO.

DEF VAR hdss AS HANDLE NO-UNDO.

DEF VAR tth1 AS HANDLE NO-UNDO.

DEF VAR tth2 AS HANDLE NO-UNDO.

DEF VAR ttdh AS HANDLE NO-UNDO.

DEF VAR lRet AS LOGICAL NO-UNDO.

DEF VAR nmsg AS INTEGER NO-UNDO.

DEF VAR n AS INTEGER NO-UNDO.

OUTPUT TO 'json-test/json-marshal.txt'.

CREATE tt-1. tt-1.f1char = '1.1111'. tt-1.f1int = 11. tt-1.f1decimal = 3.1465.

CREATE tt-1. tt-1.f1char = '1.2222'. tt-1.f1int = 12. tt-1.f1decimal = 3.1415926.

CREATE tt2. tt2.f2char = '2.1111'. tt2.f2int = 11. tt2.f2decimal = 3.1415.

CREATE tt2. tt2.f2char = '2.2222'. tt2.f2int = 22. tt2.f2decimal = 3.141515926.

CREATE tt3. tt3.f3char = '3.1111'. tt3.f3int = 11. tt3.f3decimal = 3.1415.

CREATE tt3. tt3.f3char = '3.2222'. tt3.f3int = 32. tt3.f3decimal = 3.141515926.

CREATE tt4. tt4.f4char = '4.1111'. tt4.f4int = 11. tt4.f4decimal = 3.1415.

CREATE tt4. tt4.f4char = '4.2222'. tt4.f4int = 42. tt4.f4decimal = 3.141515926.

CREATE tt5. tt5.f5char = '5.1111'. tt5.f5int = 11. tt5.f5decimal = 3.1415.

CREATE tt5. tt5.f5char = '5.2222'. tt5.f5int = 52. tt5.f5decimal = 3.141515926.

DEFINE STREAM xmlschema.

DEFINE STREAM xml.

CREATE DATASET hds.

CREATE DATASET hds1.

CREATE DATASET hdss.

CREATE TEMP-TABLE ttdh.

dsh = DATASET ds:HANDLE. 

tth1 = TEMP-TABLE tt-1:HANDLE. 

tth2 = TEMP-TABLE tt2:HANDLE. 

lRet = tth1:WRITE-JSON('file', 'json-test/tth1.json', TRUE, ?, FALSE, FALSE).

MESSAGE 'tth1:WRITE-JSON' lRet.

lRet = ttdh:READ-JSON('file', 'json-test/tth1.json', 'empty') NO-ERROR.

RUN show-error('ttdh:READ-JSON').

MESSAGE 'ttdh:READ-JSON' lRet.

IF lRet THEN DO:

    lRet = ttdh:WRITE-JSON('file', 'json-test/ttdh.json', TRUE, ?, FALSE, FALSE).

    MESSAGE 'ttdh:WRITE-JSON' lRet.

END.

lRet = dsh:WRITE-JSON('file', 'json-test/ds.json', TRUE, ?, FALSE, FALSE).

MESSAGE 'dsh:WRITE-JSON' lRet.

lRet = hdss:READ-JSON('file', 'json-test/ds.json', 'empty') NO-ERROR.

RUN show-error('hdss:READ-JSON').

MESSAGE 'hdss:READ-JSON' lRet.

lRet = hdss:WRITE-JSON('file', 'json-test/hdss.json', TRUE, ?, FALSE, FALSE).

MESSAGE 'hdss:WRITE-JSON' lRet.

OUTPUT CLOSE.

PROCEDURE show-error:

    DEF INPUT PARAM action AS CHAR.

    MESSAGE "After" action ": error =" ERROR-STATUS:ERROR 

            "num-messages =" ERROR-STATUS:NUM-MESSAGES 

            "type =" ERROR-STATUS:TYPE 

            .

    IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:

        DO nmsg = 1 TO ERROR-STATUS:NUM-MESSAGES:

          MESSAGE "***" ERROR-STATUS:GET-NUMBER(nmsg) ':' ERROR-STATUS:GET-MESSAGE(nmsg).

        END.

    END.                      

END.