Re: Read a XML document in COBOL


olivierdeman@xxxxxxxxx wrote:

I'm trying to read an XML document (see at the end of the page) in
COBOL (I'm using PerCobol). First I tried to read it doing this:

perform until einde = 1
display "|||"lijn"|||"
UNSTRING lijn DELIMITED BY '>' INTO
root

END-UNSTRING
MOVE root(2:2) TO rootTemp
UNSTRING root DELIMITED BY '<' INTO
vuller,element

END-UNSTRING

It's no where near as easy as that. You need to use a proper parser.
Given it is PerCobol you should be able to use a Java parser. However
if you want to do it in Cobol you may like to start with one that I
pulled off the net and tidied up a bit:

IDENTIFICATION DIVISION.
PROGRAM-ID. xmlparse.

* xmlparse.LST
* \xml\xml.cbl

*AUTHOR. Miami-Dade Community College.
*DATE-WRITTEN. July, 2000.
*DATE-COMPILED.
*REMARKS.
*
* LAST CHANGE: 09/12/00 12:02:24 SAHWC
*
* This program will parse any valid XML document into its
* component parts.
*

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.

DATA DIVISION.
FILE SECTION.

WORKING-STORAGE SECTION.

01 FILLER.
05 FILLER PIC X(32) VALUE
'WORKING-STORAGE FOR XMLPARSE>>>:'.
05 Wk-Index PIC S9(9) COMP SYNC.
05 Wk-Index-1 PIC S9(9) COMP SYNC.
05 Wk-Index-2 PIC S9(9) COMP SYNC.
05 Wk-Start-Index PIC S9(9) COMP SYNC.
05 Wk-Seq-Nbr PIC S9(9) COMP SYNC.
05 Ending-Ptr PIC S9(9) COMP SYNC.
05 Base-Ptr PIC S9(9) COMP SYNC.
05 Wk-Length PIC S9(4) COMP SYNC.
05 Entity-Length PIC S9(4) COMP SYNC.
05 Result PIC 9.
05 Wk-Find-Char PIC X.
05 Skip-White-Space-Check PIC X.
05 Wk-Entity PIC X(6).
05 FILLER REDEFINES Wk-Entity.
10 Wk-Entity-X PIC X OCCURS 6 TIMES.
05 Wk-Markup-Character PIC X.
05 Attr-Name PIC X(50).
05 Elem-Name PIC X(50).
05 Data-Value PIC X(1010).
05 FILLER REDEFINES Data-Value.
10 Data-Value-X PIC X OCCURS 1010 TIMES.
05 Name-Value PIC X(1000).
05 FILLER REDEFINES Name-Value.
10 Name-Value-X PIC X OCCURS 1000 TIMES.
05 FILLER REDEFINES Name-Value.
10 FILLER PIC X(5).
88 Name-Value-Start-With-CData
VALUE 'CDATA'.
05 Wk-End-of-Msg-Switch PIC X.
88 Wk-End-of-Msg VALUE '1'.
05 Wk-Found-Switch PIC X.
88 Wk-Found VALUE '1'.
05 Wk-Parsing-Error-Switch PIC X.
88 Wk-Parsing-Error VALUE '1'.

01 ToUpper.
03 Char-Comp PIC 9(4) COMP SYNC.
03 FILLER REDEFINES Char-Comp.
05 FILLER PIC X.
05 Char-X PIC X.

01 FILLER.
* ASCII values
05 LEFT-BRACKET PIC X VALUE "<".
05 RITE-BRACKET PIC X VALUE ">".
05 VALUE-TAB PIC X VALUE x"09".
05 VALUE-LF PIC X VALUE x"0A".
05 VALUE-CR PIC X VALUE x"0D".
05 VALUE-QUOTE PIC X VALUE QUOTE.

05 FILLER PIC S9(4) VALUE ZERO COMP SYNC.

05 TTL-Acceptable-Chars PIC S9(4) VALUE 66 COMP SYNC.
05 TTL-Acceptable-First-Chars
PIC S9(4) VALUE 53 COMP SYNC.

05 Acceptable-Chars PIC X(66) VALUE

'_ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz012
- '3456789-.:'.
05 FILLER REDEFINES Acceptable-Chars.
10 Acceptable-Chars-X PIC X OCCURS 66 TIMES.

05 TTL-Entity-Reference PIC S9(4) VALUE 5 COMP SYNC.
05 Entity-Reference.
10 FILLER PIC X(7) VALUE '&gt; >'.
10 FILLER PIC X(7) VALUE '&lt; <'.
10 FILLER PIC X(7) VALUE '&amp; &'.
10 FILLER.
15 FILLER PIC X(6) VALUE '&apos;'.
15 FILLER PIC X VALUE QUOTE.
10 FILLER PIC X(7) VALUE '&quot;"'.
05 FILLER REDEFINES Entity-Reference.
10 FILLER OCCURS 5 TIMES.
15 Entity-Reference-X PIC X(6).
15 Markup-Character PIC X.

05 Result-Table.
10 FILLER PIC X(3) VALUE '1 '.
10 FILLER PIC X(3) VALUE '1 '.
10 FILLER PIC X(3) VALUE '111'.
10 FILLER PIC X(3) VALUE '1 1'.
10 FILLER PIC X(3) VALUE ' '.
10 FILLER PIC X(3) VALUE ' '.
10 FILLER PIC X(3) VALUE '111'.
10 FILLER PIC X(3) VALUE '111'.
10 FILLER PIC X(3) VALUE '111'.
05 FILLER REDEFINES Result-Table.
10 FILLER OCCURS 9 TIMES.
15 FILLER PIC X.
88 Elem-Name-Required VALUE '1'.
15 FILLER PIC X.
88 Attr-Name-Required VALUE '1'.
15 FILLER PIC X.
88 Data-Value-Required VALUE '1'.

LINKAGE SECTION.

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

PROCEDURE DIVISION USING XML-Interface
XML-Document
.
Program-XMLParse.

MOVE '0' TO Wk-End-of-Msg-Switch
Wk-Parsing-Error-Switch

IF ( XML-Reserved = ZEROES )
MOVE ZERO TO Char-Ptr
Wk-Seq-Nbr
MOVE 00 TO State
MOVE 6 TO Result
END-IF

PERFORM Main-Rtn
UNTIL Wk-End-of-Msg
OR Wk-Parsing-Error

IF ( Wk-Parsing-Error )
PERFORM Parsed-Data-Rtn
PERFORM Parsed-Error-Rtn
END-IF

MOVE ZERO TO RETURN-CODE
.

EXIT PROGRAM
.

Main-Rtn.

ADD 1 TO Char-Ptr

IF ( State > 00 AND < 07 )
PERFORM Parsed-Data-Rtn
END-IF
.

IF ( Char-Ptr > XML-Length
)
MOVE '1' TO Wk-End-of-Msg-Switch
PERFORM Parsed-Data-Rtn
ELSE

EVALUATE State
WHEN ZERO
PERFORM Skip-White-Space-Rtn
IF ( XML-Document-X(Char-Ptr) = '<' )
MOVE 07 TO State
ELSE
MOVE 33 TO State
SUBTRACT 1 FROM Char-Ptr
END-IF

WHEN 1
PERFORM Skip-White-Space-Rtn
IF ( XML-Document-X(Char-Ptr) = '/' )
MOVE 21 TO State
ELSE
IF ( XML-Document-X(Char-Ptr) = '>' )
MOVE 00 TO State
ELSE
PERFORM Find-Valid-First-Name-Rtn
IF ( Wk-Found )
MOVE Char-Ptr TO Base-Ptr
MOVE 27 TO State
ELSE
MOVE '1' TO Wk-Parsing-Error-Switch
END-IF
END-IF
END-IF

WHEN 2
WHEN 3
WHEN 4
WHEN 5
WHEN 6
CONTINUE

WHEN 7
PERFORM Skip-White-Space-Rtn
IF ( XML-Document-X(Char-Ptr) = '/' )
MOVE 25 TO State
ELSE
IF ( XML-Document-X(Char-Ptr) = '?' )
MOVE 22 TO State
ELSE
IF ( XML-Document-X(Char-Ptr) = '!' )
MOVE 08 TO State
ELSE
PERFORM Find-Valid-First-Name-Rtn
IF ( Wk-Found )
MOVE Char-Ptr TO Base-Ptr
MOVE 20 TO State
ELSE
MOVE '1' TO Wk-Parsing-Error-Switch
END-IF
END-IF
END-IF
END-IF

WHEN 8
IF ( XML-Document-X(Char-Ptr) = '-' )
MOVE 09 TO State
ELSE
IF ( XML-Document-X(Char-Ptr) = LEFT-BRACKET )
MOVE 14 TO State
ELSE
MOVE '1' TO Wk-Parsing-Error-Switch
END-IF
END-IF

WHEN 9
IF ( XML-Document-X(Char-Ptr) = '-' )
MOVE 10 TO State
ELSE
MOVE '1' TO Wk-Parsing-Error-Switch
END-IF

WHEN 10
MOVE '-' TO Wk-Find-Char
PERFORM Find-This-Character-Rtn
IF ( Wk-Found )
MOVE 12 TO State
END-IF

WHEN 11
CONTINUE

WHEN 12
IF ( XML-Document-X(Char-Ptr) = '-' )
MOVE 13 TO State
ELSE
MOVE 10 TO State
END-IF

WHEN 13
IF ( XML-Document-X(Char-Ptr) = '>' )
MOVE 00 TO State
ELSE
MOVE 10 TO State
END-IF

WHEN 14
MOVE Char-Ptr TO Base-Ptr
PERFORM Find-Valid-Name-Rtn
IF ( Name-Value-Start-With-CData )
MOVE 15 TO State
END-IF
SUBTRACT 1 FROM Char-Ptr

WHEN 15
IF ( XML-Document-X(Char-Ptr) = LEFT-BRACKET )
MOVE 16 TO State
END-IF
COMPUTE Base-Ptr = Char-Ptr + 1

WHEN 16
MOVE RITE-BRACKET TO Wk-Find-Char
PERFORM Find-This-Character-Rtn
IF ( Wk-Found )
MOVE 18 TO State
END-IF

WHEN 17
CONTINUE

WHEN 18
IF ( XML-Document-X(Char-Ptr) = RITE-BRACKET )
MOVE 19 TO State
ELSE
MOVE 16 TO State
END-IF

WHEN 19
MOVE '>' TO Wk-Find-Char
PERFORM Find-This-Character-Rtn
IF ( Wk-Found )
MOVE 02 TO State
ELSE
MOVE 16 TO State
END-IF

WHEN 20
PERFORM Find-Valid-Name-Rtn
MOVE Name-Value TO Elem-Name
MOVE 01 TO State
SUBTRACT 1 FROM Char-Ptr

WHEN 21
PERFORM Skip-White-Space-Rtn
IF ( XML-Document-X(Char-Ptr) = '>' )
MOVE 03 TO State
END-IF

WHEN 22
MOVE '?' TO Wk-Find-Char
PERFORM Find-This-Character-Rtn
IF ( Wk-Found )
MOVE 24 TO State
END-IF

WHEN 23
CONTINUE

WHEN 24
IF ( XML-Document-X(Char-Ptr) = '>' )
MOVE 00 TO State
END-IF

WHEN 25
PERFORM Find-Valid-First-Name-Rtn
IF ( Wk-Found )
MOVE Char-Ptr TO Base-Ptr
MOVE 26 TO State
ELSE
MOVE '1' TO Wk-Parsing-Error-Switch
END-IF

WHEN 26
PERFORM Find-Valid-Name-Rtn
MOVE Name-Value TO Elem-Name
PERFORM Skip-White-Space-Rtn
IF ( XML-Document-X(Char-Ptr) = '>' )
MOVE 05 TO State
END-IF

WHEN 27
PERFORM Find-Valid-Name-Rtn
MOVE Name-Value TO Attr-Name
PERFORM Skip-White-Space-Rtn
IF ( XML-Document-X(Char-Ptr) = '=' )
MOVE 28 TO State
END-IF

WHEN 28
PERFORM Skip-White-Space-Rtn
IF ( XML-Document-X(Char-Ptr) = VALUE-QUOTE )
MOVE 29 TO State
ELSE
IF ( XML-Document-X(Char-Ptr) = '"' )
MOVE 31 TO State
ELSE
MOVE '1' TO Wk-Parsing-Error-Switch
END-IF
END-IF
COMPUTE Base-Ptr = Char-Ptr + 1

WHEN 29
MOVE VALUE-QUOTE TO Wk-Find-Char
PERFORM Find-This-Character-Rtn
IF ( Wk-Found )
MOVE 04 TO State
END-IF

WHEN 30
CONTINUE

WHEN 31
MOVE '"' TO Wk-Find-Char
PERFORM Find-This-Character-Rtn
IF ( Wk-Found )
MOVE 04 TO State
END-IF

WHEN 32
CONTINUE

WHEN 33
PERFORM Process-33

WHEN OTHER
MOVE '1' TO Wk-Parsing-Error-Switch

END-EVALUATE
END-IF
.

Process-33.

MOVE Char-Ptr TO Base-Ptr
MOVE '<' TO Wk-Find-Char
PERFORM Find-This-Character-Rtn
IF ( Wk-Found )
MOVE 06 TO State
END-IF
SUBTRACT 1 FROM Char-Ptr
.

Parsed-Data-Rtn.

IF ( Wk-Parsing-Error )
MOVE 6 TO Result
ELSE
IF ( Wk-End-of-Msg )
MOVE 5 TO Result
ELSE
IF ( State = 01 )
MOVE Elem-Name TO Save-Elem-Name
MOVE 1 TO Result
ELSE
IF ( State = 02 )
MOVE Save-Elem-Name TO Elem-Name
COMPUTE Ending-Ptr = Char-Ptr - 3
PERFORM GET-Data-Value-RTN
MOVE 00 TO State
MOVE 4 TO Result
ELSE
IF ( State = 03 )
MOVE Save-Elem-Name TO Elem-Name
MOVE 00 TO State
MOVE 2 TO Result
ELSE
IF ( State = 04 )
MOVE Save-Elem-Name TO Elem-Name
COMPUTE Ending-Ptr = Char-Ptr - 1
PERFORM GET-Data-Value-RTN
MOVE ZERO TO Wk-Index-1
PERFORM Entity-Reference-RTN
VARYING Wk-Index FROM 1 BY 1
UNTIL Wk-Index > 1000
MOVE 01 TO State
MOVE 3 TO Result
ELSE
IF ( State = 05 )
MOVE 00 TO State
MOVE 2 TO Result
ELSE
IF ( State = 06 )
MOVE Save-Elem-Name TO Elem-Name
MOVE Char-Ptr TO Ending-Ptr
PERFORM GET-Data-Value-RTN
MOVE ZERO TO Wk-Index-1
PERFORM Entity-Reference-RTN
VARYING Wk-Index FROM 1 BY 1
UNTIL Wk-Index > 1000

MOVE 00 TO State
MOVE 4 TO Result
END-IF
END-IF
END-IF
END-IF
END-IF
END-IF
END-IF
END-IF

ADD 1 TO Wk-Seq-Nbr

IF ( Wk-Seq-Nbr > Save-Index )
MOVE '1' TO Wk-End-of-Msg-Switch
MOVE Wk-Seq-Nbr TO Save-Index

MOVE SPACES TO XML-Parsed-Area
MOVE Result TO XML-RETURN-CODE
IF ( Elem-Name-Required(Result) )
MOVE Elem-Name TO XML-Element-Name
END-IF
IF ( Attr-Name-Required(Result) )
MOVE Attr-Name TO XML-Attribute-Name
END-IF
IF ( Data-Value-Required(Result) )
MOVE Data-Value TO XML-Data-Value
END-IF
END-IF
.

Skip-White-Space-Rtn.

IF ( Char-Ptr NOT > XML-Length )
MOVE XML-Document-X(Char-Ptr) TO Skip-White-Space-Check
IF ( Skip-White-Space-Check = SPACES
OR VALUE-TAB
OR VALUE-LF
OR VALUE-CR
)
ADD 1 TO Char-Ptr
END-IF
END-IF
.

Find-This-Character-Rtn.

MOVE '0' TO Wk-Found-Switch
PERFORM
UNTIL Char-Ptr > XML-Length
OR Wk-Found

IF ( XML-Document-X(Char-Ptr) = Wk-Find-Char )
MOVE '1' TO Wk-Found-Switch
ELSE
ADD 1 TO Char-Ptr
END-IF
END-PERFORM
.

Find-Valid-First-Name-Rtn.

MOVE '0' TO Wk-Found-Switch
PERFORM SEARCH-FOR-CHAR-RTN
VARYING Wk-Index FROM 1 BY 1
UNTIL Wk-Index > TTL-Acceptable-First-Chars
OR Wk-Found
.

SEARCH-FOR-CHAR-RTN.

IF ( XML-Document-X(Char-Ptr)
= Acceptable-Chars-X(Wk-Index) )
MOVE '1' TO Wk-Found-Switch
END-IF
.

Find-Valid-Name-Rtn.

MOVE '1' TO Wk-Found-Switch
PERFORM
UNTIL Char-Ptr > XML-Length
OR NOT Wk-Found

MOVE '0' TO Wk-Found-Switch
PERFORM SEARCH-FOR-CHAR-RTN
VARYING Wk-Index FROM 1 BY 1
UNTIL Wk-Index > TTL-Acceptable-Chars
OR Wk-Found
IF ( Wk-Found )
ADD 1 TO Char-Ptr
END-IF
END-PERFORM

MOVE ZERO TO Char-Comp
MOVE ZERO TO Wk-Index-1
MOVE SPACES TO Name-Value
PERFORM MOVE-Name-Value-RTN
VARYING Wk-Index FROM Base-Ptr BY 1
UNTIL Wk-Index = Char-Ptr
.

MOVE-Name-Value-RTN.

ADD 1 TO Wk-Index-1
MOVE XML-Document-X(Wk-Index)
TO Char-X
IF ( Char-X >= 'a' AND <= 'z' )
SUBTRACT 32 FROM Char-Comp
END-IF
MOVE Char-X TO Name-Value-X(Wk-Index-1)
.

GET-Data-Value-RTN.

MOVE SPACES TO Data-Value
MOVE ZERO TO Wk-Index-1
PERFORM MOVE-Data-Value-RTN
VARYING Wk-Index FROM Base-Ptr BY 1
UNTIL Wk-Index = Ending-Ptr

MOVE '0' TO Wk-Found-Switch
PERFORM REMOVE-Data-Value-RTN
VARYING Wk-Index FROM Wk-Index-1 BY -1
UNTIL Wk-Index < 1
OR Wk-Found

MOVE '0' TO Wk-Found-Switch
MOVE ZERO TO Wk-Length
PERFORM COUNT-LEADING-SPACES-RTN
VARYING Wk-Index FROM 1 BY 1
UNTIL Wk-Index > 1000
OR Data-Value = SPACES
OR Wk-Found

IF ( Wk-Length > ZERO )
PERFORM REMOVE-LEADING-SPACES-RTN
VARYING Wk-Index FROM 1 BY 1
UNTIL Wk-Index > 1010
END-IF
.

MOVE-Data-Value-RTN.

ADD 1 TO Wk-Index-1
MOVE XML-Document-X(Wk-Index) TO Data-Value-X(Wk-Index-1)
.

REMOVE-Data-Value-RTN.

MOVE Data-Value-X(Wk-Index) TO Skip-White-Space-Check
IF ( Skip-White-Space-Check = SPACES
OR VALUE-TAB
OR VALUE-LF
OR VALUE-CR
)
MOVE SPACES TO Data-Value-X(Wk-Index)
ELSE
MOVE '1' TO Wk-Found-Switch
END-IF
.

COUNT-LEADING-SPACES-RTN.

IF ( Data-Value-X(Wk-Index) = SPACES )
ADD 1 TO Wk-Length
ELSE
MOVE '1' TO Wk-Found-Switch
END-IF
.

REMOVE-LEADING-SPACES-RTN.

ADD 1 TO Wk-Length
MOVE Data-Value-X(Wk-Length)
TO Data-Value-X(Wk-Index)
MOVE SPACES TO Data-Value-X(Wk-Length)
.

Entity-Reference-RTN.

IF ( Data-Value-X(Wk-Index) = '&' )
MOVE '0' TO Wk-Found-Switch
MOVE SPACES TO Wk-Entity
MOVE 1 TO Entity-Length
MOVE Wk-Index TO Wk-Index-1
PERFORM FIND-Markup-Character-RTN
6 TIMES

IF ( Wk-Found )
MOVE '0' TO Wk-Found-Switch
MOVE SPACES TO Wk-Markup-Character
PERFORM MATCH-ENTITY-RTN
VARYING Wk-Index-1 FROM 1 BY 1
UNTIL Wk-Index-1 > TTL-Entity-Reference
OR Wk-Found
END-IF
IF ( Wk-Found )
MOVE Wk-Markup-Character TO Data-Value-X(Wk-Index)
COMPUTE Wk-Start-Index = Wk-Index + 1
PERFORM MOVE-Data-Value-UP-RTN
VARYING Wk-Index-1 FROM Wk-Start-Index BY 1
UNTIL Wk-Index-1 > 1100
END-IF
END-IF
.

FIND-Markup-Character-RTN.

IF ( Wk-Index-1 < 1000 )
IF NOT ( Wk-Found )
MOVE Data-Value-X(Wk-Index-1)
TO Wk-Entity-X(Entity-Length)
END-IF
IF ( Data-Value-X(Wk-Index-1) = ';' )
MOVE '1' TO Wk-Found-Switch
ELSE
ADD 1 TO Wk-Index-1
Entity-Length
END-IF
END-IF
.

MATCH-ENTITY-RTN.

IF ( Wk-Entity = Entity-Reference-X(Wk-Index-1) )
MOVE Markup-Character(Wk-Index-1)
TO Wk-Markup-Character
MOVE '1' TO Wk-Found-Switch
END-IF
.

MOVE-Data-Value-UP-RTN.

COMPUTE Wk-Index-2 = Wk-Index-1 + Entity-Length - 1
MOVE Data-Value-X(Wk-Index-2)
TO Data-Value-X(Wk-Index-1)
.

Parsed-Error-Rtn.

DISPLAY '**************************************************'
DISPLAY '************ ERROR IN PGM XMLPARSE *************'
DISPLAY '**************************************************'
DISPLAY 'Result: ' Result
DISPLAY 'Seq-Nbr: ' Wk-Seq-Nbr
DISPLAY 'State: ' State
DISPLAY 'Char-Ptr: ' Char-Ptr
DISPLAY 'Base-Ptr: ' Base-Ptr
DISPLAY 'Elem-Name: ' Elem-Name
DISPLAY 'Save-Elem-Name: ' Save-Elem-Name
DISPLAY 'Attr-Name: ' Attr-Name
DISPLAY 'Data-Value: ' Data-Value
DISPLAY 'Name-Value: ' Name-Value
DISPLAY 'Save-Index: ' Save-Index
DISPLAY 'XML-Document-X(Char-Ptr): '
XML-Document-X(Char-Ptr)
DISPLAY 'XML-Return-Code: ' XML-Return-Code
DISPLAY 'XML-Element-Name: ' XML-Element-Name
DISPLAY 'XML-Attribute-Name: ' XML-Attribute-Name
DISPLAY 'XML-Data-Value: ' XML-Data-Value
.

*
================================================================
* end of source
* ================================================================

.