$SET SQL SERIAL REENTRANT(2) NOCANCEL *> *> Micro Focus Net Express XA one-phase commit switch module. *> *> (C) Copyright 2005-2007 Micro Focus (IP) Limited *> All Rights Reserved. *> *> The Open String for this module is defined as : *> DSN=mydsn[,USRPASS=userid.passwd] *> *> where : *> *> mydsn : ODBC Data Source Name, as defined within the ODBC *> Administrator utility. *> userid : User ID required to connect to the data source *> passwd : Password required for User userid to connect to the *> data source *> 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. ESODBCXA. ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. 78 esxa-ep-prefix VALUE "ES1". 78 esxa-open VALUE esxa-ep-prefix & "ESODBCXA_OPEN". 78 esxa-close VALUE esxa-ep-prefix & "ESODBCXA_CLOSE". 78 esxa-start VALUE esxa-ep-prefix & "ESODBCXA_START". 78 esxa-end VALUE esxa-ep-prefix & "ESODBCXA_END". 78 esxa-rollback VALUE esxa-ep-prefix & "ESODBCXA_ROLLBACK". 78 esxa-prepare VALUE esxa-ep-prefix & "ESODBCXA_PREPARE". 78 esxa-commit VALUE esxa-ep-prefix & "ESODBCXA_COMMIT". 78 esxa-recover VALUE esxa-ep-prefix & "ESODBCXA_RECOVER". 78 esxa-forget VALUE esxa-ep-prefix & "ESODBCXA_FORGET". 78 esxa-complete VALUE esxa-ep-prefix & "ESODBCXA_COMPLETE". 78 78-XA-ONEPHASE-SUPPORT VALUE H'80000000'. 01 mfesxa-switch-struct. 03 mfesxa-RM-name PIC X(32). 03 mfesxa-flags PIC S9(9) COMP-5. 03 mfesxa-version PIC S9(9) COMP-5. 03 mfesxa-open-entry PROCEDURE-POINTER. 03 mfesxa-close-entry PROCEDURE-POINTER. 03 mfesxa-start-entry PROCEDURE-POINTER. 03 mfesxa-end-entry PROCEDURE-POINTER. 03 mfesxa-rollback-entry PROCEDURE-POINTER. 03 mfesxa-prepare-entry PROCEDURE-POINTER. 03 mfesxa-commit-entry PROCEDURE-POINTER. 03 mfesxa-recover-entry PROCEDURE-POINTER. 03 mfesxa-forget-entry PROCEDURE-POINTER. 03 mfesxa-complete-entry PROCEDURE-POINTER. 03 mfesxa-1phase. 05 mfesxa-1phase-flags PIC X(8). 05 mfesxa-1phase-connect-entry PROCEDURE-POINTER. 05 mfesxa-1phase-disconnect-entry PROCEDURE-POINTER. 05 mfesxa-1phase-commit-entry PROCEDURE-POINTER. 05 mfesxa-1phase-rollback-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 TmString PIC X(256) VALUE LOW-VALUES. 01 RmGuidString PIC X(256) VALUE LOW-VALUES. 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 ConnectionStructure. 03 DsnString PIC X(32) VALUE LOW-VALUES. 03 UsrPassString PIC X(32) VALUE LOW-VALUES. *> SQL Connection Handle 01 ConnectionHandle PIC X(4) COMP-5. 01 MFSQLMESSAGETEXT PIC X(150). EXEC SQL END DECLARE SECTION END-EXEC *> Support for tracing COPY "cbltypes.cpy". COPY "mfctf.cpy". 01 TmpString PIC X(200). 78 MAX-TRACE-DATA VALUE 7. 78 THIS-COMPONENT VALUE "MF.ESODBCXA". *---------------------------------------------------------------- * THIS_COMPONENT's tracer properties *---------------------------------------------------------------- 78 PROPID-ALL VALUE 1. 78 PROPNAME-ALL VALUE "all". 78 PROPNAME-OPEN VALUE "open". 78 PROPNAME-START VALUE "start". 78 PROPNAME-COMMIT VALUE "commit". 78 PROPNAME-ROLLBACK VALUE "rollback". 78 PROPNAME-CLOSE VALUE "close". 01 ws-prop-names. 03 PIC X(10) VALUE PROPNAME-ALL. 03 PIC X(10) VALUE PROPNAME-OPEN. 03 PIC X(10) VALUE PROPNAME-START. 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 7. *---------------------------------------------------------------- * THIS_COMPONENT events *---------------------------------------------------------------- 78 EVENT-INIT VALUE 0. 78 EVENT-OPEN-BADOPENSTRING VALUE 1. 78 EVENT-OPEN-CONNECT VALUE 2. 78 EVENT-START VALUE 3. 78 EVENT-COMMIT VALUE 4. 78 EVENT-ROLLBACK VALUE 5. 78 EVENT-CLOSE VALUE 6. 78 EVENT-END VALUE 7. *---------------------------------------------------------------- * 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-START VALUE h'00000002'. 78 TRACE-FLAGS-COMMIT VALUE h'00000004'. 78 TRACE-FLAGS-ROLLBACK VALUE h'00000008'. 78 TRACE-FLAGS-CLOSE VALUE h'00000010'. 78 TRACE-FLAGS-END VALUE h'00000020'. 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. *> Set up internal XA structure to point to internal *> ENTRY points of this program. INITIALIZE mfesxa-switch-struct MOVE 'Micro Focus ODBC XA struct' & esxa-ep-prefix & x'00' TO mfesxa-RM-name MOVE 0 TO mfesxa-flags MOVE 0 TO mfesxa-version SET mfesxa-open-entry TO ENTRY esxa-open SET mfesxa-close-entry TO ENTRY esxa-close SET mfesxa-start-entry TO ENTRY esxa-start SET mfesxa-end-entry TO ENTRY esxa-end SET mfesxa-rollback-entry TO ENTRY esxa-rollback SET mfesxa-prepare-entry TO ENTRY esxa-prepare SET mfesxa-commit-entry TO ENTRY esxa-commit SET mfesxa-recover-entry TO ENTRY esxa-recover SET mfesxa-forget-entry TO ENTRY esxa-forget SET mfesxa-complete-entry TO ENTRY esxa-complete SET mfesxa-1phase-commit-entry TO ENTRY esxa-commit SET mfesxa-1phase-rollback-entry TO ENTRY esxa-rollback SET mfesxa-1phase-connect-entry TO ENTRY esxa-open SET mfesxa-1phase-disconnect-entry TO ENTRY esxa-close COMPUTE mfesxa-flags = mfesxa-flags B-OR 78-XA-ONEPHASE-SUPPORT PERFORM initialise-odbc-tracing IF (TRACE-FLAGS-OPEN b-and ctf-trace-flags) NOT = 0 AND 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level MOVE EVENT-INIT TO ls-trace-event MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level PERFORM trace-odbc-event END-IF GOBACK RETURNING ADDRESS OF mfesxa-switch-struct. . *--------------------------------------------------------------* xa-open SECTION. ENTRY esxa-open USING BY REFERENCE lk-open-string BY VALUE lk-rmid BY VALUE lk-flags. *> Parse and validate the Open String passed in from ES. *> Supported format is : *> DSN=mydsn[,USRPASS=userid.passwd] *> As indicated below, it is possible to only pass the *> DSN in from ES, and pass the USRPASS parameters *> programmatically from this program. 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 "DSN" MOVE ValueString TO DsnString WHEN "USRPASS" MOVE ValueString TO UsrPassString WHEN "TM" MOVE ValueString TO TmString WHEN "RMRECOVERYGUID" MOVE ValueString TO RmGuidString 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 "mydsn" TO DsnString *> MOVE "myuserid.mypasswd" TO UsrPassString *> Ensure that at minimum, a DSN has been passed via the *> Open String. IF DsnString = 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 MOVE SPACES TO MFSQLMESSAGETEXT IF UsrPassString = LOW-VALUES EXEC SQL CONNECT TO :DsnString END-EXEC ELSE EXEC SQL CONNECT TO :DsnString USER :UsrPassString END-EXEC END-IF IF SQLCODE NOT = ZERO MOVE -3 TO ws-open-rc ELSE MOVE 0 TO ws-open-rc END-IF 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 GOBACK RETURNING ws-open-rc . xa-close SECTION. ENTRY esxa-close USING BY REFERENCE lk-close-string BY VALUE lk-rmid BY VALUE lk-flags. MOVE SPACES TO MFSQLMESSAGETEXT EXEC SQL DISCONNECT CURRENT END-EXEC IF SQLCODE NOT = ZERO MOVE -3 TO ws-close-rc ELSE MOVE 0 TO ws-close-rc END-IF 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 GOBACK RETURNING ws-close-rc . xa-start SECTION. ENTRY esxa-start USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. *> If xa_start was successful, connect to the database *> and enlist in an XA Transaction MOVE SPACES TO MFSQLMESSAGETEXT EXEC SQL BEGIN TRANSACTION END-EXEC IF SQLCODE NOT = ZERO MOVE -3 TO ws-start-rc ELSE MOVE 0 TO ws-start-rc END-IF IF (TRACE-FLAGS-START b-and ctf-trace-flags) NOT = 0 AND 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level MOVE EVENT-START TO ls-trace-event MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level PERFORM trace-odbc-event END-IF GOBACK RETURNING ws-start-rc . xa-end SECTION. ENTRY esxa-end USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. MOVE 0 TO ws-end-rc GOBACK RETURNING ws-end-rc . xa-rollback SECTION. ENTRY esxa-rollback USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. MOVE SPACES TO MFSQLMESSAGETEXT EXEC SQL ROLLBACK TRANSACTION END-EXEC IF SQLCODE NOT = ZERO MOVE -3 TO ws-rollback-rc ELSE MOVE 0 TO ws-rollback-rc END-IF 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 GOBACK RETURNING ws-rollback-rc . xa-prepare SECTION. ENTRY esxa-prepare USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. MOVE 0 TO ws-prepare-rc GOBACK RETURNING ws-prepare-rc . xa-commit SECTION. ENTRY esxa-commit USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. MOVE SPACES TO MFSQLMESSAGETEXT EXEC SQL COMMIT TRANSACTION END-EXEC IF SQLCODE NOT = ZERO MOVE -3 TO ws-commit-rc ELSE MOVE 0 TO ws-commit-rc END-IF 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 GOBACK RETURNING ws-commit-rc . xa-recover SECTION. ENTRY esxa-recover USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. MOVE 0 TO ws-recover-rc GOBACK RETURNING ws-recover-rc . xa-forget SECTION. ENTRY esxa-forget USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. MOVE 0 TO ws-forget-rc GOBACK RETURNING ws-forget-rc . xa-complete SECTION. ENTRY esxa-complete USING BY REFERENCE lk-xid BY VALUE lk-rmid BY VALUE lk-flags. MOVE 0 TO ws-complete-rc GOBACK RETURNING ws-complete-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-odbc-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-odbc-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-START 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 WHEN EVENT-INIT WHEN EVENT-END CONTINUE 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 MFSQLMESSAGETEXT DELIMITED BY " " INTO TmpString COUNT ctf-trace-event-lens(1) SET ctf-trace-event-ptrs(1) TO ADDRESS OF MFSQLMESSAGETEXT 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 *> *> SQLSTATE *> SET ctf-trace-event-ptrs(3) TO ADDRESS OF SQLSTATE MOVE length of SQLSTATE TO ctf-trace-event-lens(3) MOVE 78-TRACE-EVENT-TYPE-TEXT TO ctf-trace-event-types(3) 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 .