Skip to content

Commit

Permalink
Merge pull request #283 from vargajb/patch-1
Browse files Browse the repository at this point in the history 
Handling SQL error codes
  • Loading branch information
@tanto259
tanto259 authored Oct 29, 2022
2 parents 35eb1ff + f961f39 commit a2087a4
Show file tree
Hide file tree
Showing 4 changed files with 145 additions and 4 deletions.
38 changes: 38 additions & 0 deletions COBOL Programming Course #3 - Advanced Topics/Labs/cbl/CBLDB21.cbl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,17 @@
* SQL INCLUDE FOR SQLCA *
*****************************************************
EXEC SQL INCLUDE SQLCA END-EXEC.
*****************************************************
* DECLARATIONS FOR SQL ERROR HANDLING *
*****************************************************
01 ERROR-MESSAGE.
02 ERROR-LEN PIC S9(4) COMP VALUE +1320.
02 ERROR-TEXT PIC X(132) OCCURS 10 TIMES
INDEXED BY ERROR-INDEX.
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +132.
77 ERROR-TEXT-HBOUND PIC S9(9) COMP VALUE +10.
* USER DEFINED ERROR MESSAGE
01 UD-ERROR-MESSAGE PIC X(80) VALUE SPACES.
*****************************************************
* SQL DECLARATION FOR VIEW ACCOUNTS *
*****************************************************
Expand Down Expand Up @@ -89,10 +100,23 @@
*****************************************************
LIST-ALL.
EXEC SQL OPEN CUR1 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'OPEN CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
PERFORM PRINT-AND-GET1
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
IF SQLCODE NOT = 100 THEN
MOVE 'FETCH CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL CLOSE CUR1 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'CLOSE CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
.
PRINT-AND-GET1.
PERFORM PRINT-A-LINE.
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
Expand All @@ -104,3 +128,17 @@
MOVE ACCT-FIRSTN TO ACCT-FIRSTN-O.
MOVE ACCT-COMMENT TO ACCT-COMMENT-O.
WRITE REPREC AFTER ADVANCING 2 LINES.
SQL-ERROR-HANDLING.
DISPLAY 'ERROR AT ' FUNCTION TRIM(UD-ERROR-MESSAGE, TRAILING)
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
PERFORM VARYING ERROR-INDEX FROM 1 BY 1
UNTIL ERROR-INDEX > ERROR-TEXT-HBOUND
OR ERROR-TEXT(ERROR-INDEX) = SPACES
DISPLAY FUNCTION TRIM(ERROR-TEXT(ERROR-INDEX), TRAILING)
END-PERFORM
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE 1000 TO RETURN-CODE
STOP RUN
END-IF
.
55 changes: 53 additions & 2 deletions COBOL Programming Course #3 - Advanced Topics/Labs/cbl/CBLDB22.cbl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,17 @@
* SQL INCLUDE FOR SQLCA *
*****************************************************
EXEC SQL INCLUDE SQLCA END-EXEC.
*****************************************************
* DECLARATIONS FOR SQL ERROR HANDLING *
*****************************************************
01 ERROR-MESSAGE.
02 ERROR-LEN PIC S9(4) COMP VALUE +1320.
02 ERROR-TEXT PIC X(132) OCCURS 10 TIMES
INDEXED BY ERROR-INDEX.
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +132.
77 ERROR-TEXT-HBOUND PIC S9(9) COMP VALUE +10.
* USER DEFINED ERROR MESSAGE
01 UD-ERROR-MESSAGE PIC X(80) VALUE SPACES.
*****************************************************
* SQL DECLARATION FOR VIEW ACCOUNTS *
*****************************************************
Expand Down Expand Up @@ -120,21 +131,47 @@
*
GET-ALL.
EXEC SQL OPEN CUR1 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'OPEN CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
PERFORM PRINT-ALL
PERFORM PRINT-ALL
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
IF SQLCODE NOT = 100 THEN
MOVE 'FETCH CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL CLOSE CUR1 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'CLOSE CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
.
*
PRINT-ALL.
PERFORM PRINT-A-LINE.
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
*
GET-SPECIFIC.
EXEC SQL OPEN CUR2 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'OPEN CUR2' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL FETCH CUR2 INTO :CUSTOMER-RECORD END-EXEC.
PERFORM PRINT-SPECIFIC
PERFORM PRINT-SPECIFIC
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
IF SQLCODE NOT = 100 THEN
MOVE 'FETCH CUR2' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL CLOSE CUR2 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'CLOSE CUR2' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
.
*
PRINT-SPECIFIC.
PERFORM PRINT-A-LINE.
Expand All @@ -148,3 +185,17 @@
MOVE ACCT-FIRSTN TO ACCT-FIRSTN-O.
MOVE ACCT-COMMENT TO ACCT-COMMENT-O.
WRITE REPREC AFTER ADVANCING 2 LINES.
SQL-ERROR-HANDLING.
DISPLAY 'ERROR AT ' FUNCTION TRIM(UD-ERROR-MESSAGE, TRAILING)
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
PERFORM VARYING ERROR-INDEX FROM 1 BY 1
UNTIL ERROR-INDEX > ERROR-TEXT-HBOUND
OR ERROR-TEXT(ERROR-INDEX) = SPACES
DISPLAY FUNCTION TRIM(ERROR-TEXT(ERROR-INDEX), TRAILING)
END-PERFORM
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE 1000 TO RETURN-CODE
STOP RUN
END-IF
.
55 changes: 53 additions & 2 deletions COBOL Programming Course #3 - Advanced Topics/Labs/cbl/CBLDB23.cbl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,17 @@
* SQL INCLUDE FOR SQLCA *
*****************************************************
EXEC SQL INCLUDE SQLCA END-EXEC.
*****************************************************
* DECLARATIONS FOR SQL ERROR HANDLING *
*****************************************************
01 ERROR-MESSAGE.
02 ERROR-LEN PIC S9(4) COMP VALUE +1320.
02 ERROR-TEXT PIC X(132) OCCURS 10 TIMES
INDEXED BY ERROR-INDEX.
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +132.
77 ERROR-TEXT-HBOUND PIC S9(9) COMP VALUE +10.
* USER DEFINED ERROR MESSAGE
01 UD-ERROR-MESSAGE PIC X(80) VALUE SPACES.
*****************************************************
* SQL DECLARATION FOR VIEW ACCOUNTS *
*****************************************************
Expand Down Expand Up @@ -113,19 +124,45 @@
AT END SET NOMORE-INPUT TO TRUE.
GET-ALL.
EXEC SQL OPEN CUR1 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'OPEN CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
PERFORM PRINT-ALL
PERFORM PRINT-ALL
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
IF SQLCODE NOT = 100 THEN
MOVE 'FETCH CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL CLOSE CUR1 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'CLOSE CUR1' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
.
PRINT-ALL.
PERFORM PRINT-A-LINE.
EXEC SQL FETCH CUR1 INTO :CUSTOMER-RECORD END-EXEC.
GET-SPECIFIC.
EXEC SQL OPEN CUR2 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'OPEN CUR2' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL FETCH CUR2 INTO :CUSTOMER-RECORD END-EXEC.
PERFORM PRINT-SPECIFIC
PERFORM PRINT-SPECIFIC
UNTIL SQLCODE IS NOT EQUAL TO ZERO.
IF SQLCODE NOT = 100 THEN
MOVE 'FETCH CUR2' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
EXEC SQL CLOSE CUR2 END-EXEC.
IF SQLCODE NOT = 0 THEN
MOVE 'CLOSE CUR2' TO UD-ERROR-MESSAGE
PERFORM SQL-ERROR-HANDLING
END-IF
.
PRINT-SPECIFIC.
PERFORM PRINT-A-LINE.
EXEC SQL FETCH CUR2 INTO :CUSTOMER-RECORD END-EXEC.
Expand All @@ -135,3 +172,17 @@
MOVE ACCT-FIRSTN TO ACCT-FIRSTN-O.
MOVE ACCT-ADDR3 TO ACCT-ADDR3-O.
WRITE REPREC AFTER ADVANCING 2 LINES.

SQL-ERROR-HANDLING.
DISPLAY 'ERROR AT ' FUNCTION TRIM(UD-ERROR-MESSAGE, TRAILING)
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
PERFORM VARYING ERROR-INDEX FROM 1 BY 1
UNTIL ERROR-INDEX > ERROR-TEXT-HBOUND
OR ERROR-TEXT(ERROR-INDEX) = SPACES
DISPLAY FUNCTION TRIM(ERROR-TEXT(ERROR-INDEX), TRAILING)
END-PERFORM
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE 1000 TO RETURN-CODE
STOP RUN
END-IF
.
1 change: 1 addition & 0 deletions COBOL Programming Course #3 - Advanced Topics/Labs/jcl/CBLDB22R.jcl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
//***************************************************/
//RUN EXEC PGM=IKJEFT01
//STEPLIB DD DSN=DSNC10.SDSNLOAD,DISP=SHR
//REPORT DD SYSOUT=*
//RECIN DD *
LINCOLN
/*
Expand Down

0 comments on commit a2087a4

Please sign in to comment.