Re: Read a XML document in COBOL


Richard wrote:

Test program

IDENTIFICATION DIVISION.
PROGRAM-ID. xmltest.

* xmltest.lst
* xmlparse.cbl
* \az\xmltest.dta
*

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.

INPUT-OUTPUT SECTION.
FILE-CONTROL.

SELECT XML-File
ASSIGN XML-Name
ORGANIZATION LINE SEQUENTIAL
FILE STATUS File-Status
.

DATA DIVISION.
FILE SECTION.

FD XML-File.

01 XML-Record.
03 XMLC PIC X OCCURS 256.

WORKING-STORAGE SECTION.

01 XML-Name PIC X(80).
01 File-Status.
03 FS-B1 PIC X.
03 FS-B2 PIC X.

01 DA-Index PIC S9(4).
01 DA-Limit PIC S9(4).
01 DA-Found PIC S9(4).

01 XML-Data-Array.
03 DA-Item OCCURS 100.
05 DA-Level PIC 99.
05 DA-Name PIC X(20).
05 DA-Attribute PIC X(20).
05 DA-Repeats PIC X.
05 DA-Value PIC X(100).

01 Work-Text.
03 Work-Level.
05 Work-LevelZ PIC ZZZ9.
03 Work-Name PIC X(20).
03 Work-Repeat PIC X(8).

01 FILLER.
05 FILLER PIC X(32) VALUE
'WORKING-STORAGE FOR XMLTEST >>>:'.
05 WK-EOF-SW PIC X.
05 WK-TAG PIC X(21).
05 TAG-TABLE.
10 FILLER PIC X(21) VALUE 'Start tag:'.
10 FILLER PIC X(21) VALUE 'End tag:'.
10 FILLER PIC X(21) VALUE 'Attribute-Value pair:'.
10 FILLER PIC X(21) VALUE 'Character data:'.
10 FILLER PIC X(21) VALUE 'End-of-document'.
10 FILLER PIC X(21) VALUE 'Parsing error.'.
10 FILLER PIC X(21) VALUE 'Unknown return code 7'.
10 FILLER PIC X(21) VALUE 'Unknown return code 8'.
10 FILLER PIC X(21) VALUE 'Unknown return code 9'.
05 FILLER REDEFINES TAG-TABLE.
10 TAG-X PIC X(21) OCCURS 9 TIMES.

01 File-Parameter PIC X(80).
01 WS-XML-Name PIC X(80).
01 WS-Control-Name PIC X(80).

01 Tag-Level PIC 9(4).
01 White PIC S9(4) COMP.
01 I PIC S9(4) COMP.

COPY "xmlparse.ws". *> \az\include\xmlparse.ws

01 XML-Element-Name-xxx PIC X(20).
01 XML-Attribute-Name-xxx PIC X(15).
01 XML-Data-Value-xxx PIC X(60).

PROCEDURE DIVISION.
Program-XMLTest.

MOVE SPACES TO XML-Data-Array
MOVE ZERO TO DA-Index
DA-Limit

MOVE SPACES TO WS-XML-Name
WS-Control-Name

* ACCEPT File-Parameter FROM COMMAND-LINE
DISPLAY "FileName ControlName: "
ACCEPT File-Parameter
UNSTRING File-Parameter
DELIMITED BY ALL SPACES
INTO WS-XML-Name
WS-Control-Name

IF ( WS-Control-Name NOT = SPACES )
PERFORM Read-Control
END-IF

MOVE WS-XML-Name TO XML-Name

MOVE 20000 TO XML-Occurs
MOVE ALL ZEROES TO XML-Reserved
MOVE SPACES TO XML-Parsed-Area
XML-Document
MOVE ZERO TO XML-Return-Code
MOVE 1 TO XML-Length

MOVE '0' TO WK-EoF-Sw
OPEN INPUT XML-File
IF ( FS-B1 NOT = ZERO )
DISPLAY "File Failed: " File-Status
MOVE '1' TO WK-EOF-SW
END-IF

PERFORM
UNTIL WK-EoF-Sw = "1"

READ XML-File
AT END
MOVE '1' TO WK-EOF-SW
NOT AT END

* DISPLAY XML-Record

IF ( XML-Record = SPACES )
CONTINUE
ELSE
MOVE 1 TO White
PERFORM
VARYING I FROM 1 BY 1
UNTIL I > 256
OR XML-Length >= XML-Occurs

IF ( XMLC(I) = SPACE
AND White = 1
)
CONTINUE
ELSE
MOVE XMLC(I)
TO
XML-Document-X(XML-Length)
ADD 1 TO XML-Length
END-IF
IF ( XMLC(I) = SPACE )
MOVE 1 TO White
ELSE
MOVE ZERO TO White
END-IF
END-PERFORM
END-IF
END-READ
END-PERFORM
CLOSE XML-File

