midrange.com code scratchpad
Name:
TSTXMLSAX1
Scriptlanguage:
Plain Text
Tabwidth:
2
Date:
01/26/2012 09:38:40 pm
IP:
Logged
Description:
Test XML-SAX functionality from RPG REF book Samp
Code:
  1.       * Data structure used as a parameter between
  2.       * the XML-SAX operation and the handling
  3.       * procedure.
  4.       *   - "attrName" is set by the procedure doing the
  5.       *     XML-SAX operation and used by the handling procedure
  6.       *   - "attrValue" is set by the handling procedure
  7.       *     and used by the procedure doing the XML-SAX
  8.       *     operation
  9.       *   - "haveAttr" is used internally by the handling
  10.       *     procedure
  11.      H/COPY QCPYSRC,HSPECLE
  12.      HDEBUG(*XMLSAX)
  13.      Fqsysprt   o    f  132        printer
  14.      Fprint     o    f  132        printer
  15.  
  16.      D qsysprtDs       DS           132
  17.      D Printds         DS           132
  18.  
  19.  
  20.      D XmlEvnts        DS                  Qualified Inz
  21.      D  EventId                      10I 0 Dim(25) Overlay(Xmlevnts:*Next)
  22.      D  Event                        30A   Dim(25) Overlay(Xmlevnts:*Next)
  23.      D  EventId#                     10I 0 Dim(25) Overlay(Xmlevnts:*Next)
  24.  
  25.      D Element#        S             10I 0
  26.      D Idx             S             10I 0
  27.      D Idx2            S             10I 0
  28.  
  29.      D/COPY QCPYSRC,Dspgminf4
  30.      D   xmlRc                       10I 0 OVERLAY(PGMINF:368)
  31.  
  32.      D info            DS                  INZ
  33.      D   attrName                    20A    VARYING
  34.      D   haveAttr                      N
  35.      D   attrValue                   20A    VARYING
  36.  
  37.       * Prototype for procedure "myHandler" defining
  38.       * the communication-area parameter as being
  39.       * like data structure "info"
  40.      D myHandler       PR            10I 0
  41.      D   commArea                           LIKEDS(info)
  42.      D   event                       10I 0  VALUE
  43.      D   string                        *    VALUE
  44.      D   stringLen                   20I 0  VALUE
  45.      D   exceptionId                 10I 0  VALUE
  46.  
  47.  
  48.      D Xmldoc          S            265A   VARYING
  49.  
  50.  
  51.      D Inpdoc          S             57A
  52.  
  53.  
  54.      C     *Entry        Plist
  55.      C                   Parm                    Inpdoc
  56.       /free
  57.  
  58.        Xmldoc = %Trim(Inpdoc);
  59.  
  60.         // Start SAX processing.  The procedure "myHandler"
  61.         // will be called for every SAX event; the first
  62.         // parameter will be the data structure "info".
  63.         xml-sax(e) %handler(myHandler : info) %xml(xmldoc :'doc=file');
  64.         // The XML-SAX operation is complete.  The
  65.         // communication area can be checked to get the
  66.         // value of the attribute.
  67.         if not %error() and attrValue <> '';
  68.           dsply (attrName + '=' + attrValue);
  69.         endif;
  70.  
  71.         For Idx2 = 1 To Idx By 1;
  72.           QsysprtDS = 'XML Event: ' +XmlEvnts.Event(Idx2)
  73.                        +' = ' +%Editc(XmlEvnts.EventId(Idx2):'3')
  74.                        +'     Count:' +%Editc(XmlEvnts.EventID#(Idx2) :'3')
  75.                        ;
  76.  
  77.           write qsysprt qsysprtDs;
  78.         Endfor;
  79.  
  80.        *Inlr = *On;
  81.        Return;
  82.       /End-Free
  83.       // The SAX handling procedure "myHandler"
  84.      P myHandler       B
  85.      D                 PI            10I 0
  86.      D   comm                               LIKEDS(info)
  87.      D   event                       10I 0  VALUE
  88.      D   string                        *    VALUE
  89.      D   stringLen                   20I 0  VALUE
  90.      D   exceptionId                 10I 0  VALUE
  91.      D value           S          65535A    BASED(string)
  92.      D ucs2value       S          16383C    BASED(string)
  93.      D rc              S             10I 0  INZ(0)
  94.  
  95.      D ParentEvt       S                   Like(Event) static
  96.       /free
  97.  
  98.           Element# += 1;
  99.           Idx2 = %Lookup(Event :XmlEvnts.EventId);
  100.           If Idx2 > 0;
  101.             XmlEvnts.EventId#(Idx2) += 1;
  102.           Else;
  103.             Idx += 1;
  104.             XmlEvnts.EventId(Idx) = Event;
  105.             XmlEvnts.EventId#(Idx) += 1;
  106.             Idx2 = Idx;
  107.           Endif;
  108.           select;
  109.           //
  110.           when event = *XML_START_DOCUMENT;
  111.             XmlEvnts.Event(Idx2) = '*XML_START_DOCUMENT';
  112.           when event = *XML_VERSION_INFO;
  113.             XmlEvnts.Event(Idx2) = '*XML_VERSION_INFO';
  114.           when event = *XML_ENCODING_DECL;
  115.             XmlEvnts.Event(Idx2) = '*XML_ENCODING_DECL';
  116.           when event = *XML_STANDALONE_DECL;
  117.             XmlEvnts.Event(Idx2) = '*XML_STANDALONE_DECL';
  118.           when event = *XML_DOCTYPE_DECL;
  119.             XmlEvnts.Event(Idx2) = '*XML_DOCTYPE_DECL';
  120.           //
  121.           when event = *XML_START_ELEMENT;
  122.             XmlEvnts.Event(Idx2) = '*XML_START_ELEMENT';
  123.             ParentEvt = Event;
  124.           when event = *XML_CHARS;
  125.             XmlEvnts.Event(Idx2) = '*XML_CHARS(ELEMENT) ['+%char(parentevt)+']';
  126.           when event = *XML_PREDEF_REF;
  127.             XmlEvnts.Event(Idx2) = '*XML_PREDEF_REF';
  128.           when event = *XML_UCS2_REF;
  129.             XmlEvnts.Event(Idx2) = '*XML_UCS2_REF';
  130.           when event = *XML_UNKNOWN_REF;
  131.             XmlEvnts.Event(Idx2) = '*XML_UNKNOWN_REF';
  132.           when event = *XML_END_ELEMENT;
  133.             XmlEvnts.Event(Idx2) = '*XML_END_ELEMENT';
  134.             ParentEvt = Event;
  135.           //
  136.           when event = *XML_ATTR_NAME;
  137.             XmlEvnts.Event(Idx2) = '*XML_ATTR_NAME';
  138.           when event = *XML_ATTR_CHARS;
  139.             XmlEvnts.Event(Idx2) = '*XML_ATTR_CHARS';
  140.           when event = *XML_ATTR_PREDEF_REF;
  141.             XmlEvnts.Event(Idx2) = '*XML_ATTR_PREDEF_REF';
  142.           when event = *XML_ATTR_UCS2_REF;
  143.             XmlEvnts.Event(Idx2) = '*XML_ATTR_UCS2_REF';
  144.           when event = *XML_UNKNOWN_ATTR_REF;
  145.             XmlEvnts.Event(Idx2) = '*XML_UNKNOWN_ATTR_REF';
  146.           when event = *XML_END_ATTR;
  147.             XmlEvnts.Event(Idx2) = '*XML_END_ATTR';
  148.           //
  149.           when event = *XML_PI_TARGET;
  150.             XmlEvnts.Event(Idx2) = '*XML_PI_TARGET';
  151.           when event = *XML_PI_DATA;
  152.             XmlEvnts.Event(Idx2) = '*XML_PI_DATA';
  153.           //
  154.           when event = *XML_START_CDATA;
  155.             XmlEvnts.Event(Idx2) = '*XML_START_CDATA';
  156.             ParentEvt = Event;
  157.           when event = *XML_END_CDATA;
  158.             XmlEvnts.Event(Idx2) = '*XML_END_CDATA';
  159.             ParentEvt = Event;
  160.           //
  161.           when event = *XML_COMMENT;
  162.             XmlEvnts.Event(Idx2) = '*XML_COMMENT';
  163.           when event = *XML_EXCEPTION;
  164.             XmlEvnts.Event(Idx2) = '*XML_EXCEPTION';
  165.             PrintDs = 'Parsed to position:' +%Char(Stringlen) +'  ExceptID:'
  166.                  +%Char(exceptionId);
  167.             write print PrintDs;
  168.           when event = *XML_END_DOCUMENT;
  169.             XmlEvnts.Event(Idx2) = '*XML_END_DOCUMENT';
  170.           endsl;
  171.  
  172.          PrintDs = XmlEvnts.Event(Idx2)
  173.                     +' = ' +%Editc(XmlEvnts.EventId(Idx2):'3')
  174.                     ;
  175.          If Stringlen > 0;
  176.            PrintDs = %Trimr(PrintDs)+ ' :: ' +%Subst(Value :1 :Stringlen)
  177.                     ;
  178.          Endif;
  179.          write print PrintDs;
  180.  
  181.         return rc;
  182.       /end-free
  183.      P                 E
  184.  
  185.  
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css