MXMLTEST ;SAIC/DKM - Test XML SAX interface ;01/31/2002 17:11
;;7.3;TOOLKIT;**58**;Apr 25, 1995
;=================================================================
; This application acts as a client to the XML parser. It displays
; parsing events as they occur and generates a summary at the end.
EN(DOC,OPTION) ;
N CBK,CNT
W !!!,"Invoking XML Parser...",!!!
D SET(.CBK),EN^MXMLPRSE(DOC,.CBK,.OPTION)
S CNT=""
W !!!,"Parser Summary:",!!
F S CNT=$O(CNT(CNT)) Q:CNT="" W CNT,":",?25,CNT(CNT),!
Q
; Direct entry of XML text from keyboard
; Terminate text entry with a solitary '^'
PASTE(OPTION) ;
N X,Y,GBL
S GBL=$NA(^TMP("MXMLTEST",$J))
K @GBL
F X=1:1 D Q:Y="^"
.W X,"> "
.R Y:$G(DTIME,600),!
.E S Y="^"
.S:Y'="^" @GBL@(X)=Y
D EN(GBL,.OPTION)
K @GBL
Q
; Set the event interface entry points
SET(CBK) N X,Y
K CBK
F X=0:1 S Y=$P($T(SETX+X),";;",2) Q:Y="" D
.S CBK(Y)=$E(Y,1,8)_"^MXMLTEST"
Q
; Convert special characters to \x format
ESC(X) N C,Y,Z
F Z=1:1 S C=$E(X,Z) Q:C="" D
.S Y=$TR(C,$C(9,10,13,92),"tnc")
.S:C'=Y $E(X,Z)=$S(Y="":"\\",1:"\"_Y),Z=Z+1
Q X
SETX ;;STARTDOCUMENT
;;ENDDOCUMENT
;;DOCTYPE
;;STARTELEMENT
;;ENDELEMENT
;;CHARACTERS
;;PI
;;ERROR
;;COMMENT
;;EXTERNAL
;;NOTATION
;;
; Event interface callbacks
STARTDOC ;
ENDDOCUM W EVT,"()",!
Q
DOCTYPE(P1,P2,P3) ;
W EVT,"(""",P1,""",""",P2,""",""",P3,""")",!
Q
STARTELE(ELE,ATR) ;
D ARGS(ELE,.ATR),COUNT("Elements")
Q
ARGS(ELE,ATR) ;
N X,Y
W EVT,"(""",ELE,""""
S X="",Y=","""
F S X=$O(ATR(X)) Q:X="" W Y,X,"=",$$ESC(ATR(X)) S Y=";"
W $S($L(Y)=1:""")",1:")"),!
Q
ENDELEME(ELE) ;
W EVT,"(""",ELE,""")",!
Q
CHARACTE(TXT) ;
D COUNT("Non-markup Content",$L(TXT))
W EVT,"(""",$$ESC(TXT),""")",!
Q
PI(TGT,TXT) ;
D ARGS(TGT,.TXT)
D COUNT("Processing Instructions")
Q
W EVT,"(""",TXT,""")",!
D COUNT("Comments")
Q
EXTERNAL(SYS,PUB,GBL) ;
W EVT,"(""",SYS,""",""",PUB,""")",!
D COUNT("External Entities")
Q
NOTATION(NAME,SYS,PUB) ;
W EVT,"(""",NAME,""",""",SYS,""",""",PUB,""")",!
D COUNT("Notation Declarations")
Q
COUNT(TYPE,INC) ;
S CNT(TYPE)=$G(CNT(TYPE))+$G(INC,1)
Q
ERROR(ERR) ;
N X
S X=$P("Warning^Validation Error^Conformance Error","^",ERR("SEV")+1)
D COUNT(X_"s")
W X,": ",ERR("MSG")
W:$G(ERR("ARG"))'="" " (",ERR("ARG"),")"
W ". ","Line ",ERR("LIN"),", Position ",ERR("POS"),!
W $TR(ERR("XML"),$C(9,10,13)," "),!,$$REPEAT^XLFSTR("-",ERR("POS")-1),"^",!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMXMLTEST 2526 printed Sep 23, 2025@19:46:34 Page 2
MXMLTEST ;SAIC/DKM - Test XML SAX interface ;01/31/2002 17:11
+1 ;;7.3;TOOLKIT;**58**;Apr 25, 1995
+2 ;=================================================================
+3 ; This application acts as a client to the XML parser. It displays
+4 ; parsing events as they occur and generates a summary at the end.
EN(DOC,OPTION) ;
+1 NEW CBK,CNT
+2 WRITE !!!,"Invoking XML Parser...",!!!
+3 DO SET(.CBK)
DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+4 SET CNT=""
+5 WRITE !!!,"Parser Summary:",!!
+6 FOR
SET CNT=$ORDER(CNT(CNT))
if CNT=""
QUIT
WRITE CNT,":",?25,CNT(CNT),!
+7 QUIT
+8 ; Direct entry of XML text from keyboard
+9 ; Terminate text entry with a solitary '^'
PASTE(OPTION) ;
+1 NEW X,Y,GBL
+2 SET GBL=$NAME(^TMP("MXMLTEST",$JOB))
+3 KILL @GBL
+4 FOR X=1:1
Begin DoDot:1
+5 WRITE X,"> "
+6 READ Y:$GET(DTIME,600),!
+7 IF '$TEST
SET Y="^"
+8 if Y'="^"
SET @GBL@(X)=Y
End DoDot:1
if Y="^"
QUIT
+9 DO EN(GBL,.OPTION)
+10 KILL @GBL
+11 QUIT
+12 ; Set the event interface entry points
SET(CBK) NEW X,Y
+1 KILL CBK
+2 FOR X=0:1
SET Y=$PIECE($TEXT(SETX+X),";;",2)
if Y=""
QUIT
Begin DoDot:1
+3 SET CBK(Y)=$EXTRACT(Y,1,8)_"^MXMLTEST"
End DoDot:1
+4 QUIT
+5 ; Convert special characters to \x format
ESC(X) NEW C,Y,Z
+1 FOR Z=1:1
SET C=$EXTRACT(X,Z)
if C=""
QUIT
Begin DoDot:1
+2 SET Y=$TRANSLATE(C,$CHAR(9,10,13,92),"tnc")
+3 if C'=Y
SET $EXTRACT(X,Z)=$SELECT(Y="":"\\",1:"\"_Y)
SET Z=Z+1
End DoDot:1
+4 QUIT X
SETX ;;STARTDOCUMENT
+1 ;;ENDDOCUMENT
+2 ;;DOCTYPE
+3 ;;STARTELEMENT
+4 ;;ENDELEMENT
+5 ;;CHARACTERS
+6 ;;PI
+7 ;;ERROR
+8 ;;COMMENT
+9 ;;EXTERNAL
+10 ;;NOTATION
+11 ;;
+12 ; Event interface callbacks
STARTDOC ;
ENDDOCUM WRITE EVT,"()",!
+1 QUIT
DOCTYPE(P1,P2,P3) ;
+1 WRITE EVT,"(""",P1,""",""",P2,""",""",P3,""")",!
+2 QUIT
STARTELE(ELE,ATR) ;
+1 DO ARGS(ELE,.ATR)
DO COUNT("Elements")
+2 QUIT
ARGS(ELE,ATR) ;
+1 NEW X,Y
+2 WRITE EVT,"(""",ELE,""""
+3 SET X=""
SET Y=","""
+4 FOR
SET X=$ORDER(ATR(X))
if X=""
QUIT
WRITE Y,X,"=",$$ESC(ATR(X))
SET Y=";"
+5 WRITE $SELECT($LENGTH(Y)=1:""")",1:")"),!
+6 QUIT
ENDELEME(ELE) ;
+1 WRITE EVT,"(""",ELE,""")",!
+2 QUIT
CHARACTE(TXT) ;
+1 DO COUNT("Non-markup Content",$LENGTH(TXT))
+2 WRITE EVT,"(""",$$ESC(TXT),""")",!
+3 QUIT
PI(TGT,TXT) ;
+1 DO ARGS(TGT,.TXT)
+2 DO COUNT("Processing Instructions")
+3 QUIT
+1 WRITE EVT,"(""",TXT,""")",!
+2 DO COUNT("Comments")
+3 QUIT
EXTERNAL(SYS,PUB,GBL) ;
+1 WRITE EVT,"(""",SYS,""",""",PUB,""")",!
+2 DO COUNT("External Entities")
+3 QUIT
NOTATION(NAME,SYS,PUB) ;
+1 WRITE EVT,"(""",NAME,""",""",SYS,""",""",PUB,""")",!
+2 DO COUNT("Notation Declarations")
+3 QUIT
COUNT(TYPE,INC) ;
+1 SET CNT(TYPE)=$GET(CNT(TYPE))+$GET(INC,1)
+2 QUIT
ERROR(ERR) ;
+1 NEW X
+2 SET X=$PIECE("Warning^Validation Error^Conformance Error","^",ERR("SEV")+1)
+3 DO COUNT(X_"s")
+4 WRITE X,": ",ERR("MSG")
+5 if $GET(ERR("ARG"))'=""
WRITE " (",ERR("ARG"),")"
+6 WRITE ". ","Line ",ERR("LIN"),", Position ",ERR("POS"),!
+7 WRITE $TRANSLATE(ERR("XML"),$CHAR(9,10,13)," "),!,$$REPEAT^XLFSTR("-",ERR("POS")-1),"^",!!
+8 QUIT
