Changeset 35 for ccr/trunk/p/GPLXPATH.m
- Timestamp:
- Jul 3, 2008, 10:37:05 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLXPATH.m
r34 r35 1 GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 2 ;;0.2;CCDCCR;nopatch;noreleasedate 3 W "This is an XML XPATH utility library",! 4 W ! 5 Q 6 ; 7 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE 8 ; 9 N Y 10 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) 11 I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,! 12 ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml") 13 Q 14 ; 15 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) 16 ; VAL IS A STRING AND STK IS PASSED BY NAME 17 ; 18 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE 19 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH 20 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY 21 Q 22 ; 23 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL 24 ; VAL AND STK ARE PASSED BY REFERENCE 25 ; 26 I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY 27 I @STK@(0)>0 D 28 . S VAL=@STK@(@STK@(0)) 29 . K @STK@(@STK@(0)) 30 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY 31 Q 32 ; 33 MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 34 ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS 35 S RTN="" 36 N I 37 ; W "STK= ",STK,! 38 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY 39 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON 40 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON 41 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) 42 Q 43 ; 44 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG 45 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME 46 ; ISTR IS PASSED BY VALUE 47 N CUR,TMP 48 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET 49 . S TMP=$P(ISTR,"<",2) 50 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME> 51 . S TMP=$P(TMP,"/",2) 52 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME 53 ; W "CUR= ",CUR,! 54 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> 55 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER 56 ; W "CUR2= ",CUR,! 57 Q CUR 58 ; 59 INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index 60 ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE 61 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE 62 ; XML SECTION 63 ; ZXML IS PASSED BY NAME 64 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND 65 N GPLSTK ; LEAVE OUT FOR DEBUGGING 66 I '$D(@ZXML@(0)) D ; NO XML PASSED 67 . W "ERROR IN XML FILE",! 68 S GPLSTK(0)=0 ; INITIALIZE STACK 69 F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY 70 . S LINE=@ZXML@(I) 71 . ;W LINE,! 72 . S FOUND=0 ; INTIALIZED FOUND FLAG 73 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS 74 . I FOUND'=1 D 75 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D 76 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE 77 . . . ; W "FOUND ",LINE,! 78 . . . S FOUND=1 ; SET FOUND FLAG 79 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 80 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK 81 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 82 . . . ; W "MDX=",MDX,! 83 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 84 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 85 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE 86 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST LINE 87 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK 88 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC 89 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION 90 . . . ; W "FOUND ",LINE,! 91 . . . S FOUND=1 ; SET FOUND FLAG 92 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 93 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 94 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 95 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK 96 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START 97 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,! 98 . . . . Q 99 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION 100 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION 101 . . . ; W "FOUND ",LINE,! 102 . . . S FOUND=1 ; SET FOUND FLAG 103 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 104 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK 105 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 106 . . . ; W "MDX=",MDX,! 107 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 108 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 109 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE 110 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX 111 S @ZXML@("INDEXED")="" 112 S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH 113 Q 114 ; 115 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION 116 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" 117 ; IARY AND OARY ARE PASSED BY NAME 118 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY 119 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML 120 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN 121 N TMP,I,J,QXPATH 122 S FIRST=1 123 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT 124 I XPATH'="//" D ; NOT A ROOT QUERY 125 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES 126 . S FIRST=$P(TMP,"^",1) 127 . S LAST=$P(TMP,"^",2) 128 K @OARY 129 S @OARY@(0)=+LAST-FIRST+1 130 S J=1 131 FOR I=FIRST:1:LAST D 132 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY 133 . S J=J+1 134 ; ZWR OARY 135 Q 136 ; 137 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH 138 ; INDEX WITH TWO PIECES START^FINISH 139 ; IDX IS PASSED BY NAME 140 Q $P(@IDX@(XPATH),"^",1) 141 ; 142 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH 143 ; INDEX WITH TWO PIECES START^FINISH 144 ; IDX IS PASSED BY NAME 145 Q $P(@IDX@(XPATH),"^",2) 146 ; 147 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX 148 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 149 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME 150 Q $P(ISTR,";",2) 151 ; 152 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX 153 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 154 Q $P(ISTR,";",3) 155 ; 156 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX 157 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 158 Q $P(ISTR,";",1) 159 ; 160 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 161 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 162 ; DEST IS CLEARED TO START 163 ; USES PUSH TO DO THE COPY 164 N I 165 K @BDEST 166 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 167 . N J,ATMP 168 . S ATMP=$$ARRAY(@BLIST@(I)) 169 . I DEBUG W "ATMP=",ATMP,! 170 . I DEBUG W @BLIST@(I),! 171 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 172 . . ; FOR EACH LINE IN THIS INSTR 173 . . I DEBUG W "BDEST= ",BDEST,! 174 . . I DEBUG W "ATMP= ",@ATMP@(J),! 175 . . D PUSH(BDEST,@ATMP@(J)) 176 Q 177 ; 178 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 179 ; 180 I DEBUG W "QUEUEING ",BLST,! 181 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 182 Q 183 ; 184 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 185 ; KILLS CPDEST FIRST 186 N CPINSTR 187 I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,! 188 I @CPSRC@(0)<1 D ; BAD LENGTH 189 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 190 . Q 191 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE 192 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 193 D BUILD("CPINSTR",CPDEST) 194 Q 195 ; 196 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 197 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 198 ; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT 199 ; USED TO INSERT CHILDREN NODES 200 I @QOXML@(0)<1 D ; MALFORMED XML 201 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 202 . Q 203 I DEBUG W "DOING QOPEN",! 204 N S1,E1,QOT,QOTMP 205 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 206 I $D(QOXPATH) D ; XPATH PROVIDED 207 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 208 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 209 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 210 . S E1=@QOXML@(0)-1 211 D QUEUE(QOBLIST,QOXML,S1,E1) 212 ; S QOTMP=QOXML_"^"_S1_"^"_E1 213 ; D PUSH(QOBLIST,QOTMP) 214 Q 215 ; 216 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 217 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 218 ; USED TO FINISH INSERTING CHILDERN NODES 219 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 220 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 221 I @QCXML@(0)<1 D ; MALFORMED XML 222 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 223 I DEBUG W "GOING TO CLOSE",! 224 N S1,E1,QCT,QCTMP 225 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 226 I $D(QCXPATH) D ; XPATH PROVIDED 227 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 228 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 229 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 230 . S S1=@QCXML@(0) 231 D QUEUE(QCBLIST,QCXML,S1,E1) 232 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 233 Q 234 ; 235 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 236 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 237 ; OMITTED, INSERTION WILL BE AT THE ROOT 238 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 239 ; XML AT THE END OF THE XPATH POINT 240 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 241 N INSBLD,INSTMP 242 I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 243 I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 244 I '$D(@INSXML@(0)) D Q ; INSERT INTO AN EMPTY ARRAY 245 . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 246 I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 247 . I $D(INSXPATH) D ; XPATH PROVIDED 248 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 249 . . I DEBUG ZWR INSBLD 250 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 251 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 252 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 253 . I $D(INSXPATH) D ; XPATH PROVIDED 254 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 255 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 256 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 257 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 258 . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 259 Q 260 ; 261 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 262 ; INTO INNXML AT THE INNXPATH XPATH POINT 263 ; 264 N INNBLD,UXPATH 265 N INNTBUF 266 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 267 I '$D(INNXPATH) D ; XPATH NOT PASSED 268 . S UXPATH="//" ; USE ROOT XPATH 269 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 270 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 271 . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 272 . D BUILD("INNBLD",INNXML) 273 I @INNXML@(0)>0 D ; NOT EMPTY 274 . D QOPEN("INNBLD",INNXML,UXPATH) ; 275 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 276 . D QCLOSE("INNBLD",INNXML,UXPATH) 277 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 278 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 279 Q 280 ; 281 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT 282 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE 283 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE 284 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") 285 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 286 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 287 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 288 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 289 S XFIRST=$P(XNODE,"^",1) 290 S XLAST=$P(XNODE,"^",2) 291 D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE 292 I RENEW'="" D ; NEW XML IS NOT NULL 293 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW 294 D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST 295 I DEBUG W "REPALCE PREBUILD",! 296 I DEBUG ZWR REBLD 297 D BUILD("REBLD","RTMP") 298 K @REXML ; KILL WHAT WAS THERE 299 D CP("RTMP",REXML) ; COPY IN THE RESULT 300 Q 301 ; 302 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY 303 ; W "Reporting on the missing",! 304 ; W OARY 305 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q 306 N I 307 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT 308 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY 309 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE 310 . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY 311 . . Q 312 Q 313 ; 314 MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY 315 ; AND PUT THE RESULTS IN OXML 316 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q 317 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q 318 N I,TNAM,TVAL 319 S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT 320 F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY 321 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT 322 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? 323 . . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME 324 . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? 325 . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE 326 . . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT 327 W "MAPPED",! 328 Q 329 ; 330 PARY(GLO) ;PRINT AN ARRAY 331 N I 332 F I=1:1:@GLO@(0) W @GLO@(I),! 333 Q 334 ; 335 TEST ; Run all the test cases 336 D TESTALL^GPLUNIT("GPLXPATH") 337 Q 338 ; 339 OLDTEST ; RUN ALL THE TEST CASES 340 N ZTMP 341 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 342 D ZTEST^GPLUNIT(.ZTMP,"ALL") 343 W "PASSED: ",TPASSED,! 344 W "FAILED: ",TFAILED,! 345 W ! 346 ; W "THE TESTS!",! 347 ; ZWR ZTMP 348 Q 349 ; 350 ZTEST(WHICH) ; RUN ONE SET OF TESTS 351 N ZTMP 352 S DEBUG=1 353 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 354 D ZTEST^GPLUNIT(.ZTMP,WHICH) 355 Q 356 ; 357 TLIST ; LIST THE TESTS 358 N ZTMP 359 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 360 D TLIST^GPLUNIT(.ZTMP) 361 Q 362 ; 363 ;;><TEST> 364 ;;><INIT> 365 ;;>>>K GPL S GPL="" 366 ;;>>>D PUSH^GPLXPATH("GPL","FIRST") 367 ;;>>>D PUSH^GPLXPATH("GPL","SECOND") 368 ;;>>>D PUSH^GPLXPATH("GPL","THIRD") 369 ;;>>>D PUSH^GPLXPATH("GPL","FOURTH") 370 ;;>>?GPL(0)=4 371 ;;><INITXML> 372 ;;>>>K GXML S GXML="" 373 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>") 374 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 375 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>") 376 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>") 377 ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>") 378 ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@") 379 ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>") 380 ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />") 381 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>") 382 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 383 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 384 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 385 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>") 386 ;;><INITXML2> 387 ;;>>>K GXML S GXML="" 388 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>") 389 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 390 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>") 391 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>") 392 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>") 393 ;;>>>D PUSH^GPLXPATH("GXML","DATA2") 394 ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>") 395 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>") 396 ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>") 397 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>") 398 ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>") 399 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 400 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>") 401 ;;><PUSHPOP> 402 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 403 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") 404 ;;>>?GPL(GPL(0))="FOURTH" 405 ;;>>>D POP^GPLXPATH("GPL",.GX) 406 ;;>>?GX="FOURTH" 407 ;;>>?GPL(GPL(0))="THIRD" 408 ;;>>>D POP^GPLXPATH("GPL",.GX) 409 ;;>>?GX="THIRD" 410 ;;>>?GPL(GPL(0))="SECOND" 411 ;;><MKMDX> 412 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 413 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") 414 ;;>>>S GX="" 415 ;;>>>D MKMDX^GPLXPATH("GPL",.GX) 416 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" 417 ;;><XNAME> 418 ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH" 419 ;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH" 420 ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD" 421 ;;><INDEX> 422 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 423 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML") 424 ;;>>>D INDEX^GPLXPATH("GXML") 425 ;;>>?GXML("//FIRST/SECOND")="2^12" 426 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" 427 ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" 428 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" 429 ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8" 430 ;;>>?GXML("//FIRST/SECOND")="2^12" 431 ;;>>?GXML("//FIRST")="1^13" 432 ;;><INDEX2> 433 ;;>>>D ZTEST^GPLXPATH("INITXML2") 434 ;;>>>D INDEX^GPLXPATH("GXML") 435 ;;>>?GXML("//FIRST/SECOND")="2^12" 436 ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" 437 ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10" 438 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" 439 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" 440 ;;>>?GXML("//FIRST")="1^13" 441 ;;><MISSING> 442 ;;>>>D ZTEST^GPLXPATH("INITXML") 443 ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")" 444 ;;>>>D MISSING^GPLXPATH("GXML",OUTARY) 445 ;;>>?@OUTARY@(1)="DATA1" 446 ;;>>?@OUTARY@(2)="DATA2" 447 ;;><MAP> 448 ;;>>>D ZTEST^GPLXPATH("INITXML") 449 ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" 450 ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" 451 ;;>>>S @MAPARY@("DATA2")="VALUE2" 452 ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY) 453 ;;>>?@OUTARY@(6)="VALUE2" 454 ;;><QUEUE> 455 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3) 456 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5) 457 ;;>>?$P(BTLIST(2),";",2)=4 458 ;;><BUILD> 459 ;;>>>D ZTEST^GPLXPATH("INITXML") 460 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2") 461 ;;>>>D ZTEST^GPLXPATH("QUEUE") 462 ;;>>>D BUILD^GPLXPATH("BTLIST","G3") 463 ;;><CP> 464 ;;>>>D ZTEST^GPLXPATH("INITXML") 465 ;;>>>D CP^GPLXPATH("GXML","G2") 466 ;;>>?G2(0)=13 467 ;;><QOPEN> 468 ;;>>>K G2,GBL 469 ;;>>>D ZTEST^GPLXPATH("INITXML") 470 ;;>>>D QOPEN^GPLXPATH("GBL","GXML") 471 ;;>>?$P(GBL(1),";",3)=12 472 ;;>>>D BUILD^GPLXPATH("GBL","G2") 473 ;;>>?G2(G2(0))="</SECOND>" 474 ;;><QOPEN2> 475 ;;>>>K G2,GBL 476 ;;>>>D ZTEST^GPLXPATH("INITXML") 477 ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND") 478 ;;>>?$P(GBL(1),";",3)=11 479 ;;>>>D BUILD^GPLXPATH("GBL","G2") 480 ;;>>?G2(G2(0))="</SECOND>" 481 ;;><QCLOSE> 482 ;;>>>K G2,GBL 483 ;;>>>D ZTEST^GPLXPATH("INITXML") 484 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML") 485 ;;>>?$P(GBL(1),";",3)=13 486 ;;>>>D BUILD^GPLXPATH("GBL","G2") 487 ;;>>?G2(G2(0))="</FIRST>" 488 ;;><QCLOSE2> 489 ;;>>>K G2,GBL 490 ;;>>>D ZTEST^GPLXPATH("INITXML") 491 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD") 492 ;;>>?$P(GBL(1),";",3)=13 493 ;;>>>D BUILD^GPLXPATH("GBL","G2") 494 ;;>>?G2(G2(0))="</FIRST>" 495 ;;>>?G2(1)="</THIRD>" 496 ;;><INSERT> 497 ;;>>>K G2,GBL,G3,G4 498 ;;>>>D ZTEST^GPLXPATH("INITXML") 499 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 500 ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") 501 ;;>>>D INSERT^GPLXPATH("G3","G2","//") 502 ;;>>?G2(1)=GXML(9) 503 ;;><REPLACE> 504 ;;>>>K G2,GBL,G3 505 ;;>>>D ZTEST^GPLXPATH("INITXML") 506 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 507 ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND") 508 ;;>>?GXML(3)="<FIFTH>" 509 ;;><INSINNER> 510 ;;>>>K GXML,G2,GBL,G3 511 ;;>>>D ZTEST^GPLXPATH("INITXML") 512 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") 513 ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") 514 ;;>>?GXML(10)="<FIFTH>" 515 ;;><INSINNER2> 516 ;;>>>K GXML,G2,GBL,G3 517 ;;>>>D ZTEST^GPLXPATH("INITXML") 518 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") 519 ;;>>>D INSINNER^GPLXPATH("G2","G2") 520 ;;>>?G2(8)="<FIFTH>" 521 ;;></TEST> 1 GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 2 ;;0.2;CCDCCR;nopatch;noreleasedate 3 W "This is an XML XPATH utility library",! 4 W ! 5 Q 6 ; 7 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE 8 ; 9 N Y 10 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) 11 I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,! 12 ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml") 13 Q 14 ; 15 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) 16 ; VAL IS A STRING AND STK IS PASSED BY NAME 17 ; 18 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE 19 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH 20 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY 21 Q 22 ; 23 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL 24 ; VAL AND STK ARE PASSED BY REFERENCE 25 ; 26 I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY 27 I @STK@(0)>0 D 28 . S VAL=@STK@(@STK@(0)) 29 . K @STK@(@STK@(0)) 30 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY 31 Q 32 ; 33 MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 34 ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS 35 S RTN="" 36 N I 37 ; W "STK= ",STK,! 38 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY 39 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON 40 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON 41 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) 42 Q 43 ; 44 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG 45 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME 46 ; ISTR IS PASSED BY VALUE 47 N CUR,TMP 48 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET 49 . S TMP=$P(ISTR,"<",2) 50 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME> 51 . S TMP=$P(TMP,"/",2) 52 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME 53 ; W "CUR= ",CUR,! 54 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> 55 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER 56 ; W "CUR2= ",CUR,! 57 Q CUR 58 ; 59 INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index 60 ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE 61 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE 62 ; XML SECTION 63 ; ZXML IS PASSED BY NAME 64 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND 65 N GPLSTK ; LEAVE OUT FOR DEBUGGING 66 I '$D(@ZXML@(0)) D ; NO XML PASSED 67 . W "ERROR IN XML FILE",! 68 S GPLSTK(0)=0 ; INITIALIZE STACK 69 F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY 70 . S LINE=@ZXML@(I) 71 . ;W LINE,! 72 . S FOUND=0 ; INTIALIZED FOUND FLAG 73 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS 74 . I FOUND'=1 D 75 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D 76 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS 77 . . . ; ON THE SAME LINE 78 . . . ; W "FOUND ",LINE,! 79 . . . S FOUND=1 ; SET FOUND FLAG 80 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 81 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK 82 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 83 . . . ; W "MDX=",MDX,! 84 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 85 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 86 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 87 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST 88 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK 89 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END 90 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION 91 . . . ; W "FOUND ",LINE,! 92 . . . S FOUND=1 ; SET FOUND FLAG 93 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 94 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 95 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 96 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK 97 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START 98 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,! 99 . . . . Q 100 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING 101 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION 102 . . . ; W "FOUND ",LINE,! 103 . . . S FOUND=1 ; SET FOUND FLAG 104 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 105 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK 106 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 107 . . . ; W "MDX=",MDX,! 108 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 109 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 110 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 111 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX 112 S @ZXML@("INDEXED")="" 113 S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH 114 Q 115 ; 116 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION 117 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" 118 ; IARY AND OARY ARE PASSED BY NAME 119 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY 120 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML 121 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN 122 N TMP,I,J,QXPATH 123 S FIRST=1 124 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT 125 I XPATH'="//" D ; NOT A ROOT QUERY 126 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES 127 . S FIRST=$P(TMP,"^",1) 128 . S LAST=$P(TMP,"^",2) 129 K @OARY 130 S @OARY@(0)=+LAST-FIRST+1 131 S J=1 132 FOR I=FIRST:1:LAST D 133 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY 134 . S J=J+1 135 ; ZWR OARY 136 Q 137 ; 138 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH 139 ; INDEX WITH TWO PIECES START^FINISH 140 ; IDX IS PASSED BY NAME 141 Q $P(@IDX@(XPATH),"^",1) 142 ; 143 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH 144 ; INDEX WITH TWO PIECES START^FINISH 145 ; IDX IS PASSED BY NAME 146 Q $P(@IDX@(XPATH),"^",2) 147 ; 148 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX 149 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 150 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME 151 Q $P(ISTR,";",2) 152 ; 153 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX 154 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 155 Q $P(ISTR,";",3) 156 ; 157 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX 158 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 159 Q $P(ISTR,";",1) 160 ; 161 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 162 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 163 ; DEST IS CLEARED TO START 164 ; USES PUSH TO DO THE COPY 165 N I 166 K @BDEST 167 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 168 . N J,ATMP 169 . S ATMP=$$ARRAY(@BLIST@(I)) 170 . I DEBUG W "ATMP=",ATMP,! 171 . I DEBUG W @BLIST@(I),! 172 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 173 . . ; FOR EACH LINE IN THIS INSTR 174 . . I DEBUG W "BDEST= ",BDEST,! 175 . . I DEBUG W "ATMP= ",@ATMP@(J),! 176 . . D PUSH(BDEST,@ATMP@(J)) 177 Q 178 ; 179 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 180 ; 181 I DEBUG W "QUEUEING ",BLST,! 182 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 183 Q 184 ; 185 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 186 ; KILLS CPDEST FIRST 187 N CPINSTR 188 I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,! 189 I @CPSRC@(0)<1 D ; BAD LENGTH 190 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 191 . Q 192 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT 193 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 194 D BUILD("CPINSTR",CPDEST) 195 Q 196 ; 197 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 198 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 199 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT 200 ; USED TO INSERT CHILDREN NODES 201 I @QOXML@(0)<1 D ; MALFORMED XML 202 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 203 . Q 204 I DEBUG W "DOING QOPEN",! 205 N S1,E1,QOT,QOTMP 206 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 207 I $D(QOXPATH) D ; XPATH PROVIDED 208 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 209 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 210 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 211 . S E1=@QOXML@(0)-1 212 D QUEUE(QOBLIST,QOXML,S1,E1) 213 ; S QOTMP=QOXML_"^"_S1_"^"_E1 214 ; D PUSH(QOBLIST,QOTMP) 215 Q 216 ; 217 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 218 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 219 ; USED TO FINISH INSERTING CHILDERN NODES 220 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 221 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 222 I @QCXML@(0)<1 D ; MALFORMED XML 223 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 224 I DEBUG W "GOING TO CLOSE",! 225 N S1,E1,QCT,QCTMP 226 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 227 I $D(QCXPATH) D ; XPATH PROVIDED 228 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 229 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 230 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 231 . S S1=@QCXML@(0) 232 D QUEUE(QCBLIST,QCXML,S1,E1) 233 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 234 Q 235 ; 236 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 237 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 238 ; OMITTED, INSERTION WILL BE AT THE ROOT 239 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 240 ; XML AT THE END OF THE XPATH POINT 241 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 242 N INSBLD,INSTMP 243 I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 244 I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 245 I '$D(@INSXML@(0)) D Q ; INSERT INTO AN EMPTY ARRAY 246 . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 247 I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 248 . I $D(INSXPATH) D ; XPATH PROVIDED 249 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 250 . . I DEBUG ZWR INSBLD 251 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 252 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 253 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 254 . I $D(INSXPATH) D ; XPATH PROVIDED 255 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 256 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 257 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 258 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 259 . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 260 Q 261 ; 262 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 263 ; INTO INNXML AT THE INNXPATH XPATH POINT 264 ; 265 N INNBLD,UXPATH 266 N INNTBUF 267 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 268 I '$D(INNXPATH) D ; XPATH NOT PASSED 269 . S UXPATH="//" ; USE ROOT XPATH 270 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 271 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 272 . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER 273 . D BUILD("INNBLD",INNXML) 274 I @INNXML@(0)>0 D ; NOT EMPTY 275 . D QOPEN("INNBLD",INNXML,UXPATH) ; 276 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 277 . D QCLOSE("INNBLD",INNXML,UXPATH) 278 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 279 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 280 Q 281 ; 282 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT 283 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE 284 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE 285 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") 286 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 287 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 288 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 289 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 290 S XFIRST=$P(XNODE,"^",1) 291 S XLAST=$P(XNODE,"^",2) 292 D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE 293 I RENEW'="" D ; NEW XML IS NOT NULL 294 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW 295 D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST 296 I DEBUG W "REPALCE PREBUILD",! 297 I DEBUG ZWR REBLD 298 D BUILD("REBLD","RTMP") 299 K @REXML ; KILL WHAT WAS THERE 300 D CP("RTMP",REXML) ; COPY IN THE RESULT 301 Q 302 ; 303 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY 304 ; W "Reporting on the missing",! 305 ; W OARY 306 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q 307 N I 308 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT 309 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY 310 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE 311 . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY 312 . . Q 313 Q 314 ; 315 MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY 316 ; AND PUT THE RESULTS IN OXML 317 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q 318 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q 319 N I,TNAM,TVAL 320 S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT 321 F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY 322 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT 323 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? 324 . . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME 325 . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? 326 . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE 327 . . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) 328 W "MAPPED",! 329 Q 330 ; 331 PARY(GLO) ;PRINT AN ARRAY 332 N I 333 F I=1:1:@GLO@(0) W @GLO@(I),! 334 Q 335 ; 336 TEST ; Run all the test cases 337 D TESTALL^GPLUNIT("GPLXPATH") 338 Q 339 ; 340 OLDTEST ; RUN ALL THE TEST CASES 341 N ZTMP 342 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 343 D ZTEST^GPLUNIT(.ZTMP,"ALL") 344 W "PASSED: ",TPASSED,! 345 W "FAILED: ",TFAILED,! 346 W ! 347 ; W "THE TESTS!",! 348 ; ZWR ZTMP 349 Q 350 ; 351 ZTEST(WHICH) ; RUN ONE SET OF TESTS 352 N ZTMP 353 S DEBUG=1 354 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 355 D ZTEST^GPLUNIT(.ZTMP,WHICH) 356 Q 357 ; 358 TLIST ; LIST THE TESTS 359 N ZTMP 360 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 361 D TLIST^GPLUNIT(.ZTMP) 362 Q 363 ; 364 ;;><TEST> 365 ;;><INIT> 366 ;;>>>K GPL S GPL="" 367 ;;>>>D PUSH^GPLXPATH("GPL","FIRST") 368 ;;>>>D PUSH^GPLXPATH("GPL","SECOND") 369 ;;>>>D PUSH^GPLXPATH("GPL","THIRD") 370 ;;>>>D PUSH^GPLXPATH("GPL","FOURTH") 371 ;;>>?GPL(0)=4 372 ;;><INITXML> 373 ;;>>>K GXML S GXML="" 374 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>") 375 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 376 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>") 377 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>") 378 ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>") 379 ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@") 380 ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>") 381 ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />") 382 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>") 383 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 384 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 385 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 386 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>") 387 ;;><INITXML2> 388 ;;>>>K GXML S GXML="" 389 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>") 390 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 391 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>") 392 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>") 393 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>") 394 ;;>>>D PUSH^GPLXPATH("GXML","DATA2") 395 ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>") 396 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>") 397 ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>") 398 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>") 399 ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>") 400 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 401 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>") 402 ;;><PUSHPOP> 403 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 404 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") 405 ;;>>?GPL(GPL(0))="FOURTH" 406 ;;>>>D POP^GPLXPATH("GPL",.GX) 407 ;;>>?GX="FOURTH" 408 ;;>>?GPL(GPL(0))="THIRD" 409 ;;>>>D POP^GPLXPATH("GPL",.GX) 410 ;;>>?GX="THIRD" 411 ;;>>?GPL(GPL(0))="SECOND" 412 ;;><MKMDX> 413 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 414 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") 415 ;;>>>S GX="" 416 ;;>>>D MKMDX^GPLXPATH("GPL",.GX) 417 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" 418 ;;><XNAME> 419 ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH" 420 ;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH" 421 ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD" 422 ;;><INDEX> 423 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 424 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML") 425 ;;>>>D INDEX^GPLXPATH("GXML") 426 ;;>>?GXML("//FIRST/SECOND")="2^12" 427 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" 428 ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" 429 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" 430 ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8" 431 ;;>>?GXML("//FIRST/SECOND")="2^12" 432 ;;>>?GXML("//FIRST")="1^13" 433 ;;><INDEX2> 434 ;;>>>D ZTEST^GPLXPATH("INITXML2") 435 ;;>>>D INDEX^GPLXPATH("GXML") 436 ;;>>?GXML("//FIRST/SECOND")="2^12" 437 ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" 438 ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10" 439 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" 440 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" 441 ;;>>?GXML("//FIRST")="1^13" 442 ;;><MISSING> 443 ;;>>>D ZTEST^GPLXPATH("INITXML") 444 ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")" 445 ;;>>>D MISSING^GPLXPATH("GXML",OUTARY) 446 ;;>>?@OUTARY@(1)="DATA1" 447 ;;>>?@OUTARY@(2)="DATA2" 448 ;;><MAP> 449 ;;>>>D ZTEST^GPLXPATH("INITXML") 450 ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" 451 ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" 452 ;;>>>S @MAPARY@("DATA2")="VALUE2" 453 ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY) 454 ;;>>?@OUTARY@(6)="VALUE2" 455 ;;><QUEUE> 456 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3) 457 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5) 458 ;;>>?$P(BTLIST(2),";",2)=4 459 ;;><BUILD> 460 ;;>>>D ZTEST^GPLXPATH("INITXML") 461 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2") 462 ;;>>>D ZTEST^GPLXPATH("QUEUE") 463 ;;>>>D BUILD^GPLXPATH("BTLIST","G3") 464 ;;><CP> 465 ;;>>>D ZTEST^GPLXPATH("INITXML") 466 ;;>>>D CP^GPLXPATH("GXML","G2") 467 ;;>>?G2(0)=13 468 ;;><QOPEN> 469 ;;>>>K G2,GBL 470 ;;>>>D ZTEST^GPLXPATH("INITXML") 471 ;;>>>D QOPEN^GPLXPATH("GBL","GXML") 472 ;;>>?$P(GBL(1),";",3)=12 473 ;;>>>D BUILD^GPLXPATH("GBL","G2") 474 ;;>>?G2(G2(0))="</SECOND>" 475 ;;><QOPEN2> 476 ;;>>>K G2,GBL 477 ;;>>>D ZTEST^GPLXPATH("INITXML") 478 ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND") 479 ;;>>?$P(GBL(1),";",3)=11 480 ;;>>>D BUILD^GPLXPATH("GBL","G2") 481 ;;>>?G2(G2(0))="</SECOND>" 482 ;;><QCLOSE> 483 ;;>>>K G2,GBL 484 ;;>>>D ZTEST^GPLXPATH("INITXML") 485 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML") 486 ;;>>?$P(GBL(1),";",3)=13 487 ;;>>>D BUILD^GPLXPATH("GBL","G2") 488 ;;>>?G2(G2(0))="</FIRST>" 489 ;;><QCLOSE2> 490 ;;>>>K G2,GBL 491 ;;>>>D ZTEST^GPLXPATH("INITXML") 492 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD") 493 ;;>>?$P(GBL(1),";",3)=13 494 ;;>>>D BUILD^GPLXPATH("GBL","G2") 495 ;;>>?G2(G2(0))="</FIRST>" 496 ;;>>?G2(1)="</THIRD>" 497 ;;><INSERT> 498 ;;>>>K G2,GBL,G3,G4 499 ;;>>>D ZTEST^GPLXPATH("INITXML") 500 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 501 ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") 502 ;;>>>D INSERT^GPLXPATH("G3","G2","//") 503 ;;>>?G2(1)=GXML(9) 504 ;;><REPLACE> 505 ;;>>>K G2,GBL,G3 506 ;;>>>D ZTEST^GPLXPATH("INITXML") 507 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 508 ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND") 509 ;;>>?GXML(3)="<FIFTH>" 510 ;;><INSINNER> 511 ;;>>>K GXML,G2,GBL,G3 512 ;;>>>D ZTEST^GPLXPATH("INITXML") 513 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") 514 ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") 515 ;;>>?GXML(10)="<FIFTH>" 516 ;;><INSINNER2> 517 ;;>>>K GXML,G2,GBL,G3 518 ;;>>>D ZTEST^GPLXPATH("INITXML") 519 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") 520 ;;>>>D INSINNER^GPLXPATH("G2","G2") 521 ;;>>?G2(8)="<FIFTH>" 522 ;;></TEST>
Note:
See TracChangeset
for help on using the changeset viewer.