-
Readme
-
Installation
-
API Docs
-
Samples
-
Programming
-
License
|
COBOL: SAXCount and SAXCounter
The Code: qcbllesrc.SAXCount
The lines of code that correspond to XML parser initialization, use and clean-up are displayed in blue.
Process nomonoprc.
Identification division.
Program-id. SAXCOUNT.
Author. IBM.
************************************************************
* SAXCount -- This sample program uses the SAX parser and
* counts the number of elements and attributes in an XML
* document. The xml file to be counted is input by the user.
************************************************************
Environment Division.
Configuration Section.
Special-Names.
*
* API identification for linkages to API wrappers
*
COPY QXML4PRLNK.
LINKAGE PROCEDURE FOR "QXMLNULL"
local-data is local-data-area.
Input-Output Section.
File-Control.
Data Division.
*
*
*
Working-Storage Section.
*
* Bring in handle definition, structures and constants for XML
*
COPY XML4PR400.
* true/false constants
01 trueValue PIC S9(9) usage binary VALUE 1.
01 falseValue PIC S9(9) USAGE binary VALUE 0.
*
* Storage for file name
*
01 XMLfile.
05 XMLChars OCCURS 256 TIMES PIC X.
*
* Position counter for setting null terminator
*
01 Charcount PIC S9(9) USAGE BINARY.
*
* index array, name space & validation schema indicator
*
01 indx PIC S9(9) usage binary.
01 doNameSpace PIC S9(9) usage binary.
01 valScheme PIC S9(9) usage binary.
01 unRepFlags PIC S9(9) usage binary.
01 doSchema PIC S9(9) usage binary.
01 schemaFullChecking PIC S9(9) usage binary.
01 XMLtempString PIC X(50).
01 doCreate PIC S9(9) usage binary.
01 nodetype PIC S9(9) usage binary.
*
* Storage for handles
*
01 XMLNODEARRAY.
05 XMLNODE OCCURS 100000 TIMES USAGE POINTER.
*
* Position counter for setting null terminator
*
01 CurrentNodePosition PIC S9(9) USAGE BINARY.
*
* Object handle pointers
*
01 parser TYPE QXMLHANDLE-PTR.
01 DocHandler TYPE QXMLHANDLE-PTR.
01 ErrHandler TYPE QXMLHANDLE-PTR.
*
* 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 " SAXCount [-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 prints the number ofe
- "elements,".
05 FILLER PIC X(1) VALUE X"15".
05 FILLER PIC X(52) VALUE "attributes, white spaces and othern
- " non-white spaces".
05 FILLER PIC X(1) VALUE X"18".
05 FILLER PIC X(52) VALUE "in the input 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 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 erroroccurred.
05 FILLER PIC X VALUE x"15".
05 FILLER PIC X(15) VALUE "Error occurred ".
05 newline PIC X VALUE x"15".
05 FILLER PIC X VALUE x"00".
01 elementtext.
05 FILLER PIC X(10) VALUE " Elements ".
05 FILLER PIC X VALUE x"15".
05 FILLER PIC X VALUE x"00".
01 attrtext.
05 FILLER PIC X(12) VALUE " Attributes ".
05 FILLER PIC X VALUE x"15".
05 FILLER PIC X VALUE x"00".
01 chartext.
05 FILLER PIC X(12) VALUE " Characters ".
05 FILLER PIC X VALUE x"15".
05 FILLER PIC X VALUE x"00".
01 spacetext.
05 FILLER PIC X(8) VALUE " Spaces ".
05 FILLER PIC X VALUE x"15".
05 FILLER PIC X VALUE x"00".
01 local-data.
05 fELementCount PIC S9(9) usage binary.
05 fAttrCount PIc s9(9) usage binary.
05 fCharacterCount PIC s9(9) usage binary.
05 fSpaceCount PIC S9(9) usage binary.
05 errorind PIC S9(9) usage binary.
01 callbackpgm usage is procedure-pointer.
01 countval PIC S9(9).
01 arguments.
05 arg occurs 5 times pic x(256).
Linkage Section.
01 arg1 PIC x(256).
01 arg2 PIC x(256).
01 arg3 PIC x(256).
01 arg4 PIC x(256).
01 arg5 PIC x(256).
Procedure Division using arg1, arg2, arg3, arg4, arg5.
Mainline.
*
* Initialize to run XML APIs
*
CALL PROCEDURE "QxmlInit" USING QXMLXML_ENV_T.
*
* 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
*
IF ADDRESS OF arg1 = NULL
PERFORM OUTPUT-USAGE-MESSAGE.
*
* Copy in the first parameter to determine if control
* options have been specified
*
UNSTRING arg (1) DELIMITED BY " "
INTO XMLfile COUNT IN Charcount.
IF XMLfile(1:2) = "-?"
PERFORM OUTPUT-USAGE-MESSAGE.
*
* Initialize validation parameter for parser call
* - default is validation
*
MOVE Qxml_AUTO_VALIDATE TO valScheme.
*
* Initialize name space processing for parser call
* - default is no name space processing
MOVE 0 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.
*
* Loop thru the options till we get the XML file.
*
MOVE 1 TO indx.
PERFORM UNTIL indx = 3 OR XMLChars(1) NOT = "-"
IF XMLChars(1) = "-"
IF XMLChars(2) = "n" OR XMLChars(2) = "N"
MOVE 1 TO doNameSpace
ELSE
IF XMLfile = "-v=never"
MOVE Qxml_NEVER_VALIDATE TO valScheme
ELSE
IF XMLfile = "-v=always"
MOVE Qxml_ALWAYS_VALIDATE TO valScheme
ELSE
IF XMLfile = "-v=auto"
MOVE Qxml_AUTO_VALIDATE TO valScheme
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
STOP RUN
END-IF
END-IF
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-IF
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 parse
* call (have the last character position stored
* in Charcount
*
*
MOVE X"00" TO XMLchars(Charcount + 1).
*
*
* Every thing is set up to start dealing with the
* SAX APIs
*
*
CALL procedure "QxmlSAXParser_new" RETURNING
- parser.
*
*
* Set the validation option for this instance of the parser
*
CALL procedure "QxmlSAXParser_setValidationScheme" USING
- BY VALUE parser, BY VALUE valScheme.
*
*
* Set the name space option for this instance of the parser
*
CALL procedure "QxmlSAXParser_setDoNamespaces" USING
- BY VALUE parser, BY VALUE doNameSpace.
*
* Set the schema processing for this instance of the parser
*
CALL procedure "QxmlSAXParser_setDoSchema" USING
- BY VALUE parser, BY VALUE doSchema.
*
* Set the schema validation checking for this instance of the parser
*
CALL procedure
- "QxmlSAXParser_setValidationSchemaFullChecking"
- USING BY VALUE parser, BY VALUE schemaFullChecking.
*
* Create our SAX handler object and install it on the parser
* as the document and error handler.
*
* First create the default handles for document and errors
*
CALL procedure "QxmlDocumentHandler_new" RETURNING
DocHandler.
CALL procedure "QxmlErrorHandler_new" RETURNING
ErrHandler.
*
* Register the handlers into the SAXParser
*
CALL procedure "QxmlSAXParser_setDocumentHandler"
- USING BY VALUE parser, BY VALUE
- DocHandler.
CALL procedure "QxmlSAXParser_setErrorHandler"
- USING BY VALUE parser, BY VALUE
- ErrHandler.
SET callbackpgm to ENTRY "SAXCOUNTER".
CALL PROCEDURE "Qxml_COBOL_DocumentHandler_setCallback"
using BY VALUE DocHandler,
Qxml_STARTELEMENT, callbackpgm.
CALL PROCEDURE "Qxml_COBOL_DocumentHandler_setCallback"
using BY VALUE DocHandler,
Qxml_IGNORABLEWHSP, callbackpgm.
CALL PROCEDURE "Qxml_COBOL_DocumentHandler_setCallback"
using BY VALUE DocHandler,
Qxml_STARTDOCUMENT, callbackpgm.
CALL PROCEDURE "Qxml_COBOL_DocumentHandler_setCallback"
using BY VALUE DocHandler,
Qxml_RESETDOCUMENT, callbackpgm.
CALL PROCEDURE "Qxml_COBOL_DocumentHandler_setCallback"
using BY VALUE DocHandler,
Qxml_CHARACTERS, callbackpgm.
CALL PROCEDURE "Qxml_COBOL_ErrorHandler_setCallback"
using BY VALUE ErrHandler,
Qxml_WARNINGHNDLR, callbackpgm.
CALL PROCEDURE "Qxml_COBOL_ErrorHandler_setCallback"
using BY VALUE ErrHandler,
Qxml_ERRORHNDLR, callbackpgm.
CALL PROCEDURE "Qxml_COBOL_ErrorHandler_setCallback"
using BY VALUE ErrHandler,
Qxml_FATALERRORHNDLR, callbackpgm.
*
* Invoke the parser
*
CALL PROCEDURE
"QxmlSAXParser_parse_SystemId" USING BY VALUE
parser, BY REFERENCE xmlFile, BY VALUE Qxml_CCSID37,
BY VALUE 0
IF QXML_RETURN_VALUE NOT EQUAL 0
STOP RUN.
ACCEPT local-data FROM local-data-area
IF errorind = 1
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
erroroccurred , BY VALUE 0.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
newline, BY VALUE 0.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
XMLFILE , BY VALUE 0.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
newline, BY VALUE 0.
MOVE fElementCount TO countval.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
countval, BY VALUE 0.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
elementtext, BY VALUE 0.
MOVE fAttrCount TO countval.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
countval, BY VALUE 0.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
attrtext, BY VALUE 0.
MOVE fCharacterCount TO countval.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
countval , BY VALUE 0.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
chartext BY VALUE 0.
MOVE fSpaceCount TO countval.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
countval, BY VALUE 0.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
spacetext, BY VALUE 0.
CALL PROCEDURE "QxmlDocumentHandler_delete"
USING BY VALUE dochandler.
CALL PROCEDURE "QxmlErrorHandler_delete"
USING BY VALUE errhandler.
CALL PROCEDURE "QxmlSAXParser_delete"
USING BY VALUE parser.
CALL PROCEDURE "QxmlTerm"
STOP RUN.
*
output-usage-message.
CALL procedure "QxmlGenPrint" USING BY REFERENCE
usage-msg, by value 0
STOP RUN.
The Code: qcbllesrc.SAXCounter
The lines of code that correspond to XML parser initialization, use and clean-up are displayed in blue.
Process nomonoprc.
Identification division.
Program-id. SAXCOUNTER.
Author. IBM.
************************************************************
* SAXCOUNTER - Contains the callback programs for SAXCOUNT to
* count the number of elements and attributes in an XML
* document.
************************************************************
Environment Division.
Configuration Section.
SPECIAL-NAMES.
*
* API identification for linkages to API wrappers
*
COPY QXML4PRLNK.
LINKAGE PROCEDURE FOR "QXMLNULL"
local-data is local-data-area.
*
*
Data Division.
Working-Storage Section.
*
* Bring in typedef for handle,constants, and XML structures
*
COPY XML4PR400.
01 local-data.
05 fELementCount PIC S9(9) usage binary.
05 fAttrCount PIc s9(9) usage binary.
05 fCharacterCount PIC s9(9) usage binary.
05 fSpaceCount PIC S9(9) usage binary.
05 errorind PIC S9(9) usage binary.
01 errormsg.
05 FILLER pic x(1) value x"15".
05 FILLER pic x(11) value "Error at (".
05 FILLER PIC X(1) VALUE X"00".
01 fatalerrormsg.
05 FILLER PIC X(1) value X"15".
05 FILLER PIC X(16) value "Fatal Error at (".
05 FILLER PIC X(1) VALUE X"00".
01 warningmsg.
05 FILLER PIC X(1) value X"15".
05 FILLER PIC X(12) value "Warning at (".
05 FILLER PIC X(1) VALUE X"00".
01 unknownmsg.
05 FILLER PIC X(1) value X"15".
05 FILLER PIC X(20) VALUE "unknown type passed".
05 FILLER PIC x(1) value X"00".
01 xmlFileprint.
05 FILLER PIC X(9) value "XML file ".
05 FILLER PIC X(1) value x"00".
01 lineline.
05 FILLER PIC x(7) value ", line ".
05 FILLER PIC X(1) value x"00".
01 charline.
05 FILER PIC X(7) value ", char ".
05 FILLER PIC x(1) value x"00".
01 printtermination.
05 FILLER PIC x(3) value "): ".
05 FILLER PIC x(2) value x"1500".
01 OUTPUTSTRING.
05 OUTPUTSTRINGC PIC X OCCURS 300.
01 avail pic s9(9) usage binary.
01 linenumber pic s9(9) usage binary.
01 columnnumber pic s9(9) usage binary.
01 linenumberprint pic s9(9).
01 columnnumberprint pic s9(9).
01 bytesprovided pic s9(9) usage binary value 300.
01 sizeattr pic s9(9) usage binary.
01 SystemId usage pointer.
01 xmlchpointer usage pointer.
01 printdata usage pointer.
01 rtnmessage usage pointer.
Linkage Section.
* type of call
01 callbacktype pic s9(9) usage binary.
* first parameter can be eiher an object handle for SAXParseexc
* for warning,error or fatalerror callback
* or a pointer to unicode character string for character
* end element, ignorablewhitespace, processing instruction or
* start element
01 arg2.
05 names usage pointer.
05 target redefines names usage pointer.
05 exception1 redefines names usage pointer.
05 resolvepublicid redefines names usage pointer.
05 prefix redefines names usage pointer.
05 chars redefines names usage pointer.
05 uri redefines names usage pointer.
* pointer for this parameter for processingInstruction or set
* documentlocator or start element
01 arg3.
05 publicid usage pointer.
05 attributes redefines publicid usage pointer.
05 number1 redefines publicid pic s9(9) binary.
05 resolvesystemid redefines publicid usage pointer.
05 lengthval redefines publicid pic s9(9) binary.
05 localname redefines publicid usage pointer.
05 data1 redefines publicid usage pointer.
*
01 arg4.
05 systemId1 usage pointer.
05 inputsource redefines systemId1 usage pointer.
05 qname redefines systemId1 usage pointer.
*
01 arg5.
05 notationName usage pointer.
05 attr_hndl redefines notationName usage pointer.
Procedure Division using callbacktype, arg2, arg3, arg4, arg5.
Mainline.
* decode the function type - need to do this to differentiate
* multiple callbacks that are part of this one program
*
ACCEPT local-data FROM local-data-area
IF callbacktype = Qxml_STARTELEMENT
PERFORM startElement
ELSE
IF callbacktype = Qxml_CHARACTERS
PERFORM charactersum
ELSE
IF callbacktype = Qxml_IGNORABLEWHSP
PERFORM ignorableWhitespace
ELSE
IF callbacktype = Qxml_RESETDOCUMENT
PERFORM resetDocument
ELSE
IF callbacktype = Qxml_ERRORHNDLR
PERFORM erroroutput
ELSE
IF callbacktype = Qxml_FATALERRORHNDLR
PERFORM fatalErroroutput
ELSE
IF callbacktype = Qxml_WARNINGHNDLR
PERFORM warningoutput
ELSE
IF callbacktype =
Qxml_STARTDOCUMENT
PERFORM startDocument
ELSE
PERFORM unknown.
DISPLAY local-data UPON local-data-area.
EXIT PROGRAM.
*
* individual handling routines
*
startElement.
ADD 1 TO fElementCount
CALL PROCEDURE "QxmlAttributeList_getLength" USING BY
REFERENCE attributes RETURNING sizeattr
ADD sizeattr to fAttrCount.
charactersum.
ADD lengthval TO fCharacterCount.
ignorableWhitespace.
ADD lengthval TO fSpaceCount.
resetDocument.
MOVE 0 to fAttrCount
MOVE 0 to fCharacterCount
MOVE 0 to fElementCount
Move 0 to fSpaceCount.
Move 0 to errorind.
startDocument.
MOVE 0 to fAttrCount
MOVE 0 to fCharacterCount
MOVE 0 to fElementCount
Move 0 to fSpaceCount.
Move 0 to errorind.
erroroutput.
move 1 to errorind
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
errormsg, BY VALUE 0
PERFORM print_the_rest.
fatalerroroutput.
Move 1 to errorind
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
fatalerrormsg, BY VALUE 0
PERFORM print_the_rest.
warningoutput.
Move 1 to errorind
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
warningmsg, BY VALUE 0
PERFORM print_the_rest.
unknown.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
unknownmsg, BY VALUE 0.
print_the_rest.
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
xmlFileprint, BY VALUE 0
CALL PROCEDURE "QxmlSAXParseException_getSystemId"
USING BY REFERENCE names RETURNING Systemid
SET printdata to Systemid
PERFORM convert_and_print
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
lineline, BY VALUE 0
CALL PROCEDURE "QxmlSAXParseException_getLineNumber"
USING BY REFERENCE names RETURNING LineNumber
MOVE LineNumber TO lineNumberPrint
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
lineNumberPrint, BY VALUE 0
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
charline, BY VALUE 0
CALL PROCEDURE "QxmlSAXParseException_getColumnNumber"
USING BY REFERENCE names RETURNING columnNumber
MOVE columnNumber TO columnNumberPrint
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
columnNumberPrint, BY VALUE 0
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
printtermination, BY VALUE 0
CALL PROCEDURE "QxmlSAXException_getMessage"
USING BY REFERENCE names RETURNING rtnmessage
SET printdata to rtnmessage
PERFORM convert_and_print
convert_and_print.
CALL Procedure "QxmlTranscode" USING BY VALUE
printdata, BY VALUE Qxml_UNICODE,
BY REFERENCE outputstring,
BY REFERENCE bytesprovided,
BY REFERENCE avail, BY VALUE 0
IF avail <300
MOVE x"00" to OUTPUTSTRINGC(AVAIL + 1)
ELSE
MOVE x"00" to OUTPUTSTRINGC(300)
CALL PROCEDURE "QxmlGenPrint" USING BY REFERENCE
outputstring, BY VALUE 0.
END PROGRAM SAXCOUNTER.
|