source: FOIAVistA/tag/r/XML_PARSER-MXML/MXMLPRS1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1MXMLPRS1 ;SAIC/DKM - XML Parser ;12/04/2002 15:55
2 ;;7.3;TOOLKIT;**58,67**;Apr 25, 1995
3 ;=================================================================
4 ; Initialize tables
5INIT N X,Y,Z
6 F X=0:1 S Y=$P($T(ENTITIES+X),";;",2,99) Q:'$L(Y) D
7 .D SETENT^MXMLPRSE($P(Y,";"),$P(Y,";",2,99))
8 F X=0:1 S Y=$P($T(DTDTAG+X),";;",2,99) Q:'$L(Y) D
9 .S DTD($P(Y,";"))=$P(Y,";",2)
10 F X=0:1 S Y=$P($T(TYPE+X),";;",2,99) Q:'$L(Y) D
11 .S ^TMP(ID,$J,"TYP",$P(Y,";",2))=+Y
12 F X=0:1 S Y=$P($T(MOD+X),";;",2,99) Q:'$L(Y) D
13 .S ^TMP(ID,$J,"MOD",$P(Y,";",2))=+Y
14 F X=0:1 S Y=$P($T(REF+X),";;",2,99) Q:'$L(Y) D
15 .S ^TMP(ID,$J,"REF",$P(Y,";",2))=+Y
16 F X=0:1 S Y=$P($T(CBKARGS+X),";;",2,99) Q:'$L(Y) D
17 .S ^TMP(ID,$J,"CBK",$P(Y,";",2))=+Y
18 F X=0:1 S Y=$P($T(PROLOG+X),";;",2,99) Q:'$L(Y) D
19 .S Z=$P(Y,";"),^TMP(ID,$J,"ATT","?xml",Z)="1^"_$S('X:1,1:2)
20 .F S Y=$P(Y,";",2,99) Q:'$L(Y) S ^TMP(ID,$J,"ATT","?xml",Z,$P(Y,";"))=""
21 Q
22 ; Search parse tree for child element (CHILD) under parent element
23 ; (ELEMENT) starting at specified node (NODE).
24 ; Returns next node # in parse tree or 0
25 ; If validation is disabled, the function always returns 1.
26 ; If parent element is marked as EMPTY, 0 is returned.
27 ; If parent element is marked as ANY, 1 is returned.
28ISCHILD(ELEMENT,CHILD,NODE) ;
29 N TRN
30 S TRN=+$G(^TMP(ID,$J,"ELE",ELEMENT),2)
31 Q $S(OPTION'["V"!'NODE:1,TRN=1:CHILD="*",TRN=2:1,1:$$IC(NODE))
32IC(NODE) N X,Y
33 S X=+$G(^TMP(ID,$J,"ELE",ELEMENT,NODE,CHILD)),Y=0
34 I 'X D
35 .F S Y=$O(^TMP(ID,$J,"ELE",ELEMENT,NODE,Y)) Q:'Y D Q:X
36 ..S:'$D(TRN(NODE,Y)) TRN(NODE,Y)="",X=$$IC(Y)
37 Q X
38 ; Check attribute value for validity
39CHKVAL(ENAME,ANAME,VALUE) ;
40 N TYPE,X,Y,Z
41 Q:'$L(VALUE)
42 I $D(^TMP(ID,$J,"ATT",ENAME,ANAME))>1 D:'$D(^(ANAME,VALUE)) ERROR(38,VALUE) Q
43 S TYPE=+$G(^TMP(ID,$J,"ATT",ENAME,ANAME))
44 Q:'TYPE
45 I TYPE=5 D Q ; ID type
46 .I '$$ISNAME(VALUE) D ERROR(38,VALUE) Q
47 .I '$D(^TMP(ID,$J,"ID",VALUE)) D
48 ..S ^(VALUE)=""
49 ..D NOFWD("ID",VALUE)
50 .E D ERROR(28,VALUE)
51 I TYPE=9!(TYPE=10) D Q ; ENTITY/ENTITIES type
52 .S X=$S(TYPE=9:" ",1:" ")
53 .F Z=1:1:$L(VALUE,X) D FWD("UNP",$P(VALUE,X,Z))
54 I TYPE=3!(TYPE=4) D Q ; NMTOKEN/NMTOKENS type
55 .S X=$S(TYPE=3:" ",1:" ")
56 .F Z=1:1:$L(VALUE,X) D
57 ..S Y=$P(VALUE,X,Z)
58 ..D:'$$ISNMTKN(Y) ERROR(38,Y)
59 I TYPE=6!(TYPE=7) D Q ; IDREF/IDREFS type
60 .S X=$S(TYPE=6:" ",1:" ")
61 .F Z=1:1:$L(VALUE,X) D
62 ..S Y=$P(VALUE,X,Z)
63 ..I '$$ISNAME(Y) D ERROR(38,Y) Q
64 ..D FWD("ID",Y)
65 Q
66 ; Return true if valid name
67ISNAME(VALUE) ;
68 Q VALUE?1(1A,1"_",1":").(1AN,1".",1"-",1"_",1":")
69 ; Return true if valid name token
70ISNMTKN(VALUE) ;
71 Q VALUE?1.(1AN,1".",1"-",1"_",1":")
72 ; Log a forward reference
73FWD(TYPE,VALUE) ;
74 Q:'$L(VALUE)
75 Q:$D(^TMP(ID,$J,TYPE,VALUE))
76 N Z
77 S Z=$O(^TMP(ID,$J,"REF",TYPE,VALUE,""),-1)+1
78 M ^(Z)=ERR
79 Q
80 ; Resolve forward reference
81NOFWD(TYPE,VALUE) ;
82 K ^TMP(ID,$J,"REF",TYPE,VALUE)
83 Q
84 ; Signal unresolved references
85UNRESLV N X,Y,Z,E
86 F X=1:1:LVL D
87 .K ERR
88 .M ERR=LVL(X)
89 .D ERROR(8,LVL(X))
90 S X=""
91 F S X=$O(^TMP(ID,$J,"REF",X)),Y="" Q:'$L(X) D ; Look for IDREF w/o corresponding ID value
92 .S E=^(X)
93 .F S Y=$O(^TMP(ID,$J,"REF",X,Y)),Z=0 Q:'$L(Y) D
94 ..F S Z=$O(^TMP(ID,$J,"REF",X,Y,Z)) Q:'Z D
95 ...K ERR
96 ...M ERR=^(Z)
97 ...D ERROR(E,Y)
98 Q
99 ; Log error
100ERROR(X,Y) D ERROR^MXMLPRSE(.X,.Y) Q
101 ; Predefined general entities
102 ; Format=entity name;entity value
103ENTITIES ;;amp;&
104 ;;lt;<
105 ;;gt;>
106 ;;quot;"
107 ;;apos;'
108 ;;
109 ; Callback events
110 ; Format=#args;event type
111CBKARGS ;;0;STARTDOCUMENT
112 ;;0;ENDDOCUMENT
113 ;;3;DOCTYPE
114 ;;1;CHARACTERS
115 ;;2;STARTELEMENT
116 ;;1;ENDELEMENT
117 ;;3;NOTATION
118 ;;2;PI
119 ;;1;COMMENT
120 ;;3;EXTERNAL
121 ;;1;ERROR
122 ;;
123 ; Prolog attributes
124 ; Format=attribute name;val1;val2;...;valn
125PROLOG ;;version;1.0
126 ;;encoding;UTF-8;utf-8
127 ;;standalone;no;yes
128 ;;
129 ; Recognized DTD tags
130 ; Format=tag name;state
131DTDTAG ;;ENTITY;20
132 ;;ELEMENT;30
133 ;;ATTLIST;40
134 ;;NOTATION;50
135 ;;[;60
136 ;;
137 ; Attribute types
138 ; Format=identifier;type
139TYPE ;;1;(
140 ;;2;CDATA
141 ;;3;NMTOKEN
142 ;;4;NMTOKENS
143 ;;5;ID
144 ;;6;IDREF
145 ;;7;IDREFS
146 ;;8;NOTATION
147 ;;9;ENTITY
148 ;;10;ENTITIES
149 ;;
150 ; Default modifiers
151 ; Format=identifier;modifier
152MOD ;;1;#REQUIRED
153 ;;2;#IMPLIED
154 ;;3;#FIXED
155 ;;
156 ; Forward references
157 ; Format=type;error #;type
158REF ;;49;UNP
159 ;;46;NOT
160 ;;26;ELE
161 ;;47;ID
162 ;;
Note: See TracBrowser for help on using the repository browser.