*************************************************************************
**
** Source File Name = trigsql.sqb
**
** Licensed Materials - Property of IBM
**
** (C) COPYRIGHT International Business Machines Corp. 1995, 2000
** All Rights Reserved.
**
** US Government Users Restricted Rights - Use, duplication or
** disclosure restricted by GSA ADP Schedule Contract with IBM Corp.
**
** PURPOSE: an example of using advanced SQL statements, to show the
** use of TRIGGERs within a database.
** New tables are created for this example.
** (currentquote, quotehistory)
**
** For more information about these samples see the README file.
**
** For more information on Programming in COBOL, see the:
** - "Programming in COBOL" section of the Application Development Guide.
**
** For more information on Building COBOL Applications, see the:
** - "Building COBOL Applications" section of the Application Building Guide.
**
** For more information on the SQL language see the SQL Reference.
**
*************************************************************************
Identification Division.
Program-ID. "trigsql".
Data Division.
Working-Storage Section.
copy "sql.cbl".
copy "sqlca.cbl".
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 userid pic x(8).
01 passwd.
49 passwd-length pic s9(4) comp-5 value 0.
49 passwd-name pic x(18).
01 st pic x(80).
01 st2 pic x(80).
01 symbol pic x(3).
01 curr-quote pic s9(8)v9(2) comp-3.
01 curr-status.
49 curr-status-length pic s9(4) comp-5 value 15.
49 curr-status-name pic x(15).
01 timestamp pic x(26).
EXEC SQL END DECLARE SECTION END-EXEC.
77 disp-quote pic z(8).99 usage display.
77 errloc pic x(80).
77 counter pic s9(4) comp-5 value 0.
Procedure Division.
Main Section.
display "Sample COBOL program: TRIGSQL".
display " ".
* Get database connection information.
display "Enter your user id (default none): "
with no advancing.
accept userid.
if userid = spaces
EXEC SQL CONNECT TO sample END-EXEC
else
display "Enter your password : " with no advancing
accept passwd-name.
* Passwords in a CONNECT statement must be entered in a VARCHAR format
* with the length of the input string.
inspect passwd-name tallying passwd-length for characters
before initial " ".
display " ".
EXEC SQL CONNECT TO sample USER :userid USING :passwd
END-EXEC.
move "CONNECT TO" to errloc.
call "checkerr" using SQLCA errloc.
* drop TABLES and TRIGGERS from previous executions of this program.
EXEC SQL DROP TABLE currentquote END-EXEC.
EXEC SQL DROP TABLE quotehistory END-EXEC.
EXEC SQL DROP TRIGGER stock_status END-EXEC.
EXEC SQL DROP TRIGGER record_history END-EXEC.
* create TABLES and TRIGGERS needed for this program.
EXEC SQL CREATE TABLE currentquote (symbol CHAR(3) NOT NULL,
quote DECIMAL(6,2), status VARCHAR(8)) END-EXEC.
move "CREATE TABLE CURRENTQUOTE" to errloc.
call "checkerr" using SQLCA errloc.
EXEC SQL CREATE TABLE quotehistory (symbol CHAR(3) NOT NULL,
quote DECIMAL(6,2), timestamp TIMESTAMP) END-EXEC.
move "CREATE TABLE QUOTEHISTORY" to errloc.
call "checkerr" using SQLCA errloc.
move "INSERT INTO currentquote VALUES ('IBM', 68.0, NULL)"
to st.
EXEC SQL EXECUTE IMMEDIATE :st END-EXEC.
move "INSERT INTO CURRENTQUOTE" to errloc.
call "checkerr" using SQLCA errloc.
EXEC SQL CREATE TRIGGER STOCK_STATUS
NO CASCADE BEFORE UPDATE OF QUOTE ON CURRENTQUOTE
REFERENCING NEW AS NEWQUOTE OLD AS OLDQUOTE
FOR EACH ROW MODE DB2SQL
SET NEWQUOTE.STATUS =
CASE
WHEN NEWQUOTE.QUOTE >=
(SELECT MAX(QUOTE) FROM QUOTEHISTORY
WHERE SYMBOL = NEWQUOTE.SYMBOL
AND YEAR(TIMESTAMP)=YEAR(CURRENT DATE))
THEN 'High'
WHEN NEWQUOTE.QUOTE <=
(SELECT MIN(QUOTE) FROM QUOTEHISTORY
WHERE SYMBOL = NEWQUOTE.SYMBOL
AND YEAR(TIMESTAMP)=YEAR(CURRENT DATE))
THEN 'Low'
WHEN NEWQUOTE.QUOTE > OLDQUOTE.QUOTE
THEN 'Rising'
WHEN NEWQUOTE.QUOTE < OLDQUOTE.QUOTE
THEN 'Dropping'
WHEN NEWQUOTE.QUOTE = OLDQUOTE.QUOTE
THEN 'Steady'
END END-EXEC.
move "CREATE TRIGGER STOCK_STATUS" to errloc.
call "checkerr" using SQLCA errloc.
EXEC SQL CREATE TRIGGER RECORD_HISTORY
AFTER UPDATE OF QUOTE ON CURRENTQUOTE
REFERENCING NEW AS NEWQUOTE
FOR EACH ROW MODE DB2SQL
INSERT INTO QUOTEHISTORY
VALUES (NEWQUOTE.SYMBOL,NEWQUOTE.QUOTE,
CURRENT TIMESTAMP) END-EXEC.
move "CREATE TRIGGER RECORD_HISTORY" to errloc.
call "checkerr" using SQLCA errloc.
* main section of the program - activation of the triggers
move "SELECT * from currentquote" to st2.
move "UPDATE currentquote SET quote=? WHERE symbol='IBM'"
to st.
EXEC SQL PREPARE QUPDATE FROM :st END-EXEC.
move 68.25 to curr-quote.
perform Fetch-Info thru End-Fetch-Info.
move 68.75 to curr-quote.
perform Fetch-Info thru End-Fetch-Info.
move 68.5 to curr-quote.
perform Fetch-Info thru End-Fetch-Info.
move 68.5 to curr-quote.
perform Fetch-Info thru End-Fetch-Info.
move 68.62 to curr-quote.
perform Fetch-Info thru End-Fetch-Info.
move 68 to curr-quote.
perform Fetch-Info thru End-Fetch-Info.
move "SELECT * FROM quotehistory" to st.
EXEC SQL PREPARE S2 FROM :st END-EXEC.
EXEC SQL DECLARE C2 CURSOR FOR S2 END-EXEC.
EXEC SQL OPEN C2 END-EXEC.
display " ".
display "Contents of the 'quotehistory' table after updates".
perform Quote-History thru End-Quote-History
until SQLCODE not equal 0.
EXEC SQL CLOSE C2 END-EXEC.
EXEC SQL CONNECT RESET END-EXEC.
move "CONNECT RESET" to errloc.
call "checkerr" using SQLCA errloc.
End-Main.
go to End-Prog.
Fetch-Info Section.
* Need to use a cursor, and dynamically select from the tables since the
* tables may not exist prior to the execution of the program.
move space to curr-status.
EXEC SQL EXECUTE QUPDATE USING :curr-quote END-EXEC.
move "UPDATE" to errloc.
call "checkerr" using SQLCA errloc.
EXEC SQL PREPARE S1 FROM :st2 END-EXEC.
EXEC SQL DECLARE C1 CURSOR FOR S1 END-EXEC.
EXEC SQL OPEN C1 END-EXEC.
EXEC SQL FETCH C1 INTO :symbol, :curr-quote, :curr-status
END-EXEC.
EXEC SQL CLOSE C1 END-EXEC.
move curr-quote to disp-quote.
display symbol, " ", disp-quote, " ", curr-status-name.
End-Fetch-Info. exit.
Quote-History Section.
EXEC SQL FETCH C2 INTO :symbol, :curr-quote, :timestamp
END-EXEC.
if SQLCODE not equal 0
go to End-Quote-History.
move curr-quote to disp-quote.
display symbol, " ", disp-quote, " ", timestamp.
End-Quote-History. exit.
End-Prog.
stop run.