* DISPLAY XML-Document
* DISPLAY "Length = " XML-Length
MOVE ZERO TO Tag-Level

PERFORM Get-XML-Item
UNTIL XML-Return-Code > 4

MOVE ZERO TO Return-Code

STOP RUN
.

Get-XML-Item.

FJON * CALL 'XMLPARSE'
FJOFF CALL 'xmlparse'
USING XML-Interface
XML-Document

MOVE XML-Element-Name TO XML-Element-Name-xxx
MOVE XML-Attribute-Name TO XML-Attribute-Name-xxx
MOVE XML-Data-Value TO XML-Data-Value-xxx
MOVE TAG-X(XML-Return-Code) TO WK-Tag

MOVE ZERO TO DA-Found
EVALUATE XML-Return-Code
WHEN 1 ADD 1 TO Tag-Level
WHEN 2 SUBTRACT 1 FROM Tag-Level
WHEN 3 PERFORM Find-Data-Table
WHEN 4 MOVE "CDATA" TO XML-Attribute-Name-xxx
PERFORM Find-Data-Table
END-EVALUATE

IF ( DA-Found > ZERO )
PERFORM Display-Data-Found
END-IF
.

Display-Data-Found.

* DISPLAY WK-Tag
DISPLAY Tag-Level
'/' XML-Element-Name-xxx
'/' XML-Attribute-Name-xxx
'/' XML-Data-Value-xxx
.

Read-Control.

MOVE WS-Control-Name TO XML-Name
MOVE '0' TO WK-EoF-Sw
OPEN INPUT XML-File
IF ( FS-B1 NOT = ZERO )
DISPLAY "File Failed: " File-Status
MOVE '1' TO WK-EOF-SW
END-IF

PERFORM
UNTIL WK-EoF-Sw = "1"

READ XML-File
AT END
MOVE '1' TO WK-EOF-SW
NOT AT END

* DISPLAY XML-Record

MOVE SPACES TO Work-Text
IF ( XML-Record = SPACES )
CONTINUE
ELSE
IF ( XML-Record(1:1) = "+" )
PERFORM Add-Attribute

ELSE
UNSTRING XML-Record
DELIMITED BY ","
INTO Work-Level
Work-Name
Work-Repeat
ADD 1 TO DA-Limit
MOVE Work-LevelZ TO DA-Level (DA-Limit)
MOVE Work-Name TO DA-Name (DA-Limit)
MOVE SPACES TO DA-Attribute(DA-Limit)
MOVE Work-Repeat TO DA-Repeats (DA-Limit)
MOVE SPACES TO DA-Value (DA-Limit)
END-IF
END-IF
END-READ
END-PERFORM
CLOSE XML-File
MOVE '0' TO WK-EoF-Sw

* PERFORM Display-Data-Table
.

Add-Attribute.

IF ( DA-Limit < 1 )
CONTINUE
ELSE
IF ( DA-Attribute(DA-Limit) NOT = SPACES )
MOVE DA-Limit TO DA-Index
ADD 1 TO DA-Limit
MOVE DA-Level (DA-Index) TO DA-Level (DA-Limit)
MOVE DA-Name (DA-Index) TO DA-Name (DA-Limit)
MOVE DA-Repeats(DA-Index) TO DA-Repeats(DA-Limit)
MOVE SPACES TO DA-Value (DA-Limit)
END-IF
MOVE XML-Record(2:) TO DA-Attribute(DA-Limit)
END-IF
.

Display-Data-Table.

PERFORM
VARYING DA-Index FROM 1 BY 1
UNTIL DA-Index > DA-Limit

DISPLAY DA-Level (DA-Index)
DA-Name (DA-Index)
DA-Attribute(DA-Index)
DA-Repeats (DA-Index)

END-PERFORM
.

Find-Data-Table.

MOVE ZERO TO DA-Found
PERFORM
VARYING DA-Index FROM 1 BY 1
UNTIL DA-Index > DA-Limit
OR DA-Found NOT = ZERO

IF ( XML-Element-Name-xxx = DA-Name (DA-Index)
AND XML-Attribute-Name-xxx = DA-Attribute(DA-Index)
)
MOVE DA-Index TO DA-Found
END-IF
END-PERFORM
.

* ================================================================

.

Relevant Pages

  • Displaying XML-File in Webbrowser Control
    ... I have just created a Word document, saved it as XML-file. ... Now I have created a WebBrowser-Control and would like to use it to ... display the file, but how? ...
    (microsoft.public.dotnet.languages.csharp)
  • Re: Drawing from XML or EMF
    ... The perfect solution would be if there was a tool that allowed me to display the information from an xml-file that was exported from visio. ...
    (comp.soft-sys.matlab)