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 Oct 16, 2024@18:11:19 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))
