Skip to content

Commit a2087a4

Browse files
tanto259tanto259
authored
Merge pull request #283 from vargajb/patch-1
Handling SQL error codes
2 parents 35eb1ff + f961f39 commit a2087a4

File tree

4 files changed

+145
-4
lines changed

4 files changed

+145
-4
lines changed

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

+38
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,17 @@
3636
* SQL INCLUDE FOR SQLCA *
3737
*****************************************************
3838
EXEC SQL INCLUDE SQLCA END-EXEC.
39+
*****************************************************
40+
* DECLARATIONS FOR SQL ERROR HANDLING *
41+
*****************************************************
42+
01 ERROR-MESSAGE.
43+
02 ERROR-LEN PIC S9(4) COMP VALUE +1320.
44+
02 ERROR-TEXT PIC X(132) OCCURS 10 TIMES
45+
INDEXED BY ERROR-INDEX.
46+
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +132.
47+
77 ERROR-TEXT-HBOUND PIC S9(9) COMP VALUE +10.
48+
* USER DEFINED ERROR MESSAGE
49+
01 UD-ERROR-MESSAGE PIC X(80) VALUE SPACES.
3950
*****************************************************
4051
* SQL DECLARATION FOR VIEW ACCOUNTS *
4152
*****************************************************
@@ -89,10 +100,23 @@
89100
*****************************************************
90101
LIST-ALL.
91102
EXEC SQL OPEN CUR1 END-EXEC.
103+
IF SQLCODE NOT = 0 THEN
104+
MOVE 'OPEN CUR1' TO UD-ERROR-MESSAGE
105+
PERFORM SQL-ERROR-HANDLING
106+
END-IF
92107
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
93108
PERFORM PRINT-AND-GET1
94109
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
110+
IF SQLCODE NOT = 100 THEN
111+
MOVE 'FETCH CUR1' TO UD-ERROR-MESSAGE
112+
PERFORM SQL-ERROR-HANDLING
113+
END-IF
95114
EXEC SQL CLOSE CUR1 END-EXEC.
115+
IF SQLCODE NOT = 0 THEN
116+
MOVE 'CLOSE CUR1' TO UD-ERROR-MESSAGE
117+
PERFORM SQL-ERROR-HANDLING
118+
END-IF
119+
.
96120
PRINT-AND-GET1.
97121
PERFORM PRINT-A-LINE.
98122
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
@@ -104,3 +128,17 @@
104128
MOVE ACCT-FIRSTN TO ACCT-FIRSTN-O.
105129
MOVE ACCT-COMMENT TO ACCT-COMMENT-O.
106130
WRITE REPREC AFTER ADVANCING 2 LINES.
131+
132+
SQL-ERROR-HANDLING.
133+
DISPLAY 'ERROR AT ' FUNCTION TRIM(UD-ERROR-MESSAGE, TRAILING)
134+
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
135+
PERFORM VARYING ERROR-INDEX FROM 1 BY 1
136+
UNTIL ERROR-INDEX > ERROR-TEXT-HBOUND
137+
OR ERROR-TEXT(ERROR-INDEX) = SPACES
138+
DISPLAY FUNCTION TRIM(ERROR-TEXT(ERROR-INDEX), TRAILING)
139+
END-PERFORM
140+
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
141+
MOVE 1000 TO RETURN-CODE
142+
STOP RUN
143+
END-IF
144+
.

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

