source: cprs/branches/tmg-cprs/m_files/TMGXMLP.m@ 1099

Last change on this file since 1099 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 5.9 KB
Line 
1TMGXMLP;TMG/kst/Detail XML Parsing functions ;03/25/06
2 ;;1.0;TMG-LIB;**1**;01/01/05
3
4 ;"TMG DETAIL XML PARSE FUNCTIONS
5
6 ;"=======================================================================
7 ;" API -- Public Functions.
8 ;"=======================================================================
9 ;"DetailParse ;
10 ;"ListChildren(Node,IndentN)
11
12
13 ;"=======================================================================
14 ;"PRIVATE API FUNCTIONS
15 ;"=======================================================================
16 ;"StartDoc
17 ;"EndDoc
18 ;"DocType(ROOT,PUBID,SYSID)
19 ;"StartElement(NAME,ATTRLIST)
20 ;"EndElement(NAME)
21 ;"Chars(TEXT)
22 ;"ParseErr(ERR)
23 ;"ShowNode(Node,IndentN)
24 ;"Indent(IndentN)
25 ;"=================================================================
26
27DetailParse(pArray)
28 ;"Purpose: To do a detailed deconstruction of parse to detect errors.
29 ;"Input: pArray -- PASS BY NAME. OPTIONAL.
30 ;" Default = $name(^TMP("TMG",$J))
31 ;"Output: Puts info to debug stream
32 ;"results: none
33
34 ;"if $data(TMGDEBUG)#10=0 goto QuitLabel
35
36 new Y,PATH,FILE,GBLREF
37
38 set pArray=$get(pArray,$name(^TMP("TMG",$J)))
39
40 new FnArray set FnArray="Array of Callback Functions"
41 set FnArray("ERROR")="ParseErr^TMGXMLP"
42
43 set FnArray("STARTDOCUMENT")="StartDoc^TMGXMLP"
44 set FnArray("ENDDOCUMENT")="EndDoc^TMGXMLP"
45 set FnArray("DOCTYPE")="DocType^TMGXMLP"
46 set FnArray("STARTELEMENT")="StartElement^TMGXMLP"
47 set FnArray("ENDELEMENT")="EndElement^TMGXMLP"
48 set FnArray("CHARACTERS")="Chars^TMGXMLP"
49
50 do DebugMsg^TMGDEBUG(DBIndent,"This part of the program will do a detailed parse analysis...")
51 do DebugMsg^TMGDEBUG(DBIndent,"Hopefully this will reveal the parsing error.")
52
53 do DebugMsg^TMGDEBUG(DBIndent,"Here is loaded file that is being parsed:")
54 new % set %=1
55 write "View array containing XML data"
56 do YN^DICN write !
57 if %=1 do ArrayDump^TMGDEBUG(pArray)
58 if %=-1 goto QuitLabel
59
60 do DebugMsg^TMGDEBUG(DBIndent,"Calling EN^MXMLPRSE (a detailed parse assessment.)")
61 do DebugMsg^TMGDEBUG(DBIndent,"As each element of the XML file is encountered, it will be listed.")
62 do EN^MXMLPRSE(pArray,.FnArray,"V")
63 do DebugMsg^TMGDEBUG(DBIndent,"Done calling EN^MXMLPRSE")
64
65 do DebugMsg^TMGDEBUG(DBIndent,"---------------------------")
66
67QuitLabel quit
68
69
70
71StartDoc
72 do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
73 do DebugMsg^TMGDEBUG(DBIndent,"##Starting Document Processing##")
74 quit
75
76EndDoc
77 do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
78 do DebugMsg^TMGDEBUG(DBIndent,"##End of Document Processing##")
79 quit
80
81
82DocType(ROOT,PUBID,SYSID)
83 do DebugMsg^TMGDEBUG(DBIndent,"--------------------")
84 do DebugMsg^TMGDEBUG(DBIndent,"Doctype encountered.")
85 do DebugMsg^TMGDEBUG(DBIndent,"ROOT=",$get(ROOT))
86 do DebugMsg^TMGDEBUG(DBIndent,"PUBID=",$get(PUBID))
87 do DebugMsg^TMGDEBUG(DBIndent,"SYSID=",$get(SYSID))
88 quit
89
90
91StartElement(NAME,ATTRLIST)
92 do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
93 do DebugMsg^TMGDEBUG(DBIndent,"Start Element:")
94 do DebugMsg^TMGDEBUG(DBIndent,"Name=",$get(NAME))
95 if $data(ATTRLIST) do
96 do DebugMsg^TMGDEBUG(DBIndent,"AttrList:")
97 . zwr ATTRLIST
98 quit
99
100EndElement(NAME)
101 do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
102 do DebugMsg^TMGDEBUG(DBIndent,"End Element:")
103 do DebugMsg^TMGDEBUG(DBIndent,"Name=",$get(NAME))
104 quit
105
106Chars(TEXT)
107 do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
108 do DebugMsg^TMGDEBUG(DBIndent,"TEXT=",$get(TEXT))
109 quit
110
111ParseErr(ERR)
112 if ($data(ERR)=0)!($data(ERR)=1) goto PrsErrQ
113 if ERR("SEV")<2 goto PrsErrQ ;"Bypass all but error>=2
114
115 new Header,Text,PtrLine
116 new i
117
118 set Header="<!> XML "
119 if ERR("SEV")=0 set Header=Header_"Processing Warning"
120 if ERR("SEV")=1 set Header=Header_"Validation Error"
121 if ERR("SEV")=2 set Header=Header_"Conformance Error"
122
123 set Text="Document Line #"_ERR("LIN")_" Position #"_ERR("POS")_"\n"
124 set Text=Text_"'"_ERR("XML")_"'\n\n"
125
126 set PtrLine=""
127 for i=1:1:ERR("POS")-1 set PtrLine=PtrLine_"."
128 set Text=Text_PtrLine_"^"_"\n"
129
130 set PtrLine=""
131 for i=1:1:ERR("POS")-1 set PtrLine=PtrLine_" "
132 set Text=Text_PtrLine_"|"_"\n"
133
134 if ERR("MSG")'="" do
135 . set Text=Text_ERR("MSG")_"\n"
136 set Text=Text_"\nErroneous token: '"_ERR("ARG")_"'\n"
137
138 do PopupBox^TMGUSRIF(Header,Text,75)
139
140 if $data(pArray) do
141 . do ArrayDump^TMGDEBUG(pArray,$get(ERR("LIN")))
142
143PrsErrQ
144 quit
145
146
147 ;"-------------------------------------------------------------
148
149ListChildren(Node,IndentN)
150 new ChildNode
151 set ChildNode=$$CHILD^MXMLDOM(ParseHandle,Node,0)
152 if ChildNode=0 quit
153
154 new loop
155 for loop=1:1 do if ChildNode=0 quit
156 . do ShowNode(ChildNode,IndentN)
157 . do ListChildren(ChildNode,IndentN+1)
158 . set ChildNode=$$CHILD^MXMLDOM(ParseHandle,Node,ChildNode)
159
160 quit
161
162ShowNode(Node,IndentN)
163 new NodeText
164 new AttribText
165
166 do Indent(IndentN)
167 write $$NAME^MXMLDOM(ParseHandle,Node),!
168 if $$CMNT^MXMLDOM(ParseHandle,Node,$NAME(NodeText)) do
169 . do Indent(IndentN)
170 . write " Comment: ",NodeText(1),!
171 if $$TEXT^MXMLDOM(ParseHandle,Node,$NAME(NodeText)) do
172 . do Indent(IndentN)
173 . write " '",NodeText(1),"'",!
174 set AttribText=$$ATTRIB^MXMLDOM(ParseHandle,Node)
175 if $data(AttribText),AttribText'="" do
176 . do Indent(IndentN)
177 . write " Attrib: ",AttribText,"="
178 . write $$VALUE^MXMLDOM(ParseHandle,Node,AttribText),!
179
180 quit
181
182
183
184Indent(IndentN)
185 for i=1:1:IndentN write " "
186 quit
187
188
Note: See TracBrowser for help on using the repository browser.