1 ****************************************************************** 2 * Open Cobol ESQL (Ocesql) Sample Program 3 * 4 * FETCHTBL --- demonstrates CONNECT, SELECT COUNT(*), 5 * DECLARE cursor, FETCH cursor, COMMIT, 6 * ROLLBACK, DISCONNECT 7 * 8 * Copyright 2013 Tokyo System House Co., Ltd. 9 ****************************************************************** 10 IDENTIFICATION DIVISION. 11 ****************************************************************** 12 PROGRAM-ID. FETCHTBL. 13 AUTHOR. TSH. 14 DATE-WRITTEN. 2013-06-28. 15 16 ****************************************************************** 17 DATA DIVISION. 18 ****************************************************************** 19 WORKING-STORAGE SECTION. 20 01 D-EMP-REC. 21 05 D-EMP-NO PIC 9(04). 22 05 FILLER PIC X. 23 05 D-EMP-NAME PIC X(20). 24 05 FILLER PIC X. 25 05 D-EMP-SALARY PIC --,--9. 26 27 EXEC SQL BEGIN DECLARE SECTION END-EXEC. 28 01 DBNAME PIC X(30) VALUE SPACE. 29 01 USERNAME PIC X(30) VALUE SPACE. 30 01 PASSWD PIC X(10) VALUE SPACE. 31 01 EMP-REC-VARS. 32 05 EMP-NO PIC S9(04). 33 05 EMP-NAME PIC X(20) . 34 05 EMP-SALARY PIC S9(04). 35 01 EMP-CNT PIC 9(04). 36 EXEC SQL END DECLARE SECTION END-EXEC. 37 38 EXEC SQL INCLUDE SQLCA END-EXEC. 39 ****************************************************************** 40 PROCEDURE DIVISION. 41 ****************************************************************** 42 MAIN-RTN. 43 DISPLAY "*** FETCHTBL STARTED ***". 44 45 * WHENEVER IS NOT YET SUPPORTED :( 46 * EXEC SQL WHENEVER SQLERROR PERFORM ERROR-RTN END-EXEC. 47 48 * CONNECT 49 MOVE "testdb" TO DBNAME. 50 MOVE "postgres" TO USERNAME. 51 MOVE SPACE TO PASSWD. 52 EXEC SQL 53 CONNECT :USERNAME IDENTIFIED BY :PASSWD USING :DBNAME 54 END-EXEC. 55 IF SQLCODE NOT = ZERO PERFORM ERROR-RTN STOP RUN. 56 57 * SELECT COUNT(*) INTO HOST-VARIABLE 58 EXEC SQL 59 SELECT COUNT(*) INTO :EMP-CNT FROM EMP 60 END-EXEC. 61 DISPLAY "TOTAL RECORD: " EMP-CNT. 62 63 * DECLARE CURSOR 64 EXEC SQL 65 DECLARE C1 CURSOR FOR 66 SELECT EMP_NO, EMP_NAME, EMP_SALARY 67 FROM EMP 68 ORDER BY EMP_NO 69 END-EXEC. 70 EXEC SQL 71 OPEN C1 72 END-EXEC. 73 74 * FETCH 75 DISPLAY "---- -------------------- ------". 76 DISPLAY "NO NAME SALARY". 77 DISPLAY "---- -------------------- ------". 78 EXEC SQL 79 FETCH C1 INTO :EMP-NO, :EMP-NAME, :EMP-SALARY 80 END-EXEC. 81 PERFORM UNTIL SQLCODE NOT = ZERO 82 MOVE EMP-NO TO D-EMP-NO 83 MOVE EMP-NAME TO D-EMP-NAME 84 MOVE EMP-SALARY TO D-EMP-SALARY 85 DISPLAY D-EMP-REC 86 EXEC SQL 87 FETCH C1 INTO :EMP-NO, :EMP-NAME, :EMP-SALARY 88 END-EXEC 89 END-PERFORM. 90 91 * CLOSE CURSOR 92 EXEC SQL 93 CLOSE C1 94 END-EXEC. 95 96 * COMMIT 97 EXEC SQL 98 COMMIT WORK 99 END-EXEC. 100 101 * DISCONNECT 102 EXEC SQL 103 DISCONNECT ALL 104 END-EXEC. 105 106 * END 107 DISPLAY "*** FETCHTBL FINISHED ***". 108 STOP RUN. 109 110 ****************************************************************** 111 ERROR-RTN. 112 ****************************************************************** 113 DISPLAY "*** SQL ERROR ***". 114 DISPLAY "SQLCODE: " SQLCODE " " NO ADVANCING. 115 EVALUATE SQLCODE 116 WHEN +10 117 DISPLAY "Record not found" 118 WHEN -01 119 DISPLAY "Connection falied" 120 WHEN -20 121 DISPLAY "Internal error" 122 WHEN -30 123 DISPLAY "PostgreSQL error" 124 DISPLAY "ERRCODE: " SQLSTATE 125 DISPLAY SQLERRMC 126 *> TO RESTART TRANSACTION, DO ROLLBACK. 127 EXEC SQL 128 ROLLBACK 129 END-EXEC 130 WHEN OTHER 131 DISPLAY "Undefined error" 132 DISPLAY "ERRCODE: " SQLSTATE 133 DISPLAY SQLERRMC 134 END-EVALUATE. 135 ****************************************************************** 136 137