Transaction Wrapper Sample

The following is an example of an transaction wrapper generated by the OCX Wizard modified to include the OpenESQL logic to handle the following scenarios using an MS SQL Server data source:

$set ooctrl(+p) sql(thread=isolate autocommit)
*>-----------------------------------------------------------
*> Class description
*>-----------------------------------------------------------
 class-id. cblsqlwrapper
           inherits from olebase.
 object section.
 class-control.
     cblsqlwrapper is class "cblsqlwrapper"
*> OCWIZARD - start list of classes
     objectcontext is class "objectcontext"
     olebase is class "olebase"
     oleSafeArray is class "olesafea"
     oleVariant is class "olevar"
*> OCWIZARD - end list of classes
*>---USER-CODE. Add any additional class names below.
*>-----------------------------------------------------------
 working-storage section. *> Definition of global data
*>-----------------------------------------------------------

*>-----------------------------------------------------------
 class-object.   *> Definition of class data and methods
*>-----------------------------------------------------------
 object-storage section.

*> OCWIZARD - start standard class methods
*>-----------------------------------------------------------
*> Return details about the class.
*> If you have a type library, theClassId and theInterfaceId
*> here MUST match.
*> theProgId must match the registry entry for this class
*>   (a zero length string implies using the class file name)
*> theClassId must match the CLSID stored in the registry.
*> theVersion is currently ignored (default 1 used).
*>-----------------------------------------------------------
 method-id. queryClassInfo.
 linkage section.
 01 theProgId             pic x(256).
 01 theClassId            pic x(39).
 01 theInterfceId         pic x(39).
 01 theVersion            pic x(4) comp-5.
 01 theDescription        pic x(256).
 01 theThreadModel        pic x(20).
 procedure division using by reference theProgId
                          by reference theClassId
                          by reference theInterfceId
                          by reference theVersion
                          by reference theDescription
                          by reference theThreadModel.
     move z"{3EADD92C-06C5-46F2-A2E0-7EB0794C14DF}"
                                            to theClassId
     move z"{5BF3F966-9932-4835-BFF6-2582CA2592AD}"
                                            to theInterfceId
     move z"Description for class cblsqlwrapper"
                                            to theDescription
     move z"Apartment" to theThreadModel
     exit method.
 end method queryClassInfo.
 .

*>-----------------------------------------------------------
*> Return details about the type library - delete if unused.
*> theLocale is currently ignored (default 0 used).
*> theLibraryName is a null terminated string used for auto
*> registration, and supports the following values:
*>    <no string> - Library is embedded in this binary
*>    <number>    - As above, with this resource number
*>    <Path>      - Library is at this (full path)
*>                        location
*>-----------------------------------------------------------
 method-id. queryLibraryInfo.
 linkage section.
 01 theLibraryName        pic x(512).
 01 theMajorVersion       pic x(4) comp-5.
 01 theMinorVersion       pic x(4) comp-5.
 01 theLibraryId          pic x(39).
 01 theLocale             pic x(4) comp-5.
 procedure division using by reference theLibraryName
                          by reference theMajorVersion
                          by reference theMinorVersion
                          by reference theLibraryId
                          by reference theLocale.
     move 1 to theMajorVersion
     move 0 to theMinorVersion
     move z"{24207F46-7136-4285-A660-4594F5EE7B87}"
                                            to theLibraryId
     exit method.
 end method queryLibraryInfo.

*>-----------------------------------------------------------

*> OCWIZARD - end standard class methods

 end class-object.

*>-----------------------------------------------------------
 object.         *> Definition of instance data and methods
*>-----------------------------------------------------------
 object-storage section.

*> OCWIZARD - start standard instance methods
*> OCWIZARD - end standard instance methods

*>-----------------------------------------------------------
 method-id. "RetrieveString".
 working-storage section.

 01 mfsqlmessagetext pic x(400).
 01 ESQLAction       pic x(100).

 COPY DFHEIBLK.

 COPY SQLCA.
*>...your transaction program name
 01 transactionPgm           PIC X(7) VALUE 'mytran'.


 local-storage Section.
 01 theContext              object reference.
 01 transactionStatusFlag   pic 9.
   88 transactionPassed     value 1.
   88 transactionFailed     value 0.
*>---USER-CODE. Add any local storage items needed below.

 01 ReturnValue             pic x(4) comp-5.
   88 IsNotInTransaction    value 0.

 01 transactionControlFlag  pic 9.
   88 TxnControlledByMTS    value 0.
   88 TxnNotControlledByMTS value 1.

 linkage Section.

