source: ccr/trunk/p/GPLXPATH.m@ 56

Last change on this file since 56 was 56, checked in by George Lilly, 16 years ago

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