574 lines
22 KiB
Mathematica
574 lines
22 KiB
Mathematica
GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
|
|
;;0.2;CCDCCR;nopatch;noreleasedate
|
|
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|
;General Public License See attached copy of the License.
|
|
;
|
|
;This program is free software; you can redistribute it and/or modify
|
|
;it under the terms of the GNU General Public License as published by
|
|
;the Free Software Foundation; either version 2 of the License, or
|
|
;(at your option) any later version.
|
|
;
|
|
;This program is distributed in the hope that it will be useful,
|
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;GNU General Public License for more details.
|
|
;
|
|
;You should have received a copy of the GNU General Public License along
|
|
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
;
|
|
W "This is an XML XPATH utility library",!
|
|
W !
|
|
Q
|
|
;
|
|
OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
|
|
;
|
|
N Y
|
|
S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
|
|
I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
|
|
; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
|
|
Q
|
|
;
|
|
PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
|
|
; VAL IS A STRING AND STK IS PASSED BY NAME
|
|
;
|
|
I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
|
|
S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
|
|
S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
|
|
Q
|
|
;
|
|
POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
|
|
; VAL AND STK ARE PASSED BY REFERENCE
|
|
;
|
|
I @STK@(0)<1 D ; IF ARRAY IS EMPTY
|
|
. S VAL=""
|
|
. S @STK@(0)=0
|
|
I @STK@(0)>0 D ;
|
|
. S VAL=@STK@(@STK@(0))
|
|
. K @STK@(@STK@(0))
|
|
. S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
|
|
Q
|
|
;
|
|
MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
|
|
; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
|
|
S RTN=""
|
|
N I
|
|
; W "STK= ",STK,!
|
|
I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
|
|
. S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
|
|
. I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
|
|
. . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
|
|
Q
|
|
;
|
|
XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
|
|
; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
|
|
; ISTR IS PASSED BY VALUE
|
|
N CUR,TMP
|
|
I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
|
|
. S TMP=$P(ISTR,"<",2)
|
|
I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
|
|
. S TMP=$P(TMP,"/",2)
|
|
S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
|
|
; W "CUR= ",CUR,!
|
|
I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
|
|
. S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
|
|
; W "CUR2= ",CUR,!
|
|
Q CUR
|
|
;
|
|
INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
|
|
; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
|
|
; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
|
|
; XML SECTION
|
|
; ZXML IS PASSED BY NAME
|
|
N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
|
|
N GPLSTK ; LEAVE OUT FOR DEBUGGING
|
|
I '$D(@ZXML@(0)) D ; NO XML PASSED
|
|
. W "ERROR IN XML FILE",!
|
|
S GPLSTK(0)=0 ; INITIALIZE STACK
|
|
F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY
|
|
. S LINE=@ZXML@(I)
|
|
. ;W LINE,!
|
|
. S FOUND=0 ; INTIALIZED FOUND FLAG
|
|
. I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
|
|
. I FOUND'=1 D
|
|
. . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
|
|
. . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
|
|
. . . ; ON THE SAME LINE
|
|
. . . ; W "FOUND ",LINE,!
|
|
. . . S FOUND=1 ; SET FOUND FLAG
|
|
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
|
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
|
|
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
|
. . . ; W "MDX=",MDX,!
|
|
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
|
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
|
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
|
. . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST
|
|
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
|
|
. I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END
|
|
. . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
|
|
. . . ; W "FOUND ",LINE,!
|
|
. . . S FOUND=1 ; SET FOUND FLAG
|
|
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
|
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
|
. . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
|
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
|
|
. . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
|
|
. . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
|
|
. . . . Q
|
|
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
|
|
. . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
|
|
. . . ; W "FOUND ",LINE,!
|
|
. . . S FOUND=1 ; SET FOUND FLAG
|
|
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
|
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
|
|
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
|
. . . ; W "MDX=",MDX,!
|
|
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
|
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
|
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
|
. . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
|
|
S @ZXML@("INDEXED")=""
|
|
S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
|
|
Q
|
|
;
|
|
QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
|
|
; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
|
|
; IARY AND OARY ARE PASSED BY NAME
|
|
I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
|
|
. D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
|
|
N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
|
|
N TMP,I,J,QXPATH
|
|
S FIRST=1
|
|
S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
|
|
I XPATH'="//" D ; NOT A ROOT QUERY
|
|
. S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
|
|
. S FIRST=$P(TMP,"^",1)
|
|
. S LAST=$P(TMP,"^",2)
|
|
K @OARY
|
|
S @OARY@(0)=+LAST-FIRST+1
|
|
S J=1
|
|
FOR I=FIRST:1:LAST D
|
|
. S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
|
|
. S J=J+1
|
|
; ZWR OARY
|
|
Q
|
|
;
|
|
XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
|
|
; INDEX WITH TWO PIECES START^FINISH
|
|
; IDX IS PASSED BY NAME
|
|
Q $P(@IDX@(XPATH),"^",1)
|
|
;
|
|
XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
|
|
; INDEX WITH TWO PIECES START^FINISH
|
|
; IDX IS PASSED BY NAME
|
|
Q $P(@IDX@(XPATH),"^",2)
|
|
;
|
|
START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
|
|
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
|
; COMPANION TO FINISH ; IDX IS PASSED BY NAME
|
|
Q $P(ISTR,";",2)
|
|
;
|
|
FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
|
|
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
|
Q $P(ISTR,";",3)
|
|
;
|
|
ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
|
|
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
|
Q $P(ISTR,";",1)
|
|
;
|
|
BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
|
|
; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
|
|
; DEST IS CLEARED TO START
|
|
; USES PUSH TO DO THE COPY
|
|
N I
|
|
K @BDEST
|
|
F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
|
|
. N J,ATMP
|
|
. S ATMP=$$ARRAY(@BLIST@(I))
|
|
. I DEBUG W "ATMP=",ATMP,!
|
|
. I DEBUG W @BLIST@(I),!
|
|
. F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
|
|
. . ; FOR EACH LINE IN THIS INSTR
|
|
. . I DEBUG W "BDEST= ",BDEST,!
|
|
. . I DEBUG W "ATMP= ",@ATMP@(J),!
|
|
. . D PUSH(BDEST,@ATMP@(J))
|
|
Q
|
|
;
|
|
QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
|
|
;
|
|
I DEBUG W "QUEUEING ",BLST,!
|
|
D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
|
|
Q
|
|
;
|
|
CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
|
|
; KILLS CPDEST FIRST
|
|
N CPINSTR
|
|
I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
|
|
I @CPSRC@(0)<1 D ; BAD LENGTH
|
|
. W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
|
|
. Q
|
|
; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
|
|
D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
|
|
D BUILD("CPINSTR",CPDEST)
|
|
Q
|
|
;
|
|
QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
|
|
; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
|
|
; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
|
|
; USED TO INSERT CHILDREN NODES
|
|
I @QOXML@(0)<1 D ; MALFORMED XML
|
|
. W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
|
|
. Q
|
|
I DEBUG W "DOING QOPEN",!
|
|
N S1,E1,QOT,QOTMP
|
|
S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
|
|
I $D(QOXPATH) D ; XPATH PROVIDED
|
|
. D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
|
|
. S E1=$P(@QOXML@(QOXPATH),"^",2)-1
|
|
I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
|
. S E1=@QOXML@(0)-1
|
|
D QUEUE(QOBLIST,QOXML,S1,E1)
|
|
; S QOTMP=QOXML_"^"_S1_"^"_E1
|
|
; D PUSH(QOBLIST,QOTMP)
|
|
Q
|
|
;
|
|
QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
|
|
; ADDS THE LIST LINE OF QCXML TO QCBLIST
|
|
; USED TO FINISH INSERTING CHILDERN NODES
|
|
; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
|
|
; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
|
|
I @QCXML@(0)<1 D ; MALFORMED XML
|
|
. W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
|
|
I DEBUG W "GOING TO CLOSE",!
|
|
N S1,E1,QCT,QCTMP
|
|
S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
|
|
I $D(QCXPATH) D ; XPATH PROVIDED
|
|
. D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
|
|
. S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
|
|
I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
|
. S S1=@QCXML@(0)
|
|
D QUEUE(QCBLIST,QCXML,S1,E1)
|
|
; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
|
|
Q
|
|
;
|
|
INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
|
|
; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
|
|
; OMITTED, INSERTION WILL BE AT THE ROOT
|
|
; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
|
|
; XML AT THE END OF THE XPATH POINT
|
|
; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
|
|
N INSBLD,INSTMP
|
|
I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
|
|
I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
|
|
I '$D(@INSXML@(0)) D ; INSERT INTO AN EMPTY ARRAY
|
|
. D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
|
|
I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
|
|
. I $D(INSXPATH) D ; XPATH PROVIDED
|
|
. . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
|
|
. . I DEBUG D PARY^GPLXPATH("INSBLD")
|
|
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
|
. . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
|
|
. D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
|
|
. I $D(INSXPATH) D ; XPATH PROVIDED
|
|
. . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
|
|
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
|
. . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
|
|
. D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
|
|
. D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
|
|
Q
|
|
;
|
|
INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
|
|
; INTO INNXML AT THE INNXPATH XPATH POINT
|
|
;
|
|
N INNBLD,UXPATH
|
|
N INNTBUF
|
|
S INNTBUF=$NA(^TMP($J,"INNTBUF"))
|
|
I '$D(INNXPATH) D ; XPATH NOT PASSED
|
|
. S UXPATH="//" ; USE ROOT XPATH
|
|
I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
|
|
I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
|
|
. D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
|
|
. D BUILD("INNBLD",INNXML)
|
|
I @INNXML@(0)>0 D ; NOT EMPTY
|
|
. D QOPEN("INNBLD",INNXML,UXPATH) ;
|
|
. D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
|
|
. D QCLOSE("INNBLD",INNXML,UXPATH)
|
|
. D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
|
|
. D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
|
|
Q
|
|
;
|
|
REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
|
|
; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
|
|
; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
|
|
; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
|
|
N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
|
|
S OLD=$NA(^TMP($J,"REPLACE_OLD"))
|
|
D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
|
|
S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
|
|
S XFIRST=$P(XNODE,"^",1)
|
|
S XLAST=$P(XNODE,"^",2)
|
|
D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
|
|
I RENEW'="" D ; NEW XML IS NOT NULL
|
|
. D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
|
|
D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
|
|
I DEBUG W "REPALCE PREBUILD",!
|
|
I DEBUG D PARY("REBLD")
|
|
D BUILD("REBLD","RTMP")
|
|
K @REXML ; KILL WHAT WAS THERE
|
|
D CP("RTMP",REXML) ; COPY IN THE RESULT
|
|
Q
|
|
;
|
|
MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
|
|
; W "Reporting on the missing",!
|
|
; W OARY
|
|
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
|
|
N I
|
|
S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
|
|
F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
|
|
. I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
|
|
. . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
|
|
. . Q
|
|
Q
|
|
;
|
|
MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY
|
|
; AND PUT THE RESULTS IN OXML
|
|
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
|
|
I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
|
|
N I,TNAM,TVAL
|
|
S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
|
|
F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY
|
|
. S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
|
|
. I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
|
|
. . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME
|
|
. . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
|
|
. . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
|
|
. . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3)
|
|
W "MAPPED",!
|
|
Q
|
|
;
|
|
TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
|
|
; THEXML IS PASSED BY NAME
|
|
N I,J,TMPXML,DEL,FOUND
|
|
S FOUND=0
|
|
W "DELETING EMPTY ELEMENTS",!
|
|
F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
|
|
. S J=@THEXML@(I)
|
|
. N JM,JP ; JMINUS AND JPLUS
|
|
. S JM=@THEXML@(I-1) ; LINE BEFORE
|
|
. S JP=@THEXML@(I+1) ; LINE AFTER
|
|
. S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
|
|
. I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
|
|
. . W I,J,JP,!
|
|
. . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
|
. . S DEL(I)="" ; SET LINE TO DELETE
|
|
. . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
|
|
. I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
|
|
. . W I,J,!
|
|
. . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
|
. . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
|
|
. . I JM=JPX D ;
|
|
. . . W I,JM_J_JPX,!
|
|
. . . S DEL(I-1)=""
|
|
. . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
|
|
; . I J'["><" D PUSH("TMPXML",J)
|
|
I FOUND D ; NEED TO DELETE THINGS
|
|
. F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
|
|
. . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
|
|
. . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
|
|
. D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
|
|
Q FOUND
|
|
;
|
|
PARY(GLO) ;PRINT AN ARRAY
|
|
N I
|
|
F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
|
|
Q
|
|
;
|
|
TEST ; Run all the test cases
|
|
D TESTALL^GPLUNIT("GPLXPATH")
|
|
Q
|
|
;
|
|
OLDTEST ; RUN ALL THE TEST CASES
|
|
N ZTMP
|
|
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
|
|
D ZTEST^GPLUNIT(.ZTMP,"ALL")
|
|
W "PASSED: ",TPASSED,!
|
|
W "FAILED: ",TFAILED,!
|
|
W !
|
|
; W "THE TESTS!",!
|
|
; ZWR ZTMP
|
|
Q
|
|
;
|
|
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
|
N ZTMP
|
|
S DEBUG=1
|
|
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
|
|
D ZTEST^GPLUNIT(.ZTMP,WHICH)
|
|
Q
|
|
;
|
|
TLIST ; LIST THE TESTS
|
|
N ZTMP
|
|
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
|
|
D TLIST^GPLUNIT(.ZTMP)
|
|
Q
|
|
;
|
|
;;><TEST>
|
|
;;><INIT>
|
|
;;>>>K GPL S GPL=""
|
|
;;>>>D PUSH^GPLXPATH("GPL","FIRST")
|
|
;;>>>D PUSH^GPLXPATH("GPL","SECOND")
|
|
;;>>>D PUSH^GPLXPATH("GPL","THIRD")
|
|
;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
|
|
;;>>?GPL(0)=4
|
|
;;><INITXML>
|
|
;;>>>K GXML S GXML=""
|
|
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
|
|
;;><INITXML2>
|
|
;;>>>K GXML S GXML=""
|
|
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","DATA2")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
|
|
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
|
|
;;><PUSHPOP>
|
|
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
|
|
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
|
|
;;>>?GPL(GPL(0))="FOURTH"
|
|
;;>>>D POP^GPLXPATH("GPL",.GX)
|
|
;;>>?GX="FOURTH"
|
|
;;>>?GPL(GPL(0))="THIRD"
|
|
;;>>>D POP^GPLXPATH("GPL",.GX)
|
|
;;>>?GX="THIRD"
|
|
;;>>?GPL(GPL(0))="SECOND"
|
|
;;><MKMDX>
|
|
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
|
|
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
|
|
;;>>>S GX=""
|
|
;;>>>D MKMDX^GPLXPATH("GPL",.GX)
|
|
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
|
|
;;><XNAME>
|
|
;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
|
|
;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
|
|
;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
|
|
;;><INDEX>
|
|
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
|
|
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
|
|
;;>>>D INDEX^GPLXPATH("GXML")
|
|
;;>>?GXML("//FIRST/SECOND")="2^12"
|
|
;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
|
|
;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
|
|
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
|
|
;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
|
|
;;>>?GXML("//FIRST/SECOND")="2^12"
|
|
;;>>?GXML("//FIRST")="1^13"
|
|
;;><INDEX2>
|
|
;;>>>D ZTEST^GPLXPATH("INITXML2")
|
|
;;>>>D INDEX^GPLXPATH("GXML")
|
|
;;>>?GXML("//FIRST/SECOND")="2^12"
|
|
;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
|
|
;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
|
|
;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
|
|
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
|
|
;;>>?GXML("//FIRST")="1^13"
|
|
;;><MISSING>
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
|
|
;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
|
|
;;>>?@OUTARY@(1)="DATA1"
|
|
;;>>?@OUTARY@(2)="DATA2"
|
|
;;><MAP>
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
|
|
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
|
|
;;>>>S @MAPARY@("DATA2")="VALUE2"
|
|
;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
|
|
;;>>?@OUTARY@(6)="VALUE2"
|
|
;;><QUEUE>
|
|
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
|
|
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
|
|
;;>>?$P(BTLIST(2),";",2)=4
|
|
;;><BUILD>
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
|
|
;;>>>D ZTEST^GPLXPATH("QUEUE")
|
|
;;>>>D BUILD^GPLXPATH("BTLIST","G3")
|
|
;;><CP>
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D CP^GPLXPATH("GXML","G2")
|
|
;;>>?G2(0)=13
|
|
;;><QOPEN>
|
|
;;>>>K G2,GBL
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QOPEN^GPLXPATH("GBL","GXML")
|
|
;;>>?$P(GBL(1),";",3)=12
|
|
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
|
;;>>?G2(G2(0))="</SECOND>"
|
|
;;><QOPEN2>
|
|
;;>>>K G2,GBL
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
|
|
;;>>?$P(GBL(1),";",3)=11
|
|
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
|
;;>>?G2(G2(0))="</SECOND>"
|
|
;;><QCLOSE>
|
|
;;>>>K G2,GBL
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
|
|
;;>>?$P(GBL(1),";",3)=13
|
|
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
|
;;>>?G2(G2(0))="</FIRST>"
|
|
;;><QCLOSE2>
|
|
;;>>>K G2,GBL
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
|
|
;;>>?$P(GBL(1),";",3)=13
|
|
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
|
;;>>?G2(G2(0))="</FIRST>"
|
|
;;>>?G2(1)="</THIRD>"
|
|
;;><INSERT>
|
|
;;>>>K G2,GBL,G3,G4
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
|
;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
|
;;>>>D INSERT^GPLXPATH("G3","G2","//")
|
|
;;>>?G2(1)=GXML(9)
|
|
;;><REPLACE>
|
|
;;>>>K G2,GBL,G3
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
|
;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
|
|
;;>>?GXML(3)="<FIFTH>"
|
|
;;><INSINNER>
|
|
;;>>>K GXML,G2,GBL,G3
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
|
;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
|
;;>>?GXML(10)="<FIFTH>"
|
|
;;><INSINNER2>
|
|
;;>>>K GXML,G2,GBL,G3
|
|
;;>>>D ZTEST^GPLXPATH("INITXML")
|
|
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
|
;;>>>D INSINNER^GPLXPATH("G2","G2")
|
|
;;>>?G2(8)="<FIFTH>"
|
|
;;></TEST>
|