      $SET p(cobsql) csqlt=oracle8 end-c endp
       *>
       *> Micro Focus one-phase commit Oracle switch module.
       *>
       *> (C) Copyright 2007 Micro Focus (IP) Limited
       *> All Rights Reserved.
       *> 

       *> As indicated below -- search for CUSTOMIZE -- it is possible to
       *> only pass the DSN parameter in from Enterprise Server, and
       *> define the USRPASS parameters programmatically from this
       *> program.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. ESORAOPC.
       ENVIRONMENT DIVISION.

       DATA DIVISION.

       WORKING-STORAGE SECTION.

       01 esoraopc-switch-struct.
          03 esoraopc-RM-name                PIC X(32).
          03 esoraopc-flags                  PIC S9(9) COMP-5.
          03 esoraopc-version                PIC S9(9) COMP-5.
          03 esoraopc-open-entry             PROCEDURE-POINTER.
          03 esoraopc-close-entry            PROCEDURE-POINTER.
          03 esoraopc-start-entry            PROCEDURE-POINTER.
          03 esoraopc-end-entry              PROCEDURE-POINTER.
          03 esoraopc-rollback-entry         PROCEDURE-POINTER.
          03 esoraopc-prepare-entry          PROCEDURE-POINTER.
          03 esoraopc-commit-entry           PROCEDURE-POINTER.
          03 esoraopc-recover-entry          PROCEDURE-POINTER.
          03 esoraopc-forget-entry           PROCEDURE-POINTER.
          03 esoraopc-complete-entry         PROCEDURE-POINTER.

       *> Return codes for XA calls

       01 ws-return-flags.
          03 ws-open-rc                    PIC S9(9) COMP-5 VALUE 0.
          03 ws-close-rc                   PIC S9(9) COMP-5 VALUE 0.
          03 ws-start-rc                   PIC S9(9) COMP-5 VALUE 0.
          03 ws-end-rc                     PIC S9(9) COMP-5 VALUE 0.
          03 ws-rollback-rc                PIC S9(9) COMP-5 VALUE 0.
          03 ws-prepare-rc                 PIC S9(9) COMP-5 VALUE 0.
          03 ws-commit-rc                  PIC S9(9) COMP-5 VALUE 0.
          03 ws-recover-rc                 PIC S9(9) COMP-5 VALUE 0.
          03 ws-forget-rc                  PIC S9(9) COMP-5 VALUE 0.
          03 ws-complete-rc                PIC S9(9) COMP-5 VALUE 0.

       *> Variables for extracting the DSN, UserID and Password from
       *> the Open String passed from the Enterprise Server
       *> Configuration page.

       01 TmpWorkString                    PIC X(256).
       01 ParamString                      PIC X(256).
       01 ValueString                      PIC X(256).

       01 OuterPosn                        PIC 9(3).
       01 InnerPosn                        PIC 9(3).

           EXEC SQL INCLUDE SQLCA END-EXEC.

           EXEC SQL BEGIN DECLARE SECTION END-EXEC.

       *> SQL Connect information, derived from the Open string
       *> as defined within the Enterprise Server configuration.

       01 DbNameString                 PIC X(32) VALUE LOW-VALUES.
       01 UidPwdString                 PIC X(32) VALUE LOW-VALUES.
       01 ServerString                 PIC X(32) VALUE LOW-VALUES.

           EXEC SQL END DECLARE SECTION END-EXEC.

       *> Support for tracing

       COPY "cbltypes.cpy".

      *>***************************************************************
      *>
      *> Consolidated Tracing Facility (CTF)
      *>
      *>***************************************************************

      *>---------------------------------------------------------------
      *> CBL_CTF_ API return codes
      *>---------------------------------------------------------------
       78  78-CTF-RET-SUCCESS                   value 0.
       78  78-CTF-RET-FAILURE                   value -1.
       78  78-CTF-RET-INVALID-TRACE-HANDLE      value 1.
       78  78-CTF-RET-INVALID-TRACE-LEVEL       value 2.
       78  78-CTF-RET-NOT-TRACE-ENABLED         value 3.
       78  78-CTF-RET-NOT-TRACING-LEVEL         value 4.
       78  78-CTF-RET-NOT-ENOUGH-MEMORY         value 5.
       78  78-CTF-RET-OUTPUT-ERROR              value 6.
       78  78-CTF-RET-PROPERTY-NOT-FOUND        value 7.
       78  78-CTF-RET-BUFFER-TOO-SMALL          value 8.
       78  78-CTF-RET-VALUE-NOT-INTEGER         value 9.
       78  78-CTF-RET-EMITTER-NOT-FOUND         value 10.
       78  78-CTF-RET-INVALID-EVENT-HANDLE      value 11.
       78  78-CTF-RET-ZERO-LENGTH-DATA          value 12.
       78  78-CTF-RET-INVALID-PROP-NAME         value 13.
       78  78-CTF-RET-INVALID-COMP-NAME         value 14.
       78  78-CTF-RET-INVALID-EMITTER-NAME      value 15.
       78  78-CTF-RET-INVALID-PROG-NAME         value 16.
       78  78-CTF-RET-CALLBACK-NOT-FOUND        value 17.
       78  78-CTF-RET-CALLBACK-EXISTS           value 18.

      *>---------------------------------------------------------------
      *> CBL_CTF_ API control flags
      *>---------------------------------------------------------------
       78  78-DESTFLGS-COMPID-STRING            value h'80000000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_EMITTER
      *>
       78  78-CTF-FLAG-PROG-NAME-NULL-TERM      value h'00000001'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_ENABLE
      *>
       78  78-CTF-FLAG-COMP-ENABLE              value h'00000000'.
       78  78-CTF-FLAG-COMP-DISABLE             value h'00000001'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_DEST
      *>
       78  78-CTF-FLAG-DEST-ADD                 value h'00000000'.
       78  78-CTF-FLAG-DEST-REMOVE              value h'00000001'.
       78  78-CTF-FLAG-DEST-NOINHERIT           value h'00000002'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_EMITTER_PROPERTY_GET
      *>        CBL_CTF_EMITTER_PROPERTY_SET
      *>
       78  78-CTF-FLAG-PROP-STRING-VALUE        value h'00000000'.
       78  78-CTF-FLAG-PROP-INT-VALUE           value h'00000001'.
       78  78-CTF-FLAG-PROP-NULL-TERM           value h'00000002'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_TRACE
      *>
       78  78-CTF-FLAG-TRACE-OUTPUT-FORCE       value h'00001000'.
       78  78-CTF-FLAG-TRACE-ARRAY-DATA         value h'00002000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_DEST
      *>        CBL_CTF_EMITTER
      *>        CBL_CTF_EMITTER_PROPERTY_GET
      *>        CBL_CTF_EMITTER_PROPERTY_SET
      *>
       78  78-CTF-FLAG-EMIT-NAME-NULL-TERM      value h'10000000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_EMITTER_PROPERTY_GET
      *>        CBL_CTF_EMITTER_PROPERTY_SET
      *>
       78  78-CTF-FLAG-PROP-NAME-NULL-TERM      value h'20000000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_DEST
      *>        CBL_CTF_ENABLE
      *>        CBL_CTF_LEVEL
      *>        CBL_CTF_TRACE
      *>        CBL_CTF_TRACER_GET
      *>        CBL_CTF_TRACER_LEVEL_GET
      *>
       78  78-CTF-FLAG-COMP-NAME-NULL-TERM      value h'40000000'.
      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_DEST
      *>        CBL_CTF_ENABLE
      *>        CBL_CTF_LEVEL
      *>        CBL_CTF_TRACE
      *>        CBL_CTF_TRACER_LEVEL_GET
      *>
       78  78-CTF-FLAG-COMPID-STRING            value h'80000000'.

      *>---------------------------------------------------------------
      *> Trace levels
      *>---------------------------------------------------------------
       78  78-CTF-FLAG-LEVEL-DEBUG              value 0.
       78  78-CTF-FLAG-LEVEL-INFO               value 1.
       78  78-CTF-FLAG-LEVEL-WARN               value 2.
       78  78-CTF-FLAG-LEVEL-ERROR              value 3.
       78  78-CTF-FLAG-LEVEL-FATAL              value 4.

       78  78-CTF-FLAG-LEVEL-NONE               value h'FFFFFFFF'.

      *>---------------------------------------------------------------
      *> Trace event
      *>---------------------------------------------------------------
       01       cblt-trc-event                  typedef.
         03     cblte-trcevt-version            cblt-x4-comp5.
         03     cblte-trcevt-flags              cblt-x4-comp5.
         03     cblte-trcevt-event-id           cblt-x4-comp5.
         03     cblte-trcevt-level              cblt-x4-comp5.
         03     cblte-trcevt-data-count         cblt-x4-comp5.
         03     cblte-trcevt-event-len          cblt-pointer.
         03     cblte-trcevt-event-type         cblt-pointer.
         03     cblte-trcevt-event-data         cblt-pointer.

      *>
      *> Version types (cblte-trcevt-version)
      *>
       78  78-TRACE-EVENT-VERSION               value 0.

      *>
      *> Control flags (cblte-trcevt-flags)
      *>
       78  78-TRACE-EVENT-FLAGS-NONE            value h'00000000'.

      *>
      *> Trace event types (cblte-trcevt-event-type)
      *>
       78  78-TRACE-EVENT-TYPE-BINARY           value 0.
       78  78-TRACE-EVENT-TYPE-TEXT             value 1.
       78  78-TRACE-EVENT-TYPE-ADDRESS          value 2.
       78  78-TRACE-EVENT-TYPE-COMP5            value 3.
       78  78-TRACE-EVENT-TYPE-COMPX            value 4.
       78  78-TRACE-EVENT-TYPE-UTF8             value 5.
       78  78-TRACE-EVENT-TYPE-COMP5S           value 6.
       78  78-TRACE-EVENT-TYPE-COMPXS           value 7.

      *>---------------------------------------------------------------
      *> Tracer notification callback installation
      *>---------------------------------------------------------------
       01       cblt-trc-notif-install          typedef.
         03     cblte-tni-version               cblt-x4-comp5.
         03     cblte-tni-handle                cblt-x4-comp5.
         03     cblte-tni-callback              cblt-ppointer.

       78  78-TRC-NOTIF-TYPE-PROP-CHANGE        value 0.
       78  78-TRC-NOTIF-TYPE-LEVEL-CHANGE       value 1.

      *>---------------------------------------------------------------
      *> Tracer notification: property change
      *>---------------------------------------------------------------
       01       cblt-trc-notif-prop-change      typedef.
         03     cblte-tnpc-version              cblt-x4-comp5.
         03     cblte-tnpc-flags                cblt-x4-comp5.
         03     cblte-tnpc-namelen              cblt-x4-comp5.
         03     cblte-tnpc-vallen               cblt-x4-comp5.
         03     cblte-tnpc-valint               cblt-x4-comp5.
         03     cblte-tnpc-name                 cblt-pointer.
         03     cblte-tnpc-value                cblt-pointer.

      *>
      *> Version types (cblte-tnpc-version)
      *>
       78  78-PROP-CHANGE-VERSION               value 0.

      *>
      *> Control flags (cblte-tnpc-flags)
      *>
       78  78-PROP-CHANGE-FLAGS-NONE            value h'00000000'.
       78  78-PROP-CHANGE-FLAGS-VAL-INT         value h'00000001'.

       01  TmpString                   PIC X(200).

       78  MAX-TRACE-DATA              VALUE 7.
       78  THIS-COMPONENT              VALUE "MF.ESORAOPC".

      *----------------------------------------------------------------
      *    THIS_COMPONENT's tracer properties
      *----------------------------------------------------------------
       78  PROPID-ALL                  VALUE 1.

       78  PROPNAME-ALL                VALUE "all".
       78  PROPNAME-OPEN               VALUE "connect".
       78  PROPNAME-COMMIT             VALUE "commit".
       78  PROPNAME-ROLLBACK           VALUE "rollback".
       78  PROPNAME-CLOSE              VALUE "disconnect".

       01  ws-prop-names.
           03                         PIC X(10) VALUE PROPNAME-ALL.
           03                         PIC X(10) VALUE PROPNAME-OPEN.
           03                         PIC X(10) VALUE PROPNAME-COMMIT.
           03                         PIC X(10) VALUE PROPNAME-ROLLBACK.
           03                         PIC X(10) VALUE PROPNAME-CLOSE.
           03                         PIC X(10) VALUE spaces.
       01  ws-prop-name               REDEFINES ws-prop-names
                                      PIC X(10) OCCURS 6.
      *----------------------------------------------------------------
      *    THIS_COMPONENT events
      *----------------------------------------------------------------
       78  EVENT-OPEN-BADOPENSTRING    VALUE 0.
       78  EVENT-OPEN-CONNECT          VALUE 1.
       78  EVENT-COMMIT                VALUE 2.
       78  EVENT-ROLLBACK              VALUE 3.
       78  EVENT-CLOSE                 VALUE 4.

      *----------------------------------------------------------------
      *    Trace flags for THIS-COMPONENT. Each bit of these flags
      *    corresponds to a property being set (non-zero value) for 
      *    THIS-COMPONENT. The actual bit set for a given property
      *    corresponds to the position-1 of the property's name in the
      *    'ws-prop-name' table above. For example, if bit 0 is set,
      *    it indicates that the 'APPLES' property was set. If the 'ALL'
      *    property is set, then all bits of 'trace_flags' will be set.
      *
      *    N.B. This is just an example of how properties and their
      *    values may be processed by a component.How properties are
      *    processed is completely transparent to CTF.
      *----------------------------------------------------------------
       78  TRACE-FLAGS-OPEN            VALUE h'00000001'.
       78  TRACE-FLAGS-COMMIT          VALUE h'00000002'.
       78  TRACE-FLAGS-ROLLBACK        VALUE h'00000004'.
       78  TRACE-FLAGS-CLOSE           VALUE h'00000008'.

       01  ctf-config-data.
           03  ctf-trace-level         PIC X(4) COMP-5.
           03  ctf-trace-flags         PIC X(4) COMP-5.

      *----------------------------------------------------------------
      *    Variables required for CTF event generation
      *----------------------------------------------------------------
       01  ctf-event-data.
           03  ctf-tracer-handle       PIC X(4) COMP-5.
           03  ctf-trace-event         cblt-trc-event.
           03  ctf-trace-event-lens    PIC X(4) comp-5
                                       OCCURS MAX-TRACE-DATA.
           03  ctf-trace-event-types   PIC X(4) comp-5
                                       OCCURS MAX-TRACE-DATA.
           03  ctf-trace-event-ptrs    pointer
                                       OCCURS MAX-TRACE-DATA.

      *****************************************************************
       local-storage section.
       01  ls-data.
           03  ls-api-flags            PIC X(4) COMP-5.
           03  ls-bunch-size           PIC X(4) COMP-5.
           03  ls-comp-name            PIC X(16).
           03  ls-install-param        cblt-trc-notif-install.
           03  ls-net-size             PIC X(4) COMP-5.
           03  ls-prop-id              PIC X(4) COMP-5.
           03  ls-prop-value           PIC X(4) COMP-5.
           03  ls-trace-data-count     PIC X(4) COMP-5.
           03  ls-trace-data-desc      PIC X(80).
           03  ls-trace-start-desc     PIC X(14).
           03  ls-trace-event          PIC X(4) COMP-5.
           03  ls-trace-level          PIC X(4) COMP-5.
           03  ls-work-var             PIC X(4) COMP-5.

       LINKAGE SECTION.

       01 lk-xid.
          03 lk-xid-formatid               PIC S9(9) COMP-5.
             88 lk-xid-nullxid-88          VALUE -1.
          03 lk-xid-gtrid-length           PIC S9(9) COMP-5.
          03 lk-xid-bqual-length           PIC S9(9) COMP-5.
          03 lk-xid-value.
             05 lk-xid-global.
                07 lk-xid-id               PIC X(6).
                07 lk-xid-sysid            PIC X(4).
                07 lk-xid-tran-no          PIC 9(6).
             05 lk-xid-branch-no           PIC 9(6).
             05                            PIC X(105).

       01 lk-rmid                          PIC S9(9) COMP-5.
       01 lk-flags                         PIC S9(9) COMP-5.
       01 lk-open-string                   PIC X(256).
       01 lk-close-string                  PIC X(256).
       01 lk-rc                            PIC S9(9) COMP-5.

       *> Tracing support

       01  lk-ctf-tracer-handle        PIC X(4) COMP-5.
       01  lk-ctf-notif-type           PIC X(4) COMP-5.

       01  lk-ctf-notif-param          PIC X.
       01  lk-ctf-notif-param-level    REDEFINES lk-ctf-notif-param
                                       PIC X(4) COMP-5.
       01  lk-ctf-notif-param-property REDEFINES lk-ctf-notif-param
                                       cblt-trc-notif-prop-change.
       01  lk-ctf-property-name        PIC X.
       01  lk-ctf-property-value       PIC X.

       PROCEDURE DIVISION.
       
           GOBACK
           .
      *--------------------------------------------------------------*
       xa-open SECTION.
       ENTRY "esoraopc_1pc_connect" USING BY REFERENCE lk-open-string
                                 BY VALUE     lk-rmid
                                 BY VALUE     lk-flags.


        *> Parse and validate the Open String passed in from ES.

           MOVE 1 TO OuterPosn

           PERFORM UNTIL OuterPosn > 256

             *> From the start point, loop until the end of param
             *> or end of string

                PERFORM VARYING InnerPosn 
                    FROM OuterPosn BY 1 UNTIL
                       lk-open-string(InnerPosn : 1) = "+"
                    OR lk-open-string(InnerPosn : 1) = LOW-VALUES

                END-PERFORM

             *> Remove any leading spaces

                PERFORM WITH TEST BEFORE UNTIL
                    lk-open-string(OuterPosn:1) NOT = SPACE

                    ADD 1 TO OuterPosn

                END-PERFORM

                MOVE lk-open-string(OuterPosn : InnerPosn - OuterPosn)
                     TO TmpWorkString

             *> Separate the Parameter and Value

                UNSTRING TmpWorkString DELIMITED BY "="
                         INTO ParamString, ValueString
                END-UNSTRING

                CALL "CBL_TOUPPER" USING ParamString
                                   BY VALUE 256
                END-CALL

                EVALUATE ParamString
                WHEN "ACC"
                     IF ValueString = "P/" OR ValueString = "p/"
                        MOVE "/" TO UidPwdString
                     ELSE
                        MOVE ValueString(3:) TO UidPwdString
                     END-IF
                WHEN "DB"
                     MOVE ValueString TO DbNameString
                WHEN "SQLNET"
                     MOVE ValueString TO ServerString
                END-EVALUATE

             *> If we've reached the end of the string, drop out
             *> of the perform loop.

                IF     lk-open-string(InnerPosn : 2) = LOW-VALUES
                   EXIT PERFORM
                END-IF

                MOVE InnerPosn TO OuterPosn
                ADD 1 TO OuterPosn

           END-PERFORM

        *> CUSTOMIZE
        *> If you don't want to make the userID and password visible
        *> within the ES configuration pages, then code them directly
        *> here. Likewise for the ConnectionName to be used.

        *> MOVE "mysqlnetalias"       TO ServerString
        *> MOVE "myuserid/mypasswd"   TO UidPwdString
        *> MOVE "myconnname"          TO DbNameString

        *> Ensure that at minimum, a DSN has been passed via the
        *> Open String.

           IF UidPwdString = LOW-VALUES
              MOVE -2 TO ws-open-rc

              IF (TRACE-FLAGS-OPEN b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-ERROR >= ctf-trace-level
                  MOVE EVENT-OPEN-BADOPENSTRING TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-ERROR TO ls-trace-level
                  perform trace-odbc-event
              end-if

           ELSE

           *> Connect to the database

              IF ServerString = LOW-VALUES
                 IF DbNameString = LOW-VALUES
                    EXEC SQL
                         CONNECT :UidPwdString
                    END-EXEC
                 ELSE
                    EXEC SQL
                         CONNECT :UidPwdString AT :DbNameString
                    END-EXEC
                 END-IF
              ELSE
                 IF DbNameString = LOW-VALUES
                    EXEC SQL
                         CONNECT :UidPwdString USING :ServerString
                    END-EXEC
                 ELSE
                    EXEC SQL
                         CONNECT :UidPwdString AT :DbNameString
                                  USING :ServerString
                    END-EXEC
                 END-IF
              END-IF
   
              IF SQLCODE NOT = ZERO

                 MOVE -3 TO ws-open-rc

                 IF (TRACE-FLAGS-OPEN b-and ctf-trace-flags) not = 0
                 and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                     MOVE EVENT-OPEN-CONNECT TO ls-trace-event
                     MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                     perform trace-odbc-event
                 end-if

              ELSE
                 MOVE 0 TO ws-open-rc

                 IF (TRACE-FLAGS-OPEN b-and ctf-trace-flags) not = 0
                 and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                     MOVE EVENT-OPEN-CONNECT TO ls-trace-event
                     MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                     perform trace-odbc-event
                 end-if

              END-IF

           END-IF

           GOBACK RETURNING ws-open-rc
           .

       xa-close SECTION.
       ENTRY "esoraopc_1pc_disconnect" USING
                                  BY REFERENCE lk-close-string
                                  BY VALUE     lk-rmid
                                  BY VALUE     lk-flags.

              EXEC SQL
                   ROLLBACK WORK RELEASE
              END-EXEC

           IF SQLCODE NOT = ZERO
              MOVE -3 TO ws-close-rc

              IF (TRACE-FLAGS-CLOSE b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-CLOSE TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trace-odbc-event
              end-if
           ELSE
              MOVE 0 TO ws-close-rc

              IF (TRACE-FLAGS-CLOSE b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-CLOSE TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trace-odbc-event
              end-if
           END-IF


           GOBACK RETURNING ws-close-rc
           .

       xa-rollback SECTION.
       ENTRY "esoraopc_1pc_rollback" USING
                                      BY REFERENCE lk-xid
                                      BY VALUE     lk-rmid
                                      BY VALUE     lk-flags.

           EXEC SQL
                ROLLBACK
           END-EXEC

           IF SQLCODE NOT = ZERO
              MOVE -3 TO ws-rollback-rc

              IF (TRACE-FLAGS-ROLLBACK b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-ROLLBACK TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trace-odbc-event
              end-if

           ELSE
              MOVE 0 TO ws-rollback-rc

              IF (TRACE-FLAGS-ROLLBACK b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-ROLLBACK TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trace-odbc-event
              end-if

           END-IF

           GOBACK RETURNING ws-rollback-rc
           .

       xa-commit SECTION.
       ENTRY "esoraopc_1pc_commit" USING
                                    BY REFERENCE lk-xid
                                    BY VALUE     lk-rmid
                                    BY VALUE     lk-flags.

           EXEC SQL
                COMMIT
           END-EXEC

           IF SQLCODE NOT = ZERO
              MOVE -3 TO ws-commit-rc

              IF (TRACE-FLAGS-COMMIT b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-COMMIT TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
               perform trace-odbc-event
              end-if

           ELSE
              MOVE 0 TO ws-commit-rc

              IF (TRACE-FLAGS-COMMIT b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-COMMIT TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trace-odbc-event
              end-if

           END-IF

           GOBACK RETURNING ws-commit-rc
           .

      *****************************************************************
      *  Initialise tracing for THIS-COMPONENT.
      *
      *  On exit from this section 'ctf-tracer-handle',
      *  'ctf-trace-flags' and 'ctf-trace-level' will be set for
      *  THIS-COMPONENT
      *****************************************************************
       initialise-odbc-tracing section.

           MOVE 0 TO ctf-trace-flags

           *>
           *>  Pick up THIS-COMPONENT's tracer handle
           *>
           MOVE 78-CTF-FLAG-COMP-NAME-NULL-TERM TO ls-api-flags
           MOVE THIS-COMPONENT & x"00" TO ls-comp-name

           CALL "CBL_CTF_TRACER_GET" USING
                                     BY VALUE     ls-api-flags
                                     BY REFERENCE ls-comp-name
                                     BY REFERENCE ctf-tracer-handle
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_CTF_TRACER_GET (rc = "
                       RETURN-CODE
                       ")"
               EXIT SECTION
           END-IF

           *>
           *>  Get THIS-COMPONENT's tracer properties.
           *>
           *>  For the purpose of this demo, all properties are
           *>  expected to have integer values, so if the property
           *>  exists, but has a non-integer value it will be ignored.
           *>
           MOVE 78-CTF-FLAG-PROP-INT-VALUE TO ls-api-flags

           PERFORM VARYING ls-prop-id FROM 1 BY 1
                     UNTIL ws-prop-name(ls-prop-id) = SPACES

               CALL "CBL_CTF_COMP_PROPERTY_GET" USING
                              BY VALUE     ls-api-flags
                              BY REFERENCE ctf-tracer-handle
                              BY REFERENCE ws-prop-name(ls-prop-id)
                              BY VALUE     0
                              BY REFERENCE ls-prop-value
               END-CALL

               IF RETURN-CODE = 0
                   PERFORM apply-odbc-property-value
               END-IF
           END-PERFORM

           *>
           *>  Get THIS-COMPONENT's tracer trace level
           *>
           MOVE 0 TO ls-api-flags

           CALL "CBL_CTF_TRACER_LEVEL_GET" USING
                                       BY VALUE     ls-api-flags
                                       BY REFERENCE ctf-tracer-handle
                                       BY REFERENCE ctf-trace-level
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_TRACER_LEVEL_GET (rc = "
                       return-code
                       ")"
               EXIT SECTION
           END-IF

           *>
           *> Install tracer notification callback
           *>
           MOVE LOW-VALUES TO ls-install-param
           MOVE ctf-tracer-handle TO
                cblte-tni-handle OF ls-install-param
           SET cblte-tni-callback OF ls-install-param TO
               ENTRY "ctf-tracer-esoraopcsub-notif-callback"

           CALL "CBL_CTF_TRACER_NOTIFY" USING
                                        BY VALUE 0
                                        BY REFERENCE ls-install-param
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_CTF_TRACER_NOTIFY (rc = "
                       return-code
                       ")"
               EXIT SECTION
           END-IF

           *>
           *> Initialise fixed fields in trace event structure
           *>
           MOVE LOW-VALUES TO ctf-trace-event

           SET cblte-trcevt-event-len OF ctf-trace-event TO
               ADDRESS OF ctf-trace-event-lens(1)
           SET cblte-trcevt-event-type OF ctf-trace-event TO
               ADDRESS OF ctf-trace-event-types(1)
           SET cblte-trcevt-event-data OF ctf-trace-event TO
               ADDRESS OF ctf-trace-event-ptrs(1)
           .

      *****************************************************************
      *    Set appropriate trace flags bit
      *****************************************************************
       apply-odbc-property-value section.
           IF ls-prop-id = PROPID-ALL
               IF ls-prop-value NOT = 0
                  COMPUTE ctf-trace-flags = ctf-trace-flags b-or
                                            h'FFFFFFFF'
               ELSE
                  MOVE 0 TO ctf-trace-flags
               END-IF
           ELSE
               COMPUTE ls-work-var = 2 ** (ls-prop-id - 2)

               IF ls-prop-value NOT = 0
                   COMPUTE ctf-trace-flags = ctf-trace-flags b-or
                                             ls-work-var
               ELSE
                   COMPUTE ctf-trace-flags = ctf-trace-flags b-and b-not
                                             ls-work-var
               END-IF
           END-IF
           .

      *****************************************************************
      *  THIS-COMPONENT tracer callback. Processes THIS-COMPONENT's
      *  property and trace level changes.
      *
      *  lk-ctf-tracer-handle  =  tracer handle
      *
      *  lk-ctf-notif-type     =  notification type
      *
      *                           0 = property change
      *                           1 = trace level change
      *
      *  lk-ctf-notif-info     =  address of item whose type is
      *                           dependent upon notification type
      *
      *                           type 0 = cblt-trc-notif-prop-change
      *                           type 1 = pic x(4) comp-5
      *****************************************************************
       ctf-tracer-odbc-notif-callback section.
           ENTRY "ctf-tracer-esoraopcsub-notif-callback" USING
                                      BY VALUE     lk-ctf-tracer-handle
                                      BY VALUE     lk-ctf-notif-type
                                      BY REFERENCE lk-ctf-notif-param.
           EVALUATE lk-ctf-notif-type
               WHEN 78-TRC-NOTIF-TYPE-PROP-CHANGE
                   PERFORM ctf-tracer-odbc-notif-property

               WHEN 78-TRC-NOTIF-TYPE-LEVEL-CHANGE
                   MOVE lk-ctf-notif-param-level TO ctf-trace-level

               WHEN OTHER
                    CONTINUE
           END-EVALUATE

           GOBACK
           .

      *-----------------------------------------------------------------
      *    Tracer property changed
      *-----------------------------------------------------------------
       ctf-tracer-odbc-notif-property section.
           SET ADDRESS OF lk-ctf-property-name TO
               cblte-tnpc-name OF lk-ctf-notif-param-property

           PERFORM VARYING ls-prop-id FROM 1 BY 1
                     UNTIL ws-prop-name(ls-prop-id) = SPACES

               IF ws-prop-name(ls-prop-id) =
                  lk-ctf-property-name
                   (1:cblte-tnpc-namelen OF lk-ctf-notif-param-property)

                   MOVE cblte-tnpc-valint OF lk-ctf-notif-param-property
                        TO ls-prop-value

                   PERFORM apply-odbc-property-value
                   EXIT PERFORM
               END-IF
           END-PERFORM
           .

      *****************************************************************
      *    Output trace event
      *****************************************************************
       trace-odbc-event section.
           MOVE 78-TRACE-EVENT-FLAGS-NONE TO
                cblte-trcevt-flags OF ctf-trace-event
           MOVE ls-trace-event TO
                cblte-trcevt-event-id OF ctf-trace-event
           MOVE ls-trace-level TO
                cblte-trcevt-level OF ctf-trace-event

           MOVE 0 TO ls-trace-data-count

           EVALUATE ls-trace-event
               WHEN EVENT-OPEN-CONNECT
               WHEN EVENT-COMMIT
               WHEN EVENT-ROLLBACK
               WHEN EVENT-CLOSE
                   PERFORM trace-odbc-event-rtn-sqlerr

               WHEN EVENT-OPEN-BADOPENSTRING
                   PERFORM trace-odbc-event-openstr-err

           END-EVALUATE

           MOVE ls-trace-data-count TO
                cblte-trcevt-data-count OF ctf-trace-event

           CALL "CBL_CTF_TRACE" USING BY VALUE     0
                                      BY REFERENCE ctf-tracer-handle
                                      BY REFERENCE ctf-trace-event
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_CTF_TRACE (rc = "
                       RETURN-CODE
                       ")"
           END-IF
           .

      *-----------------------------------------------------------------
      *    Set up trace data for handling sql errors
      *-----------------------------------------------------------------
       trace-odbc-event-rtn-sqlerr section.

           *>
           *>  SQL Error message
           *>

           UNSTRING SQLERRMC DELIMITED BY "   " INTO TmpString
                COUNT ctf-trace-event-lens(1)

           SET ctf-trace-event-ptrs(1) TO 
               ADDRESS OF SQLERRMC

           MOVE 78-TRACE-EVENT-TYPE-TEXT TO
                ctf-trace-event-types(1)

           ADD 1 TO ls-trace-data-count

           *>
           *>  SQLCODE
           *>

           SET ctf-trace-event-ptrs(2) TO 
               ADDRESS OF SQLCODE

           MOVE length of SQLCODE TO
                ctf-trace-event-lens(2)

           MOVE 78-TRACE-EVENT-TYPE-COMP5S TO
                ctf-trace-event-types(2)

           ADD 1 TO ls-trace-data-count

           .

       trace-odbc-event-openstr-err section.

           *>
           *>  info text
           *>

           MOVE "Error: Open String format is DSN=odbc_dsn"
                & "[,USRPASS=userid.passwd]."
                TO ls-trace-data-desc

           SET ctf-trace-event-ptrs(1) TO 
               ADDRESS OF ls-trace-data-desc

           UNSTRING ls-trace-data-desc DELIMITED BY "  " INTO TmpString
                COUNT ctf-trace-event-lens(1)

           MOVE 78-TRACE-EVENT-TYPE-TEXT TO
                ctf-trace-event-types(1)

           ADD 1 TO ls-trace-data-count

           .

