XML for RPG and Procedural Languages Documentation

Readme
Installation
API Docs
Samples
Programming
License

COBOL: DOMCount

The Code: qcbllesrc.DOMCount

    The lines of code that correspond to XML parser initialization, use and clean-up are displayed in blue.

       PROCESS NOMONOPRC.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DOMCOUNT.
       AUTHOR. IBM.


       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
        SPECIAL-NAMES.

      * bring in the procedure linkages to xml
        COPY QXML4PRLNK.
      * following needs to be added to terminate linkages
        LINKAGE PROCEDURE FOR "XMLNULL".
       DATA DIVISION.
       WORKING-STORAGE SECTION.
      * bring in the apis,type and constant declarations
         COPY XML4PR400.

       01 ibmid.
          05 FILLER PIC X(30) VALUE "Copyright IBM Corporation 2001".
          05 FILLER PIC X(17) VALUE "LICENSED MATERIAL".
          05 FILLER PIC X(23) VALUE "PROGRAM PROPERTY OF IBM".

      * true/false constants
       01 trueValue PIC S9(9) usage binary VALUE 1.
       01 falseValue PIC S9(9) USAGE binary VALUE 0.

      * pointer for nodelist handle
       01 nodelist TYPE QXMLHANDLE-PTR.
      * pointer for parser handle
       01 parser TYPE QXMLHANDLE-PTR.
      * pointer for document handle
       01 document TYPE QXMLHANDLE-PTR.

      * xml file name integers
       01 COUNTVAL PIC S9(9).
       01 charcount pic s9(9) usage binary.
      * array integer
       01 indx     PIC S9(9).
      * element integer
       01 ElementCount PIC S9(9) USAGE BINARY.
      *
      * PARSER VALIDATION FLAG
      * Validation input parameter for call to parser
      *
        01 ValScheme  PIC S9(9) USAGE BINARY.
      *
      * namespace input parameter for call to parser
      *
        01 doNameSpace PIC S9(9) usage binary.
      *
      *  schema processing for parser call
      *
        01 doSchema PIC S9(9) usage binary.
      *
      * full schema constraint checking for parser call
      *
        01 schemaFullChecking PIC S9(9) usage binary.
      *
      * XML FILE NAME STORAGE
      *
       01 XMLFILE.
          05 XMLCHARS OCCURS 256 TIMES PIC X.
      * SPECIFICATION OF * FOR GET ELEMENTBY - ALONG WITH ASSOC DATA
      *
       01 INPUTSIZE PIC S9(9) usage binary VALUE 1.
       01 NODEVALUE PIC X(1) VALUE "*".
       01 STRINGIND PIC S9(9) USAGE BINARY VALUE 0.
      * USAGE ERROR MESSAGE DATA LINES
      *
       01 usage-msg.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(8) VALUE "Usage:".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(25) VALUE "   DOMCount [-v -n -s -f]".
          05 FILLER PIC X(10) VALUE "{XML FILE}".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(44)  VALUE "This program invokes the DOM parse
      -    "r, builds".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(52) VALUE "the DOM tree, and then prints the n
      -    "umber of elements".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(28) VALUE "found in the input XML file.".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(08) VALUE "Options:".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(12) VALUE "          -v".
          05 FILLER PIC X(25) VALUE "=[always | never | auto*]".
          05 FILLER PIC X(28) VALUE " Do validation in this parse".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(29) VALUE " * = default if not speicifed".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(12) VALUE "          -n".
          05 FILLER PIC X(29) VALUE " Enable namespace processing.".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(17) VALUE " Defaults to off.".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(12) VALUE "          -s".
          05 FILLER PIC X(26) VALUE " Enable schema processing.".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(17) VALUE " Defaults to off.".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(12) VALUE "          -f".
          05 FILLER PIC X(31) VALUE " Enable full schema constraint ".
          05 FILLER PIC X(9) VALUE "checking.".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(17) VALUE " Defaults to off.".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(1) VALUE X"00".
        01 Init-Error-Line.
          05 FILLER PIC X(1) VALUE X"15".
          05 GENERAL PIC X(29) VALUE "Error during Initialization!:".
          05 FILLER PIC X(1) VALUE X"00".
        01 unknown-v-value.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(16) VALUE "Unknown -v value".
          05 FILLER PIC X(1) VALUE X"00".
        01 unknown-option.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(16) VALUE "Unknown option: ".
          05 FILLER PIC X(1) VALUE X"00".
        01 Parse-Prob.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(22) VALUE "Error during parsing".
          05 FILLER PIC X(1) VALUE X"00".
        01 Error-occur.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(22) VALUE "Error occured . . . : ".
          05 FILLER PIC X(1) VALUE X"00".
        01 Line-number.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(31) VALUE "Line number . . . . . . . .  : ".
          05 FILLER PIC X(1) VALUE X"00".
        01 Column-number.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(31) VALUE "Column number . . . . . . .  : ".
          05 FILLER PIC X(1) VALUE X"00".
        01 Source-file.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(31) VALUE "At source file  . . . . . .  : ".
          05 FILLER PIC X(1) VALUE X"00".
        01 Parsing-file.
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(31) VALUE "While parsing XML file . . . : ".
          05 FILLER PIC X(1) VALUE X"00".
        01 colon-space.
          05 FILLER PIC X(2) VALUE ": ".
          05 FILLER PIC X(1) VALUE X"00".

        01 elements.
          05 FILLER PIC X(10) VALUE " elements ".
          05 FILLER PIC X(1) VALUE X"15".
          05 FILLER PIC X(1) VALUE X"00".

        01 arguments.
          05 arg occurs 5 times pic x(256).
        LINKAGE SECTION.
        77 arg1 PIC x(256).
        77 arg2 PIC X(256).
        77 arg3 PIC X(256).
        77 arg4 PIC X(256).
        77 arg5 PIC X(256).

        PROCEDURE DIVISION USING arg1, arg2, arg3, arg4, arg5.
        MAINLINE.
      *
      * Linkage section doesn't allow arrays, so we'll set it here.
            IF ADDRESS OF arg1  NOT = NULL
               MOVE arg1 TO arg (1).
            IF ADDRESS OF arg2  NOT = NULL
               MOVE arg2 TO arg (2).
            IF ADDRESS OF arg3  NOT = NULL
               MOVE arg3 TO arg (3).
            IF ADDRESS OF arg4  NOT = NULL
               MOVE arg4 TO arg (4).
            IF ADDRESS OF arg5  NOT = NULL
               MOVE arg5 TO arg (5).
      *  Check the input parameters - if usage message output
      *    control not returned
      *
      *  Expecting parameters - if none passed - output usage message
      *   (control is not returned)
            IF ADDRESS OF arg1 = NULL
              PERFORM OUTPUT-USAGE-MESSAGE.
          ENDIF.
      *
      * Initialize validation parameter for parser call
      *  - default is no validation
      *
           MOVE Qxml_AUTO_VALIDATE TO ValScheme.
      *
      * Initialize name space processing for parser call
      *  - default is no name space processing
            MOVE QxmlNONAMESPACE TO doNameSpace.

      *
      * Initialize schema processing for parser call
      *  - default is no schema processing
            MOVE falseValue TO doSchema.

      *
      * Initialize full schema constraint checking for parser call
      *  - default is no full schema constraint checking
            MOVE falseValue TO schemaFullChecking.

      *
      * Copy in the first parameter to determine if control
      *    options have been specified

            UNSTRING arg1 DELIMITED BY " "
              INTO XMLfile COUNT IN Charcount.
            IF XMLfile(1:2) = "-?"
              PERFORM OUTPUT-USAGE-MESSAGE.
      *
      * Loop thru the options till we get the XML file.
      *
               MOVE 1 TO indx.
               PERFORM UNTIL indx = 5 OR XMLChars(1) NOT = "-"
                     IF XMLfile(1 : 2) = "-n" OR XMLfile(1 : 2) = "-N"
                        MOVE 1 TO doNameSpace
                     ELSE
                         IF XMLfile (1 : 2) = "-v" OR
                            XMLfile (1 : 2) = "-V"
                            IF XMLfile (4 : 5) = "never"
                               MOVE Qxml_NEVER_VALIDATE TO ValScheme
                            ELSE
                               IF XMLfile (4 : 6) = "always"
                                 MOVE Qxml_ALWAYS_VALIDATE TO
                                      ValScheme
                               ELSE
                                 IF XMLfile (4 : 4) = "auto"
                                    MOVE Qxml_AUTO_VALIDATE TO
                                      ValScheme
                                 ELSE
      *                             unknown -v value
                                    CALL PROCEDURE "QxmlGenPrint"
                                       USING BY REFERENCE
                                       unknown-v-value, BY VALUE 0
                                    STOP RUN
                                 END-IF
                               END-IF
                            END-IF
                         ELSE
                            IF XMLfile (1 : 2) = "-s" OR
                            XMLfile (1 : 2) = "-S"
                                MOVE trueValue TO doSchema
                            ELSE
                               IF XMLfile (1 : 2) = "-f" OR
                               XMLfile (1 : 2) = "-F"
                                   MOVE trueValue TO schemaFullChecking
                               ELSE
      *                           unknown option
                                  CALL PROCEDURE "QxmlGenPrint"
                                  USING BY REFERENCE
                                  unknown-option, BY VALUE 0
      *                           null terminate invalid option
                                  MOVE X"00" TO
                                   XMLchars(Charcount + 1)
                                  CALL PROCEDURE "QxmlGenPrint"
                                     USING BY REFERENCE
                                    xmlfile(1 : Charcount), BY VALUE 0
                                  STOP RUN
                               END-IF
                            END-IF
                         END-IF
                     END-IF
      *   read next argument.
                  ADD 1 TO indx
                  UNSTRING arg (indx) DELIMITED BY " "
                     INTO  XMLfile COUNT IN Charcount
               END-PERFORM.
      *
      *
      *  Input parameters have been validated - XMLfile
      *  contains the name of the file to process
      *
      *  Need to null terminate the file name for the
      *  parser call ( have the last character position stored
      *  in Charcount
      *
             MOVE X"00" TO XMLchars(Charcount + 1).
      *
      *  Initialize to run XML APIs
      *
            CALL PROCEDURE "QxmlInit" USING QXMLXML_ENV_T.
      *
      * verify that the initialization worked.
      *
            IF QXML_RETURN_VALUE > 0
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
               init-error-line, BY VALUE 0
               STOP RUN
            END-IF.
      *
      *
      *  Everything is set up to start dealing with the XML
      *   APIs - create an instance of the parser to be used
      *
      *
           CALL PROCEDURE  "QxmlDOMParser_new"
             USING BY REFERENCE QXML_PARSER_ENV_T,
             RETURNING parser.
      *
      *   Set the validation option for this instance of the parser
      *
           CALL PROCEDURE "QxmlDOMParser_setValidationScheme" USING
             BY VALUE parser, BY VALUE ValScheme.
      *
      *  Set the name space option for this instance of the parser
      *
            CALL procedure "QxmlDOMParser_setDoNamespaces" USING
     -        BY VALUE parser, BY VALUE doNameSpace.
      *
      *  Set the schema processing for this instance of the parser
      *
            CALL procedure "QxmlDOMParser_setDoSchema" USING
     -        BY VALUE parser, BY VALUE doSchema.
      *
      *  Set the schema validation checking for this instance of the parser
      *
            CALL procedure
     -        "QxmlDOMParser_setValidationSchemaFullChecking"
     -        USING BY VALUE parser, BY VALUE schemaFullChecking.
      *
      *   Parse the XML file
      *
            MOVE 0 TO QXML_ERRORTYPE.
            MOVE 0 TO QXML_RETURN_VALUE.
            CALL PROCEDURE "QxmlDOMParser_parse_SystemId" USING BY VALUE
               parser, BY REFERENCE XMLfile, BY VALUE Qxml_CCSID37,
               BY VALUE Charcount

            IF QXML_RETURN_VALUE IS NOT EQUAL Qxml_DOMNOERROR
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 parse-prob, BY VALUE 0
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 QXML_RESERVE, BY VALUE 0
            END-IF.

            IF QXML_ERRORTYPE IS NOT EQUAL Qxml_NOERROR
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 Error-occur, BY VALUE 0
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 QXML_ERRMSG, BY VALUE 0
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 Line-number, BY VALUE 0
      *  To make life easy copy the count returned to a zoned
      *  storage area for easy outputing to screen
      *
              MOVE QXML_LINE_NUMBER to countval
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 countval, BY VALUE 9
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 Column-number, BY VALUE 0
              MOVE QXML_COLNUMBER to countval
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 countval, BY VALUE 9
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 Source-file, BY VALUE 0
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 QXML_DATASRC, BY VALUE 0
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 Parsing-file, BY VALUE 0
              CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
                 xmlfile, BY VALUE 0
            END-IF.

            IF QXML_RETURN_VALUE IS NOT ZERO OR
               QXML_ERRORTYPE IS NOT ZERO
              CALL PROCEDURE "QxmlDOMParser_delete" USING
    -             BY VALUE parser
              CALL PROCEDURE "QxmlTerm"
              STOP RUN
            END-IF.
      *
      *  EXTRACT THE DOM TREE, GET THE LIST OF ALL THE ELEMENTS AND
      *  REPORT THE LENGTH AS THE COUNT OF ELEMENTS.
      *
      *
           CALL "QxmlDOMParser_getDocument" USING BY VALUE parser,
     -        RETURNING document.
      *
      * build the node list and get it returned
      *
           CALL PROCEDURE "QxmlDOM_Document_getElementsByTagName"
     -        USING BY VALUE document, BY REFERENCE nodevalue,
     -        BY VALUE Qxml_CCSID37, BY VALUE inputsize, RETURNING
     -         nodelist.
      *
      * determine the number of elements in the nodelist just returned
      *
           CALL PROCEDURE "QxmlDOM_NodeList_getLength" USING
     -      BY VALUE nodelist RETURNING elementCount.
      *
      *   Output the name of the file
      *
           CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE Xmlfile,
             BY VALUE 0.
           CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE colon-space
            , BY VALUE 0.
      *  To make life easy copy the count returned to a zoned
      *  storage area for easy outputing to screen
      *
           MOVE elementCount to countval.
      *
      *   output the count to the user
      *
           CALL PROCEDURE "QxmlGenPrint"  USING BY REFERENCE
             countval, BY VALUE 9.
      *
      *
      *   output elements string
      *
           CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
             elements, BY VALUE 0.
      *
      *
      * CLEAN UP.
           CALL PROCEDURE "QxmlDOMParser_delete" USING
    -        BY VALUE document.
           CALL PROCEDURE "QxmlDOMParser_delete" USING
    -        BY VALUE parser.
           CALL PROCEDURE "QxmlDOMParser_delete" USING
    -        BY VALUE Nodelist.
           CALL PROCEDURE "QxmlTerm".

           STOP RUN.

      *
      *
      *  usage procedure
      *

          output-usage-message.

           CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
    -           usage-msg, BY VALUE 0
           STOP RUN.

       END PROGRAM DOMCOUNT.

	

XML4PR - XML4C Interface Wrapper for RPG, C and COBOL
Copyright 2000,2001,2002 International Business Machines. All Rights Reserved.