Copyright © TIBCO Software Inc. All Rights Reserved
Copyright © TIBCO Software Inc. All Rights Reserved


Chapter 22 Coding SQL Access Statements : Writing a COBOL Program with Embedded SQL Statements

Writing a COBOL Program with Embedded SQL Statements
TIBCO Object Service Broker tables can be accessed from your COBOL programs if you have coded SQL statements within them. These statements are converted to valid COBOL statements by the TIBCO Object Service Broker preprocessor. The COBOL programs participate with TIBCO Object Service Broker as a client as opposed to a server as outlined in this manual.
Sample COBOL Program
The following sample COBOL program contains embedded SQL statements. The following conventions are used:

 
 
CBL MAP,RENT,NOSEQUENCE,TEST(SYM),THREAD,VBREF,OFFSET
IDENTIFICATION DIVISION.
 
PROGRAM-ID. COBSQL RECURSIVE.
AUTHOR. JANE SMITH.
INSTALLATION. TIBCO Software Inc.
DATE-COMPILED.
*****************************************************************
*
* Demonstration of HLI Preprocessor *
* A COBOL program with SQL statements to access Object Service *
* Broker tables a in TSO or batch Object Service Broker session.*
* *
* To execute this Cobol program, you must make an entry in the *
* Object Service Broker ROUTINES table such as: *
* NAME :COBSQL *
* LANGUAGE :LEPERSIST *
* FUNCTION :N *
* LOADNAME :COBSQL *
* *
* *
* Invoke the program via a RULE call: *
* CALL 'COBSQL'; *
* *
* The program uses the table #ED_EMPLOYEES as its data source. *
* *
*****************************************************************
ENVIRONMENT DIVISION.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
* set the NODENAME for table LOCATION parameter
77 LOCATION77 PIC X(16) VALUE 'A'.
*
* Variables in this section remain in their last state for
* every invokation of this subroutine within a run-unit /
* enclave.
*
* Include Statement.
Exec Sql
Include Sqlca
End-Exec
* Define table and fields of EMPLOYEE
Exec Sql
Define Employee Table = #ED_EMPLOYEES
Parameter USER-ID = USERID,
LOCATION77 = LOCATION
Field mgrno = MGR#,
state-prov = PROV,
zipcode = P_CODE
End-Exec
Exec Sql
Declare Cursa Cursor For
Select EMPNO, LNAME, MGR#
From #ED_EMPLOYEES('EDUC',LOCATION77) where
MGR#= 84021
End-Exec
* Data areas to receive data from Object Service Broker
01 COB-EMPNO PIC 9(7).
01 LAST-NAME PIC X(22).
01 MANAGER PIC 9(7).
*
LOCAL-STORAGE SECTION.
*
* Variables in this section are initialized at each invokation.
*
LINKAGE SECTION.
*
* Variables in this section are passed from/to caller on each
* invokation. Use ARGUMENTS table to define parameters to pass
* and the "PROCEDURE DIVISION USING parm1, parm2" etc to pass
* entries to the external routine as necessary. Each parameter
* should be a LINKAGE SECTION 01 entry.
*
PROCEDURE DIVISION.
MAINLINE-CODE SECTION.
DISPLAY 'ENTERED COBSQL COBOL PROGRAM'.
* Open cursor
DISPLAY 'ABOUT TO OPEN CURSOR'.
Exec Sql
Open Cursa
End-Exec
DISPLAY 'CURSOR OPENED'.
* Check for error on cursor open
DISPLAY 'SQLCODE=', SQLCODE.
* Put Object Service Broker values in data areas
Exec Sql
Fetch Cursa into :cob-EMPNO, :last-name, :manager
End-Exec
* Check for error on fetch
DISPLAY 'SQLCODE=', SQLCODE.
* Display contents of two of the data areas
DISPLAY 'RESULT OF FETCH ', COB-EMPNO, ' ', LAST-NAME.
* Close cursor
Exec Sql
Close Cursa
End-Exec
* Check for error on cursor close
DISPLAY 'SQLCODE=', SQLCODE.
NORMAL-EXIT-HERE.
DISPLAY 'ABOUT TO EXIT COBSQL COBOL PROGRAM'.
GOBACK.

 
Sample TIBCO Object Service Broker Table Definition
The following definition is of the table EMPLOYEE. This is the TIBCO Object Service Broker table used by the COBOL program with embedded SQL statements. (Only the first 80 columns are shown.)
Partial Definition of the EMPLOYEE Table

 
COMMAND==> TABLE DEFINITION
Table: #ED_EMPLOYEES Type: TDS Unit: EDUC IDgen: N
Parameter Name Typ Syn Len Dec Class ' Event Rule Typ Acc
---------------- - - --- -- - ' ---------------- - -
_ USERID I C 16 0 D ' _
_ LOCATION I C 16 0 L ' _
Field Name Typ Syn Len Dec Key Ord Rqd Default Reference
---------------- - - ---- -- - - - ---------------- --------------
_ EMPNO I P 3 0 P
_ LNAME S C 22 0
_ POSITION S C 14 0
_ MGR# I P 3 0 MANAGER
_ DEPTNO I B 2 0
_ SALARY Q P 3 2
_ HIREDATE D B 4 0
_ ADDRESS S V 38 0
_ CITY S C 20 0
_ PROV S C 3 0
_ P_CODE S C 7 0
_
_
PFKEYS: 3=END 12=CANCEL 22=DELETE 13=PRINT 14=FIELDS 21=DATA 2=DOC

 

Copyright © TIBCO Software Inc. All Rights Reserved
Copyright © TIBCO Software Inc. All Rights Reserved