Парсер XML на Cobol

******************************************************************
* This program parses INPUT DATA using standart XML parser AND   *
* RETURNS parsed DATA back TO calling PROCESS                    *
******************************************************************
 IDENTIFICATION DIVISION.
  PROGRAM-ID.             MYPROG1.
  AUTHOR.                 My NAME
  DATE-WRITTEN.           Current DATE
 DATA DIVISION.
*----------------------------------------------------------------*
* DECLARE variables AND structures                               *
*----------------------------------------------------------------*
  WORKING-STORAGE SECTION.
   01 XML-LENGTH                    PIC S9(4) COMP.
   01 XML-CONTENT                   PIC X(31988).
   01 XML-TYPE                      PIC X(30).
   01 TAGS-ARRAY.
    02 CURRENT-TAG                  PIC X(50) OCCURS 2 TIMES.
   01 CURRENT-LEVEL                 PIC S9(4) COMP.
   01 TEMP-STR                      PIC X(20800) VALUE SPACES.
   01 TEMP-STR-POS                  PIC 99999  VALUE 1.
   01 TEMP-EXT-DES                  PIC X(03).
   01 TEMP-LAN-COD                  PIC X(02).
 
  LINKAGE SECTION.
*----------------------------------------------------------------*
* The LINKAGE SECTION describes DATA made available FROM another *
* program OR method                                              *
*----------------------------------------------------------------*
* INPUT XML document structure:                                  *
*----------------------------------------------------------------*
   01 INPUT-DATA.
     02 XML-DOC                     PIC X(32000).
*----------------------------------------------------------------*
* Ouput DATA that will be sent TO calling program:               *
*----------------------------------------------------------------*
   01 OUTPUT-DATA.
    02 XML-DATA                     PIC X(300).
*----------------------------------------------------------------*
* Structure FOR parsed XML DATA :                                *
*----------------------------------------------------------------*
    02 parsedXMLdata                REDEFINES XML-DATA.
     03 field1                      PIC X(100).
     03 field2                      PIC X(100).
     03 field3                      PIC X(100).
 
 PROCEDURE DIVISION USING IMS-TRIGGER OUTPUT-DATA.
*----------------------------------------------------------------*
* MAIN PROCEDURE:                                                *
*----------------------------------------------------------------*
  MAINLINE SECTION.
* INIT parameters                                                *
     MOVE SPACES TO OUTPUT-DATA
     MOVE SPACES TO TAGS-ARRAY
     MOVE 0 TO CURRENT-LEVEL
     MOVE XML-DOC OF IMS-TRIGGER TO XML-CONTENT
* Parse XML-CONTENT using standart COBOL parser                  *
     XML PARSE XML-CONTENT PROCESSING PROCEDURE XML-HANDLER
     END-XML
* RETURN back TO the calling program                             *
     GOBACK.
 
*----------------------------------------------------------------*
* XML-HANDLER PROCEDURE:                                         *
*----------------------------------------------------------------*
  XML-HANDLER SECTION.
     EVALUATE XML-EVENT
* PROCESS START-OF-ELEMENT event                                 *
       WHEN 'START-OF-ELEMENT'
* Increment CURRENT-LEVEL BY 1                                   *
         COMPUTE CURRENT-LEVEL = CURRENT-LEVEL + 1
* IF current level is less than 3                                *
         IF CURRENT-LEVEL < 3 THEN
* Store uppercased XML element value                             *
           MOVE FUNCTION UPPER-CASE(XML-TEXT)
             TO CURRENT-TAG(CURRENT-LEVEL)
         END-IF
* IF the first level is processed                                *
         IF CURRENT-LEVEL = 1 THEN
* SET DEFAULT value TO TEMP-STR-POS variable                     *
           MOVE 1 TO TEMP-STR-POS
* Fill TEMP-STR variable with blanks                             *
           MOVE SPACES TO TEMP-STR
* Store tag NAME                                                 *
           MOVE CURRENT-TAG(1) TO XML-TYPE
         END-IF
* PROCESS CONTENT-CHARACTERS event                               *
       WHEN 'CONTENT-CHARACTERS'
* CALL PROCEDURE TAGS-PROCESSING TO PROCESS XML DATA             *
         PERFORM TAGS-PROCESSING
* PROCESS END-OF-ELEMEN event                                    *
       WHEN 'END-OF-ELEMENT'
* IF current level is less than 3                                *
         IF CURRENT-LEVEL < 3 THEN
* Fill CURRENT-TAG(CURRENT-LEVEL) with blanks                    *
           MOVE SPACES TO CURRENT-TAG(CURRENT-LEVEL)
         END-IF
* Decrement CURRENT-LEVEL BY 1                                   *
         COMPUTE CURRENT-LEVEL = CURRENT-LEVEL - 1
* PROCESS END-OF-DOCUMENT evend                                  *
       WHEN 'END-OF-DOCUMENT'
* PROCESS EXCEPTION event                                        *
       WHEN 'EXCEPTION'
         IF XML-CODE >= 50 AND XML-CODE <= 99 THEN
           MOVE 0 TO XML-CODE
         END-IF
         IF XML-CODE >= 100001 AND XML-CODE <= 165535 THEN
           COMPUTE XML-CODE = XML-CODE - 100000
         END-IF
         IF XML-CODE >= 200001 AND XML-CODE <= 265535 THEN
           COMPUTE XML-CODE = XML-CODE - 200000
         END-IF
     END-EVALUATE
     .
*----------------------------------------------------------------*
* PROCESS XML tags                                               *
*----------------------------------------------------------------*
  TAGS-PROCESSING SECTION.
     IF CURRENT-LEVEL = 2 THEN
       EVALUATE XML-TYPE
*----------------------------------------------------------------*
* PARSE FOR "parsedXMLdatata"                                   *
*----------------------------------------------------------------*
         WHEN 'REQUEST'
           EVALUATE CURRENT-TAG(CURRENT-LEVEL)
             WHEN 'FIELD1'
               MOVE FUNCTION UPPER-CASE(XML-TEXT) TO
               field1               OF parsedXMLdata
             WHEN 'FIELD2'
               MOVE FUNCTION UPPER-CASE(XML-TEXT) TO
               field2               OF parsedXMLdata
             WHEN 'FIELD3'
               MOVE FUNCTION UPPER-CASE(XML-TEXT) TO
               field3               OF parsedXMLdata
           END-EVALUATE
       END-EVALUATE
     END-IF
     .