The following program accepts all valid dynamic SQL requests except select commands. delete requests must have a where clause, or they will be rejected. Upon successful completion, this program sends a confirmation message to the client; otherwise it sends an error message.
SYSAMP1: PROC OPTIONS(MAIN REENTRANT);
/* @(#) sycpsal1.pli 1.1 3/17/98 */
/****** SYCPSAL1 - LANGUAGE REQUEST APPLICATION - PL/I - CICS *******/
/* */
/* TRANID: SYL1 */
/* PROGRAM: SYCPSAL1 */
/* PLAN NAME: SYL1PLAN */
/* FILES: none */
/* TABLES: adhoc */
/* */
/* This program is executed via a client language request */
/* from sample dblib program 'SYL1', or by SYBASE's ISQL if */
/* installed. The client program must login to a transaction */
/* group with SYL1 as the language handler. */
/* */
/* The purpose of the program is primarily to demonstrate Server */
/* Library calls, especially those which would be used in a */
/* server application designed to handle language requests. */
/* */
/* Server Library calls: */
/* TDACCEPT accept request from client */
/* TDFREE free TDPROC structure */
/* TDINFLOG return trace settings */
/* TDINFPGM return program information */
/* TDINIT establish environment */
/* TDRCVSQL receive language text */
/* TDRESULT describe next communication */
/* TDSETSPT set specific tracing */
/* TDSNDDON send results-completion to client */
/* TDSNDMSG send message to client */
/* TDSQLLEN get length of incoming text */
/* TDSTATUS get status information */
/* */
/* */
/* The program accepts all valid SQL requests other than */
/* 'SELECT'. A 'DELETE' must have a WHERE clause, or it is */
/* rejected. */
/* */
/* A confirmation message is sent to the client if all is */
/* well, otherwise an error message is sent. */
/* */
/* CHANGE ACTIVITY: */
/* 6/90 - Created, MPM */
/* */
/********************************************************************/
/*------------------------------------------------------------------*/
/* DB2 SQLCA */
/*------------------------------------------------------------------*/
EXEC SQL INCLUDE SQLCA;
/*------------------------------------------------------------------*/
/* minimum SQLDA */
/*------------------------------------------------------------------*/
DCL
01 SQLDA,
05 SQLDAID CHAR(8) INIT(' '),
05 SQLDABC FIXED BIN(31) INIT(0),
05 SQLN FIXED BIN(15) INIT(0),
05 SQLD FIXED BIN(15) INIT(0);
/********************************************************************/
/* SERVER LIBRARY PL/I COPY BOOK */
/********************************************************************/
%INCLUDE SYGWPLI;
/*------------------------------------------------------------------*/
/* SERVER LIB ROUTINES DECLARATIONS */
/*------------------------------------------------------------------*/
DCL
TDACCEPT ENTRY OPTIONS(INTER ASSEMBLER),
TDFREE ENTRY OPTIONS(INTER ASSEMBLER),
TDINFLOG ENTRY OPTIONS(INTER ASSEMBLER),
TDINFPGM ENTRY OPTIONS(INTER ASSEMBLER),
TDINIT ENTRY OPTIONS(INTER ASSEMBLER),
TDRCVSQL ENTRY OPTIONS(INTER ASSEMBLER),
TDRESULT ENTRY OPTIONS(INTER ASSEMBLER),
TDSETSPT ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDDON ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDMSG ENTRY OPTIONS(INTER ASSEMBLER),
TDSQLLEN ENTRY OPTIONS(INTER ASSEMBLER),
TDSTATUS ENTRY OPTIONS(INTER ASSEMBLER);
/*------------------------------------------------------------------*/
/* BUILT IN FUNCTIONS DECLARATIONS */
/*------------------------------------------------------------------*/
DCL
ADDR BUILTIN,
INDEX BUILTIN,
LENGTH BUILTIN,
NULL BUILTIN,
STG BUILTIN,
STRING BUILTIN,
SUBSTR BUILTIN,
TRANSLATE BUILTIN,
VERIFY BUILTIN;
/*------------------------------------------------------------------*/
/* WORK AREAS */
/*------------------------------------------------------------------*/
DCL
01 GW_LIB_MISC_FIELDS,
05 GWL_PROC PTR,
05 GWL_INIT_HANDLE PTR,
05 GWL_RC FIXED BIN(31),
05 GWL_SQLLEN FIXED BIN(31),
05 GWL_STATUS_NR FIXED BIN(31),
05 GWL_STATUS_DONE FIXED BIN(31),
05 GWL_STATUS_COUNT FIXED BIN(31),
05 GWL_STATUS_COMM FIXED BIN(31),
05 GWL_STATUS_RETURN_CODE FIXED BIN(31),
05 GWL_STATUS_SUBCODE FIXED BIN(31),
05 GWL_INFPGM_TDS_VERSION FIXED BIN(31),
05 GWL_INFPGM_LONGVAR FIXED BIN(31),
05 GWL_INFPGM_ROW_LIMIT FIXED BIN(31),
05 GWL_INFPGM_REMOTE_TRACE FIXED BIN(31),
05 GWL_INFPGM_CORRELATOR FIXED BIN(31),
05 GWL_INFPGM_DB2GW_OPTION FIXED BIN(31),
05 GWL_INFPGM_DB2GW_PID FIXED BIN(31),
05 GWL_INFPGM_TYPE_RPC FIXED BIN(31),
05 GWL_INFLOG_GLOBAL FIXED BIN(31),
05 GWL_INFLOG_API FIXED BIN(31),
05 GWL_INFLOG_TDS_HEADER FIXED BIN(31),
05 GWL_INFLOG_TDS_DATA FIXED BIN(31),
05 GWL_INFLOG_TRACE_ID FIXED BIN(31),
05 GWL_INFLOG_FILENAME CHAR(08),
05 GWL_INFLOG_TOTAL_RECS FIXED BIN(31),
05 GWL_SETSPT_TRACE_LEVEL FIXED BIN(31),
05 GWL_SETSPT_RPC_NAME CHAR(04) INIT('SYL1'),
05 GWL_SETSPT_RPC_NAME_L FIXED BIN(31) INIT(4);
DCL
01 LANGUAGE_FIELDS,
05 LANG_BUFFER_PTR PTR,
05 LANG_MAX_L FIXED BIN(31),
05 LANG_ACTUAL_L FIXED BIN(31),
05 LANG_TEXT_SS FIXED BIN(15) INIT(1);
DCL
01 LANG_BUFFER_DB2 CHAR(1024) VAR;
DCL
01 LANG_BUFFER_LL_TEXT BASED(LANG_BUFFER_PTR),
05 LANG_BUFFER_LL FIXED BIN(15),
05 LANG_BUFFER_TEXT CHAR(1024);
DCL
01 PARSESQL_BUFFER BASED(LANG_BUFFER_PTR),
05 PARSESQL_TEXT_LL FIXED BIN(15),
05 PARSESQL_TEXT_CHARS(1024)
CHAR(01);
DCL
01 SNA_FIELDS,
05 SNA_SUBC FIXED BIN(31),
05 SNA_CONNECTION_NAME CHAR(08) INIT(' ');
DCL
01 PARSE_FIELDS,
05 PARSE_BYTES FIXED BIN(31),
05 PARSE_SS FIXED BIN(15) INIT(0),
05 PARSE_ACTION CHAR(06);
DCL
01 XLATE_FIELDS STATIC,
05 XLATE_LOWER CHAR(07) INIT('dehlrtw'),
05 XLATE_UPPER CHAR(07) INIT('DEHLRTW');
DCL
01 WORK_FIELDS,
05 WRK_DONE_STATUS FIXED BIN(31),
05 WRK_XLATE_WHERE CHAR(06);
DCL
01 MESSAGE_FIELDS,
05 MSG_TYPE FIXED BIN(31),
05 MSG_SEVERITY FIXED BIN(31),
05 MSG_SEVERITY_OK FIXED BIN(31) INIT(9),
05 MSG_SEVERITY_ERROR FIXED BIN(31) INIT(11),
05 MSG_NR FIXED BIN(31),
05 MSG_NR_OK FIXED BIN(31) INIT(1),
05 MSG_NR_ERROR FIXED BIN(31) INIT(2),
05 MSG_RPC CHAR(04) INIT('SYL1'),
05 MSG_RPC_L FIXED BIN(31)
INIT(STG(MSG_RPC)),
05 MSG_TEXT CHAR(50),
05 MSG_TEXT_L FIXED BIN(31),
05 MSG_SQL_ERROR,
10 MSG_SQL_ERROR_T CHAR(31)
INIT('Invalid sql request, sqlcode = '),
10 MSG_SQL_ERROR_C PIC '---9',
05 MSG_SELECT CHAR(24)
INIT('SQL select not supported'),
05 MSG_NOT_LANG CHAR(35)
INIT('SYL1 not begun via language request'),
05 MSG_BAD_LEN CHAR(31)
INIT('Request has too many characters'),
05 MSG_NO_WHERE CHAR(26)
INIT('Delete has no where clause'),
05 MSG_OK CHAR(22)
INIT('Execute was successful'),
05 MSG_NOT_OK,
10 FILLER1 CHAR(26)
INIT('Execute failed, sqlcode = '),
10 MSG_NOT_OK_C PIC '---9',
10 FILLER2 CHAR(18)
INIT(', ROLLBACK issued.');
DCL
01 CICS_FIELDS,
05 CICS_RESPONSE FIXED BIN(31);
DCL
01 SWITCHES,
05 TRACING_SET_SW BIT(01) INIT('0'B),
05 TRACING_RESET BIT(01) INIT('0'B),
05 TRACING_SET BIT(01) INIT('1'B),
05 ALL_DONE BIT(01) INIT('0'B),
05 ALL_DONE_YES BIT(01) INIT('1'B),
05 SEND_DONE BIT(01) INIT('1'B),
05 SEND_DONE_ERROR BIT(01) INIT('0'B),
05 SEND_DONE_OK BIT(01) INIT('1'B);
/*------------------------------------------------------------------*/
/* DECLARE STATEMENT AND CURSOR */
/*------------------------------------------------------------------*/
EXEC SQL DECLARE S1 STATEMENT;
EXEC SQL DECLARE C1 CURSOR FOR S1;
/*------------------------------------------------------------------*/
INITIALIZE_PROGRAM:
/*------------------------------------------------------------------*/
/* ------------------------------------------------------------*/
/* reset db2 error handlers */
/* ------------------------------------------------------------*/
EXEC SQL WHENEVER SQLWARNING CONTINUE;
EXEC SQL WHENEVER SQLERROR CONTINUE;
EXEC SQL WHENEVER NOT FOUND CONTINUE;
/* ------------------------------------------------------------*/
/* establish gateway environment */
/* ------------------------------------------------------------*/
CALL TDINIT (DFHEIBLK, GWL_RC, GWL_INIT_HANDLE);
/* ------------------------------------------------------------*/
/* turn on local tracing if not on globally or locally */
/* ------------------------------------------------------------*/
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
GWL_INFLOG_GLOBAL,
GWL_INFLOG_API,
GWL_INFLOG_TDS_HEADER,
GWL_INFLOG_TDS_DATA,
GWL_INFLOG_TRACE_ID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_TOTAL_RECS);
IF GWL_INFLOG_GLOBAL ^= TDS_TRACE_ALL_RPCS &
GWL_INFLOG_GLOBAL ^= TDS_TRACE_SPECIFIC_RPCS THEN
DO;
TRACING_SET_SW = TRACING_SET;
CALL LOCAL_TRACING;
END;
/* ------------------------------------------------------------*/
/* accept client request */
/* ------------------------------------------------------------*/
CALL TDACCEPT (GWL_PROC, GWL_RC, GWL_INIT_HANDLE,
SNA_CONNECTION_NAME,
SNA_SUBC);
/* ------------------------------------------------------------*/
/* ensure kicked off via language request */
/* (this could be handled more reasonably by TDRESULT) */
/* ------------------------------------------------------------*/
CALL TDINFPGM (GWL_PROC, GWL_RC,
GWL_INFPGM_TDS_VERSION,
GWL_INFPGM_LONGVAR,
GWL_INFPGM_ROW_LIMIT,
GWL_INFPGM_REMOTE_TRACE,
GWL_INFPGM_CORRELATOR,
GWL_INFPGM_DB2GW_OPTION,
GWL_INFPGM_DB2GW_PID,
GWL_INFPGM_TYPE_RPC);
IF GWL_INFPGM_TYPE_RPC ^= TDS_START_SQL THEN
DO;
MSG_TEXT = MSG_NOT_LANG;
MSG_TEXT_L = STG(MSG_NOT_LANG);
CALL SEND_ERROR_MESSAGE;
GO TO END_PROGRAM;
END;
/*------------------------------------------------------------------*/
READ_IN_SQL_TEXT:
/*------------------------------------------------------------------*/
/* ------------------------------------------------------------*/
/* prepare for receive */
/* ------------------------------------------------------------*/
CALL TDRESULT (GWL_PROC, GWL_RC);
/* ------------------------------------------------------------*/
/* load ptr to redefined sql text */
/* ------------------------------------------------------------*/
LANG_BUFFER_PTR = ADDR(LANG_BUFFER_DB2);
/* ------------------------------------------------------------*/
/* get len of language text, ensure not too big for us */
/* (this could be handled without TDSQLLEN by checking */
/* LANG_ACTUAL_LEN doesn't exceed LANG_MAX_L in TDRCVSQL call) */
/* ------------------------------------------------------------*/
CALL TDSQLLEN (GWL_PROC, GWL_SQLLEN);
LANG_MAX_L = STG(LANG_BUFFER_TEXT);
IF GWL_SQLLEN > LANG_MAX_L THEN
DO;
MSG_TEXT = MSG_BAD_LEN;
MSG_TEXT_L = STG(MSG_BAD_LEN);
CALL SEND_ERROR_MESSAGE;
GO TO END_PROGRAM;
END;
/* ------------------------------------------------------------*/
/* get language text */
/* ------------------------------------------------------------*/
CALL TDRCVSQL (GWL_PROC, GWL_RC,
LANG_BUFFER_TEXT,
LANG_MAX_L,
LANG_ACTUAL_L);
LANG_BUFFER_LL = LANG_ACTUAL_L;
/*------------------------------------------------------------------*/
EDIT_TEXT:
/*------------------------------------------------------------------*/
/* ------------------------------------------------------------*/
/* ensure line feeds, low-values, etc. translated to blanks */
/* ------------------------------------------------------------*/
DO WHILE (LANG_TEXT_SS <= PARSESQL_TEXT_LL);
IF PARSESQL_TEXT_CHARS(LANG_TEXT_SS) < ' ' THEN
DO;
PARSESQL_TEXT_CHARS(LANG_TEXT_SS) = ' ';
END;
ELSE
DO;
IF PARSE_SS = 0 &
PARSESQL_TEXT_CHARS(LANG_TEXT_SS) > ' ' THEN
DO;
PARSE_SS = LANG_TEXT_SS;
PARSE_BYTES = PARSESQL_TEXT_LL - LANG_TEXT_SS;
END;
END;
LANG_TEXT_SS = LANG_TEXT_SS +1;
END;
/* ------------------------------------------------------------*/
/* let DB2 edit and tell us if SELECT */
/* ------------------------------------------------------------*/
EXEC SQL PREPARE S1 INTO SQLDA FROM :LANG_BUFFER_DB2;
IF SQLD ^= 0 THEN
DO;
MSG_TEXT = MSG_SELECT;
MSG_TEXT_L = STG(MSG_SELECT);
CALL SEND_ERROR_MESSAGE;
GO TO END_PROGRAM;
END;
IF SQLCODE < 0 THEN
DO;
MSG_SQL_ERROR_C = SQLCODE;
MSG_TEXT = STRING(MSG_SQL_ERROR);
MSG_TEXT_L = STG(MSG_SQL_ERROR);
CALL SEND_ERROR_MESSAGE;
GO TO END_PROGRAM;
END;
/* ------------------------------------------------------------*/
/* parse and handle special case of DELETE without WHERE clause*/
/* ------------------------------------------------------------*/
PARSE_ACTION = TRANSLATE(SUBSTR(LANG_BUFFER_TEXT,
PARSE_SS,
STG(PARSE_ACTION)),
XLATE_UPPER,
XLATE_LOWER);
IF PARSE_ACTION ^= 'DELETE' THEN
DO;
GO TO EXECUTE_SQL;
END;
ELSE DO;
/* --------------------------------------------------------*/
/* skip past delete to from */
/* --------------------------------------------------------*/
CALL SKIP_TO_BLANK;
CALL SKIP_BLANKS;
/* --------------------------------------------------------*/
/* skip past from to tableid */
/* --------------------------------------------------------*/
CALL SKIP_TO_BLANK;
CALL SKIP_BLANKS;
/* --------------------------------------------------------*/
/* skip past tableid to correlator or where */
/* --------------------------------------------------------*/
CALL SKIP_TO_BLANK;
CALL SKIP_BLANKS;
IF PARSE_BYTES > STG(WRK_XLATE_WHERE) THEN
DO;
WRK_XLATE_WHERE =
TRANSLATE(SUBSTR(LANG_BUFFER_TEXT,
PARSE_SS,
STG(WRK_XLATE_WHERE)),
XLATE_UPPER,
XLATE_LOWER);
IF WRK_XLATE_WHERE = 'WHERE ' THEN
DO;
GO TO EXECUTE_SQL;
END;
/* ----------------------------------------------------*/
/* skip correlator */
/* ----------------------------------------------------*/
CALL SKIP_TO_BLANK;
IF PARSE_BYTES > 0 THEN
DO;
CALL SKIP_TO_BLANK;
IF PARSE_BYTES > 0 THEN
DO;
GO TO EXECUTE_SQL;
END;
END;
END;
END;
MSG_TEXT = MSG_NO_WHERE;
MSG_TEXT_L = STG(MSG_NO_WHERE);
CALL SEND_ERROR_MESSAGE;
GO TO END_PROGRAM;
/*------------------------------------------------------------------*/
SKIP_TO_BLANK: PROC;
/*------------------------------------------------------------------*/
DCL J FIXED BIN(15) INIT(0);
IF PARSE_SS < LANG_BUFFER_LL THEN
DO;
J = INDEX(SUBSTR(LANG_BUFFER_TEXT,
PARSE_SS,
PARSE_BYTES),
' ');
END;
IF J = 0 THEN
DO;
PARSE_SS = LANG_BUFFER_LL +1;
PARSE_BYTES = -1;
END;
ELSE DO;
PARSE_SS = PARSE_SS +J -1;
PARSE_BYTES = PARSE_BYTES -J +1;
END;
RETURN;
END SKIP_TO_BLANK;
/*------------------------------------------------------------------*/
SKIP_BLANKS: PROC;
/*------------------------------------------------------------------*/
DCL J FIXED BIN(15) INIT(0);
IF PARSE_SS < LANG_BUFFER_LL THEN
DO;
J = VERIFY(SUBSTR(LANG_BUFFER_TEXT,
PARSE_SS,
PARSE_BYTES),
' ');
END;
IF J = 0 THEN
DO;
PARSE_SS = LANG_BUFFER_LL +1;
PARSE_BYTES = -1;
END;
ELSE DO;
PARSE_SS = PARSE_SS +J -1;
PARSE_BYTES = PARSE_BYTES -J +1;
END;
RETURN;
END SKIP_BLANKS;
/*------------------------------------------------------------------*/
EXECUTE_SQL:
/*------------------------------------------------------------------*/
EXEC SQL EXECUTE S1;
IF SQLCODE < 0 THEN
DO;
CALL CICS_ROLLBACK;
MSG_NOT_OK_C = SQLCODE;
MSG_TEXT = STRING(MSG_NOT_OK);
MSG_TEXT_L = STG(MSG_NOT_OK);
CALL SEND_ERROR_MESSAGE;
GO TO END_PROGRAM;
END;
MSG_TEXT = MSG_OK;
MSG_TEXT_L = STG(MSG_OK);
CALL SEND_CONFIRM_MESSAGE;
GO TO END_PROGRAM;
/*------------------------------------------------------------------*/
SEND_CONFIRM_MESSAGE: PROC;
/*------------------------------------------------------------------*/
MSG_SEVERITY = MSG_SEVERITY_OK;
MSG_NR = MSG_NR_OK;
MSG_TYPE = TDS_INFO_MSG;
CALL SEND_MESSAGE;
RETURN;
END SEND_CONFIRM_MESSAGE;
/*------------------------------------------------------------------*/
SEND_ERROR_MESSAGE: PROC;
/*------------------------------------------------------------------*/
SEND_DONE = SEND_DONE_ERROR;
MSG_SEVERITY = MSG_SEVERITY_ERROR;
MSG_NR = MSG_NR_ERROR;
MSG_TYPE = TDS_ERROR_MSG;
CALL SEND_MESSAGE;
RETURN;
END SEND_ERROR_MESSAGE;
/*------------------------------------------------------------------*/
SEND_MESSAGE: PROC;
/*------------------------------------------------------------------*/
/* ------------------------------------------------------------*/
/* ensure we're in right state to send a message */
/* ------------------------------------------------------------*/
CALL TDSTATUS (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 THEN
DO;
IF GWL_STATUS_COMM = TDS_RECEIVE THEN
CALL TDSNDMSG (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;
RETURN;
END SEND_MESSAGE;
/*------------------------------------------------------------------*/
LOCAL_TRACING: PROC;
/*------------------------------------------------------------------*/
CALL TDSETSPT (GWL_INIT_HANDLE, GWL_RC,
TRACING_SET_SW,
GWL_SETSPT_TRACE_LEVEL,
GWL_SETSPT_RPC_NAME,
GWL_SETSPT_RPC_NAME_L);
RETURN;
END LOCAL_TRACING;
/*------------------------------------------------------------------*/
CICS_ROLLBACK: PROC;
/*------------------------------------------------------------------*/
EXEC CICS SYNCPOINT
ROLLBACK
RESP(CICS_RESPONSE);
RETURN;
END CICS_ROLLBACK;
/*------------------------------------------------------------------*/
END_PROGRAM:
/*------------------------------------------------------------------*/
IF (TRACING_SET_SW) THEN
DO;
TRACING_SET_SW = TRACING_RESET;
CALL LOCAL_TRACING;
END;
IF SEND_DONE = SEND_DONE_OK THEN
WRK_DONE_STATUS = TDS_DONE_COUNT;
ELSE
DO;
WRK_DONE_STATUS = TDS_DONE_ERROR;
SQLERRD(3) = 0;
END;
CALL TDSNDDON (GWL_PROC, GWL_RC,
WRK_DONE_STATUS,
SQLERRD(3),
TDS_ZERO,
TDS_ENDRPC);
CALL TDFREE (GWL_PROC, GWL_RC);
EXEC CICS RETURN;
END SYSAMP1;
