* * $Header: cbdem2.cob,v 1.3 1995/11/20 13:48:28 plocke Exp $ * $Header: /private1/RCS_27Nov/src.mig/./demo/RCS/cbdem2.cob,v 1.3 1995/11/20 13:48:28 plocke Exp $ * * Copyright (c) 1991 by Oracle Corporation * NAME * cbdem2.cob - Cobol demo program #2 * MODIFIED (MM/DD/YY) * plocke 11/14/95 - to update for v7.3 * dchatter 07/20/95 - merge changes from branch 1.1.720.1 * dchatter 04/14/95 - fix test to work on sun * sjain 03/16/92 - Creation * * The program CBDEM2 accepts SQL statements from the * user at run time and processes them. * If the statement was a Data Definition Language (DDL), * Data Control Language (DCL), or Data Manipulation * Language (DML) statement, it is parsed and executed, * and the next statement is retrieved. (Note that * performing the execute step for a DDL or DCL statement * is not necessary, but it does no harm, and simplifies * the program logic.) * If the statement was a query, the program describes * the select list, and defines output variables of the * appropriate type and size, depending on the internal * datatype of the select-list item. * Then, each row of the query is fetched, and the results * are displayed. * To keep the size of this example program to a * reasonable limit for this book, the following * restrictions are present: * (1) The SQL statement can contain only 25 elements (words * and punctuation), and must be entered on a single line. * There is no terminating ';'. * (2) A maximum of 8 bind (input) variables is permitted. * Additional input variables are not bound, which will * cause an error at execute time. Input values must be * enterable as character strings * (numeric or alphanumeric). * Placeholders for bind variables are :bv, * as for OBNDRV. * (3) A maximum of 8 select-list items per table are * described and defined. Additional columns are * not defined, which will cause unpredictable behavior * at fetch time. * (4) Not all internal datatypes are handled for queries. * Selecting a RAW or LONG column could cause problems. IDENTIFICATION DIVISION. PROGRAM-ID. CBDEM2. ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. * Logon, cursor, and host data areas. 01 LDA. 02 LDA-V2RC PIC S9(4) COMP. 02 FILLER PIC X(10). 02 LDA-RC PIC S9(4) COMP. 02 FILLER PIC X(50). 01 CDA. 02 C-V2RC PIC S9(4) COMP. 02 C-TYPE PIC S9(4) COMP. 02 C-ROWS PIC S9(9) COMP. 02 C-OFFS PIC S9(4) COMP. 02 C-FNC PIC S9(4) COMP. 02 C-RC PIC S9(4) COMP. 02 FILLER PIC X(50). 01 HDA PIC X(512). * Error message variables for the OERHMS routine. 01 MSGBUF PIC X(256). 01 MSGBUF-L PIC S9(9) VALUE 256 COMP. 01 ERR-FNC-D PIC ZZZ. * Connect info. Link the program single-task, or * modify to use a SQL*Net connect string appropriate * to your site. 01 USER-ID PIC X(5) VALUE "SCOTT". 01 USER-ID-L PIC S9(9) VALUE 5 COMP. 01 PSW PIC X(5) VALUE "TIGER". 01 PSW-L PIC S9(9) VALUE 5 COMP. 01 CONN PIC S9(9) VALUE 0 COMP. 01 CONN-L PIC S9(9) VALUE 0 COMP. 01 CONN-MODE PIC S9(9) VALUE 0 COMP. * Parameters for OPARSE. 01 SQL-STMT PIC X(132). 01 SQLL PIC S9(9) COMP. 01 DEF-MODE PIC S9(9) VALUE 1 COMP. 01 NO-DEF-MODE PIC S9(9) VALUE 0 COMP. 01 V7-FLG PIC S9(9) VALUE 2 COMP. * Parameters for OBNDRV. 01 BVNX. 03 BV-NAME OCCURS 25 TIMES. 05 BV-NAMEX OCCURS 10 TIMES PIC X. 01 BVVX. 03 BV-VAL OCCURS 10 TIMES PIC X(10). 01 BV-VAL-L PIC S9(9) VALUE 10 COMP. 01 N-BV PIC S9(9) COMP. * Parameters for ODESCR. Note: some are two bytes (S9(4)) * some are four bytes (S9(9)). 01 DBSIZEX. 03 DBSIZE OCCURS 8 TIMES PIC S9(9) COMP. 01 DBTYPEX. 03 DBTYPE OCCURS 8 TIMES PIC S9(4) COMP. 01 NAMEX. 03 DBNAME OCCURS 8 TIMES PIC X(10). 01 NAME-LX. 03 NAME-L OCCURS 8 TIMES PIC S9(9) COMP. 01 DSIZEX. 03 DSIZE OCCURS 8 TIMES PIC S9(9) COMP. 01 PRECX. 03 PREC OCCURS 8 TIMES PIC S9(4) COMP. 01 SCALEX. 03 SCALE OCCURS 8 TIMES PIC S9(4) COMP. 01 NULL-OKX. 03 NULL-OK OCCURS 8 TIMES PIC S9(4) COMP. * Parameters for ODEFIN. 01 OV-CHARX. 03 OV-CHAR OCCURS 8 TIMES PIC X(10). 01 OV-NUMX. 03 OV-NUM OCCURS 8 TIMES PIC S99999V99 COMP-3. 01 INDPX. 03 INDP OCCURS 8 TIMES PIC S9(4) COMP. 01 N-OV PIC S9(9) COMP. 01 N-ROWS PIC S9(9) COMP. 01 N-ROWS-D PIC ZZZ9 DISPLAY. 01 OV-CHAR-L PIC S9(9) VALUE 10 COMP. 01 SEVEN PIC S9(9) VALUE 7 COMP. 01 PACKED-DEC-L PIC S9(9) VALUE 4 COMP. 01 PACKED-DEC-T PIC S9(9) VALUE 7 COMP. 01 NUM-DISP PIC ZZZZZ.ZZ. 01 FMT PIC X(6) VALUE "08.+02". 01 FMT-L PIC S9(9) VALUE 6 COMP. 01 FMT-NONE PIC X(6). * Miscellaneous parameters. 01 ZERO-A PIC S9(9) VALUE 0 COMP. 01 ZERO-B PIC S9(9) VALUE 0 COMP. 01 ZERO-C PIC S9(4) VALUE 0 COMP. 01 ONE PIC S9(9) VALUE 1 COMP. 01 TWO PIC S9(9) VALUE 2 COMP. 01 FOUR PIC S9(9) VALUE 4 COMP. 01 INDX PIC S9(9) COMP. 01 NAME-D8 PIC X(8). 01 NAME-D10 PIC X(10). 01 VARCHAR2-T PIC S9(9) VALUE 1 COMP. 01 NUMBER-T PIC S9(9) VALUE 2 COMP. 01 INTEGER-T PIC S9(9) VALUE 3 COMP. 01 DATE-T PIC S9(9) VALUE 12 COMP. 01 CHAR-T PIC S9(9) VALUE 96 COMP. PROCEDURE DIVISION. BEGIN. * Connect to ORACLE in non-blocking mode. * HDA must be initialized to all zeros before call to OLOG. MOVE LOW-VALUES TO HDA. CALL "OLOG" USING LDA, HDA, USER-ID, USER-ID-L, PSW, PSW-L, CONN, CONN-L, CONN-MODE. * Check for error, perform error routine if required. IF LDA-RC NOT = 0 PERFORM ORA-ERROR GO TO EXIT-STOP. DISPLAY "Logged on to ORACLE as user " USER-ID ".". DISPLAY "Type EXIT at SQL prompt to quit." * Open a cursor. Only the first two parameters are * used, the remainder (for V2 compatibility) are ignored. CALL "OOPEN" USING CDA, LDA, USER-ID, ZERO-A, ZERO-A, USER-ID, ZERO-A. IF C-RC IN CDA NOT = 0 PERFORM ORA-ERROR GO TO EXIT-LOGOFF. * Process each SQL statement. STMT-LOOP. PERFORM DO-SQL-STMT. GO TO STMT-LOOP. EXIT-CLOSE. CALL "OCLOSE" USING CDA. EXIT-LOGOFF. CALL "OLOGOF" USING LDA. EXIT-STOP. STOP RUN. * Perform paragraphs. DO-SQL-STMT. MOVE " " TO SQL-STMT. DISPLAY " ". DISPLAY "SQL > " NO ADVANCING. ACCEPT SQL-STMT. * Get first word of statement. UNSTRING SQL-STMT DELIMITED BY ALL " " INTO BV-NAME(1). IF (BV-NAME(1) = "exit" OR BV-NAME(1) = "EXIT") GO TO EXIT-CLOSE. MOVE 132 TO SQLL. * Use non-deferred parse, to catch syntax errors * right after the parse. CALL "OPARSE" USING CDA, SQL-STMT, SQLL, NO-DEF-MODE, V7-FLG. IF C-RC IN CDA NOT = 0 PERFORM ORA-ERROR GO TO DO-SQL-STMT. PERFORM BIND-VARS. DISPLAY " ". MOVE N-BV TO ERR-FNC-D. DISPLAY "There were" ERR-FNC-D " bind variables.". * Execute the statement. CALL "OEXN" USING CDA, ONE, ZERO-B. IF C-RC IN CDA NOT = 0 PERFORM ORA-ERROR GO TO DO-SQL-STMT. * Describe the SQL statement, and define output * variables if it is a query. Limit output variables * to eight. PERFORM DESCRIBE-DEFINE THRU DESCRIBE-DEFINE-EXIT. SUBTRACT 1 FROM N-OV. IF (N-OV > 0) MOVE N-OV TO ERR-FNC-D DISPLAY "There were" ERR-FNC-D " define variables." DISPLAY " " PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > N-OV IF (DBTYPE(INDX) NOT = 2) MOVE DBNAME(INDX) TO NAME-D10 DISPLAY NAME-D10 NO ADVANCING ELSE MOVE DBNAME(INDX) TO NAME-D8 DISPLAY NAME-D8 NO ADVANCING END-IF DISPLAY " " NO ADVANCING END-PERFORM DISPLAY " " PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > N-OV DISPLAY "--------" NO ADVANCING IF DBTYPE(INDX) NOT = 2 DISPLAY "--" NO ADVANCING END-IF DISPLAY " " NO ADVANCING END-PERFORM DISPLAY " " END-IF. * If the statement was a query, fetch the rows and * display them. IF (C-TYPE IN CDA = 4) PERFORM FETCHN THRU FETCHN-EXIT MOVE N-ROWS TO N-ROWS-D DISPLAY " " DISPLAY N-ROWS-D " rows returned.". * End of DO-SQL-STMT. BIND-VARS. MOVE 0 TO N-BV. PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > 25 MOVE " " TO BV-NAME(INDX) END-PERFORM. UNSTRING SQL-STMT DELIMITED BY "(" OR "," OR ";" OR "=" OR ")" OR ALL " " INTO BV-NAME(1) BV-NAME(2) BV-NAME(3) BV-NAME(4) BV-NAME(5) BV-NAME(6) BV-NAME(7) BV-NAME(8) BV-NAME(9) BV-NAME(10) BV-NAME(11) BV-NAME(12) BV-NAME(13) BV-NAME(14) BV-NAME(15) BV-NAME(16) BV-NAME(17) BV-NAME(18) BV-NAME(19) BV-NAME(20) BV-NAME(21) BV-NAME(22) BV-NAME(23) BV-NAME(24) BV-NAME(25). * Scan the words in the SQL statement. If the * word begins with ':', it is a placeholder for * a bind variable. Get a value for it (as a string) * and bind using the OBNDRV routine, datatype 1. MOVE 0 TO INDP(1). PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > 25 IF BV-NAMEX(INDX,1) = ':' ADD 1 TO N-BV MOVE 0 TO SQLL INSPECT BV-NAME(INDX) TALLYING SQLL FOR CHARACTERS BEFORE INITIAL ' ' DISPLAY "Enter value for " BV-NAME(INDX) " --> " NO ADVANCING ACCEPT BV-VAL(N-BV) CALL "OBNDRV" USING CDA, BV-NAME(INDX), SQLL, BV-VAL(N-BV), BV-VAL-L, VARCHAR2-T, ZERO-A, INDP(1), FMT-NONE, ZERO-A, ZERO-A IF C-RC IN CDA NOT = 0 PERFORM ORA-ERROR GO TO EXIT-CLOSE ELSE DISPLAY "Bound " BV-VAL(N-BV) END-IF END-IF END-PERFORM. DESCRIBE-DEFINE. MOVE 0 TO N-OV. PERFORM 9 TIMES ADD 1 TO N-OV IF (N-OV > 8) GO TO DESCRIBE-DEFINE-EXIT END-IF MOVE 10 TO NAME-L(N-OV) MOVE " " TO DBNAME(N-OV) CALL "ODESCR" USING CDA, N-OV, DBSIZE(N-OV), DBTYPE(N-OV), DBNAME(N-OV), NAME-L(N-OV), DSIZE(N-OV), PREC(N-OV), SCALE(N-OV), NULL-OK(N-OV) * Check for end of select list. IF (C-RC IN CDA = 1007) GO TO DESCRIBE-DEFINE-EXIT END-IF * Check for error. IF (C-RC IN CDA NOT = 0) PERFORM ORA-ERROR GO TO DESCRIBE-DEFINE-EXIT END-IF * Define an output variable for the select-list item. * If it is a number, define a packed decimal variable, * and create a format string for it. IF (DBTYPE(N-OV) = 2) CALL "ODEFIN" USING CDA, N-OV, OV-NUM(N-OV), PACKED-DEC-L, PACKED-DEC-T, TWO, INDP(N-OV), FMT, FMT-L, PACKED-DEC-T, ZERO-C, ZERO-C ELSE * For all other types, convert to a VARCHAR2 of length 10. CALL "ODEFIN" USING CDA, N-OV, OV-CHAR(N-OV), OV-CHAR-L, VARCHAR2-T, ZERO-A, INDP(N-OV), FMT, ZERO-A, ZERO-A, ZERO-C, ZERO-C END-IF IF (C-RC IN CDA NOT = 0) PERFORM ORA-ERROR GO TO DESCRIBE-DEFINE-EXIT END-IF END-PERFORM. DESCRIBE-DEFINE-EXIT. FETCHN. MOVE 0 TO N-ROWS. PERFORM 10000 TIMES * Clear any existing values from storage buffers MOVE SPACES TO OV-CHARX MOVE LOW-VALUES TO OV-NUMX CALL "OFETCH" USING CDA * Check for end of fetch ("no data found") IF C-RC IN CDA = 1403 GO TO FETCHN-EXIT END-IF IF C-RC IN CDA NOT = 0 PERFORM ORA-ERROR GO TO FETCHN-EXIT END-IF ADD 1 TO N-ROWS PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > N-OV IF (DBTYPE(INDX) = 2) MOVE OV-NUM(INDX) TO NUM-DISP INSPECT NUM-DISP REPLACING ALL ".00" BY " " DISPLAY NUM-DISP NO ADVANCING ELSE DISPLAY OV-CHAR(INDX) NO ADVANCING END-IF DISPLAY " " NO ADVANCING END-PERFORM DISPLAY " " END-PERFORM. DISPLAY "LEAVING FETCHN...". FETCHN-EXIT. * Report an error. Obtain the error message * text using the OERHMS routine. ORA-ERROR. IF LDA-RC IN LDA NOT = 0 DISPLAY "OLOGON error" MOVE 0 TO C-FNC IN CDA MOVE LDA-RC IN LDA TO C-RC IN CDA. DISPLAY "ORACLE error " NO ADVANCING. IF C-FNC NOT = 0 DISPLAY "processing OCI function" NO ADVANCING MOVE C-FNC IN CDA TO ERR-FNC-D DISPLAY ERR-FNC-D ELSE DISPLAY ":". MOVE " " TO MSGBUF. CALL "OERHMS" USING LDA, C-RC IN CDA, MSGBUF,MSGBUF-L. DISPLAY MSGBUF.