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

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

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