Pro*COBOL Supplement to the Oracle Precompilers | ![]() Library |
![]() Product |
![]() Contents |
![]() Index |
Note: The precompiler option FORMAT specifies the format of COBOL input lines. If you specify FORMAT=ANSI (default), columns 1 through 6 can contain an optional sequence number, column 7 indicates comments or continuation lines, paragraph names begin in columns 8 through 11, and statements begin in columns 12 through 72.
If you specify FORMAT=TERMINAL, columns 1 through 6 are dropped, making column 7 the leftmost column. In this manual, program examples reflect the FORMAT=TERMINAL setting. The sample programs are in ANSI format.
EXEC SQL SELECT ENAME, JOB, SAL
INTO :EMP-NAME, :JOB-TITLE, :SALARY
FROM EMP
WHERE EMPNO = :EMP-NUMBER
END-EXEC.
In COBOL, you can use commas or blanks to separate list items. For example, the following two statements are equivalent:
ADD AMT1, AMT2, AMT3 TO TOTAL-AMT.
ADD AMT1 AMT2 AMT3 TO TOTAL-AMT.
The following example shows all three styles of comments:
EXEC SQL SELECT ENAME, SAL
* assign column values to output host variables
INTO :EMP-NAME, :SALARY -- output host variables
/* column values assigned to output host variables */
FROM EMP
WHERE DEPTNO = :DEPT-NUMBER
END-EXEC. -- illegal comment
However, you cannot nest comments or place them on the last line of a SQL statement after the terminator END-EXEC.
EXEC SQL SELECT ENAME, SAL INTO :EMP-NAME, :SALARY FROM EMP
WHERE DEPTNO = :DEPT-NUMBER
END-EXEC.
No continuation indicator is needed.
To continue a string literal from one line to the next, code the literal through column 72. On the next line, code a hyphen (-) in column 7, a quote in column 12 or beyond, and then the rest of the literal. An example follows:
WORKING STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 UPDATE-STATEMENT PIC X(80) VALUE "UPDATE EMP SET BON
- "US = 500 WHERE DEPTNO = 20".
EXEC SQL END DECLARE SECTION END-EXEC.
CALL "SQLROL" USING SQL-TMP0.
In SQL statements, you must use quotation marks to delimit identifiers containing special or lowercase characters, as in
EXEC SQL CREATE TABLE "Emp2" END-EXEC.
However, you must use apostrophes to delimit string constants, as in
EXEC SQL SELECT ENAME FROM EMP WHERE JOB = 'CLERK' END-EXEC.
Regardless of which delimiter is used in the Pro*COBOL source file, the precompiler generates the delimiter specified by the LITDELIM value.
EXEC SQL DELETE FROM EMP WHERE COMM = ZERO END-EXEC.
Instead, use the following:
EXEC SQL DELETE FROM EMP WHERE COMM = 0 END-EXEC.
MOVE "DELETE FROM EMP WHERE EMPNO = :EMP-NUMBER" TO SQLSTMT.
EXEC SQL PREPARE STMT1 FROM SQLSTMT END-EXEC.
For example, if your COBOL compiler cannot handle string literals longer than 132 characters, specify MAXLITERAL=132. Check your COBOL compiler user's guide.
LOAD-DATA.
EXEC SQL
INSERT INTO EMP (EMPNO, ENAME, DEPTNO)
VALUES (:EMP-NUMBER, :EMP-NAME, :DEPT-NUMBER)
END-EXEC.
Also, you can reference paragraph names in a WHENEVER ... DO or WHENEVER ... GOTO statement, as the next example shows:
PROCEDURE DIVISION.
MAIN.
EXEC SQL WHENEVER SQLERROR GOTO SQL-ERROR END-EXEC.
...
SQL-ERROR.
...
You must begin all paragraph names in columns 8 through 11.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 REC-ID PIC X(4).
01 REC-NUM REDEFINES REC-ID PIC S9(4) COMP.
EXEC SQL END DECLARE SECTION END-EXEC.
However, the next declaration is invalid:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 STOCK.
05 DIVIDEND PIC X(5).
05 PRICE PIC X(6).
01 BOND REDEFINES STOCK.
05 COUPON-RATE PIC X(4).
05 PRICE PIC X(7).
EXEC SQL END DECLARE SECTION END-EXEC.
SQL Operators | COBOL Operators |
= | =, EQUAL TO |
< >, !=, ^= | NOT=, NOT EQUAL TO |
> | >, GREATER THAN |
< | <, LESS THAN |
>= | >=, GREATER THAN OR EQUAL TO |
<= | <=, LESS THAN OR EQUAL TO |
IF EMP-NUMBER = ZERO
MOVE FALSE TO VALID-DATA
PERFORM GET-EMP-NUM UNTIL VALID-DATA = TRUE
ELSE
EXEC SQL DELETE FROM EMP
WHERE EMPNO = :EMP-NUMBER
END-EXEC
ADD 1 TO DELETE-TOTAL.
END-IF.
With COBOL-74, however, if you use WHENEVER ... GOTO or WHENEVER ... STOP to handle errors for a SQL statement, the SQL statement must be terminated by a period or followed by an ELSE.
The DELETE statement below is repositioned to meet this requirement:
EXEC SQL WHENEVER SQLERROR GOTO SQL-ERROR END-EXEC.
IF EMP-NUMBER = ZERO
MOVE FALSE TO VALID-DATA
PERFORM GET-EMP-NUM UNTIL VALID-DATA = TRUE
ELSE
ADD 1 TO DELETE-TOTAL
EXEC SQL DELETE FROM EMP
WHERE EMPNO = :EMP-NUMBER
END-EXEC.
Alternatively, you can place the SQL statement in a separate paragraph and PERFORM that paragraph.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
and ends with the statement
EXEC SQL END DECLARE SECTION END-EXEC.
Between these two statements only the following are allowed:
* Copy in the SQL Communications Area (SQLCA)
EXEC SQL INCLUDE SQLCA END-EXEC.
* Copy in the Oracle Communications Area (ORACA)
EXEC SQL INCLUDE ORACA END-EXEC.
You can INCLUDE any file. When you precompile your Pro*COBOL program, each EXEC SQL INCLUDE statement is replaced by a copy of the file named in the statement.
Do not confuse the SQL command INCLUDE with the COBOL COPY command. If a file contains embedded SQL, you must INCLUDE it because only INCLUDEd files are precompiled.
INCLUDE=path
where path defaults to the current directory.
The precompiler first searches the current directory, then the directory specified by the INCLUDE option, and finally the directory for standard INCLUDE files. You need not specify a path for standard files such as the SQLCA and ORACA. However, a path is required for nonstandard files unless they are stored in the current directory.
You can also specify multiple paths on the command line, as follows:
... INCLUDE=<path1> INCLUDE=<path2> ...
When multiple paths are specified, the precompiler searches the current directory first, then the path1 directory, then the path2 directory, and so on. The directory containing standard INCLUDE files is searched last. The path syntax is system specific. For more information, see your Oracle system-specific documentation.
Variable Declaration | Description |
PIC X...X PIC X(n) | fixed-length string of 1-byte characters (1) n-length string of 1-byte characters |
PIC X...X VARYING PIC X(n) VARYING | variable-length string of 1-byte characters (1,2) variable-length (n max.) string of 1-byte characters (2) |
PIC N...N PIC N(n) | fixed-length string of 2-byte NLS characters (1,3) n-length string of 2-byte NLS characters (3) |
PIC S9...9 BINARY PIC S9(n) BINARY | integer (4,5,7) |
PIC S9...9 COMP PIC S9(n) COMP | |
PIC S9...9 COMP-5 PIC S9(n) COMP-5 | byte-swapped integer (4,5,6,7) |
COMP-1 COMP-2 | floating-point number (4,5) |
PIC S9...9V9...9 COMP-3 PIC S9(n)V9(n) COMP-3 | packed decimal (4,5) integer (if precision, which is optional, is omitted) |
PIC S9...9V9...9 DISPLAY SIGN LEADING SEPARATE PIC S9(n)V9(n) DISPLAY SIGN LEADING SEPARATE | display |
SQL-CURSOR | cursor variable |
Notes:
Internal Type | COBOL Type | Description |
CHAR(x) (1) VARCHAR2(y) (1) | PIC [X...X|PIC N...N] | character string |
PIC [X(n)|PIC N(n)] | n-character string | |
PIC [X(n)|X(n)] VARYING | variable-length string | |
PIC S9...9 COMP PIC S9(n) COMP | integer | |
PIC S9...9 BINARY PIC S9(n) BINARY | integer | |
PIC S9...9 COMP-5 PIC S9(n) COMP-5 | integer | |
COMP-1 COMP-2 | floating point number | |
PIC S9...9V9...9 COMP-3 PIC S9(n)V9(n) COMP-3 | packed decimal or integer | |
NUMBER NUMBER (p,s) (2) | PIC S9...9 COMP PIC S9(n) COMP | integer |
PIC S9...9 BINARY PIC S9(n) BINARY | integer | |
PIC S9...9 COMP-5 PIC S9(n) COMP-5 | integer | |
COMP-1 COMP-2 | floating point number | |
PIC S9...9V9...9 COMP-3 PIC S9(n)V9(n) COMP-3 | packed decimal | |
PIC [X...X|PIC N...N] | character string (3) | |
PIC [X(n)|PIC N(n)] | n-character string (3) | |
PIC X...X VARYING | variable-length string | |
PICX(n) VARYING | n-byte variable-length string | |
DATE (4) LONG RAW (1) LONG RAW ROWID (5) MLSLABEL (6) | PIC X(n) PIC X...X VARYING | n-byte character string n-byte variable-length string |
DISPLAY | PIC S9...9V9...9 DISPLAY SIGN LEADING SEPARATE PIC S9(n)V9(n) DISPLAY SIGN LEADING SEPARATE | display |
CURSOR | SQL-CURSOR | cursor variable |
Notes:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 STR1 PIC X(3).
01 STR2 PIC X(3) VARYING.
01 NUM1 PIC S9(5) COMP.
01 NUM2 COMP-1.
01 NUM3 COMP-2.
EXEC SQL END DECLARE SECTION END-EXEC.
You can also declare one-dimensional tables of simple COBOL types, as the next example shows:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 XMP-TABLES.
05 TAB1 PIC XXX OCCURS 3 TIMES.
05 TAB2 PIC XXX VARYING OCCURS 3 TIMES.
05 TAB3 PIC S999 COMP-3 OCCURS 3 TIMES.
EXEC SQL END DECLARE SECTION END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 USERNAME PIC X(10) VALUE "SCOTT".
01 MAX-SALARY PIC S9(4) COMP VALUE 5000.
EXEC SQL END DECLARE SECTION END-EXEC.
If a string value assigned to a character variable is shorter than the declared length of the variable, the string is blank-padded on the right. If the string value assigned to a character variable is longer than the declared length, the string is truncated.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 ID-NUMBER PIC 9(4).
01 FIRST-NAME PIC A(10).
EXEC SQL END DECLARE SECTION END-EXEC.
Nor can you define edited data items in the Declare Section. Therefore, the following declarations are invalid:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 AMOUNT-OF-CHECK PIC ****9V99.
01 BIRTH-DATE PIC 99/99/99.
EXEC SQL END DECLARE SECTION END-EXEC.
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-NUMBER PIC S9(4) COMP VALUE ZERO.
01 EMP-NAME PIC X(10) VALUE SPACE.
01 SALARY PIC S9(5)V99 COMP-3.
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
DISPLAY "Employee number? " WITH NO ADVANCING.
ACCEPT EMP-NUMBER.
EXEC SQL SELECT ENAME, SAL
INTO :EMP-NAME, :SALARY FROM EMP
WHERE EMPNO = :EMP-NUMBER
END-EXEC.
COMPUTE BONUS = SALARY / 10.
...
Though it might be confusing, you can give a host variable the same name as an Oracle table or column, as the following example shows:
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMPNO PIC S9(4) COMP VALUE ZERO.
01 ENAME PIC X(10) VALUE SPACE.
01 COMM PIC S9(5)V99 COMP-3.
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
EXEC SQL SELECT ENAME, COMM
INTO :ENAME, :COMM FROM EMP
WHERE EMPNO = :EMPNO
END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 DEPARTURE.
05 HOUR PIC X(2).
05 MINUTE PIC X(2).
EXEC SQL END DECLARE SECTION END-EXEC.
the following statement is invalid:
EXEC SQL SELECT DHOUR, DMINUTE
INTO :DEPARTURE FROM SCHEDULE
WHERE ...
END-EXEC.
However, the following statement is valid:
EXEC SQL SELECT DHOUR, DMINUTE
INTO :HOUR, :MINUTE FROM SCHEDULE
WHERE ...
END-EXEC.
Elementary names need not be unique because you can qualify them using the following syntax:
<group_item>.<elementary_item>
This naming convention is allowed only in SQL statements. It is similar to the IN (or OF) clause in COBOL, examples of which follow:
MOVE MINUTE IN DEPARTURE TO MINUTE-OUT.
DISPLAY HOUR OF DEPARTURE.
The COBOL IN (or OF) clause is not allowed in SQL statements. Qualify elementary names to avoid ambiguity. For example, given the following declarations:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 DEPARTURE.
05 HOUR PIC X(2).
05 MINUTE PIC X(2).
01 ARRIVAL.
05 HOUR PIC X(2).
05 MINUTE PIC X(2).
EXEC SQL END DECLARE SECTION END-EXEC.
you must qualify HOUR and MINUTE, as in
EXEC SQL SELECT AHOUR, AMINUTE
INTO :ARRIVAL.HOUR, :ARRIVAL.MINUTE
FROM SCHEDULE
WHERE ...
This works for items nested deeper than two levels, provided you fully qualify them starting at the highest level -- even if that would be unnecessary in COBOL. For example, given the declarations
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 TIMETABLE.
05 DEPARTURE.
10 HOUR PIC X(2).
10 MINUTE PIC X(2).
05 ARRIVAL.
10 HOUR PIC X(2).
10 MINUTE PIC X(2).
EXEC SQL END DECLARE SECTION END-EXEC.
you must fully qualify HOUR and MINUTE, as in
EXEC SQL SELECT AHOUR, AMINUTE
INTO :TIMETABLE.ARRIVAL.HOUR, :TIMETABLE.ARRIVAL.MINUTE
FROM SCHEDULE
WHERE ...
END-EXEC.
even though in COBOL, the following would suffice:
DISPLAY HOUR OF ARRIVAL, ":", MINUTE OF ARRIVAL.
You use indicator variables in the VALUES or SET clause to assign nulls to input host variables and in the INTO clause to detect nulls or truncated values in output host variables.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-NAME PIC X(10) VALUE SPACE.
01 COMMISSION PIC S9(5)V99 COMP-3.
01 COMM-IND PIC S9(4) COMP.
EXEC SQL END DECLARE SECTION END-EXEC.
You can define an indicator variable anywhere in the Declare Section. It need not follow its associated host variable.
EXEC SQL SELECT SAL, COMM
INTO :SALARY, :COMMISSION:COMM-IND FROM EMP
WHERE EMPNO = :EMP-NUMBER
END-EXEC.
IF COMM-IND = -1
COMPUTE PAY = SALARY
ELSE
COMPUTE PAY = SALARY + COMMISSION.
To improve readability, you can precede any indicator variable with the optional keyword INDICATOR. You must still prefix the indicator variable with a colon. The correct syntax is
:<host_variable> INDICATOR :<indicator_variable>
and is equivalent to
:<host_variable>:<indicator_variable>
You can use both forms of expression in your host program.
* Set indicator variable.
COMM-IND = -1
EXEC SQL
DELETE FROM EMP WHERE COMM = :COMMISSION:COMM-IND
END-EXEC.
The correct syntax follows:
EXEC SQL
DELETE FROM EMP WHERE COMM IS NULL
END-EXEC.
ORA-01405: fetched column value is NULL
When precompiling with MODE=ORACLE and DBMS=V7 specified, you can disable the ORA-01405 message by also specifying UNSAFE_NULL=YES on the command line. For more information, see the Programmer's Guide to the Oracle Precompilers.
ORA-01406: fetched column value was truncated
However, when MODE={ANSI|ANSI14|ANSI13}, no error is generated. Values for indicator variables are discussed in Chapter 3 of the Programmer's Guide to the Oracle Precompilers.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-TABLES.
05 EMP-NUMBER OCCURS 50 TIMES PIC S9(4) COMP.
05 EMP-NAME OCCURS 50 TIMES PIC X(10.
05 SALARY OCCURS 50 TIMES PIC S9(5)V99 COMP-3.
EXEC SQL END DECLARE SECTION END-EXEC.
You can use the INDEXED BY phrase in the OCCURS clause to specify an index, as the next example shows:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-TABLES.
05 EMP-NUMBER PIC X(10) OCCURS 50 TIMES
INDEXED BY EMP-INDX.
...
EXEC SQL END DECLARE SECTION END-EXEC.
The INDEXED BY phrase implicitly declares the index item EMP-INDX.
EXEC SQL BEGIN DECLARE SECTION END-EXEC. 01 NATION. 05 STATE OCCURS 50 TIMES. 10 STATE-NAME PIC X(25). 10 COUNTY OCCURS 25 TIMES. 15 COUNTY-NAME PIX X(25). EXEC SQL END DECLARE SECTION END-EXEC.
Variable-length host tables are not allowed either. For example, the following declaration of EMP-REC is invalid:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-FILE.
05 REC-COUNT PIC S9(3) COMP.
05 EMP-REC OCCURS 0 TO 250 TIMES
DEPENDING ON REC-COUNT.
EXEC SQL END DECLARE SECTION END-EXEC.
WORKING-STORAGE SECTION.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-TABLES.
05 EMP-NUMBER PIC S9(4) COMP OCCURS 50 TIMES.
05 EMP-NAME PIC X(10) OCCURS 50 TIMES.
05 DEPT-NUMBER PIC S9(4) COMP OCCURS 25 TIMES.
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
* Populate host tables here.
...
EXEC SQL INSERT INTO EMP (EMPNO, ENAME, DEPTNO)
VALUES (:EMP-NUMBER, :EMP-NAME, :DEPT-NUMBER)
END-EXEC.
Host tables must not be subscripted in SQL statements. For example, the following INSERT statement is invalid:
WORKING-STORAGE SECTION.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-TABLES.
05 EMP-NUMBER PIC S9(4) COMP OCCURS 50 TIMES.
05 EMP-NAME PIC X(10) OCCURS 50 TIMES.
05 DEPT-NUMBER PIC S9(4) COMP OCCURS 50 TIMES.
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
PERFORM LOAD-EMP VARYING J FROM 1 BY 1 UNTIL J > 50.
...
LOAD-EMP.
EXEC SQL INSERT INTO EMP (EMPNO, ENAME, DEPTNO)
VALUES (:EMP-NUMBER(J), :EMP-NAME(J),
:DEPT-NUMBER(J))
END-EXEC.
You need not process host tables in a PERFORM VARYING statement. Instead, use the unsubscripted table names in your SQL statement. Oracle treats a SQL statement containing host tables of dimension n like the same statement executed n times with n different scalar host variables. For more information, see Chapter 8 of the Programmer's Guide to the Oracle Precompilers.
WORKING-STORAGE SECTION.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-TABLES.
05 EMP-NUMBER PIC S9(4) COMP OCCURS 50 TIMES.
05 DEPT-NUMBER PIC S9(4) COMP OCCURS 50 TIMES.
05 COMMISSION PIC S9(5)V99 COMP-3 OCCURS 50 TIMES.
05 COMM-IND PIC S9(4) COMP OCCURS 50 TIMES.
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
* Populate the host and indicator tables.
* Set indicator table to all zeros.
...
EXEC SQL INSERT INTO EMP (EMPNO, DEPTNO, COMM)
VALUES (:EMP-NUMBER, :DEPT-NUMBER,
:COMMISSION:COMM-IND)
END-EXEC.
The dimension of the indicator table must be greater than, or equal to, the dimension of the host table.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 ENAME PIC X(15) VARYING.
...
EXEC SQL END DECLARE SECTION END-EXEC.
The VARYING phrase in the preceding example is used in PERFORM and SEARCH statements to increment subscripts and indexes. Do not confuse this with the COBOL VARYING clause.
You can define a VARCHAR variable only in the Declare Section. Think of it as an extended COBOL datatype or predeclared group item. For example, the precompiler expands the VARCHAR declaration
01 ENAME PIC X(15) VARYING.
into a group item with length and string fields, as follows:
01 ENAME.
05 ENAME-LEN PIC S9(4) COMP.
05 ENAME-ARR PIC X(15).
The length field (suffixed with -LEN) holds the current length of the value stored in the string field (suffixed with -ARR). The maximum length in the VARCHAR host-variable declaration must be in the range of 1 to 65533 bytes.
Note: The keyword VARYING cannot be used when declaring multi-byte NLS character data.
The advantage of using VARCHAR variables is that you can explicitly set and reference the length field. With input host variables, Oracle reads the value of the length field and uses that many characters of the string field. With output host variables, Oracle sets the length value to the length of the character string stored in the string field.
01 DATA-NAME-1.
49 DATA-NAME-2 PIC S9(4) COMP.
49 DATA-NAME-3 PIC X(<length>).
For variable-length multi-byte NLS character types, use this structure (length expressed in double-byte characters):
01 DATA-NAME-1.
49 DATA-NAME-2 PIC S9(4) COMP.
49 DATA-NAME-3 PIC N(<length>).
The elementary items in these group-item structures must be declared as level 49 for the Pro*COBOL Precompiler to recognize them as VARCHAR host variables.
Note: Tables of multi-byte NLS VARCHAR variables are not supported.
For more information about the Pro*COBOL VARCHAR option, see Chapter 6 of the Programmer's Guide to the Oracle Precompilers.
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 PART-NUMBER PIC X(5).
01 PART-DESC PIC X(20) VARYING.
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
EXEC SQL
SELECT PDESC INTO :PART-DESC FROM PARTS
WHERE PNUM = :PART-NUMBER
END-EXEC.
After the query executes, PART-DESC-LEN holds the actual length of the character string retrieved from the database and stored in PART-DESC-ARR.
Remember, except for VARCHAR variables, you cannot reference group items in SQL statements.
In COBOL statements, you can reference VARCHAR variables using the group name or the elementary items, as this example shows:
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 EMP-TABLES.
05 EMP-NAME OCCURS 50 TIMES PIC X(15) VARYING.
...
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
PERFORM DISPLAY-NAME
VARYING J FROM 1 BY 1 UNTIL J > NAME-COUNT.
...
DISPLAY-NAME.
DISPLAY EMP-NAME-ARR OF EMP-NAME(J).
With respect to character handling, MODE={ANSI14|ANSI13} is equivalent to MODE=ORACLE. The MODE option affects character data on input (from host variables to Oracle) and on output (from Oracle to host variables).
Note: The MODE option does not affect how Pro*COBOL handles PIC X(n) VARYING variables.
When MODE=ANSI, trailing blanks are never stripped.
Make sure that the input value is not trailed by extraneous characters. For example, nulls are not stripped and are inserted into the database. Normally, this is not a problem because when a value is ACCEPTed or MOVEd into a PIC X(n) variable, COBOL appends blanks up to the length of the variable.
The following example illustrates the point:
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMPLOYEES.
05 EMP-NAME PIC X(10).
05 DEPT-NUMBER PIC S9(4) VALUE 20 COMP.
05 EMP-NUMBER PIC S9(9) VALUE 9999 COMP.
05 JOB-NAME PIC X(8).
...
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
DISPLAY "Employee name? " WITH NO ADVANCING.
ACCEPT EMP-NAME.
* Assume that the name MILLER was entered
* EMP-NAME contains "MILLER " (4 trailing blanks)
MOVE "SALES" TO JOB-NAME.
* JOB-NAME now contains "SALES " (3 trailing blanks)
EXEC SQL INSERT INTO EMP (EMPNO, ENAME, DEPTNO, JOB)
VALUES (:EMP-NUMBER, :EMP-NAME, :DEPT-NUMBER, :JOB-NAME
END-EXEC.
...
If you precompile the last example with MODE=ORACLE and the target database columns are VARCHAR2, the program interface strips the trailing blanks on input and inserts just the 6-character string "MILLER" and the 5-character string "SALES" into the database. However, if the target database columns are CHAR, the strings are blank-padded to the width of the columns.
If you precompile the last example with MODE=ANSI and the JOB column is defined as CHAR(10), the value inserted into that column is "SALES#####" (five trailing blanks). However, if the JOB column is defined as VARCHAR2(10), the value inserted is "SALES###" (three trailing blanks), because the host variable is declared as PIC X(8). This might not be what you want, so be careful.
Warning: Oracle7 SQL functions should not be used on columns or host variables that store multi-byte NLS data. Multi-byte NLS features are supported by the SQLLIB runtime library, but they are not supported by the Oracle7 Server.
To declare a multi-byte NLS character type in Pro*COBOL, use the following PICTURE clause:
WORKING-STORAGE SECTION.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 <nls_variable> PIC N(<length>).
...
EXEC SQL END DECLARE SECTION END-EXEC.
where nls_variable is a valid COBOL variable name and length is the maximum number of multi-byte NLS characters the string can hold.
The example in the "Single-Byte Character Variables" section (page 1 - 24) could be rewritten to accept double-byte NLS characters using the PIC N datatype shown in the following example:
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMPLOYEES.
05 EMP-NAME PIC N(10).
05 DEPT-NUMBER PIC S9(4) VALUE 20 COMP.
05 EMP-NUMBER PIC S9(9) VALUE 9999 COMP.
05 JOB-NAME PIC N(8).
EXEC SQL END DECLARE SECTION END-EXEC.
The EMP-NAME variable now accepts up to ten double-byte characters, while JOB-NAME accepts eight double-byte characters.
In the example for single-byte character data , the program fetches the string "MILLER" from the database. If using multi-byte NLS characters, EMP-NAME contains the value "MILLER" with each character allocated two bytes. The string is blank-padded with four double-byte spaces.
No Odd-Byte Widths. Oracle CHAR columns should not be used to store multi-byte NLS characters. A runtime error is generated if data with an odd number of bytes is FETCHed from a single-byte column into a multi-byte NLS (PIC N) host variable.
No Host Variable Equivalencing. Multi-byte NLS character variables cannot be equivalenced using an EXEC SQL VAR statement.
No Dynamic SQL. Dynamic SQL is not available for NLS multi-byte character string host variables in Pro*COBOL.
IF ENAME-IND = -1
MOVE "NOT AVAILABLE" TO ENAME-ARR
MOVE 13 TO ENAME-LEN.
You need not blank-pad the string variable. In SQL operations, Oracle uses exactly the number of characters given by the length field, counting any spaces.
Host input variables for multi-byte NLS data are not stripped of trailing double-byte spaces. The length component is assumed to be the length of the data in characters, not bytes.
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMPNO PIC S9(4) COMP.
01 ENAME PIC X(15) VARYING.
...
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
EXEC SQL
SELECT ENAME INTO :ENAME FROM EMP
WHERE EMPNO = :EMPNO
END-EXEC.
IF ENAME-LEN = 0
MOVE FALSE TO VALID-DATA.
An advantage of VARCHAR variables over fixed-length strings is that the length of the value returned by Oracle is available right away. With fixed-length strings, to get the length of the value, your program must count the number of characters.
Host output variables for multi-byte NLS data are not padded at all. The length of the buffer is set to the length in characters, not bytes.
These internal datatypes can be quite different from COBOL datatypes. For example, COBOL has no equivalent to the NUMBER datatype, which was specially designed for portability and high precision.
Name | Code | Description |
CHAR | 1 96 | <= 65535-byte, variable-length character string (1) <= 65535-byte, fixed-length character string (1) |
CHARF | 96 | <= 65535-byte, fixed-length character string |
CHARZ | 97 | <= 65535-byte, fixed-length, null-terminated string (2) |
DATE | 12 | 7-byte, fixed-length date/time value |
DECIMAL | 7 | COBOL packed decimal |
DISPLAY | 91 | COBOL numeric character string |
FLOAT | 4 | 4-byte or 8-byte floating-point number |
INTEGER | 3 | 2-byte or 4-byte signed integer |
LONG | 8 | <= 2147483647-byte, fixed-length string |
LONG RAW | 24 | <= 217483647-byte, fixed-length binary data |
LONG VARCHAR | 94 | <= 217483643-byte, variable-length string |
LONG VARRAW | 95 | <= 217483643-byte, variable-length binary data |
MLSLABEL | 106 | 2..5-byte, variable-length binary data |
NUMBER | 2 | integer or floating-point number |
RAW | 23 | <= 65535-byte, fixed-length binary data (2) |
ROWID | 11 | (typically) 13-byte, fixed-length binary value |
STRING | 5 | <= 65535-byte, null-terminated character string (2) |
UNSIGNED | 68 | 2-byte or 4-byte unsigned integer |
VARCHAR | 9 | <= 65533-byte, variable-length character string |
VARCHAR2 | 1 | <= 65535-byte, variable-length character string (2) |
VARNUM | 6 | variable-length binary number |
VARRAW | 15 | <= 65533-byte, variable-length binary data |
Notes:
Before assigning a SELECTed column value to an output host variable, Oracle must convert the internal datatype of the source column to the datatype of the host variable. Likewise, before assigning or comparing the value of an input host variable to a column, Oracle must convert the external datatype of the host variable to the internal datatype of the target column.
Conversions between internal and external datatypes follow the usual data conversion rules. For example, you can convert a CHAR value of "1234" to a PIC S9(4) COMP value. You cannot, however, convert a CHAR value of "65543" (number too large) or "10F" (number not decimal) to a PIC S9(4) COMP value. Likewise, you cannot convert a PIC X(n) value that contains alphabetic characters to a NUMBER value.
For more information about datatype conversion, see Chapter 3 of the Programmer's Guide to the Oracle Precompilers.
Attention: Multi-byte NLS character variables cannot be equivalenced using the EXEC SQL VAR statement.
With the VAR statement, you can override the default assignments by equivalencing host variables to Oracle external datatypes in the Declare Section. The syntax you use is
EXEC SQL
VAR <host_variable>
IS <ext_type_name> [({<length> | <precision>,<scale>})]
END-EXEC.
where host_variable is an input or output host variable (or host table) declared earlier in the Declare Section, ext_type_name is the name of a valid external datatype, and length is an integer literal specifying a valid length in bytes.
When ext_type_name is FLOAT, use length; when ext_type_name is DECIMAL, you must specify precision and scale instead of length.
Host variable equivalencing is useful in several ways. For example, you can use it when you want Oracle to store but not interpret data. Suppose you want to store a host table of 4-byte integers in a RAW database column. Simply equivalence the host table to the RAW external datatype, as follows:
WORKING-STORAGE SECTION.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-TABLES.
05 EMP-NUMBER PIC S9(9) COMP OCCURS 50 TIMES.
...
* Reset default datatype (INTEGER) to RAW.
EXEC SQL VAR EMP-NUMBER IS RAW (200) END-EXEC.
EXEC SQL END DECLARE SECTION END-EXEC.
With host tables, the length you specify must match the buffer size required to hold the table. In the last example, you specified a length of 200, which is the buffer size needed to hold 50 4-byte integers.
To embed a PL/SQL block in your host program, declare the variables to be shared with PL/SQL and bracket the PL/SQL block with the EXEC SQL EXECUTE and END-EXEC keywords.
The advantages of cursor variables are
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 CUR-VAR SQL-CURSOR.
...
EXEC SQL END DECLARE SECTION END-EXEC.
A SQL-CURSOR variable is implemented as a COBOL group item in the code that Pro*COBOL generates. A cursor variable is just like any other Pro*COBOL host variable.
EXEC SQL
ALLOCATE :CUR-VAR
END-EXEC.
Allocating a cursor variable does not require a call to the server, either at precompile time or at run time.
Warning: Allocating a cursor variable does cause heap memory to be used. For this reason, avoid allocating a cursor variable in a program loop.
CREATE PACKAGE demo_cur_pkg AS
TYPE EmpName IS RECORD (name VARCHAR2(10));
TYPE cur_type IS REF CURSOR RETURN EmpName;
PROCEDURE open_emp_cur (
curs IN OUT curtype,
dept_num IN number);
END;
CREATE PACKAGE BODY demo_cur_pkg AS
CREATE PROCEDURE open_emp_cur (
curs IN OUT curtype,
dept_num IN number) IS
BEGIN
OPEN curs FOR
SELECT ename FROM emp
WHERE deptno = dept_num
ORDER BY ename ASC;
END;
END;
After this package has been stored, you can open the cursor curs by calling the open_emp_cur stored procedure from your Pro*COBOL program, and FETCH from the cursor variable EMP-CURSOR in the program. For example:
WORKING-STORAGE SECTION.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 EMP-CURSOR SQL-CURSOR.
01 DEPT-NUM PIC S9(4).
01 EMP-NAME PIC X(10) VARYING.
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
* Allocate the cursor variable.
EXEC SQL
ALLOCATE :EMP-CURSOR
END-EXEC.
...
MOVE 30 TO DEPT_NUM.
* Open the cursor on the Oracle Server.
EXEC SQL EXECUTE
BEGIN
demo_cur_pkg.open_emp_cur(:EMP-CURSOR, :DEPT-NUM);
END;
END-EXEC.
EXEC SQL
WHENEVER NOT FOUND DO PERFROM SIGN-OFF
END-EXEC.
FETCH-LOOP.
EXEC SQL
FETCH :EMP-CURSOR INTO :EMP-NAME
END-EXEC.
DISPLAY "Employee Name: ",:EMP-NAME.
GO TO FETCH-LOOP.
...
PROCEDURE DIVISION. ... EXEC SQL EXECUTE BEGIN OPEN :EMP-CURSOR FOR SELECT ENAME FROM EMP WHERE DEPTNO = :DEPT-NUM; END; END-EXEC. ...
EXEC SQL
FETCH :EMP-CURSOR INTO :EMP-INFO:EMP-INFO-IND
END-EXEC.
Before you can FETCH from a cursor variable, the variable must be initialized and opened. You cannot FETCH from an unopened cursor variable.
WORKING-STORAGE SECTION. EXEC SQL BEGIN DECLARE SECTION END-EXEC. * Declare the cursor variable. 01 CUR-VAR SQL-CURSOR. ... EXEC SQL END DECLARE SECTION END-EXEC. PROCEDURE DIVISION. * Allocate and open the cursor variable, then * Fetch one or more rows. ... * Close the cursor variable. EXEC SQL CLOSE :CUR-VAR END-EXEC.
CONNECT SCOTT/TIGER CREATE OR REPLACE PACKAGE emp_demo_pkg AS TYPE emp_cur_type IS REF CURSOR RETURN emp%ROWTYPE; PROCEDURE open_cur ( cursor IN OUT emp_cur_type, dept_num IN number); END emp_demo_pkg; / CREATE OR REPLACE PACKAGE BODY emp_demo_pkg AS PROCEDURE open_cur ( cursor IN OUT emp_cur_type, dept_num IN number) IS BEGIN OPEN cursor FOR SELECT * FROM emp WHERE deptno = dept_num ORDER BY ename ASC; END; END emp_demo_pkg; /
IDENTIFICATION DIVISION. PROGRAM-ID. CURSOR-VARIABLES. ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. EXEC ORACLE OPTION (SQLCHECK=FULL) END-EXEC. EXEC SQL BEGIN DECLARE SECTION END-EXEC. 01 USERNAME PIC X(15) VARYING. 01 PASSWD PIC X(15) VARYING. 01 HOST PIC X(15) VARYING. * Declare the cursor variable. 01 EMP-CUR SQL-CURSOR. 01 EMP-INFO. 05 EMP-NUM PIC S9(4) COMP. 05 EMP-NAM PIC X(10) VARYING. 05 EMP-JOB PIC X(10) VARYING. 05 EMP-MGR PIC S9(4) COMP. 05 EMP-DAT PIC X(10) VARYING. 05 EMP-SAL PIC S9(6)V99 DISPLAY SIGN LEADING SEPARATE. 05 EMP-COM PIC S9(6)V99 DISPLAY SIGN LEADING SEPARATE. 05 EMP-DEP PIC S9(4) COMP. 01 EMP-INFO-IND. 05 EMP-NUM-IND PIC S9(2) COMP. 05 EMP-NAM-IND PIC S9(2) COMP. 05 EMP-JOB-IND PIC S9(2) COMP. 05 EMP-MGR-IND PIC S9(2) COMP. 05 EMP-DAT-IND PIC S9(2) COMP. 05 EMP-SAL-IND PIC S9(2) COMP. 05 EMP-COM-IND PIC S9(2) COMP. 05 EMP-DEP-IND PIC S9(2) COMP. EXEC SQL END DECLARE SECTION END-EXEC. EXEC SQL INCLUDE SQLCA END-EXEC. 01 DISPLAY-VARIABLES. 05 D-DEP-NUM PIC Z(3)9. 05 D-EMP-NAM PIC X(10). 05 D-EMP-SAL PIC Z(4)9.99. 05 D-EMP-COM PIC Z(4)9.99.
PROCEDURE DIVISION. BEGIN-PGM. EXEC SQL WHENEVER SQLERROR DO PERFORM SQL-ERROR END-EXEC. PERFORM LOGON. * Initialize the cursor variable. EXEC SQL ALLOCATE :EMP-CUR END-EXEC. DISPLAY "Enter department number (0 to exit): " WITH NO ADVANCING. ACCEPT EMP-DEP. IF EMP-DEP <= 0 PERFORM SIGN-OFF END-IF. MOVE EMP-DEP TO D-DEP-NUM. * Open the cursor by calling a PL/SQL stored procedure. EXEC SQL EXECUTE BEGIN emp_demo_pkg.open_cur(:EMP-CUR, :EMP-DEP); END; END-EXEC. DISPLAY " ". DISPLAY "For department ", D-DEP-NUM, ":". DISPLAY " ". DISPLAY "EMPLOYEE SALARY COMMISSION". DISPLAY "---------- ---------- ----------". FETCH-LOOP. EXEC SQL WHENEVER NOT FOUND DO PERFORM SIGN-OFF END-EXEC. MOVE SPACES TO EMP-NAM-ARR. * Fetch data from the cursor into the host variables. EXEC SQL FETCH :EMP-CUR INTO :EMP-NUM:EMP-NUM-IND, :EMP-NAM:EMP-NAM-IND, :EMP-JOB:EMP-JOB-IND, :EMP-MGR:EMP-MGR-IND, :EMP-DAT:EMP-DAT-IND, :EMP-SAL:EMP-SAL-IND, :EMP-COM:EMP-COM-IND, :EMP-DEP:EMP-DEP-IND END-EXEC. MOVE EMP-SAL TO D-EMP-SAL. MOVE EMP-COM TO D-EMP-COM.
* Check for commission and print results. IF EMP-COM-IND = 0 DISPLAY EMP-NAM-ARR, " ", D-EMP-SAL, " ", D-EMP-COM ELSE DISPLAY EMP-NAM-ARR, " ", D-EMP-SAL, " N/A" END-IF. GO TO FETCH-LOOP. LOGON. MOVE "SCOTT" TO USERNAME-ARR. MOVE 5 TO USERNAME-LEN. MOVE "TIGER" TO PASSWD-ARR. MOVE 5 TO PASSWD-LEN. MOVE "INST1_ALIAS" TO HOST-ARR. MOVE 11 TO HOST-LEN. EXEC SQL CONNECT :USERNAME IDENTIFIED BY :PASSWD END-EXEC. DISPLAY " ". DISPLAY "CONNECTED TO ORACLE AS USER: ", USERNAME-ARR. SIGN-OFF. * Close the cursor variable. EXEC SQL CLOSE :EMP-CUR END-EXEC. DISPLAY " ". DISPLAY "HAVE A GOOD DAY.". DISPLAY " ". EXEC SQL COMMIT WORK RELEASE END-EXEC. STOP RUN. SQL-ERROR. EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC. DISPLAY " ". DISPLAY "ORACLE ERROR DETECTED:". DISPLAY " ". DISPLAY SQLERRMC. EXEC SQL ROLLBACK WORK RELEASE END-EXEC. STOP RUN.
EXEC SQL CONNECT :USERNAME IDENTIFIED BY :PASSWD END-EXEC.
where USERNAME and PASSWD are PIC X(n) or PIC X(n) VARYING host variables. Alternatively, you can use the statement
EXEC SQL CONNECT :USR-PWD END-EXEC.
where the host variable USR-PWD contains your username and password separated by a slash (/).
The CONNECT statement must be the first SQL statement executed by the program. That is, other executable SQL statements can positionally, but not logically, precede the CONNECT statement.
To supply the Oracle username and password separately, you define two host variables in the Declare Section as character strings or VARCHAR variables. If you supply a userid containing both username and password, only one host variable is needed.
Make sure to set the username and password variables before the CONNECT is executed or it will fail. Your program can prompt for the values or you can hardcode them, as follows:
WORKING STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 USERNAME PIC X(10) VARYING.
01 PASSWD PIC X(10) VARYING.
...
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
LOGON.
MOVE "SCOTT" TO USERNAME-ARR.
MOVE 5 TO USERNAME-LEN.
MOVE "TIGER" TO PASSWD-ARR.
MOVE 5 TO PASSWD-LEN.
EXEC SQL WHENEVER SQLERROR GOTO LOGON-ERROR END-EXEC.
EXEC SQL
CONNECT :USERNAME IDENTIFIED BY :PASSWD
END-EXEC.
However, you cannot hardcode a username and password into the CONNECT statement or use quoted literals. For example, the following statements are invalid:
EXEC SQL
CONNECT SCOTT IDENTIFIED BY TIGER
END-EXEC.
EXEC SQL
CONNECT "SCOTT" IDENTIFIED BY "TIGER"
END-EXEC.
<prefix><username>
where prefix is the value of the Oracle initialization parameter OS_AUTHENT_PREFIX (the default value is OPS$) and username is your operating system user or task name. For example, if the prefix is OPS$, your user name is TBARNES, and OPS$TBARNES is a valid Oracle userid, you log on to Oracle as user OPS$TBARNES.
Consider the following example:
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 ORACLE-ID PIC X(1) VALUE "/".
...
EXEC SQL END DECLARE SECTION END-EXEC.
PROCEDURE DIVISION.
...
EXEC SQL
CONNECT :ORACLE-ID
END-EXEC.
...
This automatically connects you as user OPS$username. For example, if your operating system username is RHILL, and OPS$RHILL is a valid Oracle username, connecting with a slash (/) automatically logs you on to Oracle as user OPS$RHILL.
You can also pass a character string to the precompiler. However, the string cannot contain trailing blanks. For example, the following CONNECT statement will fail:
WORKING-STORAGE SECTION.
...
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
...
01 ORACLE-ID PIC X(5) VALUE "/ ".
EXEC SQL END DECLARE SECTION END-EXEC.
PROCEDURE DIVISION.
EXEC SQL
CONNECT :ORACLE-ID
END-EXEC.
...
For more information about operating system authentication, see the Oracle7 Server Administrator's Guide.
WORKING-STORAGE SECTION.
...
* Declare needed host variables.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 USERNAME PIC X(5) VALUE "SCOTT".
01 PASSWD PIC X(5) VALUE "TIGER".
01 DB-STRING1 PIC X(12) VALUE "NEWYORK".
01 DB-STRING2 PIC X(12) VALUE "BOSTON".
EXEC SQL END DECLARE SECTION END-EXEC.
...
PROCEDURE DIVISION.
...
* Give each database connection a unique name.
EXEC SQL DECLARE DB-NAME1 DATABASE END-EXEC.
EXEC SQL DECLARE DB-NAME2 DATABASE END-EXEC.
* Connect to the two non-default databases.
EXEC SQL
CONNECT :USERNAME IDENTIFIED BY :PASSWD
AT DB-NAME1 USING :DB-STRING1
END-EXEC.
EXEC SQL
CONNECT :USERNAME IDENTIFIED BY :PASSWD
AT DB-NAME2 USING :DB-STRING2
END-EXEC.
The string syntax in DB-STRING1 and DB-STRING2 depends on your network driver and how it is configured. DB-NAME1 and DB-NAME2 name the non-default connections; they can be undeclared identifiers or host variables.
For step-by-step instructions on connecting to Oracle via SQL*Net, see Chapter 3 in the Programmer's Guide to the Oracle Precompilers.
![]() ![]() Prev Next |
![]() Copyright © 1997 Oracle Corporation. All Rights Reserved. |
![]() Library |
![]() Product |
![]() Contents |
![]() Index |