- MXMLDOM ;SAIC/DKM - XML Parser - DOM model ;02/27/2002 13:24
- ;;7.3;TOOLKIT;**58**;Apr 25, 1995
- ;=================================================================
- ; This acts as an intermediate client between the event-based XML
- ; parser and a client requiring an in-memory document model.
- EN(DOC,OPTION) ;
- N CBK,SUCCESS,LEVEL,NODE,HANDLE
- K ^TMP("MXMLERR",$J)
- L +^TMP("MXMLDOM",$J):5
- E Q 0
- S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
- L -^TMP("MXMLDOM",$J)
- S CBK("STARTELEMENT")="STARTELE^MXMLDOM"
- S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
- S CBK("COMMENT")="COMMENT^MXMLDOM"
- S CBK("CHARACTERS")="CHAR^MXMLDOM"
- S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
- S CBK("ERROR")="ERROR^MXMLDOM"
- S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
- D EN^MXMLPRSE(DOC,.CBK,OPTION)
- D:'SUCCESS DELETE(HANDLE)
- Q $S(SUCCESS:HANDLE,1:0)
- ; Start element
- ; Create new child node and push info on stack
- STARTELE(ELE,ATTR) ;
- N PARENT
- S PARENT=LEVEL(LEVEL),NODE=NODE+1
- S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
- S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
- S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
- M ^("A")=ATTR
- Q
- ; End element
- ; Pops element stack
- ENDELE(ELE) ;
- K LEVEL(LEVEL)
- S LEVEL=LEVEL-1
- Q
- ; Comment data
- D TXT("X")
- Q
- ; Character data
- CHAR(TXT) ;
- D TXT("T")
- Q
- ; Store comment or character data
- TXT(SUB) N X,Y,Z
- S Y=$O(^TMP("MXMLDOM",$J,HANDLE,LEVEL(LEVEL),SUB,""),-1)
- I Y>0,($L($G(^(Y)))+$L(TXT)>200)!($G(BGN)["CDATA") S Y=Y+1 ;*rwf
- S:'Y Y=1
- F Z=$L(TXT,$C(10)):-1:1 Q:TXT="" D
- .S X=$P(TXT,$C(10)),TXT=$P(TXT,$C(10),2,9999)
- .S ^(Y)=$G(^(Y))_X
- .S:Z>1 Y=Y+1 ;*rwf old .S:Z>1 Y=Y+1,^(Y)=""
- Q
- ; End of document
- ENDDOC S SUCCESS=1
- Q
- ;Error reporting
- ERROR(ERR) ;
- N CNT
- S CNT=1+$G(^TMP("MXMLERR",$J)),^($J)=CNT
- M ^TMP("MXMLERR",$J,CNT)=ERR
- Q
- ;
- ; Below are the external API calls for the interface
- ;
- ; Delete document instance
- DELETE(HANDLE) ;
- K ^TMP("MXMLDOM",$J,HANDLE)
- Q
- ; Name of element at node
- NAME(HANDLE,NODE) ;
- Q $G(^TMP("MXMLDOM",$J,HANDLE,NODE))
- ; Node of next child
- CHILD(HANDLE,PARENT,CHILD) ;
- Q +$O(^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",+$G(CHILD)))
- ; Node of next sibling
- SIBLING(HANDLE,NODE) ;
- Q +$O(^TMP("MXMLDOM",$J,HANDLE,$$PARENT(HANDLE,NODE),"C",NODE))
- ; Parent of node
- PARENT(HANDLE,NODE) ;
- Q +$G(^TMP("MXMLDOM",$J,HANDLE,NODE,"P"))
- ; Text associated with node
- TEXT(HANDLE,NODE,RTN) ;
- D GETTXT("T")
- Q:$Q $D(@RTN)>1
- Q
- ; Comment associate with node
- CMNT(HANDLE,NODE,RTN) ;
- D GETTXT("X")
- Q:$Q $D(@RTN)>1
- Q
- ; Retrieve text or comment
- GETTXT(SUB) ;
- K @RTN
- M @RTN=^TMP("MXMLDOM",$J,HANDLE,NODE,SUB)
- Q
- ; Retrieve next attribute
- ATTRIB(HANDLE,NODE,ATTR) ;
- Q $O(^TMP("MXMLDOM",$J,HANDLE,NODE,"A",$G(ATTR)))
- ; Retrieve attribute value
- VALUE(HANDLE,NODE,ATTR) ;
- Q $G(^TMP("MXMLDOM",$J,HANDLE,NODE,"A",ATTR))
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMXMLDOM 2937 printed Jan 18, 2025@03:11:32 Page 2
- MXMLDOM ;SAIC/DKM - XML Parser - DOM model ;02/27/2002 13:24
- +1 ;;7.3;TOOLKIT;**58**;Apr 25, 1995
- +2 ;=================================================================
- +3 ; This acts as an intermediate client between the event-based XML
- +4 ; parser and a client requiring an in-memory document model.
- EN(DOC,OPTION) ;
- +1 NEW CBK,SUCCESS,LEVEL,NODE,HANDLE
- +2 KILL ^TMP("MXMLERR",$JOB)
- +3 LOCK +^TMP("MXMLDOM",$JOB):5
- +4 IF '$TEST
- QUIT 0
- +5 SET HANDLE=$ORDER(^TMP("MXMLDOM",$JOB,""),-1)+1
- SET ^(HANDLE)=""
- +6 LOCK -^TMP("MXMLDOM",$JOB)
- +7 SET CBK("STARTELEMENT")="STARTELE^MXMLDOM"
- +8 SET CBK("ENDELEMENT")="ENDELE^MXMLDOM"
- +9 SET CBK("COMMENT")="COMMENT^MXMLDOM"
- +10 SET CBK("CHARACTERS")="CHAR^MXMLDOM"
- +11 SET CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
- +12 SET CBK("ERROR")="ERROR^MXMLDOM"
- +13 SET (SUCCESS,LEVEL,LEVEL(0),NODE)=0
- SET OPTION=$GET(OPTION,"V1")
- +14 DO EN^MXMLPRSE(DOC,.CBK,OPTION)
- +15 if 'SUCCESS
- DO DELETE(HANDLE)
- +16 QUIT $SELECT(SUCCESS:HANDLE,1:0)
- +17 ; Start element
- +18 ; Create new child node and push info on stack
- STARTELE(ELE,ATTR) ;
- +1 NEW PARENT
- +2 SET PARENT=LEVEL(LEVEL)
- SET NODE=NODE+1
- +3 if PARENT
- SET ^TMP("MXMLDOM",$JOB,HANDLE,PARENT,"C",NODE)=ELE
- +4 SET LEVEL=LEVEL+1
- SET LEVEL(LEVEL)=NODE
- SET LEVEL(LEVEL,0)=ELE
- +5 SET ^TMP("MXMLDOM",$JOB,HANDLE,NODE)=ELE
- SET ^(NODE,"P")=PARENT
- +6 MERGE ^("A")=ATTR
- +7 QUIT
- +8 ; End element
- +9 ; Pops element stack
- ENDELE(ELE) ;
- +1 KILL LEVEL(LEVEL)
- +2 SET LEVEL=LEVEL-1
- +3 QUIT
- +4 ; Comment data
- +1 DO TXT("X")
- +2 QUIT
- +3 ; Character data
- CHAR(TXT) ;
- +1 DO TXT("T")
- +2 QUIT
- +3 ; Store comment or character data
- TXT(SUB) NEW X,Y,Z
- +1 SET Y=$ORDER(^TMP("MXMLDOM",$JOB,HANDLE,LEVEL(LEVEL),SUB,""),-1)
- +2 ;*rwf
- IF Y>0
- IF ($LENGTH($GET(^(Y)))+$LENGTH(TXT)>200)!($GET(BGN)["CDATA")
- SET Y=Y+1
- +3 if 'Y
- SET Y=1
- +4 FOR Z=$LENGTH(TXT,$CHAR(10)):-1:1
- if TXT=""
- QUIT
- Begin DoDot:1
- +5 SET X=$PIECE(TXT,$CHAR(10))
- SET TXT=$PIECE(TXT,$CHAR(10),2,9999)
- +6 SET ^(Y)=$GET(^(Y))_X
- +7 ;*rwf old .S:Z>1 Y=Y+1,^(Y)=""
- if Z>1
- SET Y=Y+1
- End DoDot:1
- +8 QUIT
- +9 ; End of document
- ENDDOC SET SUCCESS=1
- +1 QUIT
- +2 ;Error reporting
- ERROR(ERR) ;
- +1 NEW CNT
- +2 SET CNT=1+$GET(^TMP("MXMLERR",$JOB))
- SET ^($JOB)=CNT
- +3 MERGE ^TMP("MXMLERR",$JOB,CNT)=ERR
- +4 QUIT
- +5 ;
- +6 ; Below are the external API calls for the interface
- +7 ;
- +8 ; Delete document instance
- DELETE(HANDLE) ;
- +1 KILL ^TMP("MXMLDOM",$JOB,HANDLE)
- +2 QUIT
- +3 ; Name of element at node
- NAME(HANDLE,NODE) ;
- +1 QUIT $GET(^TMP("MXMLDOM",$JOB,HANDLE,NODE))
- +2 ; Node of next child
- CHILD(HANDLE,PARENT,CHILD) ;
- +1 QUIT +$ORDER(^TMP("MXMLDOM",$JOB,HANDLE,PARENT,"C",+$GET(CHILD)))
- +2 ; Node of next sibling
- SIBLING(HANDLE,NODE) ;
- +1 QUIT +$ORDER(^TMP("MXMLDOM",$JOB,HANDLE,$$PARENT(HANDLE,NODE),"C",NODE))
- +2 ; Parent of node
- PARENT(HANDLE,NODE) ;
- +1 QUIT +$GET(^TMP("MXMLDOM",$JOB,HANDLE,NODE,"P"))
- +2 ; Text associated with node
- TEXT(HANDLE,NODE,RTN) ;
- +1 DO GETTXT("T")
- +2 if $QUIT
- QUIT $DATA(@RTN)>1
- +3 QUIT
- +4 ; Comment associate with node
- CMNT(HANDLE,NODE,RTN) ;
- +1 DO GETTXT("X")
- +2 if $QUIT
- QUIT $DATA(@RTN)>1
- +3 QUIT
- +4 ; Retrieve text or comment
- GETTXT(SUB) ;
- +1 KILL @RTN
- +2 MERGE @RTN=^TMP("MXMLDOM",$JOB,HANDLE,NODE,SUB)
- +3 QUIT
- +4 ; Retrieve next attribute
- ATTRIB(HANDLE,NODE,ATTR) ;
- +1 QUIT $ORDER(^TMP("MXMLDOM",$JOB,HANDLE,NODE,"A",$GET(ATTR)))
- +2 ; Retrieve attribute value
- VALUE(HANDLE,NODE,ATTR) ;
- +1 QUIT $GET(^TMP("MXMLDOM",$JOB,HANDLE,NODE,"A",ATTR))