{A} * Callback procedure interfaces D startDocument pr D endDocument pr D startElement pr D Name@ * Value D Attr@ * Value D endElement pr D Name@ * Value D characters pr D Char@ * Value D Len@ * Value D ignoreWhite... D Space pr D Char@ * Value D Len@ * Value D processing... D Instructions pr D target@ * Value D data@ * Value {B} * Set up pointer to the SAX API callback routines D startDHdl@ s * procptr D inz(%paddr('STARTDOCUMENT')) D charHdl@ s * procptr D inz(%paddr('CHARACTERS')) D endDHdl@ s * procptr D inz(%paddr('ENDDOCUMENT')) D startEHDL@ s * procptr D inz(%paddr('STARTELEMENT')) D endEHDL@ s * procptr D inz(%paddr('ENDELEMENT')) D ignoreWhSp@ s * procptr D inz(%paddr('IGNOREWHITESPACE')) D processInst@ s * procptr D inz(%paddr('PROCESSINGINSTRUCTIONS')) D warnHDL@ s * procptr D inz(%paddr('SAXWARN')) D errHDL@ s * procptr D inz(%paddr('SAXERR')) D fatHDL@ s * procptr D inz(%paddr('SAXFATERR')) {C} * * SAX Error handler interfaces D SaxWarn pr D SaxE@ * Value D SaxErr pr D SaxE@ * Value D SaxFatErr pr D SaxE@ * Value * * Support procedure interfaces D getName pr D Name@ * Value D getName2 pr D Name@ * Value D PrErr1 pr D PrErr2 pr {D} D EnvData@ s * Inz(%Addr(Qxml_DOMEXCDATA)) D PrsData@ s * Inz(%Addr(Qxml_SAXEXCDATA)) D SAXParse@ s * D DocHndlr@ s * D ErrHndlr@ s * : : * * Initialize XML environment, provide pointer to DOM exception area * C Eval XmlFile = %str(XmlFile@) {E} C CallP QxmlInit(EnvData@) * * Create a Parser object, set validation option to off/on and parse * If you want to do validation, set the Do Validation on. * {F} C Eval SAXParse@ = QxmlSAXParser_new {G} C CallP QxmlSAXParser_setDoValidation C (SAXParse@: C valmode) * Create a document and error handler and register with parser {H} C Eval DocHndlr@ = QxmlDocumentHandler_new C CallP QxmlSAXParser_setDocumentHandler C (SAXParse@: C DocHndlr@) {I} C Eval ErrHndlr@ = QxmlErrorHandler_new C CallP QxmlSAXParser_setErrorHandler C (SAXParse@: C ErrHndlr@) * Register the callback routines based on specific SAX Document * and Error handler events (such as STARTDOCUMENT, CHARACTERS, etc). * * Set callback procedure for Start/End Document. {J} C CallP QxmlDocumentHandler_setCallback C (DocHndlr@: C Qxml_STARTDOCUMENT: C startDHdl@) C CallP QxmlDocumentHandler_setCallback C (DocHndlr@: C Qxml_ENDOCUMENT: C endDHdl@) * Set callback procedure for Start/End Elements. {K} C CallP QxmlDocumentHandler_setCallback C (DocHndlr@: C Qxml_STARTELEMENT: C startEHdl@) C CallP QxmlDocumentHandler_setCallback C (DocHndlr@: C Qxml_ENDELEMENT: C endEHdl@) * Set callback procedure for Characters (text nodes). {L} C CallP QxmlDocumentHandler_setCallback C (DocHndlr@: C Qxml_CHARACTERS: C charHdl@) * Set callback procedure for Processing instructions. {M} C CallP QxmlDocumentHandler_setCallback C (DocHndlr@: C Qxml_PROCESSINGINST: C processInst@) * Set callback procedure for Ignorable Whitespace. {N} C CallP QxmlDocumentHandler_setCallback C (DocHndlr@: C Qxml_IGNORABLEWHSP: C ignoreWhSp@) * Error handler events (warning, error, and fatal error). {O} 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@) * * Output the modified XML Document to a stream file. * {P} C Eval fd=QxmlOpenNewOutPutStream C (xmlFile2@: C 0: C ErrNo@: C OutCodePage) * * Note that OutPutStream open will fail if it already exists. * C If fd = *Null C Eval %str(OutStr@:256) = 'Error: output stream ' C + 'failed. Errno is' C +%editc(ErrNo:'Z') C +x'2500' C CallP QxmlGenPrint(OutStr@:0) C Else * Parse document {Q} C CallP QxmlSAXParser_parse_SystemId C (SAXParse@: C XmlFile@: C Qxml_CCSID37: C 0) C EndIf * Cleanup {R} C CallP QxmlDocumentHandler_delete(DocHndlr@) C CallP QxmlErrorHandler_delete(ErrHndlr@) C CallP QxmlSAXParser_delete(SAXParse@) C CallP QxmlCloseOutPutStream(fd) C DeAlloc XmlFile@ C DeAlloc XmlFile2@ C CallP QxmlTerm : : {S} P*-------------------------------------------------------------------- PstartDocument b P*-------------------------------------------------------------------- DstartDocument pi C Eval OutPutStr = '' + x'25' {T} C Eval rtn=QxmlWriteOutPutStream C (fd: C OutPutStr@: C InCodePage: C %len(%trim(OutPutStr))) c clear OutPutStr * Here is where you might need to specify a DTD C* Eval OutPutStr = '' + x'25' C* Eval rtn=QxmlWriteOutPutStream(fd: C* OutPutStr@: C* InCodePage: C* %len(%trim(OutPutStr))) P*-------------------------------------------------------------------- PstartDocument e P*-------------------------------------------------------------------- P*-------------------------------------------------------------------- PendDocument b P*-------------------------------------------------------------------- {U} DendDocument pi PendDocument e P*-------------------------------------------------------------------- P*-------------------------------------------------------------------- Pcharacters b P*-------------------------------------------------------------------- {V} Dcharacters pi D Char@ * Value D Len@ * Value {W} C CallP getName(Char@) C Eval OutPutStr = %str(OutString@) c If tagValue = systemValueC c If %subst(OutPutStr:1:1) > *Blank c Eval sysValName = OutPutStr c Else c Eval sysValName = %subst(OutPutStr:2:10) c EndIf c clear tagValue c EndIf C Eval rtn=QxmlWriteOutPutStream(fd: C OutPutStr@: C InCodePage: C %len(%trim(OutPutStr))) c clear OutPutStr P*-------------------------------------------------------------------- Pcharacters e P*-------------------------------------------------------------------- P*-------------------------------------------------------------------- PstartElement b P*-------------------------------------------------------------------- {X} DstartElement pi D Name@ * Value D Attr@ * Value D Len s 10i 0 inz(0) D Index s 10i 0 inz(0) {Y} C CallP getName(Name@) C Eval OutPutStr = '<' + %str(OutString@) C Eval tagValue = %str(OutString@) {Z} C Eval Len = QxmlAttributeList_getLength(Attr@) {AA} C DoW Index < Len C CallP getName(QxmlAttributeList_getName_byIndex( C Attr@:Index)) C CallP getName2(QXMLAttributeList_getValue_byIndex( C Attr@:Index)) C Eval OutPutStr2 = ' ' + %str(OutString@) + '="' + C %str(OutString2@) + '"' C Eval OutPutStr = %trim(OutPutStr) + OutPutStr2 C Eval Index = Index + 1 C EndDo C Eval OutPutStr = %trim(OutPutStr) + '>' C + x'25' C Eval rtn=QxmlWriteOutPutStream(fd: C OutPutStr@: C InCodePage: C %len(%trim(OutPutStr))) c clear OutPutStr P*-------------------------------------------------------------------- PstartElement e P*-------------------------------------------------------------------- P*-------------------------------------------------------------------- PendElement b P*-------------------------------------------------------------------- {BB} DendElement pi D Name@ * Value D index s 10i 0 inz(0) C CallP getName(Name@) C Eval OutPutStr = '' + x'25' C Eval rtn=QxmlWriteOutPutStream(fd: C OutPutStr@: C InCodePage: C %len(%trim(OutPutStr))) c clear OutPutStr * Logic to assign earned points. This could be whatever your * policy mandates. Here I have simplified to code to just use * compile-time source array values for each system value. {CC} c If ( sysValName <> *Blanks And c %str(OutString@) = pointsC ) c Eval index = 1 C sysValName Lookup sKey(index) 39 C If %Equal C Eval OutPutStr = '<' C + earnedPointsC C + '>' C + sPointsEarn(index) C + '' C + x'25' C Eval rtn=QxmlWriteOutPutStream(fd: C OutPutStr@: C InCodePage: C %len(%trim(OutPutStr))) c clear OutPutStr c EndIf c clear sysValName c EndIf P*-------------------------------------------------------------------- PendElement e P*-------------------------------------------------------------------- P*-------------------------------------------------------------------- PignoreWhiteSp... P ace b P*-------------------------------------------------------------------- {DD} DignoreWhiteSp... D ace pi D Char@ * Value D Len@ * Value C CallP getName(Char@) C Eval OutPutStr = %str(OutString@) + x'25' C Eval rtn=QxmlWriteOutPutStream(fd: C OutPutStr@: C InCodePage: C %len(%trim(OutPutStr))) c clear OutPutStr P*-------------------------------------------------------------------- PignoreWhiteSp... P ace e P*-------------------------------------------------------------------- P*-------------------------------------------------------------------- PprocessingIn... P structions b P*-------------------------------------------------------------------- {EE} DprocessingIn... D structions pi D Target@ * Value D Data@ * Value C CallP getName(Target@) C If Data@ <> *Null C CallP getName2(Data@) C Eval OutPutStr = '' C + x'25' C Else C Eval OutPutStr = '' C + x'25' C EndIf C Eval rtn=QxmlWriteOutPutStream(fd: C OutPutStr@: C InCodePage: C %len(%trim(OutPutStr))) c clear OutPutStr P*-------------------------------------------------------------------- PprocessingIn... P structions e P*--------------------------------------------------------------------