+53-2
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,17 @@
5353
* SQL INCLUDE FOR SQLCA *
5454
*****************************************************
5555
EXEC SQL INCLUDE SQLCA END-EXEC.
56+
*****************************************************
57+
* DECLARATIONS FOR SQL ERROR HANDLING *
58+
*****************************************************
59+
01 ERROR-MESSAGE.
60+
02 ERROR-LEN PIC S9(4) COMP VALUE +1320.
61+
02 ERROR-TEXT PIC X(132) OCCURS 10 TIMES
62+
INDEXED BY ERROR-INDEX.
63+
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +132.
64+
77 ERROR-TEXT-HBOUND PIC S9(9) COMP VALUE +10.
65+
* USER DEFINED ERROR MESSAGE
66+
01 UD-ERROR-MESSAGE PIC X(80) VALUE SPACES.
5667
*****************************************************
5768
* SQL DECLARATION FOR VIEW ACCOUNTS *
5869
*****************************************************
@@ -120,21 +131,47 @@
120131
*
121132
GET-ALL.
122133
EXEC SQL OPEN CUR1 END-EXEC.
134+
IF SQLCODE NOT = 0 THEN
135+
MOVE 'OPEN CUR1' TO UD-ERROR-MESSAGE
136+
PERFORM SQL-ERROR-HANDLING
137+
END-IF
123138
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
124-
PERFORM PRINT-ALL
139+
PERFORM PRINT-ALL
125140
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
141+
IF SQLCODE NOT = 100 THEN
142+
MOVE 'FETCH CUR1' TO UD-ERROR-MESSAGE
143+
PERFORM SQL-ERROR-HANDLING
144+
END-IF
126145
EXEC SQL CLOSE CUR1 END-EXEC.
146+
IF SQLCODE NOT = 0 THEN
147+
MOVE 'CLOSE CUR1' TO UD-ERROR-MESSAGE
148+
PERFORM SQL-ERROR-HANDLING
149+
END-IF
150+
.
127151
*
128152
PRINT-ALL.
129153
PERFORM PRINT-A-LINE.
130154
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
131155
*
132156
GET-SPECIFIC.
133157
EXEC SQL OPEN CUR2 END-EXEC.
158+
IF SQLCODE NOT = 0 THEN
159+
MOVE 'OPEN CUR2' TO UD-ERROR-MESSAGE
160+
PERFORM SQL-ERROR-HANDLING
161+
END-IF
134162
EXEC SQL FETCH CUR2 INTO :CUSTOMER-RECORD END-EXEC.
135-
PERFORM PRINT-SPECIFIC
163+
PERFORM PRINT-SPECIFIC
136164
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
165+
IF SQLCODE NOT = 100 THEN
166+
MOVE 'FETCH CUR2' TO UD-ERROR-MESSAGE
167+
PERFORM SQL-ERROR-HANDLING
168+
END-IF
137169
EXEC SQL CLOSE CUR2 END-EXEC.
170+
IF SQLCODE NOT = 0 THEN
171+
MOVE 'CLOSE CUR2' TO UD-ERROR-MESSAGE
172+
PERFORM SQL-ERROR-HANDLING
173+
END-IF
174+
.
138175
*
139176
PRINT-SPECIFIC.
140177
PERFORM PRINT-A-LINE.
@@ -148,3 +185,17 @@
148185
MOVE ACCT-FIRSTN TO ACCT-FIRSTN-O.
149186
MOVE ACCT-COMMENT TO ACCT-COMMENT-O.
150187
WRITE REPREC AFTER ADVANCING 2 LINES.
188+
189+
SQL-ERROR-HANDLING.
190+
DISPLAY 'ERROR AT ' FUNCTION TRIM(UD-ERROR-MESSAGE, TRAILING)
191+
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
192+
PERFORM VARYING ERROR-INDEX FROM 1 BY 1
193+
UNTIL ERROR-INDEX > ERROR-TEXT-HBOUND
194+
OR ERROR-TEXT(ERROR-INDEX) = SPACES
195+
DISPLAY FUNCTION TRIM(ERROR-TEXT(ERROR-INDEX), TRAILING)
196+
END-PERFORM
197+
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
198+
MOVE 1000 TO RETURN-CODE
199+
STOP RUN
200+
END-IF
201+
.

‎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+
.

‎COBOL Programming Course #3 - Advanced Topics/Labs/jcl/CBLDB22R.jcl

+1
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
//***************************************************/
88
//RUN EXEC PGM=IKJEFT01
99
//STEPLIB DD DSN=DSNC10.SDSNLOAD,DISP=SHR
10+
//REPORT DD SYSOUT=*
1011
//RECIN DD *
1112
LINCOLN
1213
/*

0 commit comments

Comments
 (0)