* * (C) Copyright IBM Corp. 2000 All rights reserved. * * US Government Users Restricted Rights Use, duplication or * disclosure restricted by GSA ADP Schedule Contract with IBM Corp. * * The program is provided "as is" without any warranty express or * implied, including the warranty of non-infringement and the implied * warranties of merchantibility and fitness for a particular purpose. * IBM will not be liable for any damages suffered by you as a result * of using the Program. In no event will IBM be liable for any * special, indirect or consequential damages or lost profits even if * IBM has been advised of the possibility of their occurrence. IBM * will not be liable for any third party claims against you. * ==================================================================== * NOTE, there are some code page assumptions in this file that might * not reflect your system * the COPY line for the header file /COPY XML4PR310/QRPGLESRC,QXML4PR310 * Pointers * DPRTDOC PR DPRERR1 PR DPRERR2 PR DCOUNTELM PR D NAME@ * VALUE D ATTR@ * VALUE DSTARTDOC PR DCHARCNT PR D CHar@ * VALUE D CHarlen 10I 0 VALUE DSETLOC PR D DLOC@ * VALUE DSAXWARN PR D SAXE@ * VALUE DSAXERR PR D SAXE@ * VALUE DSAXFATERR PR D SAXE@ * VALUE DENVDATA@ S * INZ(%ADDR(Qxml_DOMEXCDATA)) DPRSDATA@ S * INZ(%ADDR(Qxml_SAXEXCDATA)) * Set up pointer to the SAX API callback routines DCOUNTHDL@ S * PROCPTR D INZ(%PADDR('COUNTELM')) DSTARTHDL@ S * PROCPTR D INZ(%PADDR('STARTDOC')) DCHARCHDL@ S * PROCPTR D INZ(%PADDR('CHARCNT')) DSETLHDL@ S * PROCPTR D INZ(%PADDR('SETLOC')) DWARNHDL@ S * PROCPTR D INZ(%PADDR('SAXWARN')) DERRHDL@ S * PROCPTR D INZ(%PADDR('SAXERR')) DFATHDL@ S * PROCPTR D INZ(%PADDR('SAXFATERR')) DSAXParse@ S * DDOCHNDLR@ S * DERRHNDLR@ S * DDomDoc@ S * DPID@ S * DDomNodeList@ S * * Modify the following with a valid XML file name DXmlFile S 90A INZ('/MyXMLFile.xml') D***File S 90A INZ('/XML4PR310/AddressBook.xml') Dtransmsg S 90A DXmlFile@ S * DElemCount S 10I 0 INZ(0) DAttrCount S 10I 0 INZ(0) DCharCount S 10I 0 INZ(0) DTotalAttr S 10I 0 INZ(0) DStartCnt S 10I 0 INZ(0) DCOL S 10I 0 INZ(0) DLINE S 10I 0 INZ(0) DMSG@ S * DBYTESAVAL S 10I 0 DBYTESPROV S 10I 0 INZ(90) DTRANSMSG@ S * INZ(%ADDR(transmsg)) Dvalmode S 10I 0 INZ(0) DVALTSTR S 3A INZ('-n') DOUTSTR@ S * * Allocate local string areas * C ALLOC 256 XmlFile@ C ALLOC 256 OUTSTR@ * Set up the parameters list C *ENTRY PLIST C PARM ONE 256 C PARM TWO 256 * Make sure at least one parameter was passed C IF %PARMS < 1 C EVAL %str(OUTSTR@:256)='You must specify the ' C + 'name of the XML file you want to ' C + 'parse as a parameter. ' + x'25' C + 'If you want to run the validating ' C + 'parser pass -v as the first ' C + 'parameter.' + x'25' + x'00' C CALLP QxmlGenPrint(OUTSTR@:0) C RETURN C ENDIF * If one parameter it must be filename C IF %PARMS = 1 C EVAL %str(XmlFile@:256) = C %subst(ONE:1:%SCAN(' ':ONE:1) - 1) C EVAL valmode = Qxml_NOVALIDAT C ENDIF * If two parameters or more- parameter one will have the validate * flag and parameter two will have the name... the rest will be * ignored C IF %PARMS > 1 C EVAL %str(XmlFile@:256) = C %subst(TWO:1:%SCAN(' ':TWO:1) - 1) C EVAL VALTSTR = %SUBST(ONE:1:2) C VALTSTR ifne '-v' C EVAL valmode = Qxml_NOVALIDAT C else C EVAL valmode = Qxml_VALIDATE C ENDIF C ENDIF * Initialize XML environement, provide pointer to DOM exception area C EVAL XmlFile = %str(XmlFile@) C CALLP QxmlInit(ENVDATA@) * Create a SAX Parser object, set validation option C EVAL SAXParse@ = QxmlSAXPARSER_new C CALLP QxmlSAXParser_setDoValidation C (SAXParse@: C valmode) * Create a document and error handler and register with parsre C EVAL DOCHNDLR@ = QxmlDocumentHandler_new C EVAL ERRHNDLR@ = QxmlErrorHandler_new C CALLP QxmlSAXParser_setDocumentHandler C (SAXParse@: C DOCHNDLR@) C CALLP QxmlSAXParser_setErrorHandler C (SAXParse@: C ERRHNDLR@) * Register the callback routines based on specific SAX Document * and Error handler events (such as STARTDOUCMENT, CHARACTERS, etc) C CALLP QxmlDocumentHandler_setCallback C (DOCHNDLR@: C Qxml_STARTELEMENT: C COUNTHDL@) C CALLP QxmlDocumentHandler_setCallback C (DOCHNDLR@: C Qxml_STARTDOCUMENT: C STARTHDL@) C CALLP QxmlDocumentHandler_setCallback C (DOCHNDLR@: C Qxml_CHARACTERS: C CHARCHDL@) C CALLP QxmlDocumentHandler_setCallback C (DOCHNDLR@: C Qxml_SETDOCLOCATOR: C SETLHDL@) C CALLP QxmlErrorHandler_setCallback C (ERRHNDLR@: C Qxml_WARNINGHNDLR: C WARNHDL@) C CALLP QxmlErrorHandler_setCallback C (ERRHNDLR@: C Qxml_ERRORHNDLR: C ERRHDL@) C CALLP QxmlErrorHandler_setCallback C (ERRHNDLR@: C Qxml_FATALERRORHNDLR: C FATHDL@) * Call parser providing modified XML file name C CALLP QxmlSAXParser_parse_systemid C (SAXParse@: C XmlFile@: C Qxml_CCSID37: C 0) C CALLP QxmlDocumentHandler_delete(DOCHNDLR@) C CALLP QxmlErrorHandler_delete(ERRHNDLR@) C CALLP QxmlSAXPARSER_delete(SAXParse@) C CALLP QxmlTerm C DEALLOC XmlFile@ * Print out a detail line C EVAL %str(OUTSTR@:256)='Elements ' C +%editc(ElemCount:'Z') C + ',Attributes ' C + %editc(TotalAttr:'Z') C + ',Characters ' C + %editc(CharCount:'Z') C + x'25' + x'00' C CALLP QxmlGenPrint(OUTSTR@:0) C EVAL %str(OUTSTR@:256)= 'For File '+XmlFile C +x'25'+x'00' C CALLP QxmlGenPrint(OUTSTR@:0) C RETURN PPRERR1 B DPRERR1 PI C EVAL %str(OUTSTR@:256)='Error: ' C +%trimr(transmsg)+x'00' C CALLP QxmlGenPrint(OUTSTR@:0) C EVAL %str(OUTSTR@:256)=x'2500' C CALLP QxmlGenPrint(OUTSTR@:0) C RETURN PPRERR1 E PPRERR2 B DPRERR2 PI C EVAL %str(OUTSTR@:256) = 'Line #: ' C +%editc(LINE:'Z') C + ' Column #: ' C +%editc(COL:'Z') C + x'25' + x'00' C CALLP QxmlGenPrint(OUTSTR@:0) C RETURN PPRERR2 E PCOUNTELM B DCOUNTELM PI D NAME@ * VALUE D ATTR@ * VALUE C EVAL Elemcount = Elemcount+1 C EVAL Attrcount = C QxmlAttributeList_getLength(ATTR@) C EVAL TotalAttr = TotalAttr+Attrcount PCOUNTELM E PSTARTDOC B DSTARTDOC PI C EVAL StartCnt = StartCnt +1 PSTARTDOC E PCHARCNT B DCHARCNT PI D CHar@ * VALUE D CHarlen 10I 0 VALUE C EVAL CharCount = CharCount +Charlen PCHARCNT E PSETLOC B DSETLOC PI D DLOC@ * VALUE C EVAL PID@ = QxmlLOCATOR_getPublicId C (DLOC@) PSETLOC E PSAXWARN B DSAXWARN PI D SAXE@ * VALUE C EVAL LINE=QxmlSAXParseException_getLineNumber C (SAXE@) C EVAL COL =QxmlSAXParseException_getColumn... C Number(SAXE@) C EVAL MSG@= QxmlSAXException_getMessage C (SAXE@) C CALLP QxmlTranscode(MSG@: C Qxml_UNICODE: C TRANSMSG@: C %ADDR(BYTESPROV): C %ADDR(BYTESAVAL): C Qxml_CCSID37) C CALLP QxmlSAXException_delete(saxe@) C CALLP PRERR2 C CALLP PRERR1 PSAXWARN E PSAXERR B DSAXERR PI D SAXE@ * VALUE C EVAL LINE=QxmlSAXParseException_getLineNumber C (SAXE@) C EVAL COL =QxmlSAXParseException_getColumn... C Number(SAXE@) C EVAL MSG@= QxmlSAXException_getMessage C (SAXE@) C CALLP QxmlTRANSCODE(MSG@: C Qxml_UNICODE: C TRANSMSG@: C %ADDR(BYTESPROV): C %ADDR(BYTESAVAL): C Qxml_CCSID37) C CALLP QxmlSAXException_delete(saxe@) C CALLP PRERR2 C CALLP PRERR1 PSAXERR E PSAXFATERR B DSAXFATERR PI D SAXE@ * VALUE C EVAL LINE=QxmlSAXParseException_getLineNumber C (SAXE@) C EVAL COL =QxmlSAXParseException_getColumn... C Number(SAXE@) C EVAL MSG@= QxmlSAXException_getMessage C (SAXE@) C CALLP QxmlTranscode(MSG@: C Qxml_UNICODE: C TRANSMSG@: C %ADDR(BYTESPROV): C %ADDR(BYTESAVAL): C Qxml_CCSID37) C CALLP QxmlSAXException_delete(saxe@) C CALLP PRERR2 C CALLP PRERR1 PSAXFATERR E