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

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

less debugging output from Trim, normalize 2 template lines
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 @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.