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

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

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