This program uses the Gateway-Library system programmer calls to do tracing and accounting at the mainframe.
IDENTIFICATION DIVISION
*-----------------------
PROGRAM-ID. SYCCSAS2.
ENVIRONMENT DIVISION.
DATA DIVISION.
*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
*----------------------------------------------------------------
* SERVER LIBRARY COBOL COPY BOOK
*----------------------------------------------------------------
COPY SYGWCOB.
*----------------------------------------------------------------
* WORK AREAS
*----------------------------------------------------------------
01 GW-LIB-MISC-FIELDS.
05 GWL-PROC POINTER.
05 GWL-INIT-HANDLE POINTER.
05 GWL-INFACT-STATUS PIC S9(9) COMP.
05 GWL-INFACT-FILENAME PIC X(8).
05 GWL-INFACT-RECORDS PIC S9(9) COMP.
05 GWL-INFLOG-GLOBAL PIC S9(9) COMP.
05 GWL-INFLOG-API PIC S9(9) COMP.
05 GWL-INFLOG-HEADER PIC S9(9) COMP.
05 GWL-INFLOG-DATA PIC S9(9) COMP.
05 GWL-INFLOG-TRACEID PIC S9(9) COMP.
05 GWL-INFLOG-FILENAME PIC X(8).
05 GWL-INFLOG-RECORDS PIC S9(9) COMP.
05 GWL-INFSPT-STATUS PIC S9(9) COMP.
05 GWL-INFSPT-OPTIONS PIC S9(9) COMP.
05 GWL-INFSPT-TRANID PIC X(4).
05 GWL-INFSPT-TRANID-L PIC S9(9) COMP.
05 GWL-LSTSPT-LIST OCCURS 8 TIMES
PIC X(8).
05 GWL-RC PIC S9(9) COMP.
05 GWL-RCVPRM-ID PIC S9(9) COMP VALUE +1.
05 GWL-RCVPRM-MAX-DATA-L ThinSpaceThinSpacePIC S9(9) COMP VALUE +2.
05 GWL-RCVPRM-DATA-L PIC S9(9) COMP VALUE +2
05 GWL-SETSPT-OPTIONS PIC S9(9) COMP.
05 GWL-STATUS-NR PIC S9(9) COMP.
05 GWL-STATUS-DONE PIC S9(9) COMP.
05 GWL-STATUS-COUNT PIC S9(9) COMP.
05 GWL-STATUS-COMM PIC S9(9) COMP.
05 GWL-STATUS-RETURN-CODE PIC S9(9) COMP.
05 GWL-STATUS-SUBCODE PIC S9(9) COMP.
05 GWL-WRTLOG-MSG-L PIC S9(9) COMP VALUE +34.
05 GWL-WRTLOG-MSG PIC X(34)
VALUE 'TEST MESSAGE FROM SYS2 TRANSACTION'.
01 PARM-FIELDS.
05 PARM-REQUEST PIC X(2).
88 PARM-REQUEST-INFACT VALUE 'IA'.
88 PARM-REQUEST-INFLOG VALUE 'IL'.
88 PARM-REQUEST-LSTSPT VALUE 'IS'.
88 PARM-REQUEST-SETACT-ON VALUE 'YA'.
88 PARM-REQUEST-SETACT-OFF VALUE 'NA'.
88 PARM-REQUEST-SETLOG-ON VALUE 'YL'.
88 PARM-REQUEST-SETLOG-OFF VALUE 'NL'.
88 PARM-REQUEST-SETSPT-ON VALUE 'YS'.
88 PARM-REQUEST-SETSPT-OFF VALUE 'NS'.
88 PARM-REQUEST-WRTLOG VALUE 'WL'.
01 SNA-FIELDS.
05 SNA-SUBC PIC S9(9) COMP.
05 SNA-CONNECTION-NAME PIC X(8) VALUE SPACES.
01 COLUMN-NAME-FIELDS.
05 CN-INFACT-STATUS PIC X(13) VALUE 'ACT_STATUS'
05 CN-INFACT-FILENAME PIC X(12) VALUE 'ACT FILENAME'.
05 CN-INFACT-RECORDS PIC X(11) VALUE 'ACT RECORDS'.
05 CN-INFLOG-GLOBAL PIC X(10) VALUE 'LOG GLOBAL'.
05 CN-INFLOG-API PIC X(7) VALUE 'LOG API'.
05 CN-INFLOG-HEADER PIC X(10) VALUE 'LOG HEADER'.
05 CN-INFLOG-DATA PIC X(8) VALUE 'LOG DATA'.
05 CN-INFLOG-TRACEID PIC X(11) VALUE 'LOG TRACEID'.
05 CN-INFLOG-FILENAME PIC X(12) VALUE 'LOG FILENAME'.
05 CN-INFLOG-RECORDS PIC X(11) VALUE 'LOG RECORDS'.
05 CN-LSTSPT-TRANID PIC X(06) VALUE 'TRANID'.
01 COUNTER-FIELDS.
05 CTR-COLUMN PIC S9(9) COMP VALUE 0.
05 CTR-ROWS PIC S9(9) COMP VALUE 0.
01 WORK-FIELDS.
05 WRKLEN1 PIC S9(9) COMP.
05 WRKLEN2 PIC S9(9) COMP.
05 WRK-DONE-STATUS PIC S9(9) COMP.
05 WRK-RPC PIC X(4) VALUE 'SYS2'.
05 WRK-TRANID PIC X(4) VALUE SPACE.
05 WRK-LSTSPT-SS PIC S9(4) COMP.
01 MESSAGE-FIELDS.
05 MSG-TYPE PIC S9(9) COMP.
05 MSG-SEVERITY-ERROR PIC S9(9) COMP VALUE 11.
05 MSG-NR-ERROR PIC S9(9) COMP VALUE 2.
05 MSG-RPC PIC X(4).
05 MSG-RPC-L PIC S9(9) COMP VALUE 4.
05 MSG-TEXT PIC X(20).
05 MSG-TEXT-L PIC S9(9) COMP.
05 MSG-SRVLIB.
10 MSG-SRVLIB-FUNC PIC X(8) VALUE SPACE.
10 FILLER PIC X(6) VALUE ' RC = '.
10 MSG-SRVLIB-RC PIC Z(4)9+.
01 SWITCHES.
05 SEND-DONE-SW PIC X VALUE 'Y'.
88 SEND-DONE-ERROR ThinSpaceThinSpaceThinSpaceThinSpaceVALUE 'N'.
88 SEND-DONE-OK ThinSpaceThinSpaceThinSpaceThinSpaceVALUE 'Y'.
05 TRACING-SW PIC X VALUE 'N'.
88 TRACING-OFF VALUE 'N'.
88 TRACING-ON VALUE 'Y'.
*****************************************************************
PROCEDURE DIVISION.
*****************************************************************
*----------------------------------------------------------------
INITIALIZE-PROGRAM.
*----------------------------------------------------------------
* ------------------------------------------------------------
* Establish gateway environment.
* ------------------------------------------------------------
CALL 'TDINIT' USING DFHEIBLK, GWL-RC, GWL-INIT-HANDLE.
* ------------------------------------------------------------
* Accept client request.
* ------------------------------------------------------------
CALL 'TDACCEPT' USING GWL-PROC, GWL-RC, GWL-INIT-HANDLE,
SNA-CONNECTION-NAME,
SNA-SUBC.
* ------------------------------------------------------------
* Call TDRESULT to validate that request is an RPC.
* ------------------------------------------------------------
CALL 'TDRESULT' USING GWL-PROC, GWL-RC.
IF GWL-RC NOT = TDS-PARM-PRESENT THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDRESULT' TO MSG-SRVLIB-FUNC
GO TO END-PROGRAM
END-IF.
*----------------------------------------------------------------
GET-PARM.
*----------------------------------------------------------------
CALL 'TDRCVPRM' USING GWL-PROC, GWL-RC,
GWL-RCVPRM-ID,
PARM-REQUEST,
TDSCHAR,
GWL-RCVPRM-MAX-DATA-L,
GWL-RCVPRM-DATA-L.
IF PARM-REQUEST-INFACT THEN
PERFORM TDINFACT THRU TDINFACT-EXIT
ELSE IF PARM-REQUEST-INFLOG THEN
PERFORM TDINFLOG THRU TDINFLOG-EXIT
ELSE IF PARM-REQUEST-LSTSPT THEN
PERFORM TDLSTSPT THRU TDLSTSPT-EXIT
ELSE IF PARM-REQUEST-SETACT-ON THEN
PERFORM TDSETACT-ON THRU TDSETACT-ON-EXIT
ELSE IF PARM-REQUEST-SETACT-OFF THEN
PERFORM TDSETACT-OFF THRU TDSETACT-OFF-EXIT
ELSE IF PARM-REQUEST-SETLOG-ON THEN
PERFORM TDSETLOG-ON THRU TDSETLOG-ON-EXIT
ELSE IF PARM-REQUEST-SETLOG-OFF THEN
PERFORM TDSETLOG-OFF THRU TDSETLOG-OFF-EXIT
ELSE IF PARM-REQUEST-SETSPT-ON THEN
PERFORM TDSETSPT-ON THRU TDSETSPT-ON-EXIT
ELSE IF PARM-REQUEST-SETSPT-OFF THEN
PERFORM TDSETSPT-OFF THRU TDSETSPT-OFF-EXIT
ELSE IF PARM-REQUEST-WRTLOG THEN
PERFORM TDWRTLOG THRU TDWRTLOG-EXIT
END-IF.
*----------------------------------------------------------------
END-PROGRAM.
*----------------------------------------------------------------
IF SEND-DONE-OK THEN
MOVE TDS-DONE-COUNT TO WRK-DONE-STATUS
ELSE
PERFORM SRVLIB-ERROR THRU SRVLIB-ERROR-EXIT
MOVE TDS-DONE-ERROR TO WRK-DONE-STATUS
MOVE ZERO TO CTR-ROWS
END-IF.
CALL 'TDSNDDON' USING GWL-PROC, GWL-RC,
WRK-DONE-STATUS,
CTR-ROWS,
TDS-ZERO,
TDS-ENDRPC.
CALL 'TDFREE' USING GWL-PROC, GWL-RC.
STOP RUN.
*----------------------------------------------------------------
TDINFACT.
*----------------------------------------------------------------
MOVE LENGTH OF GWL-INFACT-STATUS TO WRKLEN1.
MOVE LENGTH OF CN-INFACT-STATUS TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
MOVE 'TDESCRIB' TO MSG-SRVLIB-FUNC.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFACT-STATUS,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFACT-STATUS,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFACT-EXIT
END-IF.
MOVE LENGTH OF GWL-INFACT-FILENAME TO WRKLEN1.
MOVE LENGTH OF CN-INFACT-FILENAME TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSCHAR,
WRKLEN1,
GWL-INFACT-FILENAME,
TDS-ZERO,
TDS-FALSE,
TDSCHAR,
WRKLEN1,
CN-INFACT-FILENAME,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFACT-EXIT
END-IF.
MOVE LENGTH OF GWL-INFACT-RECORDS TO WRKLEN1.
MOVE LENGTH OF CN-INFACT-RECORDS TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFACT-RECORDS,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFACT-RECORDS,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFACT-EXIT
END-IF.
CALL 'TDINFACT' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFACT-STATUS,
GWL-INFACT-FILENAME,
GWL-INFACT-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFACT' TO MSG-SRVLIB-FUNC
GO TO TDINFACT-EXIT
END-IF.
CALL 'TDSNDROW' USING GWL-PROC, GWL-RC.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSNDROW' TO MSG-SRVLIB-FUNC
GO TO TDINFACT-EXIT
END-IF.
ADD +1 TO CTR-ROWS.
*----------------------------------------------------------------
TDINFACT-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDINFLOG.
*----------------------------------------------------------------
MOVE LENGTH OF GWL-INFLOG-GLOBAL TO WRKLEN1.
MOVE LENGTH OF CN-INFLOG-GLOBAL TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
MOVE 'TDESCRIB' TO MSG-SRVLIB-FUNC.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFLOG-GLOBAL,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFLOG-GLOBAL,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFLOG-EXIT
END-IF.
MOVE LENGTH OF GWL-INFLOG-API TO WRKLEN1.
MOVE LENGTH OF CN-INFLOG-API TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFLOG-API,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFLOG-API,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFLOG-EXIT
END-IF.
MOVE LENGTH OF GWL-INFLOG-HEADER TO WRKLEN1.
MOVE LENGTH OF CN-INFLOG-HEADER TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFLOG-HEADER,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFLOG-HEADER,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFLOG-EXIT
END-IF.
MOVE LENGTH OF GWL-INFLOG-DATA TO WRKLEN1.
MOVE LENGTH OF CN-INFLOG-DATA TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFLOG-DATA,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFLOG-DATA, WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFLOG-EXIT
END-IF.
MOVE LENGTH OF GWL-INFLOG-TRACEID TO WRKLEN1.
MOVE LENGTH OF CN-INFLOG-TRACEID TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFLOG-TRACEID,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFLOG-TRACEID,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFLOG-EXIT
END-IF.
MOVE LENGTH OF GWL-INFLOG-FILENAME TO WRKLEN1.
MOVE LENGTH OF CN-INFLOG-FILENAME TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSCHAR,
WRKLEN1,
GWL-INFLOG-FILENAME,
TDS-ZERO,
TDS-FALSE,
TDSCHAR,
WRKLEN1,
CN-INFLOG-FILENAME,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFLOG-EXIT
END-IF.
MOVE LENGTH OF GWL-INFLOG-RECORDS TO WRKLEN1.
MOVE LENGTH OF CN-INFLOG-RECORDS TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSINT4,
WRKLEN1,
GWL-INFLOG-RECORDS,
TDS-ZERO,
TDS-FALSE,
TDSINT4,
WRKLEN1,
CN-INFLOG-RECORDS,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
GO TO TDINFLOG-EXIT
END-IF.
CALL 'TDINFLOG' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFLOG-GLOBAL,
GWL-INFLOG-API,
GWL-INFLOG-HEADER,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFLOG' TO MSG-SRVLIB-FUNC
GO TO TDINFLOG-EXIT
END-IF.
CALL 'TDSNDROW' USING GWL-PROC, GWL-RC.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSNDROW' TO MSG-SRVLIB-FUNC
GO TO TDINFLOG-EXIT
END-IF.
ADD +1 TO CTR-ROWS.
*----------------------------------------------------------------
TDINFLOG-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDLSTSPT.
*----------------------------------------------------------------
MOVE LENGTH OF WRK-TRANID TO WRKLEN1.
MOVE LENGTH OF CN-LSTSPT-TRANID TO WRKLEN2.
ADD +1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC,
CTR-COLUMN,
TDSCHAR,
WRKLEN1,
WRK-TRANID,
TDS-ZERO,
TDS-FALSE,
TDSCHAR,
WRKLEN1,
CN-LSTSPT-TRANID,
WRKLEN2.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDESCRIB' TO MSG-SRVLIB-FUNC
GO TO TDLSTSPT-EXIT
END-IF.
*
* Find global status.
*
CALL 'TDINFLOG' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFLOG-GLOBAL,
GWL-INFLOG-API,
GWL-INFLOG-HEADER,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
*
* If there are any errors, then assume tracing has been disabled.
*
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFLOG' TO MSG-SRVLIB-FUNC
GO TO TDLSTSPT-EXIT
END-IF.
*
* If specific tracing is not on, then return nothing.
*
IF GWL-INFLOG-GLOBAL NOT = TDS-TRACE-SPECIFIC-RPCS THEN
GO TO TDLSTSPT-EXIT
END-IF.
*
* Return rows.
*
CALL 'TDLSTSPT' USING GWL-INIT-HANDLE, GWL-RC,
GWL-LSTSPT-LIST(1).
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDLSTSPT' TO MSG-SRVLIB-FUNC
GO TO TDLSTSPT-EXIT
END-IF.
PERFORM VARYING WRK-LSTSPT-SS FROM 1 BY 1
UNTIL WRK-LSTSPT-SS = 8
MOVE GWL-LSTSPT-LIST(WRK-LSTSPT-SS) TO WRK-TRANID
CALL 'TDSNDROW' USING GWL-PROC, GWL-RC
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSNDROW' TO MSG-SRVLIB-FUNC
MOVE 8 TO WRK-LSTSPT-SS
END-IF
ADD +1 TO CTR-ROWS
END-PERFORM.
*----------------------------------------------------------------
TDLSTSPT-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDSETACT-ON.
*----------------------------------------------------------------
CALL 'TDINFACT' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFACT-STATUS,
GWL-INFACT-FILENAME,
GWL-INFACT-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFACT' TO MSG-SRVLIB-FUNC
GO TO TDSETACT-ON-EXIT
END-IF.
*
* Turn on host accounting.
*
CALL 'TDSETACT' USING GWL-INIT-HANDLE, GWL-RC,
TDS-TRUE,
GWL-INFACT-FILENAME,
GWL-INFACT-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSETACT' TO MSG-SRVLIB-FUNC
GO TO TDSETACT-ON-EXIT
END-IF.
*----------------------------------------------------------------
TDSETACT-ON-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDSETACT-OFF.
*----------------------------------------------------------------
CALL 'TDINFACT' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFACT-STATUS,
GWL-INFACT-FILENAME,
GWL-INFACT-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFACT' TO MSG-SRVLIB-FUNC
GO TO TDSETACT-OFF-EXIT
END-IF.
*
* Turn off host accounting if it is on.
*
IF GWL-INFACT-STATUS = TDS-TRUE THEN
CALL 'TDSETACT' USING GWL-INIT-HANDLE, GWL-RC, TDS-FALSE,
GWL-INFACT-FILENAME, GWL-INFACT-RECORDS
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSETACT' TO MSG-SRVLIB-FUNC
GO TO TDSETACT-OFF-EXIT
END-IF
END-IF.
*----------------------------------------------------------------
TDSETACT-OFF-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDSETLOG-ON.
*----------------------------------------------------------------
CALL 'TDINFLOG' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFLOG-GLOBAL,
GWL-INFLOG-API,
GWL-INFLOG-HEADER,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFLOG' TO MSG-SRVLIB-FUNC
GO TO TDSETLOG-ON-EXIT
END-IF.
*
* Turn on API (CICS Aux Trace) and header tracing.
*
CALL 'TDSETLOG' USING GWL-INIT-HANDLE, GWL-RC,
TDS-TRACE-ALL-RPCS,
TDS-TRUE,
TDS-TRUE,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSETLOG' TO MSG-SRVLIB-FUNC
GO TO TDSETLOG-ON-EXIT
END-IF.
*----------------------------------------------------------------
TDSETLOG-ON-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDSETLOG-OFF.
*----------------------------------------------------------------
CALL 'TDINFLOG' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFLOG-GLOBAL,
GWL-INFLOG-API,
GWL-INFLOG-HEADER,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFLOG' TO MSG-SRVLIB-FUNC
GO TO TDSETLOG-OFF-EXIT
END-IF.
*
* Turn off API (CICS Aux Trace) and header tracing.
*
CALL 'TDSETLOG' USING GWL-INIT-HANDLE, GWL-RC,
TDS-NO-TRACING,
TDS-FALSE,
TDS-FALSE,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSETLOG' TO MSG-SRVLIB-FUNC
GO TO TDSETLOG-OFF-EXIT
END-IF.
*----------------------------------------------------------------
TDSETLOG-OFF-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDSETSPT-ON.
*----------------------------------------------------------------
CALL 'TDINFLOG' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFLOG-GLOBAL,
GWL-INFLOG-API,
GWL-INFLOG-HEADER,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFLOG' TO MSG-SRVLIB-FUNC
GO TO TDSETSPT-ON-EXIT
END-IF.
*
* Turn on tracing for specific transactions.
*
CALL 'TDSETLOG' USING GWL-INIT-HANDLE, GWL-RC,
TDS-TRACE-SPECIFIC-RPCS,
TDS-TRUE,
TDS-TRUE,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSETLOG' TO MSG-SRVLIB-FUNC
GO TO TDSETSPT-ON-EXIT
END-IF.
*
* Enable error log recording for this tranid.
*
MOVE 2 TO GWL-SETSPT-OPTIONS.
MOVE LENGTH OF WRK-RPC TO WRKLEN1.
CALL 'TDSETSPT' USING GWL-INIT-HANDLE, GWL-RC,
TDS-TRUE,
GWL-SETSPT-OPTIONS,
WRK-RPC,
WRKLEN1.
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSETSPT' TO MSG-SRVLIB-FUNC
GO TO TDSETSPT-ON-EXIT
END-IF.
*----------------------------------------------------------------
TDSETSPT-ON-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDSETSPT-OFF.
*----------------------------------------------------------------
*
* Assume specific tracing is on for this transaction,
* and turn it off.
*
MOVE LENGTH OF WRK-RPC TO WRKLEN1.
CALL 'TDSETSPT' USING GWL-INIT-HANDLE, GWL-RC,
TDS-FALSE,
GWL-SETSPT-OPTIONS,
WRK-RPC,
WRKLEN1.
IF GWL-RC NOT = TDS-OK
AND GWL-RC NOT = TDS-ENTRY-NOT-FOUND THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDSETSPT' TO MSG-SRVLIB-FUNC
GO TO TDSETSPT-OFF-EXIT
END-IF.
*----------------------------------------------------------------
TDSETSPT-OFF-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
TDWRTLOG.
*----------------------------------------------------------------
*
* Write a log entry only if logging is enabled.
*
PERFORM GET-TRACE-STATUS THRU GET-TRACE-STATUS-EXIT.
IF TRACING-ON THEN
CALL 'TDWRTLOG' USING GWL-PROC, GWL-RC,
TDS-TRUE,
GWL-WRTLOG-MSG,
GWL-WRTLOG-MSG-L
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDWRTLOG' TO MSG-SRVLIB-FUNC
GO TO TDWRTLOG-EXIT
END-IF
ELSE
MOVE 'N' TO SEND-DONE-SW
MOVE 'LOGNOTON' TO MSG-SRVLIB-FUNC
END-IF.
*----------------------------------------------------------------
TDWRTLOG-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
GET-TRACE-STATUS.
*----------------------------------------------------------------
*
* Find global status.
*
CALL 'TDINFLOG' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFLOG-GLOBAL,
GWL-INFLOG-API,
GWL-INFLOG-HEADER,
GWL-INFLOG-DATA,
GWL-INFLOG-TRACEID,
GWL-INFLOG-FILENAME,
GWL-INFLOG-RECORDS.
*
* If there are any errors, then assume tracing has been disabled.
*
IF GWL-RC NOT = TDS-OK THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFLOG' TO MSG-SRVLIB-FUNC
GO TO GET-TRACE-STATUS-EXIT
END-IF.
*
* If global tracing is on, then tracing is enabled.
*
IF GWL-INFLOG-GLOBAL = TDS-TRACE-ALL-RPCS THEN
MOVE 'Y' TO TRACING-SW
GO TO GET-TRACE-STATUS-EXIT
END-IF.
*
* If error logging is on, then tracing is enabled.
*
IF GWL-INFLOG-GLOBAL = TDS-TRACE-ERRORS-ONLY THEN
MOVE 'Y' TO TRACING-SW
GO TO GET-TRACE-STATUS-EXIT
END-IF.
*
* If specific tracing is not on, then no tracing is on.
*
IF GWL-INFLOG-GLOBAL NOT = TDS-TRACE-SPECIFIC-RPCS THEN
GO TO GET-TRACE-STATUS-EXIT
END-IF.
*
* Specific tracing is on, see if on for this transaction.
*
MOVE LENGTH OF WRK-RPC TO WRKLEN1.
CALL 'TDINFSPT' USING GWL-INIT-HANDLE, GWL-RC,
GWL-INFSPT-STATUS,
GWL-INFSPT-OPTIONS,
WRK-RPC,
WRKLEN1.
IF GWL-RC NOT = TDS-OK AND
GWL-RC NOT = TDS-ENTRY-NOT-FOUND THEN
MOVE 'N' TO SEND-DONE-SW
MOVE 'TDINFSPT' TO MSG-SRVLIB-FUNC
GO TO GET-TRACE-STATUS-EXIT
END-IF.
IF GWL-INFSPT-STATUS = TDS-TRUE THEN
MOVE 'Y' TO TRACING-SW
END-IF.
*----------------------------------------------------------------
GET-TRACE-STATUS-EXIT.
*----------------------------------------------------------------
EXIT.
*----------------------------------------------------------------
SRVLIB-ERROR.
*----------------------------------------------------------------
MOVE GWL-RC TO MSG-SRVLIB-RC.
MOVE MSG-SRVLIB TO MSG-TEXT.
MOVE LENGTH OF MSG-SRVLIB TO MSG-TEXT-L.
MOVE TDS-ERROR-MSG TO MSG-TYPE.
MOVE WRK-RPC TO MSG-RPC.
*-----------------------------------------------------------------
SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
MOVE 'N' TO SEND-DONE-SW.
MOVE TDS-ERROR-MSG TO MSG-TYPE.
MOVE LENGTH OF MSG-RPC TO MSG-RPC-L.
* Ensure we're in right state to send a message
CALL 'TDSTATUS' USING GWL-PROC, GWL-RC,
GWL-STATUS-NR,
GWL-STATUS-DONE,
GWL-STATUS-COUNT,
GWL-STATUS-COMM,
GWL-STATUS-RETURN-CODE,
GWL-STATUS-SUBCODE.
IF (GWL-RC = TDS-OK AND
GWL-STATUS-COMM = TDS-RECEIVE) THEN
CALL 'TDSNDMSG' USING GWL-PROC, GWL-RC,
MSG-TYPE, MSG-NR,
MSG-SEVERITY,
TDS-ZERO,
TDS-ZERO,
MSG-RPC, MSG-RPC-L,
MSG-TEXT, MSG-TEXT-L
END-IF.
*----------------------------------------------------------------
SRVLIB-ERROR-EXIT.
*----------------------------------------------------------------
EXIT.
