Skip to content

Commit f961f39

Browse files
authored
Handling SQL error codes
Signed-off-by: Janos Varga <[email protected]>
1 parent 04780c4 commit f961f39

File tree

1 file changed

+53
-2
lines changed
  • COBOL Programming Course #3 - Advanced Topics/Labs/cbl

1 file changed

+53
-2
lines changed

COBOL Programming Course #3 - Advanced Topics/Labs/cbl/CBLDB23.cbl

+53-2
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,17 @@
5050
* SQL INCLUDE FOR SQLCA *
5151
*****************************************************
5252
EXEC SQL INCLUDE SQLCA END-EXEC.
53+
*****************************************************
54+
* DECLARATIONS FOR SQL ERROR HANDLING *
55+
*****************************************************
56+
01 ERROR-MESSAGE.
57+
02 ERROR-LEN PIC S9(4) COMP VALUE +1320.
58+
02 ERROR-TEXT PIC X(132) OCCURS 10 TIMES
59+
INDEXED BY ERROR-INDEX.
60+
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +132.
61+
77 ERROR-TEXT-HBOUND PIC S9(9) COMP VALUE +10.
62+
* USER DEFINED ERROR MESSAGE
63+
01 UD-ERROR-MESSAGE PIC X(80) VALUE SPACES.
5364
*****************************************************
5465
* SQL DECLARATION FOR VIEW ACCOUNTS *
5566
*****************************************************
@@ -113,19 +124,45 @@
113124
AT END SET NOMORE-INPUT TO TRUE.
114125
GET-ALL.
115126
EXEC SQL OPEN CUR1 END-EXEC.
127+
IF SQLCODE NOT = 0 THEN
128+
MOVE 'OPEN CUR1' TO UD-ERROR-MESSAGE
129+
PERFORM SQL-ERROR-HANDLING
130+
END-IF
116131
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
117-
PERFORM PRINT-ALL
132+
PERFORM PRINT-ALL
118133
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
134+
IF SQLCODE NOT = 100 THEN
135+
MOVE 'FETCH CUR1' TO UD-ERROR-MESSAGE
136+
PERFORM SQL-ERROR-HANDLING
137+
END-IF
119138
EXEC SQL CLOSE CUR1 END-EXEC.
139+
IF SQLCODE NOT = 0 THEN
140+
MOVE 'CLOSE CUR1' TO UD-ERROR-MESSAGE
141+
PERFORM SQL-ERROR-HANDLING
142+
END-IF
143+
.
120144
PRINT-ALL.
121145
PERFORM PRINT-A-LINE.
122146
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
123147
GET-SPECIFIC.
124148
EXEC SQL OPEN CUR2 END-EXEC.
149+
IF SQLCODE NOT = 0 THEN
150+
MOVE 'OPEN CUR2' TO UD-ERROR-MESSAGE
151+
PERFORM SQL-ERROR-HANDLING
152+
END-IF
125153
EXEC SQL FETCH CUR2 INTO :CUSTOMER-RECORD END-EXEC.
126-
PERFORM PRINT-SPECIFIC
154+
PERFORM PRINT-SPECIFIC
127155
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
156+
IF SQLCODE NOT = 100 THEN
157+
MOVE 'FETCH CUR2' TO UD-ERROR-MESSAGE
158+
PERFORM SQL-ERROR-HANDLING
159+
END-IF
128160
EXEC SQL CLOSE CUR2 END-EXEC.
161+
IF SQLCODE NOT = 0 THEN
162+
MOVE 'CLOSE CUR2' TO UD-ERROR-MESSAGE
163+
PERFORM SQL-ERROR-HANDLING
164+
END-IF
165+
.
129166
PRINT-SPECIFIC.
130167
PERFORM PRINT-A-LINE.
131168
EXEC SQL FETCH CUR2 INTO :CUSTOMER-RECORD END-EXEC.
@@ -135,3 +172,17 @@
135172
MOVE ACCT-FIRSTN TO ACCT-FIRSTN-O.
136173
MOVE ACCT-ADDR3 TO ACCT-ADDR3-O.
137174
WRITE REPREC AFTER ADVANCING 2 LINES.
175+
176+
SQL-ERROR-HANDLING.
177+
DISPLAY 'ERROR AT ' FUNCTION TRIM(UD-ERROR-MESSAGE, TRAILING)
178+
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
179+
PERFORM VARYING ERROR-INDEX FROM 1 BY 1
180+
UNTIL ERROR-INDEX > ERROR-TEXT-HBOUND
181+
OR ERROR-TEXT(ERROR-INDEX) = SPACES
182+
DISPLAY FUNCTION TRIM(ERROR-TEXT(ERROR-INDEX), TRAILING)
183+
END-PERFORM
184+
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
185+
MOVE 1000 TO RETURN-CODE
186+
STOP RUN
187+
END-IF
188+
.

0 commit comments

Comments
 (0)