2PC PL/I Sample Using Preprocessor2
The following CICS Preprocessor2 sample, written in PL/I, uses 2PC processing.
PPL2PC02: PROC OPTIONS(MAIN);
/******************************************************************/
/* TITLE: SAMPLE PROGRAM IN PL/I FOR 2PC PROTOCOL */
/* */
/* PROGRAM: THIS SAMPLE PROGRAM SHOWS ONE POSSIBLE METHOD */
/* FOR CODING A PL/I APPLICATION THAT UTILIZES THE*/
/* TWO PHASE COMMIT PROTOCOL FOR PERFORMING */
/* UPDATES TO EITHER A TERADATA DBS BY ITSELF OR */
/* TO OTHER ADDITIONAL DBMS SYSTEMS IN THE SAME */
/* LUW. */
/* */
/* TABLES: EMPLOYEE TABLE SUPPLIED WITH SAMPLES. */
/* */
/* CICS DEFS: PPT FOR THE PPL2PC02 SAMPLE PROGRAM. */
/* DFHPPT TYPE=ENTRY,PROGRAM=PPL2PC02,PGMLANG=PLI*/
/* PCT FOR THE PPL2PC02 SAMPLE PROGRAM. */
/* DFHPCT TYPE=ENTRY,PROGRAM=PPL2PC02,TRANSID=SAM2,*/
/* TPURGE=NO,SPURGE=NO,TRNPRTY=255 */
/* */
/******************************************************************/
/* DECLARATIONS OF BUILTIN FUNCTIONS */
DCL PPRTEXT EXTERNAL ENTRY OPTIONS (ASM INTER);
DCL ADDR BUILTIN;
DCL NULL BUILTIN;
/* DECLARATION OF VARIABLES */
DCL LOGON_STRING CHAR(80) INIT (’tdpid/userid,pswd’);
DCL SCREEN_MSG CHAR(70);
DCL UPD_STATEMENT CHAR(72) VAR
INIT (’UPDATE EMPLOYEE SET SALARY_AMOUNT = 2010210
WHERE EMPLOYEE_NUMBER = 1021’);
DCL ERROR_MSG CHAR(80) VAR;
DCL ERROR_CODE BIN FIXED(31);
DCL MAX_LENGTH BIN FIXED(15) INIT (80);
DCL REQUEST_TYPE CHAR(8);
EXEC SQL INCLUDE SQLCA;
/******************************************************************/
/**** MAIN LOGIC */
/******************************************************************/
MAIN:
CALL LOGON_DBC ();
CALL EMPLOYEE_UPDATE ();
CALL OTHER_UPDATE ();
CALL COMMIT_SYNC ();
CALL LOGOFF ();
EXEC CICS RETURN;
RETURN;
/******************************************************************/
/**** LOGON DBC */
/******************************************************************/
LOGON_DBC: PROC;
SCREEN_MSG = ’EXECUTING 2PC PLI SAMPLE - PPL2PC02...’;
CALL SEND_MSG ();
REQUEST_TYPE = ’LOGON’;
EXEC SQL
LOGON :LOGON_STRING;
CALL ERROR_CHECK ();
IF SQLCODE ¬= 0
THEN
CALL ERROR_CHECK ();
EXEC CICS RETURN;
RETURN;
END LOGON_DBC;
/******************************************************************/
/**** EMPLOYEE_UPDATE */
/******************************************************************/
EMPLOYEE_UPDATE: PROC;
REQUEST_TYPE = ’UPDATE’;
EXEC SQL
EXECUTE IMMEDIATE :UPD_STATEMENT;
CALL ERROR_CHECK ();
IF SQLCODE = 0
THEN DO;
SCREEN_MSG = ’EMPLOYEE UPDATED’;
CALL SEND_MSG;
END;
RETURN;
END EMPLOYEE_UPDATE;
/******************************************************************/
/**** UPDATE OTHER DATABASES */
/******************************************************************/
OTHER_UPDATE: PROC;
REQUEST_TYPE = ’UPDATE2’;
SCREEN_MSG = ’PUT IN CODE TO UPDATE OTHER DBMS SYSTEMS’;
CALL SEND_MSG;
RETURN;
END OTHER_UPDATE;
/******************************************************************/
/**** LOGOFF */
/****NEED TO TAKE A SYNCPOINT BEFORE LOGOFF, */
/****ELSE WILL GET ASP7 ABEND */
/******************************************************************/
LOGOFF: PROC;
REQUEST_TYPE = ’LOGOFF’;
EXEC SQL
LOGOFF;
CALL ERROR_CHECK ();
IF SQLCODE = 0
THEN DO;
SCREEN_MSG = ’UPDATE COMPLETED, LOGGED OFF’;
CALL SEND_MSG;
RETURN;
END LOGOFF;
/******************************************************************/
/**** SEND MSG TO USER */
/******************************************************************/
SEND_MSG: PROC;
EXEC CICS SEND TEXT FROM(SCREEN_MSG) LENGTH(70) FREEKB ERASE;
RETURN;
END SEND_MSG;
/******************************************************************/
/**** COMMIT SYNCPOINT */
/******************************************************************/
COMMIT_SYNC: PROC;
EXEC CICS SYNCPOINT;
CALL ERROR_CHECK;
RETURN;
END COMMIT_SYNC;
/******************************************************************/
/**** ERROR CHECK */
/******************************************************************/
ERROR_CHECK: PROC;
IF SQLCODE ^= 0
THEN DO;
ERROR_MSG = ’ ’;
CALL PPRTEXT (SQL_RDTRTCON,
ERROR_CODE,
ERROR_MSG,
MAX_LENGTH);
SCREEN_MSG = ERROR_MSG;
END;
RETURN;
END ERROR_CHECK;
END PPL2PC02;