OpenEdge applications use ProDataSets for data. The new DataSetMessage supports using ProDataSets for JMS messaging. The XMLMessage is the basis for the DataSetMessage. The OpenEdge Adapter for SonicMQ converts the ProDataSet to/from XML and uses the XMLMessage to send/receive ProDataSets. A non-OpenEdge application receives a DataSetMessage as an XMLMessage. The JMS header property signals an OpenEdge application that the incoming message is a DataSetMessage.

For more information on accessing the examples files, see OpenEdge messages.

For an alphabetical API reference, see ABL-JMS API Reference.

dsmsg_send.p

The following example shows sending a DataSetMessage.

DEFINE VARIABLE hds1     AS HANDLE  NO-UNDO.
DEFINE VARIABLE hMessage AS HANDLE  NO-UNDO.
DEFINE VARIABLE hSession AS HANDLE  NO-UNDO.
DEFINE VARIABLE ptp      AS LOGICAL NO-UNDO INITIAL TRUE.
DEFINE VARIABLE ret      AS LOGICAL NO-UNDO.
/* Definition for TEMP-TABLE ttCustomer */
DEFINE TEMP-TABLE ttCustomer NO-UNDO BEFORE-TABLE ttCustBef
  FIELD CustNum  LIKE Customer.CustNum
  FIELD Name     LIKE Customer.Name COLUMN-LABEL "custlab"
    XML-NODE-TYPE "Attribute"
  FIELD Country  LIKE Customer.Country
  FIELD Comments LIKE Customer.Comments FORMAT "x(40)"
  INDEX CustNum  IS PRIMARY UNIQUE CustNum
  INDEX Name     Name
  INDEX Comments IS WORD-INDEX Comments.
/* Definition for TEMP-TABLE ttOrder */
DEFINE TEMP-TABLE ttOrder NO-UNDO
  FIELD OrderNum  LIKE Order.OrderNum
  FIELD CustNum   LIKE Order.CustNum
  FIELD OrderDate LIKE Order.OrderDate
  INDEX OrderNum  IS PRIMARY UNIQUE OrderNum
  INDEX CustOrder IS UNIQUE CustNum OrderNum
  INDEX OrderDate OrderDate.
DEFINE DATASET myds
  NAMESPACE-URI "urn:myds" NAMESPACE-PREFIX "ds"
    FOR ttCustomer, ttOrder
  DATA-RELATION custOrd FOR ttCustomer, ttOrder
    REPOSITION RELATION-FIELDS (CustNum, CustNum).
/* Creates a session object. */
IF ptp THEN
  RUN jms/ptpsession.p PERSISTENT SET hSession ("-SMQConnect").
ELSE
  RUN jms/pubsubsession.p PERSISTENT SET hSession ("-SMQConnect").
RUN setBrokerURL IN hSession ("localhost:2506").
RUN beginSession IN hSession.
FOR EACH Customer NO-LOCK WHERE Customer.CustNum < 4:
  CREATE ttCustomer.
  BUFFER-COPY Customer TO ttCustomer.
  FOR EACH Order OF Customer NO-LOCK:
    CREATE ttOrder.
    BUFFER-COPY Order TO ttOrder.
  END. /* FOR EACH Order */
END. /* FOR EACH Customer */
hds1 = DATASET myds:HANDLE.
/* Uncomment to write XML to a file 
ret = hds1:WRITE-XML("file", "wdsCustOrd.xml", YES, ?,?,YES).
*/
RUN createDatasetMessage in hSession (OUTPUT hMessage).
RUN setDataSet IN hMessage( hds1, ?, TRUE).
IF ptp THEN
  RUN sendToQueue IN hSession ("SampleQ1", hMessage, ?, ?, ?).    
ELSE
  RUN PUBLISH IN hSession ("TestTopic", hMessage, ?, ?, ?).
RUN deleteMessage IN hMessage.
RUN deleteSession in hSession.

dsmsg_recv.p

The following example shows receiving a DataSetMessage.

DEFINE VARIABLE hBuf         AS HANDLE  NO-UNDO.
DEFINE VARIABLE hds2         AS HANDLE  NO-UNDO.
DEFINE VARIABLE hMesg        AS HANDLE  NO-UNDO.
DEFINE VARIABLE hMsgConsumer AS HANDLE  NO-UNDO.
DEFINE VARIABLE hq           AS HANDLE  NO-UNDO.
DEFINE VARIABLE hrel         AS HANDLE  NO-UNDO.
DEFINE VARIABLE hSession     AS HANDLE  NO-UNDO.
DEFINE VARIABLE ix           AS INTEGER NO-UNDO.
DEFINE VARIABLE jx           AS INTEGER NO-UNDO.
DEFINE VARIABLE numRecsRead  AS INTEGER NO-UNDO.
DEFINE VARIABLE ptp          AS LOGICAL NO-UNDO INITIAL TRUE.
DEFINE VARIABLE ret          AS LOGICAL NO-UNDO.
DEFINE VARIABLE stillWaiting AS LOGICAL NO-UNDO INITIAL TRUE.
IF ptp THEN
  RUN jms/ptpsession.p PERSISTENT SET hSession ("-SMQConnect").
ELSE
  RUN jms/pubsubsession.p PERSISTENT SET hSession ("-SMQConnect").