*>...Info passed to transaction
 01 transaction-Info.
    05 transaction-Info-RC   pic 9.
    05 transaction-Info-data pic x(100).

*>...Info returned from transaction via
 01 transaction-Info-Returned pic x(100).


 procedure division using by reference transaction-Info
                    returning transaction-Info-Returned.

*>...initialisation code
     perform A-Initialise
     perform B-ConnectToDB
     if TxnNotControlledByMTS
         perform C-SetAutoCommitOff
     end-if

*>...set isolation level to override SQLServer default,
*>...serialize
     perform D-ResetDefaultIsolationLevel

*>...set cursor type to overrde the OpenESQL default,
*>...dynamic+lock
     perform E-ResetDefaultCursorType

*>...call the transaction
     perform F-CallTransaction

*>...finalisation code - issue Commit/Rollback if not
*>...controlled by MTS/COM+
     if TxnNotControlledByMTS
         if transactionPassed
             perform X-Commit
         else
             perform X-Rollback
         end-if
     end-if

     perform Y-Disconnect

*>...Transaction Server - use setAbort if the method fails:
     if theContext not = null
         if transactionPassed
             invoke theContext "setComplete"
         else
             invoke theContext "setAbort"
         end-if
         invoke theContext "finalize" returning theContext
     end-if

     exit method
     .

 A-Initialise.
*>...Transaction Server - get the context we are running in
     invoke objectcontext "GetObjectContext"
            returning theContext

*>...check if this component is enlisted in an MTS transation
     if theContext = null
         set TxnNotControlledByMTS to true
     else
         invoke theContext "IsInTransaction"
                returning ReturnValue
         if IsNotInTransaction
             set TxnNotControlledByMTS to true
         else
            set TxnControlledByMTS    to true
          end-if
     end-if

*>...initialise program variables
     set transactionPassed to true

     INITIALIZE DFHEIBLK
     .

 B-ConnectToDB.
*>...connect to data source

     EXEC SQL
         CONNECT TO 'SQLServer 2000' USER 'SA'
     END-EXEC

     if sqlcode  zero
         move z"connection failed " to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if
     .

 C-SetAutoCommitOff.
     EXEC SQL
         SET AUTOCOMMIT OFF
     END-EXEC
     if sqlcode  zero
         move z"Set Autocommit Off failed " to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if

     perform X-Commit
    .

 D-ResetDefaultIsolationLevel.
*> the default isolation level for SQLServer is "Serialized",
*> so here we reset it to something more appropriate

     EXEC SQL
         SET TRANSACTION ISOLATION READ COMMITTED
     END-EXEC
     if sqlcode  zero
         move z"set transaction isoation failed "
                                            to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if
     .

 E-ResetDefaultCursorType.
*> the default cursor type for OpenESQL is dynamic + lock
*> the most efficient is a "client" or "firehose" cursor -
*> this is a cursor declared as forward + read only - doing
*> this here will set it as a default from now on.  If
*> Forward causes a problem, change the concurrency to fast
*> forward (but note that it will then no longer be a client
*> cursor)

     EXEC SQL
         SET CONCURRENCY READ ONLY
     END-EXEC
     if sqlcode  zero
         move z"Set Concurrency Read Only" to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if

     EXEC SQL
         SET SCROLLOPTION FORWARD
     END-EXEC
     if sqlcode  zero
         move z"Set Concurrancy Read Only" to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if
     .

 F-CallTransaction.
*>...call the program to process the transaction
     move 0               to  transaction-Info-RC
     call tranactionPgm using dfheiblk transaction-Info

*>...check if processing was okay
     if transaction-Info-RC = 0
        set transactionPassed to true
     else
        set transactionFailed to true
     end-if
     .

 X-Commit.
     EXEC SQL
         COMMIT
     END-EXEC
     if sqlcode  zero
         move z"Commit failed " to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if
     .

 X-Rollback.
     EXEC SQL
         ROLLBACK
     END-EXEC
     if sqlcode  zero
         move z"Rollback failed " to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if
     .

 Y-Disconnect.
     EXEC SQL
         DISCONNECT CURRENT
     END-EXEC
     if sqlcode  zero
         move z"Disconnect failed " to ESQLAction
         perform Z-ReportSQLErrorAndExit
     end-if
     .

 Z-ReportSQLErrorAndExit.
     move spaces to transaction-Info-Returned
     string ESQLAction delimited by x"00"
            "SQLSTATE = "
            SQLSTATE
            "  "
            mfsqlmessagetext
            into transaction-Info-Returned
     end-string

     exit method
     .

 exit method.
 end method "RetrieveString".
*>-----------------------------------------------------------

 end object.
 end class cblsqlwrapper.