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

TMGXMLP;TMG/kst/Detail XML Parsing functions ;03/25/06
         ;;1.0;TMG-LIB;**1**;01/01/05

 ;"TMG DETAIL XML PARSE FUNCTIONS

 ;"=======================================================================
 ;" API -- Public Functions.
 ;"=======================================================================
 ;"DetailParse ;
 ;"ListChildren(Node,IndentN)


 ;"=======================================================================
 ;"PRIVATE API FUNCTIONS
 ;"=======================================================================
 ;"StartDoc
 ;"EndDoc
 ;"DocType(ROOT,PUBID,SYSID)
 ;"StartElement(NAME,ATTRLIST)
 ;"EndElement(NAME)
 ;"Chars(TEXT)
 ;"ParseErr(ERR)
 ;"ShowNode(Node,IndentN)
 ;"Indent(IndentN)
 ;"=================================================================

DetailParse(pArray)
        ;"Purpose: To do a detailed deconstruction of parse to detect errors.
        ;"Input: pArray -- PASS BY NAME.  OPTIONAL.
        ;"       Default = $name(^TMP("TMG",$J))
        ;"Output: Puts info to debug stream
        ;"results: none

        ;"if $data(TMGDEBUG)#10=0 goto QuitLabel

        new Y,PATH,FILE,GBLREF

        set pArray=$get(pArray,$name(^TMP("TMG",$J)))

        new FnArray set FnArray="Array of Callback Functions"
        set FnArray("ERROR")="ParseErr^TMGXMLP"

        set FnArray("STARTDOCUMENT")="StartDoc^TMGXMLP"
        set FnArray("ENDDOCUMENT")="EndDoc^TMGXMLP"
        set FnArray("DOCTYPE")="DocType^TMGXMLP"
        set FnArray("STARTELEMENT")="StartElement^TMGXMLP"
        set FnArray("ENDELEMENT")="EndElement^TMGXMLP"
        set FnArray("CHARACTERS")="Chars^TMGXMLP"

        do DebugMsg^TMGDEBUG(DBIndent,"This part of the program will do a detailed parse analysis...")
        do DebugMsg^TMGDEBUG(DBIndent,"Hopefully this will reveal the parsing error.")

        do DebugMsg^TMGDEBUG(DBIndent,"Here is loaded file that is being parsed:")
        new % set %=1
        write "View array containing XML data"
        do YN^DICN write !
        if %=1 do ArrayDump^TMGDEBUG(pArray)
        if %=-1 goto QuitLabel

        do DebugMsg^TMGDEBUG(DBIndent,"Calling EN^MXMLPRSE (a detailed parse assessment.)")
        do DebugMsg^TMGDEBUG(DBIndent,"As each element of the XML file is encountered, it will be listed.")
        do EN^MXMLPRSE(pArray,.FnArray,"V")
        do DebugMsg^TMGDEBUG(DBIndent,"Done calling EN^MXMLPRSE")

        do DebugMsg^TMGDEBUG(DBIndent,"---------------------------")

QuitLabel  quit



StartDoc
        do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
        do DebugMsg^TMGDEBUG(DBIndent,"##Starting Document Processing##")
        quit

EndDoc
        do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
        do DebugMsg^TMGDEBUG(DBIndent,"##End of Document Processing##")
        quit


DocType(ROOT,PUBID,SYSID)
        do DebugMsg^TMGDEBUG(DBIndent,"--------------------")
        do DebugMsg^TMGDEBUG(DBIndent,"Doctype encountered.")
        do DebugMsg^TMGDEBUG(DBIndent,"ROOT=",$get(ROOT))
        do DebugMsg^TMGDEBUG(DBIndent,"PUBID=",$get(PUBID))
        do DebugMsg^TMGDEBUG(DBIndent,"SYSID=",$get(SYSID))
        quit


StartElement(NAME,ATTRLIST)
        do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
        do DebugMsg^TMGDEBUG(DBIndent,"Start Element:")
        do DebugMsg^TMGDEBUG(DBIndent,"Name=",$get(NAME))
        if $data(ATTRLIST) do
        do DebugMsg^TMGDEBUG(DBIndent,"AttrList:")
        . zwr ATTRLIST
        quit

EndElement(NAME)
        do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
        do DebugMsg^TMGDEBUG(DBIndent,"End Element:")
        do DebugMsg^TMGDEBUG(DBIndent,"Name=",$get(NAME))
        quit

Chars(TEXT)
        do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
         do DebugMsg^TMGDEBUG(DBIndent,"TEXT=",$get(TEXT))
        quit

ParseErr(ERR)
        if ($data(ERR)=0)!($data(ERR)=1) goto PrsErrQ
        if ERR("SEV")<2 goto PrsErrQ  ;"Bypass all but error>=2

        new Header,Text,PtrLine
        new i

        set Header="<!> XML "
        if ERR("SEV")=0 set Header=Header_"Processing Warning"
        if ERR("SEV")=1 set Header=Header_"Validation Error"
        if ERR("SEV")=2 set Header=Header_"Conformance Error"

        set Text="Document Line #"_ERR("LIN")_" Position #"_ERR("POS")_"\n"
        set Text=Text_"'"_ERR("XML")_"'\n\n"

        set PtrLine=""
        for i=1:1:ERR("POS")-1 set PtrLine=PtrLine_"."
        set Text=Text_PtrLine_"^"_"\n"

        set PtrLine=""
        for i=1:1:ERR("POS")-1 set PtrLine=PtrLine_" "
        set Text=Text_PtrLine_"|"_"\n"

        if ERR("MSG")'="" do
        . set Text=Text_ERR("MSG")_"\n"
        set Text=Text_"\nErroneous token: '"_ERR("ARG")_"'\n"

        do PopupBox^TMGUSRIF(Header,Text,75)

        if $data(pArray) do
        . do ArrayDump^TMGDEBUG(pArray,$get(ERR("LIN")))

PrsErrQ
        quit


 ;"-------------------------------------------------------------

ListChildren(Node,IndentN)
        new ChildNode
        set ChildNode=$$CHILD^MXMLDOM(ParseHandle,Node,0)
        if ChildNode=0 quit

        new loop
        for loop=1:1 do  if ChildNode=0 quit
        . do ShowNode(ChildNode,IndentN)
        . do ListChildren(ChildNode,IndentN+1)
        . set ChildNode=$$CHILD^MXMLDOM(ParseHandle,Node,ChildNode)

        quit

ShowNode(Node,IndentN)
         new NodeText
        new AttribText

        do Indent(IndentN)
        write $$NAME^MXMLDOM(ParseHandle,Node),!
        if $$CMNT^MXMLDOM(ParseHandle,Node,$NAME(NodeText)) do
        . do Indent(IndentN)
        . write "  Comment: ",NodeText(1),!
        if $$TEXT^MXMLDOM(ParseHandle,Node,$NAME(NodeText)) do
        . do Indent(IndentN)
        . write "  '",NodeText(1),"'",!
        set AttribText=$$ATTRIB^MXMLDOM(ParseHandle,Node)
        if $data(AttribText),AttribText'="" do
        . do Indent(IndentN)
        . write "  Attrib: ",AttribText,"="
        . write $$VALUE^MXMLDOM(ParseHandle,Node,AttribText),!

        quit



Indent(IndentN)
        for i=1:1:IndentN write "  "
        quit