| 1 | GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
|
|---|
| 2 | ;;0.2;CCDCCR;nopatch;noreleasedate
|
|---|
| 3 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|---|
| 4 | ;General Public License See attached copy of the License.
|
|---|
| 5 | ;
|
|---|
| 6 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ;(at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ;GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 17 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 18 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 19 | ;
|
|---|
| 20 | W "This is an XML XPATH utility library",!
|
|---|
| 21 | W !
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
|
|---|
| 25 | ;
|
|---|
| 26 | N Y
|
|---|
| 27 | S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
|
|---|
| 28 | I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
|
|---|
| 29 | I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
|
|---|
| 33 | ; VAL IS A STRING AND STK IS PASSED BY NAME
|
|---|
| 34 | ;
|
|---|
| 35 | I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
|
|---|
| 36 | S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
|
|---|
| 37 | S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
|
|---|
| 41 | ; VAL AND STK ARE PASSED BY REFERENCE
|
|---|
| 42 | ;
|
|---|
| 43 | I @STK@(0)<1 D ; IF ARRAY IS EMPTY
|
|---|
| 44 | . S VAL=""
|
|---|
| 45 | . S @STK@(0)=0
|
|---|
| 46 | I @STK@(0)>0 D ;
|
|---|
| 47 | . S VAL=@STK@(@STK@(0))
|
|---|
| 48 | . K @STK@(@STK@(0))
|
|---|
| 49 | . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
|
|---|
| 53 | ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
|
|---|
| 54 | S RTN=""
|
|---|
| 55 | N I
|
|---|
| 56 | ; W "STK= ",STK,!
|
|---|
| 57 | I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
|
|---|
| 58 | . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
|
|---|
| 59 | . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
|
|---|
| 60 | . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
|
|---|
| 64 | ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
|
|---|
| 65 | ; ISTR IS PASSED BY VALUE
|
|---|
| 66 | N CUR,TMP
|
|---|
| 67 | I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
|
|---|
| 68 | . S TMP=$P(ISTR,"<",2)
|
|---|
| 69 | I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
|
|---|
| 70 | . S TMP=$P(TMP,"/",2)
|
|---|
| 71 | S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
|
|---|
| 72 | ; W "CUR= ",CUR,!
|
|---|
| 73 | I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
|
|---|
| 74 | . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
|
|---|
| 75 | ; W "CUR2= ",CUR,!
|
|---|
| 76 | Q CUR
|
|---|
| 77 | ;
|
|---|
| 78 | INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
|
|---|
| 79 | ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
|
|---|
| 80 | ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
|
|---|
| 81 | ; XML SECTION
|
|---|
| 82 | ; ZXML IS PASSED BY NAME
|
|---|
| 83 | N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
|
|---|
| 84 | N GPLSTK ; LEAVE OUT FOR DEBUGGING
|
|---|
| 85 | I '$D(@ZXML@(0)) D ; NO XML PASSED
|
|---|
| 86 | . W "ERROR IN XML FILE",!
|
|---|
| 87 | S GPLSTK(0)=0 ; INITIALIZE STACK
|
|---|
| 88 | F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY
|
|---|
| 89 | . S LINE=@ZXML@(I)
|
|---|
| 90 | . ;W LINE,!
|
|---|
| 91 | . S FOUND=0 ; INTIALIZED FOUND FLAG
|
|---|
| 92 | . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
|
|---|
| 93 | . I FOUND'=1 D
|
|---|
| 94 | . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
|
|---|
| 95 | . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
|
|---|
| 96 | . . . ; ON THE SAME LINE
|
|---|
| 97 | . . . ; W "FOUND ",LINE,!
|
|---|
| 98 | . . . S FOUND=1 ; SET FOUND FLAG
|
|---|
| 99 | . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
|---|
| 100 | . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
|
|---|
| 101 | . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
|---|
| 102 | . . . ; W "MDX=",MDX,!
|
|---|
| 103 | . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
|---|
| 104 | . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
|---|
| 105 | . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
|---|
| 106 | . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST
|
|---|
| 107 | . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
|
|---|
| 108 | . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END
|
|---|
| 109 | . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
|
|---|
| 110 | . . . ; W "FOUND ",LINE,!
|
|---|
| 111 | . . . S FOUND=1 ; SET FOUND FLAG
|
|---|
| 112 | . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
|---|
| 113 | . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
|---|
| 114 | . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
|---|
| 115 | . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
|
|---|
| 116 | . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
|
|---|
| 117 | . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
|
|---|
| 118 | . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
|
|---|
| 119 | . . . . Q
|
|---|
| 120 | . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
|
|---|
| 121 | . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
|
|---|
| 122 | . . . ; W "FOUND ",LINE,!
|
|---|
| 123 | . . . S FOUND=1 ; SET FOUND FLAG
|
|---|
| 124 | . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
|---|
| 125 | . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
|
|---|
| 126 | . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
|---|
| 127 | . . . ; W "MDX=",MDX,!
|
|---|
| 128 | . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
|---|
| 129 | . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
|---|
| 130 | . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
|---|
| 131 | . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
|
|---|
| 132 | S @ZXML@("INDEXED")=""
|
|---|
| 133 | S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
|
|---|
| 134 | Q
|
|---|
| 135 | ;
|
|---|
| 136 | QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
|
|---|
| 137 | ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
|
|---|
| 138 | ; IARY AND OARY ARE PASSED BY NAME
|
|---|
| 139 | I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
|
|---|
| 140 | . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
|
|---|
| 141 | N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
|
|---|
| 142 | N TMP,I,J,QXPATH
|
|---|
| 143 | S FIRST=1
|
|---|
| 144 | S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
|
|---|
| 145 | I XPATH'="//" D ; NOT A ROOT QUERY
|
|---|
| 146 | . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
|
|---|
| 147 | . S FIRST=$P(TMP,"^",1)
|
|---|
| 148 | . S LAST=$P(TMP,"^",2)
|
|---|
| 149 | K @OARY
|
|---|
| 150 | S @OARY@(0)=+LAST-FIRST+1
|
|---|
| 151 | S J=1
|
|---|
| 152 | FOR I=FIRST:1:LAST D
|
|---|
| 153 | . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
|
|---|
| 154 | . S J=J+1
|
|---|
| 155 | ; ZWR OARY
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
|
|---|
| 159 | ; INDEX WITH TWO PIECES START^FINISH
|
|---|
| 160 | ; IDX IS PASSED BY NAME
|
|---|
| 161 | Q $P(@IDX@(XPATH),"^",1)
|
|---|
| 162 | ;
|
|---|
| 163 | XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
|
|---|
| 164 | ; INDEX WITH TWO PIECES START^FINISH
|
|---|
| 165 | ; IDX IS PASSED BY NAME
|
|---|
| 166 | Q $P(@IDX@(XPATH),"^",2)
|
|---|
| 167 | ;
|
|---|
| 168 | START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
|
|---|
| 169 | ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
|---|
| 170 | ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
|
|---|
| 171 | Q $P(ISTR,";",2)
|
|---|
| 172 | ;
|
|---|
| 173 | FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
|
|---|
| 174 | ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
|---|
| 175 | Q $P(ISTR,";",3)
|
|---|
| 176 | ;
|
|---|
| 177 | ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
|
|---|
| 178 | ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
|---|
| 179 | Q $P(ISTR,";",1)
|
|---|
| 180 | ;
|
|---|
| 181 | BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
|
|---|
| 182 | ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
|
|---|
| 183 | ; DEST IS CLEARED TO START
|
|---|
| 184 | ; USES PUSH TO DO THE COPY
|
|---|
| 185 | N I
|
|---|
| 186 | K @BDEST
|
|---|
| 187 | F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
|
|---|
| 188 | . N J,ATMP
|
|---|
| 189 | . S ATMP=$$ARRAY(@BLIST@(I))
|
|---|
| 190 | . I DEBUG W "ATMP=",ATMP,!
|
|---|
| 191 | . I DEBUG W @BLIST@(I),!
|
|---|
| 192 | . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
|
|---|
| 193 | . . ; FOR EACH LINE IN THIS INSTR
|
|---|
| 194 | . . I DEBUG W "BDEST= ",BDEST,!
|
|---|
| 195 | . . I DEBUG W "ATMP= ",@ATMP@(J),!
|
|---|
| 196 | . . D PUSH(BDEST,@ATMP@(J))
|
|---|
| 197 | Q
|
|---|
| 198 | ;
|
|---|
| 199 | QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
|
|---|
| 200 | ;
|
|---|
| 201 | I DEBUG W "QUEUEING ",BLST,!
|
|---|
| 202 | D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
|
|---|
| 203 | Q
|
|---|
| 204 | ;
|
|---|
| 205 | CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
|
|---|
| 206 | ; KILLS CPDEST FIRST
|
|---|
| 207 | N CPINSTR
|
|---|
| 208 | I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
|
|---|
| 209 | I @CPSRC@(0)<1 D ; BAD LENGTH
|
|---|
| 210 | . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
|
|---|
| 211 | . Q
|
|---|
| 212 | ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
|
|---|
| 213 | D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
|
|---|
| 214 | D BUILD("CPINSTR",CPDEST)
|
|---|
| 215 | Q
|
|---|
| 216 | ;
|
|---|
| 217 | QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
|
|---|
| 218 | ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
|
|---|
| 219 | ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
|
|---|
| 220 | ; USED TO INSERT CHILDREN NODES
|
|---|
| 221 | I @QOXML@(0)<1 D ; MALFORMED XML
|
|---|
| 222 | . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
|
|---|
| 223 | . Q
|
|---|
| 224 | I DEBUG W "DOING QOPEN",!
|
|---|
| 225 | N S1,E1,QOT,QOTMP
|
|---|
| 226 | S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
|
|---|
| 227 | I $D(QOXPATH) D ; XPATH PROVIDED
|
|---|
| 228 | . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
|
|---|
| 229 | . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
|
|---|
| 230 | I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
|---|
| 231 | . S E1=@QOXML@(0)-1
|
|---|
| 232 | D QUEUE(QOBLIST,QOXML,S1,E1)
|
|---|
| 233 | ; S QOTMP=QOXML_"^"_S1_"^"_E1
|
|---|
| 234 | ; D PUSH(QOBLIST,QOTMP)
|
|---|
| 235 | Q
|
|---|
| 236 | ;
|
|---|
| 237 | QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
|
|---|
| 238 | ; ADDS THE LIST LINE OF QCXML TO QCBLIST
|
|---|
| 239 | ; USED TO FINISH INSERTING CHILDERN NODES
|
|---|
| 240 | ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
|
|---|
| 241 | ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
|
|---|
| 242 | I @QCXML@(0)<1 D ; MALFORMED XML
|
|---|
| 243 | . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
|
|---|
| 244 | I DEBUG W "GOING TO CLOSE",!
|
|---|
| 245 | N S1,E1,QCT,QCTMP
|
|---|
| 246 | S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
|
|---|
| 247 | I $D(QCXPATH) D ; XPATH PROVIDED
|
|---|
| 248 | . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
|
|---|
| 249 | . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
|
|---|
| 250 | I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
|---|
| 251 | . S S1=@QCXML@(0)
|
|---|
| 252 | D QUEUE(QCBLIST,QCXML,S1,E1)
|
|---|
| 253 | ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
|
|---|
| 254 | Q
|
|---|
| 255 | ;
|
|---|
| 256 | INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
|
|---|
| 257 | ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
|
|---|
| 258 | ; OMITTED, INSERTION WILL BE AT THE ROOT
|
|---|
| 259 | ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
|
|---|
| 260 | ; XML AT THE END OF THE XPATH POINT
|
|---|
| 261 | ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
|
|---|
| 262 | N INSBLD,INSTMP
|
|---|
| 263 | I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
|
|---|
| 264 | I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
|
|---|
| 265 | I '$D(@INSXML@(0)) D ; INSERT INTO AN EMPTY ARRAY
|
|---|
| 266 | . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
|
|---|
| 267 | I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
|
|---|
| 268 | . I $D(INSXPATH) D ; XPATH PROVIDED
|
|---|
| 269 | . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
|
|---|
| 270 | . . I DEBUG D PARY^GPLXPATH("INSBLD")
|
|---|
| 271 | . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
|---|
| 272 | . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
|
|---|
| 273 | . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
|
|---|
| 274 | . I $D(INSXPATH) D ; XPATH PROVIDED
|
|---|
| 275 | . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
|
|---|
| 276 | . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
|---|
| 277 | . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
|
|---|
| 278 | . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
|
|---|
| 279 | . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
|
|---|
| 280 | Q
|
|---|
| 281 | ;
|
|---|
| 282 | INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
|
|---|
| 283 | ; INTO INNXML AT THE INNXPATH XPATH POINT
|
|---|
| 284 | ;
|
|---|
| 285 | N INNBLD,UXPATH
|
|---|
| 286 | N INNTBUF
|
|---|
| 287 | S INNTBUF=$NA(^TMP($J,"INNTBUF"))
|
|---|
| 288 | I '$D(INNXPATH) D ; XPATH NOT PASSED
|
|---|
| 289 | . S UXPATH="//" ; USE ROOT XPATH
|
|---|
| 290 | I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
|
|---|
| 291 | I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
|
|---|
| 292 | . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
|
|---|
| 293 | . D BUILD("INNBLD",INNXML)
|
|---|
| 294 | I @INNXML@(0)>0 D ; NOT EMPTY
|
|---|
| 295 | . D QOPEN("INNBLD",INNXML,UXPATH) ;
|
|---|
| 296 | . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
|
|---|
| 297 | . D QCLOSE("INNBLD",INNXML,UXPATH)
|
|---|
| 298 | . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
|
|---|
| 299 | . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
|
|---|
| 300 | Q
|
|---|
| 301 | ;
|
|---|
| 302 | INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
|
|---|
| 303 | ; BUT XDEST AN XNEW ARE PASSED BY NAME
|
|---|
| 304 | N XBLD,XTMP
|
|---|
| 305 | D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
|
|---|
| 306 | D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
|
|---|
| 307 | D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
|
|---|
| 308 | D BUILD("XBLD","XTMP") ; BUILD THE RESULT
|
|---|
| 309 | D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
|
|---|
| 310 | I DEBUG D PARY("XDEST")
|
|---|
| 311 | Q
|
|---|
| 312 | ;
|
|---|
| 313 | REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
|
|---|
| 314 | ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
|
|---|
| 315 | ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
|
|---|
| 316 | ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
|
|---|
| 317 | N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
|
|---|
| 318 | S OLD=$NA(^TMP($J,"REPLACE_OLD"))
|
|---|
| 319 | D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
|
|---|
| 320 | S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
|
|---|
| 321 | S XFIRST=$P(XNODE,"^",1)
|
|---|
| 322 | S XLAST=$P(XNODE,"^",2)
|
|---|
| 323 | I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
|
|---|
| 324 | . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
|
|---|
| 325 | . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
|
|---|
| 326 | I RENEW'="" D ; NEW XML IS NOT NULL
|
|---|
| 327 | . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
|
|---|
| 328 | . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
|
|---|
| 329 | . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
|
|---|
| 330 | I DEBUG W "REPLACE PREBUILD",!
|
|---|
| 331 | I DEBUG D PARY("REBLD")
|
|---|
| 332 | D BUILD("REBLD","RTMP")
|
|---|
| 333 | K @REXML ; KILL WHAT WAS THERE
|
|---|
| 334 | D CP("RTMP",REXML) ; COPY IN THE RESULT
|
|---|
| 335 | Q
|
|---|
| 336 | ;
|
|---|
| 337 | MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
|
|---|
| 338 | ; W "Reporting on the missing",!
|
|---|
| 339 | ; W OARY
|
|---|
| 340 | I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
|
|---|
| 341 | N I
|
|---|
| 342 | S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
|
|---|
| 343 | F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
|
|---|
| 344 | . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
|
|---|
| 345 | . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
|
|---|
| 346 | . . Q
|
|---|
| 347 | Q
|
|---|
| 348 | ;
|
|---|
| 349 | MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
|
|---|
| 350 | ; AND PUT THE RESULTS IN OXML
|
|---|
| 351 | I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
|
|---|
| 352 | I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
|
|---|
| 353 | N I,J,TNAM,TVAL,TSTR
|
|---|
| 354 | S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
|
|---|
| 355 | F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY
|
|---|
| 356 | . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
|
|---|
| 357 | . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
|
|---|
| 358 | . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
|
|---|
| 359 | . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
|
|---|
| 360 | . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
|
|---|
| 361 | . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
|
|---|
| 362 | . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
|
|---|
| 363 | . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
|
|---|
| 364 | . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
|
|---|
| 365 | . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
|
|---|
| 366 | . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
|
|---|
| 367 | . . I DEBUG W TSTR
|
|---|
| 368 | I DEBUG W "MAPPED",!
|
|---|
| 369 | Q
|
|---|
| 370 | ;
|
|---|
| 371 | TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
|
|---|
| 372 | ; THEXML IS PASSED BY NAME
|
|---|
| 373 | N I,J,TMPXML,DEL,FOUND,INTXT
|
|---|
| 374 | S FOUND=0
|
|---|
| 375 | S INTXT=0
|
|---|
| 376 | I DEBUG W "DELETING EMPTY ELEMENTS",!
|
|---|
| 377 | F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
|
|---|
| 378 | . S J=@THEXML@(I)
|
|---|
| 379 | . I J["<text>" D
|
|---|
| 380 | . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
|
|---|
| 381 | . . I DEBUG W "IN HTML SECTION",!
|
|---|
| 382 | . N JM,JP,JPX ; JMINUS AND JPLUS
|
|---|
| 383 | . S JM=@THEXML@(I-1) ; LINE BEFORE
|
|---|
| 384 | . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
|
|---|
| 385 | . S JP=@THEXML@(I+1) ; LINE AFTER
|
|---|
| 386 | . I INTXT=0 D ; IF NOT IN AN HTML SECTION
|
|---|
| 387 | . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
|
|---|
| 388 | . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
|
|---|
| 389 | . . . I DEBUG W I,J,JP,!
|
|---|
| 390 | . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
|---|
| 391 | . . . S DEL(I)="" ; SET LINE TO DELETE
|
|---|
| 392 | . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
|
|---|
| 393 | . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
|
|---|
| 394 | . . . I DEBUG W I,J,!
|
|---|
| 395 | . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
|---|
| 396 | . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
|
|---|
| 397 | . . . I JM=JPX D ;
|
|---|
| 398 | . . . . I DEBUG W I,JM_J_JPX,!
|
|---|
| 399 | . . . . S DEL(I-1)=""
|
|---|
| 400 | . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
|
|---|
| 401 | ; . I J'["><" D PUSH("TMPXML",J)
|
|---|
| 402 | I FOUND D ; NEED TO DELETE THINGS
|
|---|
| 403 | . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
|
|---|
| 404 | . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
|
|---|
| 405 | . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
|
|---|
| 406 | . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
|
|---|
| 407 | Q FOUND
|
|---|
| 408 | ;
|
|---|
| 409 | UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
|
|---|
| 410 | ; XSEC IS A SECTION PASSED BY NAME
|
|---|
| 411 | N XBLD,XTMP
|
|---|
| 412 | D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
|
|---|
| 413 | D BUILD("XBLD","XTMP") ; BUILD THE RESULT
|
|---|
| 414 | D CP("XTMP",XSEC) ; REPLACE PASSED XML
|
|---|
| 415 | Q
|
|---|
| 416 | ;
|
|---|
| 417 | PARY(GLO) ;PRINT AN ARRAY
|
|---|
| 418 | N I
|
|---|
| 419 | F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
|
|---|
| 420 | Q
|
|---|
| 421 | ;
|
|---|
| 422 | TEST ; Run all the test cases
|
|---|
| 423 | D TESTALL^GPLUNIT("GPLXPAT0")
|
|---|
| 424 | Q
|
|---|
| 425 | ;
|
|---|
| 426 | ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
|---|
| 427 | N ZTMP
|
|---|
| 428 | S DEBUG=1
|
|---|
| 429 | D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
|
|---|
| 430 | D ZTEST^GPLUNIT(.ZTMP,WHICH)
|
|---|
| 431 | Q
|
|---|
| 432 | ;
|
|---|
| 433 | TLIST ; LIST THE TESTS
|
|---|
| 434 | N ZTMP
|
|---|
| 435 | D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
|
|---|
| 436 | D TLIST^GPLUNIT(.ZTMP)
|
|---|
| 437 | Q
|
|---|
| 438 | ;
|
|---|
