Changeset 34 for ccr/trunk/p/GPLXPATH.m
- Timestamp:
- Jul 2, 2008, 12:34:15 PM (18 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/GPLXPATH.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLXPATH.m
r27 r34 1 GPLXPATH 2 3 4 5 6 7 OUTPUT(OUTARY,OUTNAME,OUTDIR) 8 9 10 11 12 13 14 15 PUSH(STK,VAL) 16 17 18 19 20 21 22 23 POP(STK,VAL) 24 25 26 27 28 29 30 31 32 33 MKMDX(STK,RTN) 34 35 36 37 38 39 40 41 42 43 44 XNAME(ISTR) 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 INDEX(ZXML) 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 QUERY(IARY,XPATH,OARY) 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 XF(IDX,XPATH) 138 139 140 141 142 XL(IDX,XPATH) 143 144 145 146 147 START(ISTR) 148 149 150 151 152 FINISH(ISTR) 153 154 155 156 ARRAY(ISTR) 157 158 159 160 BUILD(BLIST,BDEST) 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 QUEUE(BLST,ARRAY,FIRST,LAST) 179 180 181 182 183 184 CP(CPSRC,CPDEST) 185 186 187 188 189 190 191 192 193 194 195 196 QOPEN(QOBLIST,QOXML,QOXPATH) 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 QCLOSE(QCBLIST,QCXML,QCXPATH) 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 INSERT(INSXML,INSNEW,INSXPATH) 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 INSINNER(INNXML,INNNEW,INNXPATH) 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 REPLACE(REXML,RENEW,REXPATH) 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 MISSING(IXML,OARY) 303 304 305 306 307 308 309 310 311 312 313 314 MAP(IXML,INARY,OXML) 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 PARY(GLO) 331 332 333 334 335 TEST 336 337 338 339 OLDTEST 340 341 342 343 344 345 346 347 348 349 350 ZTEST(WHICH) 351 352 353 354 355 356 357 TLIST 358 359 360 361 362 363 ;;><TEST> 364 ;;><INIT> 365 ;;>>>K 366 ;;>>>D 367 ;;>>>D 368 ;;>>>D 369 ;;>>>D 370 ;;>>?GPL(0)=4 371 ;;><INITXML> 372 ;;>>>K 373 ;;>>>D 374 ;;>>>D 375 ;;>>>D 376 ;;>>>D 377 ;;>>>D 378 ;;>>>D 379 ;;>>>D 380 ;;>>>D 381 ;;>>>D 382 ;;>>>D 383 ;;>>>D 384 ;;>>>D 385 ;;>>>D 386 ;;><INITXML2> 387 ;;>>>K 388 ;;>>>D 389 ;;>>>D 390 ;;>>>D 391 ;;>>>D 392 ;;>>>D 393 ;;>>>D 394 ;;>>>D 395 ;;>>>D 396 ;;>>>D 397 ;;>>>D 398 ;;>>>D 399 ;;>>>D 400 ;;>>>D 401 ;;><PUSHPOP> 402 ;;>>>D 403 ;;>>>D 404 ;;>>?GPL(GPL(0))="FOURTH" 405 ;;>>>D 406 ;;>>?GX="FOURTH" 407 ;;>>?GPL(GPL(0))="THIRD" 408 ;;>>>D 409 ;;>>?GX="THIRD" 410 ;;>>?GPL(GPL(0))="SECOND" 411 ;;><MKMDX> 412 ;;>>>D 413 ;;>>>D 414 ;;>>>S 415 ;;>>>D 416 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" 417 ;;><XNAME> 418 ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH" 419 ;;>>?$$XNAME^GPLXPATH("<SIXTH 420 ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD" 421 ;;><INDEX> 422 ;;>>>D 423 ;;>>>D 424 ;;>>>D 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 434 ;;>>>D 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 443 ;;>>>S 444 ;;>>>D 445 ;;>>?@OUTARY@(1)="DATA1" 446 ;;>>?@OUTARY@(2)="DATA2" 447 ;;><MAP> 448 ;;>>>D 449 ;;>>>S 450 ;;>>>S 451 ;;>>>S 452 ;;>>>D 453 ;;>>?@OUTARY@(6)="VALUE2" 454 ;;><QUEUE> 455 ;;>>>D 456 ;;>>>D 457 ;;>>?$P(BTLIST(2),";",2)=4 458 ;;><BUILD> 459 ;;>>>D 460 ;;>>>D 461 ;;>>>D 462 ;;>>>D 463 ;;><CP> 464 ;;>>>D 465 ;;>>>D 466 ;;>>?G2(0)=13 467 ;;><QOPEN> 468 ;;>>>K 469 ;;>>>D 470 ;;>>>D 471 ;;>>?$P(GBL(1),";",3)=12 472 ;;>>>D 473 ;;>>?G2(G2(0))="</SECOND>" 474 ;;><QOPEN2> 475 ;;>>>K 476 ;;>>>D 477 ;;>>>D 478 ;;>>?$P(GBL(1),";",3)=11 479 ;;>>>D 480 ;;>>?G2(G2(0))="</SECOND>" 481 ;;><QCLOSE> 482 ;;>>>K 483 ;;>>>D 484 ;;>>>D 485 ;;>>?$P(GBL(1),";",3)=13 486 ;;>>>D 487 ;;>>?G2(G2(0))="</FIRST>" 488 ;;><QCLOSE2> 489 ;;>>>K 490 ;;>>>D 491 ;;>>>D 492 ;;>>?$P(GBL(1),";",3)=13 493 ;;>>>D 494 ;;>>?G2(G2(0))="</FIRST>" 495 ;;>>?G2(1)="</THIRD>" 496 ;;><INSERT> 497 ;;>>>K 498 ;;>>>D 499 ;;>>>D 500 ;;>>>D 501 ;;>>>D 502 ;;>>?G2(1)=GXML(9) 503 ;;><REPLACE> 504 ;;>>>K 505 ;;>>>D 506 ;;>>>D 507 ;;>>>D 508 ;;>>?GXML(3)="<FIFTH>" 509 ;;><INSINNER> 510 ;;>>>K 511 ;;>>>D 512 ;;>>>D 513 ;;>>>D 514 ;;>>?GXML(10)="<FIFTH>" 515 ;;><INSINNER2> 516 ;;>>>K 517 ;;>>>D 518 ;;>>>D 519 ;;>>>D 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 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>
Note:
See TracChangeset
for help on using the changeset viewer.
