source: ccr/trunk/p/C0CXPATH.m@ 392

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

name spacing the package to C0C ... removing all GPL references

File size: 18.0 KB
Line 
1C0CXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
2 ;;0.2;CCDCCR;nopatch;noreleasedate
3 ;Copyright 2008 George Lilly. 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 Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
29 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
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 ;
52PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
53 ;
54 N ZGI
55 F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY
56 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
57 Q
58 ;
59MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
60 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
61 S RTN=""
62 N I
63 ; W "STK= ",STK,!
64 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
65 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
66 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
67 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
68 Q
69 ;
70XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
71 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
72 ; ISTR IS PASSED BY VALUE
73 N CUR,TMP
74 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
75 . S TMP=$P(ISTR,"<",2)
76 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
77 . S TMP=$P(TMP,"/",2)
78 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
79 ; W "CUR= ",CUR,!
80 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
81 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
82 ; W "CUR2= ",CUR,!
83 Q CUR
84 ;
85INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
86 ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
87 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
88 ; XML SECTION
89 ; ZXML IS PASSED BY NAME
90 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
91 N C0CSTK ; LEAVE OUT FOR DEBUGGING
92 I '$D(@ZXML@(0)) D ; NO XML PASSED
93 . W "ERROR IN XML FILE",!
94 S C0CSTK(0)=0 ; INITIALIZE STACK
95 F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY
96 . S LINE=@ZXML@(I)
97 . ;W LINE,!
98 . S FOUND=0 ; INTIALIZED FOUND FLAG
99 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
100 . I FOUND'=1 D
101 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
102 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
103 . . . ; ON THE SAME LINE
104 . . . ; W "FOUND ",LINE,!
105 . . . S FOUND=1 ; SET FOUND FLAG
106 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
107 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
108 . . . D MKMDX("C0CSTK",.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_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST
114 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
115 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END
116 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
117 . . . ; W "FOUND ",LINE,!
118 . . . S FOUND=1 ; SET FOUND FLAG
119 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
120 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
121 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
122 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
123 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
124 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
125 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
126 . . . . Q
127 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
128 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
129 . . . ; W "FOUND ",LINE,!
130 . . . S FOUND=1 ; SET FOUND FLAG
131 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
132 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
133 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
134 . . . ; W "MDX=",MDX,!
135 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
136 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
137 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
138 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
139 S @ZXML@("INDEXED")=""
140 S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
141 Q
142 ;
143QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
144 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
145 ; IARY AND OARY ARE PASSED BY NAME
146 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
147 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
148 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
149 N TMP,I,J,QXPATH
150 S FIRST=1
151 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
152 I XPATH'="//" D ; NOT A ROOT QUERY
153 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
154 . S FIRST=$P(TMP,"^",1)
155 . S LAST=$P(TMP,"^",2)
156 K @OARY
157 S @OARY@(0)=+LAST-FIRST+1
158 S J=1
159 FOR I=FIRST:1:LAST D
160 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
161 . S J=J+1
162 ; ZWR OARY
163 Q
164 ;
165XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
166 ; INDEX WITH TWO PIECES START^FINISH
167 ; IDX IS PASSED BY NAME
168 Q $P(@IDX@(XPATH),"^",1)
169 ;
170XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
171 ; INDEX WITH TWO PIECES START^FINISH
172 ; IDX IS PASSED BY NAME
173 Q $P(@IDX@(XPATH),"^",2)
174 ;
175START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
176 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
177 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
178 Q $P(ISTR,";",2)
179 ;
180FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
181 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
182 Q $P(ISTR,";",3)
183 ;
184ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
185 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
186 Q $P(ISTR,";",1)
187 ;
188BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
189 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
190 ; DEST IS CLEARED TO START
191 ; USES PUSH TO DO THE COPY
192 N I
193 K @BDEST
194 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
195 . N J,ATMP
196 . S ATMP=$$ARRAY(@BLIST@(I))
197 . I DEBUG W "ATMP=",ATMP,!
198 . I DEBUG W @BLIST@(I),!
199 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
200 . . ; FOR EACH LINE IN THIS INSTR
201 . . I DEBUG W "BDEST= ",BDEST,!
202 . . I DEBUG W "ATMP= ",@ATMP@(J),!
203 . . D PUSH(BDEST,@ATMP@(J))
204 Q
205 ;
206QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
207 ;
208 I DEBUG W "QUEUEING ",BLST,!
209 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
210 Q
211 ;
212CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
213 ; KILLS CPDEST FIRST
214 N CPINSTR
215 I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
216 I @CPSRC@(0)<1 D ; BAD LENGTH
217 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
218 . Q
219 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
220 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
221 D BUILD("CPINSTR",CPDEST)
222 Q
223 ;
224QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
225 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
226 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
227 ; USED TO INSERT CHILDREN NODES
228 I @QOXML@(0)<1 D ; MALFORMED XML
229 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
230 . Q
231 I DEBUG W "DOING QOPEN",!
232 N S1,E1,QOT,QOTMP
233 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
234 I $D(QOXPATH) D ; XPATH PROVIDED
235 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
236 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
237 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
238 . S E1=@QOXML@(0)-1
239 D QUEUE(QOBLIST,QOXML,S1,E1)
240 ; S QOTMP=QOXML_"^"_S1_"^"_E1
241 ; D PUSH(QOBLIST,QOTMP)
242 Q
243 ;
244QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
245 ; ADDS THE LIST LINE OF QCXML TO QCBLIST
246 ; USED TO FINISH INSERTING CHILDERN NODES
247 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
248 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
249 I @QCXML@(0)<1 D ; MALFORMED XML
250 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
251 I DEBUG W "GOING TO CLOSE",!
252 N S1,E1,QCT,QCTMP
253 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
254 I $D(QCXPATH) D ; XPATH PROVIDED
255 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
256 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
257 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
258 . S S1=@QCXML@(0)
259 D QUEUE(QCBLIST,QCXML,S1,E1)
260 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
261 Q
262 ;
263INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
264 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
265 ; OMITTED, INSERTION WILL BE AT THE ROOT
266 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
267 ; XML AT THE END OF THE XPATH POINT
268 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
269 N INSBLD,INSTMP
270 I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
271 I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
272 I '$D(@INSXML@(0)) D ; INSERT INTO AN EMPTY ARRAY
273 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
274 I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
275 . I $D(INSXPATH) D ; XPATH PROVIDED
276 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
277 . . I DEBUG D PARY^C0CXPATH("INSBLD")
278 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
279 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
280 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
281 . I $D(INSXPATH) D ; XPATH PROVIDED
282 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
283 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
284 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
285 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
286 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
287 Q
288 ;
289INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
290 ; INTO INNXML AT THE INNXPATH XPATH POINT
291 ;
292 N INNBLD,UXPATH
293 N INNTBUF
294 S INNTBUF=$NA(^TMP($J,"INNTBUF"))
295 I '$D(INNXPATH) D ; XPATH NOT PASSED
296 . S UXPATH="//" ; USE ROOT XPATH
297 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
298 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
299 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
300 . D BUILD("INNBLD",INNXML)
301 I @INNXML@(0)>0 D ; NOT EMPTY
302 . D QOPEN("INNBLD",INNXML,UXPATH) ;
303 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
304 . D QCLOSE("INNBLD",INNXML,UXPATH)
305 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
306 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
307 Q
308 ;
309INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
310 ; BUT XDEST AN XNEW ARE PASSED BY NAME
311 N XBLD,XTMP
312 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
313 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
314 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
315 D BUILD("XBLD","XTMP") ; BUILD THE RESULT
316 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
317 I DEBUG D PARY("XDEST")
318 Q
319 ;
320REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
321 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
322 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
323 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
324 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
325 S OLD=$NA(^TMP($J,"REPLACE_OLD"))
326 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
327 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
328 S XFIRST=$P(XNODE,"^",1)
329 S XLAST=$P(XNODE,"^",2)
330 I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
331 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
332 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
333 I RENEW'="" D ; NEW XML IS NOT NULL
334 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
335 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
336 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
337 I DEBUG W "REPLACE PREBUILD",!
338 I DEBUG D PARY("REBLD")
339 D BUILD("REBLD","RTMP")
340 K @REXML ; KILL WHAT WAS THERE
341 D CP("RTMP",REXML) ; COPY IN THE RESULT
342 Q
343 ;
344MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
345 ; W "Reporting on the missing",!
346 ; W OARY
347 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
348 N I
349 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
350 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
351 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
352 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
353 . . Q
354 Q
355 ;
356MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
357 ; AND PUT THE RESULTS IN OXML
358 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
359 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
360 N I,J,TNAM,TVAL,TSTR
361 S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
362 F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY
363 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
364 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
365 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
366 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
367 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
368 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
369 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
370 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
371 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
372 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
373 . . . . E D DOFLD ; PROCESS A FIELD
374 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
375 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
376 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
377 . . I DEBUG W TSTR
378 I DEBUG W "MAPPED",!
379 Q
380 ;
381DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
382 ;
383 Q
384 ;
385TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
386 ; THEXML IS PASSED BY NAME
387 N I,J,TMPXML,DEL,FOUND,INTXT
388 S FOUND=0
389 S INTXT=0
390 I DEBUG W "DELETING EMPTY ELEMENTS",!
391 F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
392 . S J=@THEXML@(I)
393 . I J["<text>" D
394 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
395 . . I DEBUG W "IN HTML SECTION",!
396 . N JM,JP,JPX ; JMINUS AND JPLUS
397 . S JM=@THEXML@(I-1) ; LINE BEFORE
398 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
399 . S JP=@THEXML@(I+1) ; LINE AFTER
400 . I INTXT=0 D ; IF NOT IN AN HTML SECTION
401 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
402 . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
403 . . . I DEBUG W I,J,JP,!
404 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
405 . . . S DEL(I)="" ; SET LINE TO DELETE
406 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
407 . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
408 . . . I DEBUG W I,J,!
409 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
410 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
411 . . . I JM=JPX D ;
412 . . . . I DEBUG W I,JM_J_JPX,!
413 . . . . S DEL(I-1)=""
414 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
415 ; . I J'["><" D PUSH("TMPXML",J)
416 I FOUND D ; NEED TO DELETE THINGS
417 . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
418 . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
419 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
420 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
421 Q FOUND
422 ;
423UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
424 ; XSEC IS A SECTION PASSED BY NAME
425 N XBLD,XTMP
426 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
427 D BUILD("XBLD","XTMP") ; BUILD THE RESULT
428 D CP("XTMP",XSEC) ; REPLACE PASSED XML
429 Q
430 ;
431PARY(GLO) ;PRINT AN ARRAY
432 N I
433 F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
434 Q
435 ;
436H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
437 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
438 I '$D(IPRE) S IPRE=""
439 N H2I S H2I=""
440 ; W $O(@IHASH@(H2I)),!
441 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH
442 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES
443 . . ;W H2I_"^"_@IHASH@(H2I),!
444 . . N IH,IHI
445 . . S IH=$NA(@IHASH@(H2I)) ;
446 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
447 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
448 . . S IHI="" ; INDEX INTO "M" MULTIPLES
449 . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE
450 . . . ; W @IH@(IHI)
451 . . . S IH3=$NA(@IH2@(IHI))
452 . . . ; W "HEY",IH3,!
453 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
454 . . ; W IH,!
455 . . ; W "C0CZZ",!
456 . . ; W $NA(@IHASH@(H2I)),!
457 . . Q ;
458 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
459 . ; W @IARYRTN@(0),!
460 Q
461 ;
462XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
463 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
464 ; XVRTN AND XVIXML ARE PASSED BY NAME
465 ;
466 N XVI,XVTMP,XVT
467 F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML
468 . S XVT=@XVIXML@(XVI)
469 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
470 D H2ARY(XVRTN,"XVTMP")
471 Q
472 ;
473DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
474 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
475 ;
476 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
477 I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE
478 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
479 . S DXUSE="DTMP" ; DXUSE IS NAME
480 E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE
481 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
482 . S DXUSE="DTMP" ; DXUSE IS NAME
483 E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
484 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
485 D XVARS("DVARS",DXUSE) ; PULL OUT VARS
486 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
487 Q
488 ;
489TEST ; Run all the test cases
490 D TESTALL^C0CUNIT("C0CXPAT0")
491 Q
492 ;
493ZTEST(WHICH) ; RUN ONE SET OF TESTS
494 N ZTMP
495 S DEBUG=1
496 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
497 D ZTEST^C0CUNIT(.ZTMP,WHICH)
498 Q
499 ;
500TLIST ; LIST THE TESTS
501 N ZTMP
502 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
503 D TLIST^C0CUNIT(.ZTMP)
504 Q
505 ;
Note: See TracBrowser for help on using the repository browser.