RUN setBrokerURL IN hSession ("localhost:2506").
RUN beginSession IN hSession.
RUN createMessageConsumer IN hSession 
  (THIS-PROCEDURE,    /* this procedure will handle it */
   "messageHandler",  /* name of internal procedure */
    OUTPUT hMsgConsumer).
IF ptp THEN
  RUN receiveFromQueue IN hSession ("SampleQ1", ?, hMsgConsumer).
ELSE
  RUN subscribe IN hSession 
    ("TestTopic",
     ?,    /* durable subscription */
     ?,    /* no message selector */
     TRUE, /* want to get my own publications */
     hMsgConsumer).
RUN startReceiveMessages IN hSession.
RUN waitForMessages IN hSession ("inWait", THIS-PROCEDURE, ?).
RUN deleteSession IN hSession.
MESSAGE "Number of records processed: " + STRING(numRecsRead).
PROCEDURE messageHandler:
  DEFINE INPUT PARAMETER hMessage         AS HANDLE NO-UNDO.
  DEFINE INPUT PARAMETER hMessageConsumer AS HANDLE NO-UNDO.
  /* hAutoReply is not used in this example */
  DEFINE OUTPUT PARAMETER hAutoReply      AS HANDLE NO-UNDO.
  DEFINE VARIABLE ttH1 AS HANDLE NO-UNDO.
  DEFINE VARIABLE bh1  AS HANDLE NO-UNDO.
  DEFINE VARIABLE bh2  AS HANDLE NO-UNDO.
  DEFINE VARIABLE qh1  AS HANDLE NO-UNDO.
  IF DYNAMIC-FUNCTION("getMessageType" in hMessage) = 
    "DatasetMessage" THEN DO:
    ASSIGN
      hds2        = DYNAMIC-FUNCTION("getDataset" IN hMessage, ?, ?, ?)
      numRecsRead = numRecsRead + 1.
    MESSAGE 
      "num-buffers: " hds2:NUM-BUFFERS "name: " hds2:NAME SKIP
      "nspace-info: " hds2:NAMESPACE-URI hds2:NAMESPACE-PREFIX SKIP
      "num-relations: " hds2:NUM-RELATIONS 
      VIEW-AS ALERT-BOX.
    DO ix = 1 TO hds2:NUM-RELATIONS:
      hrel = hds2:GET-RELATION(ix).
      MESSAGE 
        "rel name: " hrel:NAME SKIP
        "reposition: " hrel:REPOSITION SKIP
        "nested: " hrel:NESTED SKIP
        "where-str: " hrel:WHERE-STRING SKIP
        "parent: " hrel:PARENT-BUFFER:NAME SKIP
        "child: " hrel:CHILD-BUFFER:NAME SKIP
        "rel-fields: " hrel:RELATION-FIELDS 
        VIEW-AS ALERT-BOX.
    END.
    DO jx = 1 TO hds2:NUM-BUFFERS:
      hBuf = hds2:GET-BUFFER-HANDLE(jx).
      MESSAGE "buf name: " hBuf:NAME VIEW-AS ALERT-BOX.
      DO ix = 1 TO hBuf:NUM-FIELDS:
        MESSAGE 
          "name:        " hBuf:BUFFER-FIELD(ix):NAME skip
          "type:        " hBuf:BUFFER-FIELD(ix):DATA-TYPE skip
          "extent:      " hBuf:BUFFER-FIELD(ix):EXTENT skip
          "decimals:    " hBuf:BUFFER-FIELD(ix):DECIMALS skip
          "xmltype:     " hBuf:BUFFER-FIELD(ix):XML-DATA-TYPE skip
          "xmlnodetype: " hBuf:BUFFER-FIELD(ix):XML-NODE-TYPE skip
          "initial:     " hBuf:BUFFER-FIELD(ix):INITIAL skip
          "format:      " hBuf:BUFFER-FIELD(ix):FORMAT skip
          "help:        " hBuf:BUFFER-FIELD(ix):HELP skip
          VIEW-AS ALERT-BOX.
      END.
    END.
    CREATE QUERY hq.
    
    DO jx = 1 TO hds2:NUM-BUFFERS:
      hBuf = hds2:GET-BUFFER-HANDLE(jx).
      MESSAGE "buf name: " hBuf:NAME VIEW-AS ALERT-BOX.
      hq:SET-BUFFERS(hBuf).
      hq:QUERY-PREPARE("FOR EACH " + hBuf:NAME).
      hq:QUERY-OPEN.
    
      DO WHILE hq:GET-NEXT():
        DO ix = 1 TO hBuf:NUM-FIELDS:
          MESSAGE 
            "name:        " hBuf:BUFFER-FIELD(ix):NAME SKIP
            "value:       " 
            IF  hBuf:BUFFER-FIELD(ix):EXTENT > 0 THEN
              hBuf:BUFFER-FIELD(ix):BUFFER-VALUE[1] 
            ELSE 
              hBuf:BUFFER-FIELD(ix):BUFFER-VALUE
            VIEW-AS ALERT-BOX.
        END.
      END.
    END.
    DELETE OBJECT hq.
    DELETE OBJECT hds2.
  END.
  ELSE
    stillWaiting = FALSE.
  RUN deleteMessage IN hMessage.
END PROCEDURE.
FUNCTION inWait RETURNS LOGICAL:
  RETURN stillWaiting.
END.