-
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.
|