The SQL Terminal Monitor Application
This application executes SQL statements that are read in from the terminal. The application reads statements from input and writes results to output. Dynamic SQL is used to process and execute the statements.
When the application starts, the user is prompted for the database name. The user is then prompted for an SQL statement. SQL comments and statement delimiters are not accepted. The SQL statement is processed using Dynamic SQL and results and SQL errors are written to output. At the end of the results, an indicator of the number of rows affected is displayed. The loop is then continued and the user is prompted for another SQL statement. When end‑of‑file is typed in the application rolls back any pending updates and disconnects from the database.
The user's SQL statement is prepared using prepare and describe. If the SQL statement is not a select statement, then it is run using execute and the number of rows affected is printed. If the SQL statement is a select statement, a Dynamic SQL cursor is opened, and all the rows are fetched and printed. The sections of code that print the results do not try to tabulate the results. A row of column names is printed, followed by each row of the results.
Keyboard interrupts are not handled. Fatal errors, such as allocation errors, and boundary condition violations are handled by rolling back pending updates and disconnecting from the database session.
Windows and UNIX:
IDENTIFICATION DIVISION.
PROGRAM-ID. SQL-MONITOR.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Include SQL Communications and Descriptor Areas
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE SQLDA END-EXEC.
* Dynamic SQL statement name (documentary only)
EXEC SQL DECLARE stmt STATEMENT END-EXEC.
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE SQLDA END-EXEC.
* Dynamic SQL statement name (documentary only)
EXEC SQL DECLARE stmt STATEMENT END-EXEC.
* Cursor declaration for dynamic statement
EXEC SQL DECLARE csr CURSOR FOR stmt END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* Database name
01 DB-NAME PIC X(30).
* Dynamic SQL statement buffer
01 STMT-BUF PIC X(1000).
* SQL error message buffer
01 ERROR-BUF PIC X(1024).
EXEC SQL END DECLARE SECTION END-EXEC.
* SQL statement number
01 STMT-NUM PIC 999.
EXEC SQL DECLARE csr CURSOR FOR stmt END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* Database name
01 DB-NAME PIC X(30).
* Dynamic SQL statement buffer
01 STMT-BUF PIC X(1000).
* SQL error message buffer
01 ERROR-BUF PIC X(1024).
EXEC SQL END DECLARE SECTION END-EXEC.
* SQL statement number
01 STMT-NUM PIC 999.
* Reading state
01 READING-STMT PIC S9(4) USAGE COMP.
88 DONE-READING VALUE 0.
88 STILL-READING VALUE 1.
* Number of rows affected by last SQL statement
01 STMT-ROWS PIC ZZZZZ9.
* Number of rows retrieved by last SELECT statement
01 SELECT-ROWS PIC S9(8) USAGE COMP.
* Dynamic SELECT statement set up state
01 SELECT-SETUP PIC S9(4) USAGE COMP.
88 SETUP-FAIL VALUE 0.
88 SETUP-OK VALUE 1.
* Index into SQLVAR table
01 COLN PIC 999.
* Base data type of SQLVAR item without nullability
01 BASE-TYPE PIC S9(4) USAGE COMP.
* Is a result column type nullable
01 IS-NULLABLE PIC S9(4) USAGE COMP.
88 NOT-NULLABLE VALUE 0.
88 NULLABLE VALUE 1.
01 READING-STMT PIC S9(4) USAGE COMP.
88 DONE-READING VALUE 0.
88 STILL-READING VALUE 1.
* Number of rows affected by last SQL statement
01 STMT-ROWS PIC ZZZZZ9.
* Number of rows retrieved by last SELECT statement
01 SELECT-ROWS PIC S9(8) USAGE COMP.
* Dynamic SELECT statement set up state
01 SELECT-SETUP PIC S9(4) USAGE COMP.
88 SETUP-FAIL VALUE 0.
88 SETUP-OK VALUE 1.
* Index into SQLVAR table
01 COLN PIC 999.
* Base data type of SQLVAR item without nullability
01 BASE-TYPE PIC S9(4) USAGE COMP.
* Is a result column type nullable
01 IS-NULLABLE PIC S9(4) USAGE COMP.
88 NOT-NULLABLE VALUE 0.
88 NULLABLE VALUE 1.
* Global result data storage. This pool of data
* includes the maximum number of result data
* items needed to execute a Dynamic SELECT
* statement. There is a table of 1024 integers,
* decimal and null indicator data items, and a
* large character string buffer.
* The display data picture formats may be
* modified if more numeric precision is
* required. floating-point and
* money types are stored in decimal variables.
01 RESULT-DATA.
02 NUMERIC-DATA OCCURS IISQ-MAX-COLS TIMES.
03 INT-DATA PIC S9(9) USAGE COMP-5 SYNC.
03 IND-DATA PIC S9(4) USAGE COMP-5 SYNC.
02 DECIMAL-DATA OCCURS IISQ-MAX-COLS TIMES.
03 DEC-DATA PIC S9(10)V9(8) USAGE COMP-3.
02 STRING-DATA.
03 CHAR-LEN PIC S9(4) USAGE COMP.
03 CHAR-DATA PIC X(2500).
02 DISPLAY-DATA.
03 DISP-INT PIC +Z(6)99.
03 DISP-DEC PIC +Z(8)99.99(8).
* Current lengths of local character data.
01 CUR-LEN PIC S9(4) USAGE COMP.
**
02 NUMERIC-DATA OCCURS IISQ-MAX-COLS TIMES.
03 INT-DATA PIC S9(9) USAGE COMP-5 SYNC.
03 IND-DATA PIC S9(4) USAGE COMP-5 SYNC.
02 DECIMAL-DATA OCCURS IISQ-MAX-COLS TIMES.
03 DEC-DATA PIC S9(10)V9(8) USAGE COMP-3.
02 STRING-DATA.
03 CHAR-LEN PIC S9(4) USAGE COMP.
03 CHAR-DATA PIC X(2500).
02 DISPLAY-DATA.
03 DISP-INT PIC +Z(6)99.
03 DISP-DEC PIC +Z(8)99.99(8).
* Current lengths of local character data.
01 CUR-LEN PIC S9(4) USAGE COMP.
**
* Procedure Division: SQL-MONITOR
*
* Main entry of SQL Monitor application. Prompt for
* database name and connect to the database. Run
* the monitor and disconnect from the database.
* Before disconnecting, roll back any pending updates.
**
PROCEDURE DIVISION.
EXAMPLE SECTION.
XBEGIN.
* Execute a dummy ACCEPT statement from the CONSOLE prior
* to using the ACCEPT statement to read in input. This
* introductory ACCEPT statement (which is documented to
* read from COMMAND-LINE)may not be necessary on all systems.
ACCEPT DB-NAME FROM CONSOLE.
*
* Main entry of SQL Monitor application. Prompt for
* database name and connect to the database. Run
* the monitor and disconnect from the database.
* Before disconnecting, roll back any pending updates.
**
PROCEDURE DIVISION.
EXAMPLE SECTION.
XBEGIN.
* Execute a dummy ACCEPT statement from the CONSOLE prior
* to using the ACCEPT statement to read in input. This
* introductory ACCEPT statement (which is documented to
* read from COMMAND-LINE)may not be necessary on all systems.
ACCEPT DB-NAME FROM CONSOLE.
* Prompt for database name.
MOVE SPACES TO DB-NAME.
DISPLAY "SQL Database: " WITH NO ADVANCING.
ACCEPT DB-NAME FROM CONSOLE.
IF (DB-NAME = SPACES) THEN
DISPLAY "**************************"
STOP RUN.
DISPLAY " -- SQL Terminal Monitor -- ".
* Treat connection errors as fatal.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT :DB-NAME END-EXEC.
* Run the Terminal Monitor
PERFORM RUN-MONITOR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
DISPLAY "SQL: Exiting monitor program.".
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
**
MOVE SPACES TO DB-NAME.
DISPLAY "SQL Database: " WITH NO ADVANCING.
ACCEPT DB-NAME FROM CONSOLE.
IF (DB-NAME = SPACES) THEN
DISPLAY "**************************"
STOP RUN.
DISPLAY " -- SQL Terminal Monitor -- ".
* Treat connection errors as fatal.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT :DB-NAME END-EXEC.
* Run the Terminal Monitor
PERFORM RUN-MONITOR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
DISPLAY "SQL: Exiting monitor program.".
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
**
* Paragraph: RUN-MONITOR
*
* Run the SQL monitor. Initialize the global
* SQLDA with the number of SQLVAR elements. Loop
* while prompting the user for input; if
* end-of-file is detected then return to the
* calling paragraph (the main program). If the
* user inputs a statement, execute it (using
* paragraph EXECUTE-STATEMENT).
**
RUN-MONITOR.
* Initialize the SQLN (the number of SQLVAR
* elements is set by default to IISQ-MAX-COLS)
* Now we are setup for input. Initialize
* statement number and reading state.
MOVE 0 TO STMT-NUM.
SET STILL-READING TO TRUE.
* Loop while prompting, reading and processing
*
* Run the SQL monitor. Initialize the global
* SQLDA with the number of SQLVAR elements. Loop
* while prompting the user for input; if
* end-of-file is detected then return to the
* calling paragraph (the main program). If the
* user inputs a statement, execute it (using
* paragraph EXECUTE-STATEMENT).
**
RUN-MONITOR.
* Initialize the SQLN (the number of SQLVAR
* elements is set by default to IISQ-MAX-COLS)
* Now we are setup for input. Initialize
* statement number and reading state.
MOVE 0 TO STMT-NUM.
SET STILL-READING TO TRUE.
* Loop while prompting, reading and processing
* the SQL statement.
PERFORM UNTIL DONE-READING
ADD 1 TO STMT-NUM
PERFORM READ-STATEMENT
IF (STILL-READING) THEN
PERFORM EXECUTE-STATEMENT THRU END-EXECUTE
END-IF
END-PERFORM.
**
PERFORM UNTIL DONE-READING
ADD 1 TO STMT-NUM
PERFORM READ-STATEMENT
IF (STILL-READING) THEN
PERFORM EXECUTE-STATEMENT THRU END-EXECUTE
END-IF
END-PERFORM.
**
* Paragraph: EXECUTE-STATEMENT
*
* Using the PREPARE and DESCRIBE facilities determine if
* the input statement is a SELECT statement or not. If
* the statement is not a SELECT statement then EXECUTE it,
* otherwise open a cursor and
* process a dynamic SELECT statement (using paragraph
* EXECUTE-SELECT). After processing the statement, print
* the number of rows affected by the statement and any SQL
* errors.
**
*
* Using the PREPARE and DESCRIBE facilities determine if
* the input statement is a SELECT statement or not. If
* the statement is not a SELECT statement then EXECUTE it,
* otherwise open a cursor and
* process a dynamic SELECT statement (using paragraph
* EXECUTE-SELECT). After processing the statement, print
* the number of rows affected by the statement and any SQL
* errors.
**
EXECUTE-STATEMENT.
EXEC SQL WHENEVER SQLERROR GO TO END-EXECUTE END-EXEC.
* PREPARE and DESCRIBE the statement. Inspect the
* contents of the SQLDA and determine if it is a SELECT
* statement or not.
EXEC SQL PREPARE stmt FROM :STMT-BUF END-EXEC.
EXEC SQL DESCRIBE stmt INTO :SQLDA END-EXEC.
* IF SQLD = 0 then this is not a SELECT.
IF (SQLD = 0) THEN
EXEC SQL EXECUTE stmt END-EXEC
MOVE SQLERRD(3) TO STMT-ROWS
EXEC SQL WHENEVER SQLERROR GO TO END-EXECUTE END-EXEC.
* PREPARE and DESCRIBE the statement. Inspect the
* contents of the SQLDA and determine if it is a SELECT
* statement or not.
EXEC SQL PREPARE stmt FROM :STMT-BUF END-EXEC.
EXEC SQL DESCRIBE stmt INTO :SQLDA END-EXEC.
* IF SQLD = 0 then this is not a SELECT.
IF (SQLD = 0) THEN
EXEC SQL EXECUTE stmt END-EXEC
MOVE SQLERRD(3) TO STMT-ROWS
* Otherwise this is a SELECT. Verify that there are enough
* SQLVAR result variables. If there are too few print an
* error and continue, otherwise call EXECUTE-SELECT.
ELSE IF (SQLD > SQLN) THEN
DISPLAY "SQL Error: SQLDA requires more than "
"1024 result variables."
MOVE 0 TO STMT-ROWS
ELSE
PERFORM EXECUTE-SELECT THRU END-SELECT
MOVE SELECT-ROWS TO STMT-ROWS
END-IF.
* Print the number of rows processed.
DISPLAY "[" STMT-ROWS " row(s)]".
* Only print the error message if we arrived at this label
* because of an SQL error.
END-EXECUTE.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
**
* SQLVAR result variables. If there are too few print an
* error and continue, otherwise call EXECUTE-SELECT.
ELSE IF (SQLD > SQLN) THEN
DISPLAY "SQL Error: SQLDA requires more than "
"1024 result variables."
MOVE 0 TO STMT-ROWS
ELSE
PERFORM EXECUTE-SELECT THRU END-SELECT
MOVE SELECT-ROWS TO STMT-ROWS
END-IF.
* Print the number of rows processed.
DISPLAY "[" STMT-ROWS " row(s)]".
* Only print the error message if we arrived at this label
* because of an SQL error.
END-EXECUTE.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
**
* Paragraph: EXECUTE-SELECT
* Execute a Dynamic SELECT statement. The SQLDA has already
* been described, so print the table header column names,
* open a dynamic cursor, and retrieve and print the results.
* Accumulate the number of rows processed in SELECT-ROWS.
**
EXECUTE-SELECT.
* So far no rows.
MOVE 0 TO SELECT-ROWS.
* Set up the result types and data items, and print result
* column names. SETUP-ROW will set SETUP-FAIL/OK if it
* fails/succeeds.
PERFORM SETUP-ROW.
IF (SETUP-FAIL) THEN
GO TO END-SELECT.
EXEC SQL WHENEVER SQLERROR GO TO SELECT-ERR END-EXEC.
* Execute a Dynamic SELECT statement. The SQLDA has already
* been described, so print the table header column names,
* open a dynamic cursor, and retrieve and print the results.
* Accumulate the number of rows processed in SELECT-ROWS.
**
EXECUTE-SELECT.
* So far no rows.
MOVE 0 TO SELECT-ROWS.
* Set up the result types and data items, and print result
* column names. SETUP-ROW will set SETUP-FAIL/OK if it
* fails/succeeds.
PERFORM SETUP-ROW.
IF (SETUP-FAIL) THEN
GO TO END-SELECT.
EXEC SQL WHENEVER SQLERROR GO TO SELECT-ERR END-EXEC.
* Open the dynamic cursor.
EXEC SQL OPEN csr FOR READONLY END-EXEC.
* Fetch and print each row. Accumulate the number of
* rows fetched.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH csr USING DESCRIPTOR :SQLDA END-EXEC
IF (SQLCODE = 0) THEN
ADD 1 TO SELECT-ROWS
PERFORM PRINT-ROW
END-IF
END-PERFORM.
SELECT-ERR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL OPEN csr FOR READONLY END-EXEC.
* Fetch and print each row. Accumulate the number of
* rows fetched.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH csr USING DESCRIPTOR :SQLDA END-EXEC
IF (SQLCODE = 0) THEN
ADD 1 TO SELECT-ROWS
PERFORM PRINT-ROW
END-IF
END-PERFORM.
SELECT-ERR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
* Only print the error message if we arrived at this
* label because of an SQL error.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
EXEC SQL CLOSE csr END-EXEC.
END-SELECT.
EXIT.
**
* Paragraph: SETUP-ROW
*
* A statement has just been described, so set up the
* SQLDA for result processing. Print all the column
* names and allocate result data items for retrieving
* data using paragraph SETUP-COLUMN.
* This paragraph sets SETUP-OK if it succeeds, and
* SETUP-FAIL if there was some sort of initialization
* error(in SETUP-COLUMN).
* label because of an SQL error.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
EXEC SQL CLOSE csr END-EXEC.
END-SELECT.
EXIT.
**
* Paragraph: SETUP-ROW
*
* A statement has just been described, so set up the
* SQLDA for result processing. Print all the column
* names and allocate result data items for retrieving
* data using paragraph SETUP-COLUMN.
* This paragraph sets SETUP-OK if it succeeds, and
* SETUP-FAIL if there was some sort of initialization
* error(in SETUP-COLUMN).
**
SETUP-ROW.
* Initialize column setup. No character data used yet.
SET SETUP-OK TO TRUE.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM SETUP-COLUMN
VARYING COLN FROM 1 BY 1
UNTIL (COLN > SQLD) OR (SETUP-FAIL).
SETUP-ROW.
* Initialize column setup. No character data used yet.
SET SETUP-OK TO TRUE.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM SETUP-COLUMN
VARYING COLN FROM 1 BY 1
UNTIL (COLN > SQLD) OR (SETUP-FAIL).
* At this point we've processed all columns for
* data type information.
* End the line of column names.
DISPLAY SPACE.
DISPLAY "----------------------------".
**
* Paragraph: SETUP-COLUMN
*
* When setting up for a SELECT statement column names are
* printed, and result data items (for retrieving data)
* are chosen out of a pool of variables (integers,
* decimals, a large character string space and null
* indicators). The SQLDATA and SQLIND fields are pointed
* at the addresses of the result data items and
* indicators. Paragraph sets SETUP-FAIL if it fails.
* data type information.
* End the line of column names.
DISPLAY SPACE.
DISPLAY "----------------------------".
**
* Paragraph: SETUP-COLUMN
*
* When setting up for a SELECT statement column names are
* printed, and result data items (for retrieving data)
* are chosen out of a pool of variables (integers,
* decimals, a large character string space and null
* indicators). The SQLDATA and SQLIND fields are pointed
* at the addresses of the result data items and
* indicators. Paragraph sets SETUP-FAIL if it fails.
**
SETUP-COLUMN.
* For each column print the number and name of the column,
* e.g.: [001] sal [002] name [003] age
DISPLAY "[" COLN "] " WITH NO ADVANCING.
DISPLAY SQLNAMEC(COLN)(1:SQLNAMEL(COLN)) WITH NO ADVANCING.
IF (COLN < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
* Determine the data type of the column and to where SQLDATA
* and SQLIND must point in order to retrieve data-compatible
* results. Use the global numeric table and the large
* character string buffer from which pieces can be allocated.
* First find the base type of the current column.
SETUP-COLUMN.
* For each column print the number and name of the column,
* e.g.: [001] sal [002] name [003] age
DISPLAY "[" COLN "] " WITH NO ADVANCING.
DISPLAY SQLNAMEC(COLN)(1:SQLNAMEL(COLN)) WITH NO ADVANCING.
IF (COLN < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
* Determine the data type of the column and to where SQLDATA
* and SQLIND must point in order to retrieve data-compatible
* results. Use the global numeric table and the large
* character string buffer from which pieces can be allocated.
* First find the base type of the current column.
* Normally you should clear the SQLIND pointer if it
* is not being used using the SET TO NULL statement. At the
* time of this writing, however, SET pointer-item TO NULL
* was not accepted. The pointer will be ignored by
* Ingres if the SQLTYPE is positive.
IF (SQLTYPE(COLN) > 0) THEN
MOVE SQLTYPE(COLN) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
* SET SQLIND(COLN) TO NULL
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COLN)
SET NULLABLE TO TRUE
SET SQLIND(COLN) TO ADDRESS OF IND-DATA(COLN)
END-IF.
* is not being used using the SET TO NULL statement. At the
* time of this writing, however, SET pointer-item TO NULL
* was not accepted. The pointer will be ignored by
* Ingres if the SQLTYPE is positive.
IF (SQLTYPE(COLN) > 0) THEN
MOVE SQLTYPE(COLN) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
* SET SQLIND(COLN) TO NULL
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COLN)
SET NULLABLE TO TRUE
SET SQLIND(COLN) TO ADDRESS OF IND-DATA(COLN)
END-IF.
* Collapse all different types into one of
* integer, decimal or character.
* Integer data uses 4-byte COMP.
IF (BASE-TYPE = IISQ-INT-TYPE) THEN
MOVE IISQ-INT-TYPE TO SQLTYPE(COLN)
MOVE 4 TO SQLLEN(COLN)
SET SQLDATA(COLN) TO ADDRESS OF INT-DATA(COLN)
* Money and floating-point data or decimal data use COMP-3
*
* integer, decimal or character.
* Integer data uses 4-byte COMP.
IF (BASE-TYPE = IISQ-INT-TYPE) THEN
MOVE IISQ-INT-TYPE TO SQLTYPE(COLN)
MOVE 4 TO SQLLEN(COLN)
SET SQLDATA(COLN) TO ADDRESS OF INT-DATA(COLN)
* Money and floating-point data or decimal data use COMP-3
*
* You must encode precision and length when settin
* SQLLEN for a decimal data type. Use the formula: SQLLEN =
* (256 * p+s) where p is the Ingres precision and s l
* is scale of the decimal host variable. DEC-DATA is
* defined as PIC S9(10)V9(8), so p = 10 + 8 (Ingres
* precision is the total number of digits.) and s = 8.
* Therefore, SQLLEN = (256 * 18 + 8) = 4616.
ELSE IF (BASE-TYPE = IISQ-MNY-TYPE) OR
(BASE-TYPE = IISQ-DEC-TYPE) OR
(BASE-TYPE = IISQ-FLT-TYPE) THEN
MOVE IISQ-DEC-TYPE TO SQLTYPE(COLN)
MOVE 4616 TO SQLLEN(COLN)
SET SQLDATA(COLN) TO ADDRESS OF DEC-DATA(COLN)
* SQLLEN for a decimal data type. Use the formula: SQLLEN =
* (256 * p+s) where p is the Ingres precision and s l
* is scale of the decimal host variable. DEC-DATA is
* defined as PIC S9(10)V9(8), so p = 10 + 8 (Ingres
* precision is the total number of digits.) and s = 8.
* Therefore, SQLLEN = (256 * 18 + 8) = 4616.
ELSE IF (BASE-TYPE = IISQ-MNY-TYPE) OR
(BASE-TYPE = IISQ-DEC-TYPE) OR
(BASE-TYPE = IISQ-FLT-TYPE) THEN
MOVE IISQ-DEC-TYPE TO SQLTYPE(COLN)
MOVE 4616 TO SQLLEN(COLN)
SET SQLDATA(COLN) TO ADDRESS OF DEC-DATA(COLN)
* Dates, fixed and varying-length character
* strings use character data.
ELSE IF (BASE-TYPE = IISQ-DTE-TYPE)
OR (BASE-TYPE = IISQ-CHA-TYPE)
OR (BASE-TYPE = IISQ-VCH-TYPE)
OR (BASE-TYPE = IISQ-LVCH-TYPE) THEN
* Fix up the lengths of dates and determine the length
* of the sub-string required from the large character
* string buffer.
IF (BASE-TYPE = IISQ-DTE-TYPE) THEN
MOVE IISQ-DTE-LEN TO SQLLEN(COLN)
END-IF
IF (BASE-TYPE = IISQ-LVCH-TYPE) THEN
* Maximize the length of a large object to 100
* for this example.
* strings use character data.
ELSE IF (BASE-TYPE = IISQ-DTE-TYPE)
OR (BASE-TYPE = IISQ-CHA-TYPE)
OR (BASE-TYPE = IISQ-VCH-TYPE)
OR (BASE-TYPE = IISQ-LVCH-TYPE) THEN
* Fix up the lengths of dates and determine the length
* of the sub-string required from the large character
* string buffer.
IF (BASE-TYPE = IISQ-DTE-TYPE) THEN
MOVE IISQ-DTE-LEN TO SQLLEN(COLN)
END-IF
IF (BASE-TYPE = IISQ-LVCH-TYPE) THEN
* Maximize the length of a large object to 100
* for this example.
MOVE 100 TO SQLLEN(COLN)
END-IF
MOVE IISQ-CHA-TYPE TO SQLTYPE(COLN)
MOVE SQLLEN(COLN) TO CUR-LEN
* If we do not have enough character space left
* print an error.
IF ((CHAR-LEN + CUR-LEN) > 2500) THEN
DISPLAY "SQL Error: Character result "
"data overflow."
SET SETUP-FAIL TO TRUE
ELSE
END-IF
MOVE IISQ-CHA-TYPE TO SQLTYPE(COLN)
MOVE SQLLEN(COLN) TO CUR-LEN
* If we do not have enough character space left
* print an error.
IF ((CHAR-LEN + CUR-LEN) > 2500) THEN
DISPLAY "SQL Error: Character result "
"data overflow."
SET SETUP-FAIL TO TRUE
ELSE
* There is enough space so point at the start of the
* corresponding sub-string. Allocate space out of
* character buffer and accumulate the currently used
* character space.
SET SQLDATA(COLN) TO ADDRESS OF
CHAR-DATA(CHAR-LEN:)
ADD CUR-LEN TO CHAR-LEN
END-IF
END-IF.
* If nullable negate the data type
IF (NULLABLE) THEN
COMPUTE SQLTYPE(COLN) = 0 - SQLTYPE(COLN)
END-IF.
**
* corresponding sub-string. Allocate space out of
* character buffer and accumulate the currently used
* character space.
SET SQLDATA(COLN) TO ADDRESS OF
CHAR-DATA(CHAR-LEN:)
ADD CUR-LEN TO CHAR-LEN
END-IF
END-IF.
* If nullable negate the data type
IF (NULLABLE) THEN
COMPUTE SQLTYPE(COLN) = 0 - SQLTYPE(COLN)
END-IF.
**
* Paragraph: PRINT-ROW
*
* For each result column inside the SQLDA, print the
* value. Print its column number too in order to
* identify it with a column name printed earlier in
* SETUP-ROW. If the value is NULL print "N/A".The
* details of the printing are done in PRINT-COLUMN.
**
PRINT-ROW.
* Reset the character counter to the first byte.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM PRINT-COLUMN
VARYING COLN FROM 1 BY 1
UNTIL (COLN > SQLD).
* End each line of column data.
DISPLAY SPACE.
*
* For each result column inside the SQLDA, print the
* value. Print its column number too in order to
* identify it with a column name printed earlier in
* SETUP-ROW. If the value is NULL print "N/A".The
* details of the printing are done in PRINT-COLUMN.
**
PRINT-ROW.
* Reset the character counter to the first byte.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM PRINT-COLUMN
VARYING COLN FROM 1 BY 1
UNTIL (COLN > SQLD).
* End each line of column data.
DISPLAY SPACE.
**
* Paragraph: PRINT-COLUMN
*
* Detailed printing of PRINT-ROW. This paragraph does
* not attempt to tabulate the results in a tabular
* format. The display formats used can be modified if
* more precision is required.
**
PRINT-COLUMN.
* For each column print the number and value of the column.
* NULL columns are printed as "N/A".
DISPLAY "[" COLN "] " WITH NO ADVANCING.
* Paragraph: PRINT-COLUMN
*
* Detailed printing of PRINT-ROW. This paragraph does
* not attempt to tabulate the results in a tabular
* format. The display formats used can be modified if
* more precision is required.
**
PRINT-COLUMN.
* For each column print the number and value of the column.
* NULL columns are printed as "N/A".
DISPLAY "[" COLN "] " WITH NO ADVANCING.
* Find the base type of the current column.
IF (SQLTYPE(COLN) > 0) THEN
MOVE SQLTYPE(COLN) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COLN)
SET NULLABLE TO TRUE
END-IF.
* Different types have been collapsed into one of
* integer, decimal or character. If the data is NULL
* then just print "N/A".
IF (NULLABLE AND (IND-DATA(COLN) = -1)) THEN
DISPLAY "N/A" WITH NO ADVANCING
IF (SQLTYPE(COLN) > 0) THEN
MOVE SQLTYPE(COLN) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COLN)
SET NULLABLE TO TRUE
END-IF.
* Different types have been collapsed into one of
* integer, decimal or character. If the data is NULL
* then just print "N/A".
IF (NULLABLE AND (IND-DATA(COLN) = -1)) THEN
DISPLAY "N/A" WITH NO ADVANCING
* Integer data.
ELSE IF (BASE-TYPE = IISQ-INT-TYPE) THEN
MOVE INT-DATA(COLN) TO DISP-INT
DISPLAY DISP-INT WITH NO ADVANCING
* Decimal, money and float column data will also
* be printed here.
ELSE IF (BASE-TYPE = IISQ-DEC-TYPE) THEN
MOVE DEC-DATA(COLN) TO DISP-DEC
DISPLAY DISP-DEC WITH NO ADVANCING
* Character data. Print only the relevant substring.
ELSE IF (BASE-TYPE = IISQ-CHA-TYPE) THEN
MOVE SQLLEN(COLN) TO CUR-LEN
DISPLAY CHAR-DATA(CHAR-LEN:CUR-LEN)
WITH NO ADVANCING
ADD CUR-LEN TO CHAR-LEN
END-IF.
ELSE IF (BASE-TYPE = IISQ-INT-TYPE) THEN
MOVE INT-DATA(COLN) TO DISP-INT
DISPLAY DISP-INT WITH NO ADVANCING
* Decimal, money and float column data will also
* be printed here.
ELSE IF (BASE-TYPE = IISQ-DEC-TYPE) THEN
MOVE DEC-DATA(COLN) TO DISP-DEC
DISPLAY DISP-DEC WITH NO ADVANCING
* Character data. Print only the relevant substring.
ELSE IF (BASE-TYPE = IISQ-CHA-TYPE) THEN
MOVE SQLLEN(COLN) TO CUR-LEN
DISPLAY CHAR-DATA(CHAR-LEN:CUR-LEN)
WITH NO ADVANCING
ADD CUR-LEN TO CHAR-LEN
END-IF.
* Add trailing space after each value.
IF (COLN < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
**
* Paragraph: PRINT-ERROR
*
* SQLCA error detected. Retrieve the error message and
* print it.
**
PRINT-ERROR.
EXEC SQL INQUIRE_SQL (:ERROR-BUF = ERRORTEXT) END-EXEC.
DISPLAY "SQL Error:".
DISPLAY ERROR-BUF.
IF (COLN < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
**
* Paragraph: PRINT-ERROR
*
* SQLCA error detected. Retrieve the error message and
* print it.
**
PRINT-ERROR.
EXEC SQL INQUIRE_SQL (:ERROR-BUF = ERRORTEXT) END-EXEC.
DISPLAY "SQL Error:".
DISPLAY ERROR-BUF.
**
* Paragraph: READ-STATEMENT
*
* Prompt user and read input SQL statement. This paragraph
* can be expanded to scan and process an SQL statement
* string searching
* for delimiters (such as quotes and the semicolon).
* Currently the user is allowed to input only one SQL e
* statement on on line without any terminators. Blank or
* empty lines will causthe normal termination of this
* program.
**
READ-STATEMENT.
DISPLAY STMT-NUM ">" WITH NO ADVANCING.
ACCEPT STMT-BUF FROM CONSOLE.
IF (STMT-BUF = SPACES) THEN
DISPLAY "**************************"
SET DONE-READING TO TRUE.
* Paragraph: READ-STATEMENT
*
* Prompt user and read input SQL statement. This paragraph
* can be expanded to scan and process an SQL statement
* string searching
* for delimiters (such as quotes and the semicolon).
* Currently the user is allowed to input only one SQL e
* statement on on line without any terminators. Blank or
* empty lines will causthe normal termination of this
* program.
**
READ-STATEMENT.
DISPLAY STMT-NUM ">" WITH NO ADVANCING.
ACCEPT STMT-BUF FROM CONSOLE.
IF (STMT-BUF = SPACES) THEN
DISPLAY "**************************"
SET DONE-READING TO TRUE.
VMS:
IDENTIFICATION DIVISION.
PROGRAM-ID. SQL-MONITOR.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
Include SQL Communications and Descriptor Areas
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE SQLDA END-EXEC.
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE SQLDA END-EXEC.
* Dynamic SQL statement name (documentary only)
EXEC SQL DECLARE stmt STATEMENT END-EXEC.
* Cursor declaration for dynamic statement
EXEC SQL DECLARE csr CURSOR FOR stmt END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* Database name
01 DB-NAME PIC X(30).
* Dynamic SQL statement buffer
01 STMT-BUF PIC X(1000).
* SQL error message buffer
01 ERROR-BUF PIC X(1024).
EXEC SQL END DECLARE SECTION END-EXEC.
EXEC SQL DECLARE stmt STATEMENT END-EXEC.
* Cursor declaration for dynamic statement
EXEC SQL DECLARE csr CURSOR FOR stmt END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* Database name
01 DB-NAME PIC X(30).
* Dynamic SQL statement buffer
01 STMT-BUF PIC X(1000).
* SQL error message buffer
01 ERROR-BUF PIC X(1024).
EXEC SQL END DECLARE SECTION END-EXEC.
* SQL statement number
01 STMT-NUM PIC 999.
* Reading state
01 READING-STMT PIC S9(4) USAGE COMP.
88 DONE-READING VALUE 0.
88 STILL-READING VALUE 1.
* Number of rows affected by last SQL statement
01 STMT-ROWS PIC ZZZZZ9.
* Number of rows retrieved by last SELECT statement
01 SELECT-ROWS PIC S9(8) USAGE COMP.
* Dynamic SELECT statement set up state
01 SELECT-SETUP PIC S9(4) USAGE COMP.
88 SETUP-FAIL VALUE 0.
88 SETUP-OK VALUE 1.
01 STMT-NUM PIC 999.
* Reading state
01 READING-STMT PIC S9(4) USAGE COMP.
88 DONE-READING VALUE 0.
88 STILL-READING VALUE 1.
* Number of rows affected by last SQL statement
01 STMT-ROWS PIC ZZZZZ9.
* Number of rows retrieved by last SELECT statement
01 SELECT-ROWS PIC S9(8) USAGE COMP.
* Dynamic SELECT statement set up state
01 SELECT-SETUP PIC S9(4) USAGE COMP.
88 SETUP-FAIL VALUE 0.
88 SETUP-OK VALUE 1.
* Index into SQLVAR table
01 COL PIC 999.
* Base data type of SQLVAR item without nullability
01 BASE-TYPE PIC S9(4) USAGE COMP.
* Is a result column type nullable
01 IS-NULLABLE PIC S9(4) USAGE COMP.
88 NOT-NULLABLE VALUE 0.
88 NULLABLE VALUE 1.
* Global result data storage. This pool of data includes the maximum
* number of result data items needed to execute a Dynamic SELECT
* statement. There is a table of 1024 integers, decimal, large object
* handlers, and null indicator data items, and a large character
* string buffer. Floating-point and money types are stored in
* decimal variables.
01 COL PIC 999.
* Base data type of SQLVAR item without nullability
01 BASE-TYPE PIC S9(4) USAGE COMP.
* Is a result column type nullable
01 IS-NULLABLE PIC S9(4) USAGE COMP.
88 NOT-NULLABLE VALUE 0.
88 NULLABLE VALUE 1.
* Global result data storage. This pool of data includes the maximum
* number of result data items needed to execute a Dynamic SELECT
* statement. There is a table of 1024 integers, decimal, large object
* handlers, and null indicator data items, and a large character
* string buffer. Floating-point and money types are stored in
* decimal variables.
01 RESULT-DATA.
02 INTEGER-DATA OCCURS 1024 TIMES.
03 INT-DATA PIC S9(9) USAGE COMP.
03 IND-DATA PIC S9(4) USAGE COMP.
02 DECIMAL-DATA OCCURS 1024 TIMES.
03 DEC-DATA PIC S9(10)V9(8) USAGE COMP-3.
02 STRING-DATA.
03 CHAR-LEN PIC S9(4) USAGE COMP.
03 CHAR-DATA PIC X(2500).
02 BLOB-DATA OCCURS 1024 TIMES.
03 BLOB-ARG USAGE POINTER.
03 BLOB-HDLR PIC S9(9) USAGE COMP.
02 INTEGER-DATA OCCURS 1024 TIMES.
03 INT-DATA PIC S9(9) USAGE COMP.
03 IND-DATA PIC S9(4) USAGE COMP.
02 DECIMAL-DATA OCCURS 1024 TIMES.
03 DEC-DATA PIC S9(10)V9(8) USAGE COMP-3.
02 STRING-DATA.
03 CHAR-LEN PIC S9(4) USAGE COMP.
03 CHAR-DATA PIC X(2500).
02 BLOB-DATA OCCURS 1024 TIMES.
03 BLOB-ARG USAGE POINTER.
03 BLOB-HDLR PIC S9(9) USAGE COMP.
* User defined handler for large objects
01 UsrDatHdlr PIC S9(9) USAGE COMP VALUE EXTERNAL UsrDataHdlr
* Limit the size of a large object
01 BLOB-MAX PIC S9(4) USAGE COMP IS EXTERNAL.
* Current lengths of local character data.
01 CUR-LEN PIC S9(4) USAGE COMP.
**
* Procedure Division: SQL-MONITOR
*
* Main entry of SQL Monitor application. Prompt for database name
* and connect to the database. Run the monitor and disconnect from
* the database. Before disconnecting roll back any pending updates.
**
PROCEDURE DIVISION.
SBEGIN.
01 UsrDatHdlr PIC S9(9) USAGE COMP VALUE EXTERNAL UsrDataHdlr
* Limit the size of a large object
01 BLOB-MAX PIC S9(4) USAGE COMP IS EXTERNAL.
* Current lengths of local character data.
01 CUR-LEN PIC S9(4) USAGE COMP.
**
* Procedure Division: SQL-MONITOR
*
* Main entry of SQL Monitor application. Prompt for database name
* and connect to the database. Run the monitor and disconnect from
* the database. Before disconnecting roll back any pending updates.
**
PROCEDURE DIVISION.
SBEGIN.
* Prompt for database name.
DISPLAY "SQL Database: " WITH NO ADVANCING.
ACCEPT DB-NAME AT END STOP RUN.
DISPLAY " -- SQL Terminal Monitor -- ".
* Treat connection errors as fatal.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT :DB-NAME END-EXEC.
* Run the Terminal Monitor
PERFORM RUN-MONITOR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
DISPLAY "SQL: Exiting monitor program.".
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
**
DISPLAY "SQL Database: " WITH NO ADVANCING.
ACCEPT DB-NAME AT END STOP RUN.
DISPLAY " -- SQL Terminal Monitor -- ".
* Treat connection errors as fatal.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT :DB-NAME END-EXEC.
* Run the Terminal Monitor
PERFORM RUN-MONITOR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
DISPLAY "SQL: Exiting monitor program.".
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
**
* Paragraph: RUN-MONITOR
*
* Run the SQL monitor. Initialize the global SQLDA with the number
* of SQLVAR elements. Loop while prompting the user for input;
* if end-of-file is detected then return to the calling paragraph
* (the main program). If the user inputs a statement, execute it
* (using paragraph EXECUTE-STATEMENT).
**
RUN-MONITOR.
* Initialize the SQLN (set the number of SQLVAR elements)
MOVE 1024 TO SQLN.
* If you increase BLOB-MAX then increase BLOB_DATA in the datahandler
MOVE 50 TO BLOB-MAX.
*
* Run the SQL monitor. Initialize the global SQLDA with the number
* of SQLVAR elements. Loop while prompting the user for input;
* if end-of-file is detected then return to the calling paragraph
* (the main program). If the user inputs a statement, execute it
* (using paragraph EXECUTE-STATEMENT).
**
RUN-MONITOR.
* Initialize the SQLN (set the number of SQLVAR elements)
MOVE 1024 TO SQLN.
* If you increase BLOB-MAX then increase BLOB_DATA in the datahandler
MOVE 50 TO BLOB-MAX.
* Now we are setup for input. Initialize statement number and
* reading state.
MOVE 0 TO STMT-NUM.
SET STILL-READING TO TRUE.
* Loop while prompting, reading and processing the SQL statement.
PERFORM UNTIL DONE-READING
ADD 1 TO STMT-NUM
PERFORM READ-STATEMENT
IF (STILL-READING) THEN
PERFORM EXECUTE-STATEMENT THRU END-EXECUTE
END-IF
END-PERFORM.
**
MOVE 0 TO STMT-NUM.
SET STILL-READING TO TRUE.
* Loop while prompting, reading and processing the SQL statement.
PERFORM UNTIL DONE-READING
ADD 1 TO STMT-NUM
PERFORM READ-STATEMENT
IF (STILL-READING) THEN
PERFORM EXECUTE-STATEMENT THRU END-EXECUTE
END-IF
END-PERFORM.
**
* Paragraph: EXECUTE-STATEMENT
*
* Using the PREPARE and DESCRIBE facilities determine if the input
* statement is a SELECT statement or not. If the statement is not
* a SELECT statement then EXECUTE it, otherwise open a cursor and
* process a dynamic SELECT statement (using paragraph EXECUTE-SELECT).
* After processing the statement, print the number of rows affected
* by the statement and any SQL errors.
**
*
* Using the PREPARE and DESCRIBE facilities determine if the input
* statement is a SELECT statement or not. If the statement is not
* a SELECT statement then EXECUTE it, otherwise open a cursor and
* process a dynamic SELECT statement (using paragraph EXECUTE-SELECT).
* After processing the statement, print the number of rows affected
* by the statement and any SQL errors.
**
EXECUTE-STATEMENT.
EXEC SQL WHENEVER SQLERROR GO TO END-EXECUTE END-EXEC.
* PREPARE and DESCRIBE the statement. Inspect the contents of the
* SQLDA and determine if it is a SELECT statement or not.
EXEC SQL PREPARE stmt FROM :STMT-BUF END-EXEC.
EXEC SQL DESCRIBE stmt INTO :SQLDA END-EXEC.
* If SQLD = 0 then this is not a SELECT.
IF (SQLD = 0) THEN
EXEC SQL EXECUTE stmt END-EXEC
MOVE SQLERRD(3) TO STMT-ROWS
EXEC SQL WHENEVER SQLERROR GO TO END-EXECUTE END-EXEC.
* PREPARE and DESCRIBE the statement. Inspect the contents of the
* SQLDA and determine if it is a SELECT statement or not.
EXEC SQL PREPARE stmt FROM :STMT-BUF END-EXEC.
EXEC SQL DESCRIBE stmt INTO :SQLDA END-EXEC.
* If SQLD = 0 then this is not a SELECT.
IF (SQLD = 0) THEN
EXEC SQL EXECUTE stmt END-EXEC
MOVE SQLERRD(3) TO STMT-ROWS
* Otherwise this is a SELECT. Verify that there are enough SQLVAR
* result variables. If there are too few print an error and continue,
* otherwise call EXECUTE-SELECT.
ELSE
IF (SQLD > SQLN) THEN
DISPLAY "SQL Error: SQLDA requires more than "
"1024 result variables."
MOVE 0 TO STMT-ROWS
ELSE
PERFORM EXECUTE-SELECT THRU END-SELECT
MOVE SELECT-ROWS TO STMT-ROWS
END-IF
END-IF.
* Print the number of rows processed.
DISPLAY "[" STMT-ROWS " row(s)]".
* Only print the error message if we arrived at this label because
* of an SQL error.
* result variables. If there are too few print an error and continue,
* otherwise call EXECUTE-SELECT.
ELSE
IF (SQLD > SQLN) THEN
DISPLAY "SQL Error: SQLDA requires more than "
"1024 result variables."
MOVE 0 TO STMT-ROWS
ELSE
PERFORM EXECUTE-SELECT THRU END-SELECT
MOVE SELECT-ROWS TO STMT-ROWS
END-IF
END-IF.
* Print the number of rows processed.
DISPLAY "[" STMT-ROWS " row(s)]".
* Only print the error message if we arrived at this label because
* of an SQL error.
END-EXECUTE.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
**
* Paragraph: EXECUTE-SELECT
*
* Execute a Dynamic SELECT statement. The SQLDA has already been
* described, so print the table header column names, open a
* dynamic cursor, and retrieve and print the results. Accumulate
* the number of rows processed in SELECT-ROWS.
**
EXECUTE-SELECT.
* So far no rows.
MOVE 0 TO SELECT-ROWS.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
**
* Paragraph: EXECUTE-SELECT
*
* Execute a Dynamic SELECT statement. The SQLDA has already been
* described, so print the table header column names, open a
* dynamic cursor, and retrieve and print the results. Accumulate
* the number of rows processed in SELECT-ROWS.
**
EXECUTE-SELECT.
* So far no rows.
MOVE 0 TO SELECT-ROWS.
* Set up the result types and data items, and print result column
* names SETUP-ROW will set SETUP-FAIL/OK if it fails/succeeds.
PERFORM SETUP-ROW.
IF (SETUP-FAIL) THEN
GO TO END-SELECT.
EXEC SQL WHENEVER SQLERROR GO TO SELECT-ERR END-EXEC.
* Open the dynamic cursor.
EXEC SQL OPEN csr FOR READONLY END-EXEC.
* Fetch and print each row. Accumulate the number of rows fetched.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH csr USING DESCRIPTOR :SQLDA END-EXEC
IF (SQLCODE = 0) THEN
ADD 1 TO SELECT-ROWS
PERFORM PRINT-ROW
END-IF
END-PERFORM.
SELECT-ERR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
PERFORM SETUP-ROW.
IF (SETUP-FAIL) THEN
GO TO END-SELECT.
EXEC SQL WHENEVER SQLERROR GO TO SELECT-ERR END-EXEC.
* Open the dynamic cursor.
EXEC SQL OPEN csr FOR READONLY END-EXEC.
* Fetch and print each row. Accumulate the number of rows fetched.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH csr USING DESCRIPTOR :SQLDA END-EXEC
IF (SQLCODE = 0) THEN
ADD 1 TO SELECT-ROWS
PERFORM PRINT-ROW
END-IF
END-PERFORM.
SELECT-ERR.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
* Only print the error message if we arrived at this label because
* of an SQL error.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
EXEC SQL CLOSE csr END-EXEC.
END-SELECT.
EXIT.
**
* Paragraph: SETUP-ROW
*
* A statement has just been described so set up the SQLDA for result
* processing. Print all the column names and allocate result data
* items for retrieving data using paragraph SETUP-COLUMN.
*
* This paragraph sets SETUP-OK if it succeeds, and SETUP-FAIL if
* there was some sort of initialization error (in SETUP-COLUMN).
* of an SQL error.
IF (SQLCODE < 0) THEN
PERFORM PRINT-ERROR.
EXEC SQL CLOSE csr END-EXEC.
END-SELECT.
EXIT.
**
* Paragraph: SETUP-ROW
*
* A statement has just been described so set up the SQLDA for result
* processing. Print all the column names and allocate result data
* items for retrieving data using paragraph SETUP-COLUMN.
*
* This paragraph sets SETUP-OK if it succeeds, and SETUP-FAIL if
* there was some sort of initialization error (in SETUP-COLUMN).
**
SETUP-ROW.
* Initialize column setup. No character data used yet.
SET SETUP-OK TO TRUE.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM SETUP-COLUMN
VARYING COL FROM 1 BY 1
UNTIL (COL > SQLD) OR (SETUP-FAIL).
* At this point we've processed all columns for data type
* information. End the line of column names.
DISPLAY SPACE.
DISPLAY "----------------------------".
**
* Paragraph: SETUP-COLUMN
*
SETUP-ROW.
* Initialize column setup. No character data used yet.
SET SETUP-OK TO TRUE.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM SETUP-COLUMN
VARYING COL FROM 1 BY 1
UNTIL (COL > SQLD) OR (SETUP-FAIL).
* At this point we've processed all columns for data type
* information. End the line of column names.
DISPLAY SPACE.
DISPLAY "----------------------------".
**
* Paragraph: SETUP-COLUMN
*
* When setting up for a SELECT statement column names are printed,
* and result data items (for retrieving data) are chosen out of a
* pool of variables (integers, floating-points, a large character
* string space, and null indicators). The SQLDATA and SQLIND fields
* are pointed at the addresses of the result data items and
* indicators. Paragraph sets SETUP-FAIL if it fails.
**
SETUP-COLUMN.
* For each column print the number and name of the column, e.g.:
* [001] sal [002] name [003] age
DISPLAY "[" COL "] " WITH NO ADVANCING.
DISPLAY SQLNAMEC(COL)(1:SQLNAMEL(COL)) WITH NO ADVANCING.
IF (COL < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
* and result data items (for retrieving data) are chosen out of a
* pool of variables (integers, floating-points, a large character
* string space, and null indicators). The SQLDATA and SQLIND fields
* are pointed at the addresses of the result data items and
* indicators. Paragraph sets SETUP-FAIL if it fails.
**
SETUP-COLUMN.
* For each column print the number and name of the column, e.g.:
* [001] sal [002] name [003] age
DISPLAY "[" COL "] " WITH NO ADVANCING.
DISPLAY SQLNAMEC(COL)(1:SQLNAMEL(COL)) WITH NO ADVANCING.
IF (COL < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
* Determine the data type of the column and to where SQLDATA and
* SQLIND must point in order to retrieve data-compatible results. Use
* the global numeric table and the large character string buffer from
* which pieces can be allocated.
* First find the base type of the current column.
IF (SQLTYPE(COL) > 0) THEN
MOVE SQLTYPE(COL) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
MOVE 0 TO SQLIND(COL)
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COL)
SET NULLABLE TO TRUE
SET SQLIND(COL) TO REFERENCE IND-DATA(COL)
END-IF.
* SQLIND must point in order to retrieve data-compatible results. Use
* the global numeric table and the large character string buffer from
* which pieces can be allocated.
* First find the base type of the current column.
IF (SQLTYPE(COL) > 0) THEN
MOVE SQLTYPE(COL) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
MOVE 0 TO SQLIND(COL)
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COL)
SET NULLABLE TO TRUE
SET SQLIND(COL) TO REFERENCE IND-DATA(COL)
END-IF.
* Collapse all different types into one of integer, float or
* character.
* Integer data uses 4-byte COMP.
IF (BASE-TYPE = 30) THEN
IF (NOT-NULLABLE) THEN
MOVE 30 TO SQLTYPE(COL)
ELSE
MOVE -30 TO SQLTYPE(COL)
END-IF
MOVE 4 TO SQLLEN(COL)
SET SQLDATA(COL) TO REFERENCE INT-DATA(COL)
* Money, decimal and floating-point data use COMP-3.
*
* character.
* Integer data uses 4-byte COMP.
IF (BASE-TYPE = 30) THEN
IF (NOT-NULLABLE) THEN
MOVE 30 TO SQLTYPE(COL)
ELSE
MOVE -30 TO SQLTYPE(COL)
END-IF
MOVE 4 TO SQLLEN(COL)
SET SQLDATA(COL) TO REFERENCE INT-DATA(COL)
* Money, decimal and floating-point data use COMP-3.
*
* You must encode precision and length when setting SQLLEN
* for a decimal data type. Use the formula: SQLLEN = (256 * p+s)
* where p is the Ingres precision and s is scale of the Decimal
* host variable. DEC-DATA is defined as PIC S9(10)V9(8), so
* p = 10+8 (Ingres precision is the total number of digits)
* and s= 8. Therefore, SQLLEN = (256 * 18+8) = 4616.
ELSE IF (BASE-TYPE = 5)
OR (BASE-TYPE = 10)
OR (BASE-TYPE = 31) THEN
IF (NOT-NULLABLE) THEN
MOVE 10 TO SQLTYPE(COL)
ELSE
MOVE -10 TO SQLTYPE(COL)
END-IF
MOVE 4616 TO SQLLEN(COL)
SET SQLDATA(COL) TO REFERENCE DEC-DATA(COL)
* Dates, fixed and varying-length character strings use
* character data.
ELSE IF (BASE-TYPE = 3) OR (BASE-TYPE = 20)
OR (BASE-TYPE = 21) THEN
* Fix up the lengths of dates and determine the length of the
* sub-string required from the large character string buffer.
* for a decimal data type. Use the formula: SQLLEN = (256 * p+s)
* where p is the Ingres precision and s is scale of the Decimal
* host variable. DEC-DATA is defined as PIC S9(10)V9(8), so
* p = 10+8 (Ingres precision is the total number of digits)
* and s= 8. Therefore, SQLLEN = (256 * 18+8) = 4616.
ELSE IF (BASE-TYPE = 5)
OR (BASE-TYPE = 10)
OR (BASE-TYPE = 31) THEN
IF (NOT-NULLABLE) THEN
MOVE 10 TO SQLTYPE(COL)
ELSE
MOVE -10 TO SQLTYPE(COL)
END-IF
MOVE 4616 TO SQLLEN(COL)
SET SQLDATA(COL) TO REFERENCE DEC-DATA(COL)
* Dates, fixed and varying-length character strings use
* character data.
ELSE IF (BASE-TYPE = 3) OR (BASE-TYPE = 20)
OR (BASE-TYPE = 21) THEN
* Fix up the lengths of dates and determine the length of the
* sub-string required from the large character string buffer.
IF (BASE-TYPE = 3) THEN
MOVE 25 TO SQLLEN(COL)
END-IF
IF (NOT-NULLABLE) THEN
MOVE 20 TO SQLTYPE(COL)
ELSE
MOVE -20 TO SQLTYPE(COL)
END-IF
MOVE SQLLEN(COL) TO CUR-LEN
* If we do not have enough character space left print an error.
IF ((CHAR-LEN + CUR-LEN) > 2500) THEN
DISPLAY "SQL Error: Character result "
"data overflow."
SET SETUP-FAIL TO TRUE
ELSE
* There is enough space so point at the start of the corresponding
* sub-string. Allocate space out of character buffer and accumulate
* the currently used character space.
MOVE 25 TO SQLLEN(COL)
END-IF
IF (NOT-NULLABLE) THEN
MOVE 20 TO SQLTYPE(COL)
ELSE
MOVE -20 TO SQLTYPE(COL)
END-IF
MOVE SQLLEN(COL) TO CUR-LEN
* If we do not have enough character space left print an error.
IF ((CHAR-LEN + CUR-LEN) > 2500) THEN
DISPLAY "SQL Error: Character result "
"data overflow."
SET SETUP-FAIL TO TRUE
ELSE
* There is enough space so point at the start of the corresponding
* sub-string. Allocate space out of character buffer and accumulate
* the currently used character space.
SET SQLDATA(COL) TO REFERENCE CHAR-DATA(CHAR-LEN:)
ADD CUR-LEN TO CHAR-LEN
END-IF
* For Long Varchar use Datahandler
ELSE IF (BASE-TYPE = 22) THEN
IF (NOT-NULLABLE) THEN
MOVE 46 TO SQLTYPE(COL)
ELSE
MOVE -46 TO SQLTYPE(COL)
END-IF
SET SQLDATA(COL) TO REFERENCE BLOB-DATA(COL)
MOVE UsrDataHdlr to BLOB-HDLR(COL)
MOVE BLOB-MAX TO SQLLEN(COL)
MOVE SQLLEN(COL) TO CUR-LEN
* If we do not have enough character space left print an error.
IF ((CHAR-LEN + CUR-LEN) > 2500) THEN
DISPLAY "SQL Error: Large object result "
"data overflow."
SET SETUP-FAIL TO TRUE
ELSE
ADD CUR-LEN TO CHAR-LEN
END-IF
* For Long Varchar use Datahandler
ELSE IF (BASE-TYPE = 22) THEN
IF (NOT-NULLABLE) THEN
MOVE 46 TO SQLTYPE(COL)
ELSE
MOVE -46 TO SQLTYPE(COL)
END-IF
SET SQLDATA(COL) TO REFERENCE BLOB-DATA(COL)
MOVE UsrDataHdlr to BLOB-HDLR(COL)
MOVE BLOB-MAX TO SQLLEN(COL)
MOVE SQLLEN(COL) TO CUR-LEN
* If we do not have enough character space left print an error.
IF ((CHAR-LEN + CUR-LEN) > 2500) THEN
DISPLAY "SQL Error: Large object result "
"data overflow."
SET SETUP-FAIL TO TRUE
ELSE
* There is enough space so point at the start of the corresponding
* sub-string. Allocate space out of character buffer and accumulate
* the currently used character space.
SET BLOB-ARG(COL) TO REFERENCE CHAR-DATA(CHAR-LEN:)
ADD CUR-LEN TO CHAR-LEN
END-IF
END-IF.
**
* Paragraph: PRINT-ROW
*
* For each result column inside the SQLDA, print the value. Print
* its column number too in order to identify it with a column name
* printed earlier in SETUP-ROW. If the value is NULL print "N/A".
* The details of the printing are done in PRINT-COLUMN.
**
PRINT-ROW.
* sub-string. Allocate space out of character buffer and accumulate
* the currently used character space.
SET BLOB-ARG(COL) TO REFERENCE CHAR-DATA(CHAR-LEN:)
ADD CUR-LEN TO CHAR-LEN
END-IF
END-IF.
**
* Paragraph: PRINT-ROW
*
* For each result column inside the SQLDA, print the value. Print
* its column number too in order to identify it with a column name
* printed earlier in SETUP-ROW. If the value is NULL print "N/A".
* The details of the printing are done in PRINT-COLUMN.
**
PRINT-ROW.
* Reset the character counter to the first byte.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM PRINT-COLUMN
VARYING COL FROM 1 BY 1
UNTIL (COL > SQLD).
* End each line of column data.
DISPLAY SPACE.
**
* Paragraph: PRINT-COLUMN
*
* Detailed printing of PRINT-ROW. This paragraph does not attempt
* to tabulate the results in a tabular format. Default formats are
* used (using WITH CONVERSION clause).
**
PRINT-COLUMN.
* For each column print the number and value of the column.
* NULL columns are printed as "N/A".
DISPLAY "[" COL "] " WITH NO ADVANCING.
MOVE 1 TO CHAR-LEN.
* Process each column.
PERFORM PRINT-COLUMN
VARYING COL FROM 1 BY 1
UNTIL (COL > SQLD).
* End each line of column data.
DISPLAY SPACE.
**
* Paragraph: PRINT-COLUMN
*
* Detailed printing of PRINT-ROW. This paragraph does not attempt
* to tabulate the results in a tabular format. Default formats are
* used (using WITH CONVERSION clause).
**
PRINT-COLUMN.
* For each column print the number and value of the column.
* NULL columns are printed as "N/A".
DISPLAY "[" COL "] " WITH NO ADVANCING.
* Find the base type of the current column.
IF (SQLTYPE(COL) > 0) THEN
MOVE SQLTYPE(COL) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COL)
SET NULLABLE TO TRUE
END-IF.
* Different types have been collapsed into one of integer, float or
* character. If the data is NULL then just print "N/A".
IF (NULLABLE AND (IND-DATA(COL) = -1)) THEN
DISPLAY "N/A" WITH NO ADVANCING
* Integer data.
ELSE IF (BASE-TYPE = 30) THEN
DISPLAY INT-DATA(COL) WITH CONVERSION WITH NO ADVANCING
* Decimal data.
ELSE IF (BASE-TYPE = 10) THEN
DISPLAY DEC-DATA(COL) WITH CONVERSION WITH NO ADVANCING
IF (SQLTYPE(COL) > 0) THEN
MOVE SQLTYPE(COL) TO BASE-TYPE
SET NOT-NULLABLE TO TRUE
ELSE
COMPUTE BASE-TYPE = 0 - SQLTYPE(COL)
SET NULLABLE TO TRUE
END-IF.
* Different types have been collapsed into one of integer, float or
* character. If the data is NULL then just print "N/A".
IF (NULLABLE AND (IND-DATA(COL) = -1)) THEN
DISPLAY "N/A" WITH NO ADVANCING
* Integer data.
ELSE IF (BASE-TYPE = 30) THEN
DISPLAY INT-DATA(COL) WITH CONVERSION WITH NO ADVANCING
* Decimal data.
ELSE IF (BASE-TYPE = 10) THEN
DISPLAY DEC-DATA(COL) WITH CONVERSION WITH NO ADVANCING
* Character and large object data. Print only the relevant substring.
ELSE IF (BASE-TYPE = 20)
OR (BASE-TYPE = 46) THEN
MOVE SQLLEN(COL) TO CUR-LEN
DISPLAY CHAR-DATA(CHAR-LEN:CUR-LEN) WITH NO ADVANCING
ADD CUR-LEN TO CHAR-LEN
END-IF.
* Add trailing space after each value.
IF (COL < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
**
* Paragraph: PRINT-ERROR
*
* SQLCA error detected. Retrieve the error message and print it.
**
PRINT-ERROR.
EXEC SQL INQUIRE_SQL (:ERROR-BUF = ERRORTEXT) END-EXEC.
DISPLAY "SQL Error:".
DISPLAY ERROR-BUF.
**
ELSE IF (BASE-TYPE = 20)
OR (BASE-TYPE = 46) THEN
MOVE SQLLEN(COL) TO CUR-LEN
DISPLAY CHAR-DATA(CHAR-LEN:CUR-LEN) WITH NO ADVANCING
ADD CUR-LEN TO CHAR-LEN
END-IF.
* Add trailing space after each value.
IF (COL < SQLD) THEN
DISPLAY SPACE WITH NO ADVANCING.
**
* Paragraph: PRINT-ERROR
*
* SQLCA error detected. Retrieve the error message and print it.
**
PRINT-ERROR.
EXEC SQL INQUIRE_SQL (:ERROR-BUF = ERRORTEXT) END-EXEC.
DISPLAY "SQL Error:".
DISPLAY ERROR-BUF.
**
* Paragraph: READ-STATEMENT
*
* Prompt user and read input SQL statement. This paragraph can be
* expanded to scan and process an SQL statement string searching
* for delimiters (such as quotes and the semicolon). Currently
* the user is allowed to input only one SQL statement on one
* line without any terminators. Blank lines or Control Z
* will cause normal termination of the program.
**
READ-STATEMENT.
DISPLAY STMT-NUM "> " WITH NO ADVANCING.
ACCEPT STMT-BUF AT END SET DONE-READING TO TRUE.
IF (STMT-BUF = SPACES) THEN
SET DONE-READING TO TRUE.
END PROGRAM SQL-MONITOR.
*****************************************************
*
* Prompt user and read input SQL statement. This paragraph can be
* expanded to scan and process an SQL statement string searching
* for delimiters (such as quotes and the semicolon). Currently
* the user is allowed to input only one SQL statement on one
* line without any terminators. Blank lines or Control Z
* will cause normal termination of the program.
**
READ-STATEMENT.
DISPLAY STMT-NUM "> " WITH NO ADVANCING.
ACCEPT STMT-BUF AT END SET DONE-READING TO TRUE.
IF (STMT-BUF = SPACES) THEN
SET DONE-READING TO TRUE.
END PROGRAM SQL-MONITOR.
*****************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. UsrDataHdlr.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
Include SQL Communications and Descriptor Areas
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 SEG-BUG PIC X(100).
01 SEG-LEN PIC S9(6) USAGE COMP.
01 DATA-END PIC S9(6) USAGE COMP.
01 MAX-LEN PIC S9(6) USAGE COMP.
01 TOTAL-LEN PIC S9(6) USAGE COMP.
EXEC SQL END DECLARE SECTION END-EXEC.
PROGRAM-ID. UsrDataHdlr.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
Include SQL Communications and Descriptor Areas
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 SEG-BUG PIC X(100).
01 SEG-LEN PIC S9(6) USAGE COMP.
01 DATA-END PIC S9(6) USAGE COMP.
01 MAX-LEN PIC S9(6) USAGE COMP.
01 TOTAL-LEN PIC S9(6) USAGE COMP.
EXEC SQL END DECLARE SECTION END-EXEC.
* Limit the size of a large object.
01 BLOB-MAX PIC S9(4) USAGE COMP IS EXTERNAL.
01 P PIC S9(6) USAGE COMP.
LINKAGE-SECTION.
01 BLOB-DATA PIC X(50).
PROCEDURE DIVISION USING BLOB-DATA.
BEGIN.
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
MOVE BLOB-MAX TO MAX-LEN.
MOVE 0 TO DATA-END.
MOVE 0 TO TOTAL-LEN.
PERFORM UNTIL DATA-END = 1
OR TOTAL-LEN NOT < BLOB-MAX
EXEC SQL GET DATA (:SEG-BUF = SEGMENT,
:SEG-LEN = SEGMENTLENGTH,
:DATA-END = DATAEND
WITH MAXLENGTH = :MAX-LEN
END-EXEC
ADD TOTAL-LEN 1 GIVING P
STRING SEG-BUG DELIMITED BY SIZE INTO BLOB-DATA WITH
POINTER P
ADD SEG-LEN TO TOTAL-LEN
END-PERFORM.
IF DATA-END = 0 THEN
EXEC SQL ENDDATA END-EXEC.
END PROGRAM UsrDataHdlr.
01 BLOB-MAX PIC S9(4) USAGE COMP IS EXTERNAL.
01 P PIC S9(6) USAGE COMP.
LINKAGE-SECTION.
01 BLOB-DATA PIC X(50).
PROCEDURE DIVISION USING BLOB-DATA.
BEGIN.
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
MOVE BLOB-MAX TO MAX-LEN.
MOVE 0 TO DATA-END.
MOVE 0 TO TOTAL-LEN.
PERFORM UNTIL DATA-END = 1
OR TOTAL-LEN NOT < BLOB-MAX
EXEC SQL GET DATA (:SEG-BUF = SEGMENT,
:SEG-LEN = SEGMENTLENGTH,
:DATA-END = DATAEND
WITH MAXLENGTH = :MAX-LEN
END-EXEC
ADD TOTAL-LEN 1 GIVING P
STRING SEG-BUG DELIMITED BY SIZE INTO BLOB-DATA WITH
POINTER P
ADD SEG-LEN TO TOTAL-LEN
END-PERFORM.
IF DATA-END = 0 THEN
EXEC SQL ENDDATA END-EXEC.
END PROGRAM UsrDataHdlr.
Last modified date: 01/30/2023