PeopleSoft SQL API for Batch COBOL

This topic discusses:

  • PeopleSoft SQL API for batch COBOL.

  • Interface.

  • Setup list.

  • Data list.

  • SQL restrictions/limitations.

  • Interface data.

  • Dynamic SQL interface.

The purpose of PeopleSoft SQL API is to enable PeopleSoft batch COBOL programs to run SQL commands and control the SQL environment.

Features

These are the features:

  • Predefined SQL statements are stored outside of the COBOL program and are identified by name.

  • SQL statements are executed dynamically.

  • Multiple (up to 254) SQL cursors are available.

  • The SQL interface is invoked from the application COBOL program from CALL with parameters.

  • Support is provided for SQL statements built dynamically by COBOL programs.

Functions

These are the functions:

  • Process Select Statement.

  • Fetch Row.

  • Process Update Statement: DELETE, INSERT, and UPDATE.

  • Commit Run Unit.

  • Clear Common Statement (after program CANCEL).

  • Disconnect Cursor.

  • Disconnect All Cursors.

  • Process Fatal Application Error.

SQL API services are provided through CALLs to program PTPSQLRT, which provides a consistent application interface for COBOL programs running on a variety of database platforms. The call has this general form:

CALL 'PTPSQLRT' USING action,
  sqlrt,
  cursor,
  statement,
  bind-setup,
  bind-data,
  select-setup,
  select-data

The actual list of parameters that are needed depends on the action requested. For example, a SELECT statement requires all of the previous parameters, while a FETCH action requires only the first three. Only the first two parameters are required in every case.

The following table identifies the parameters, the order coded, and the functions for which they are required:

Parm #

CALL Parameter

Required for Actions

1.

Action

All

2.

SQLRT

All

3.

Cursor

Select, Fetch, Update, Commit, & Disconnect

4.

Statement

Select & Update

5.

Bind-setup

Select & Update

6.

Bind-data

Select & Update

7.

Select-setup

Select

8.

Select-data

Select

Communication Area

To use the SQL interface, copy PTCSQLRT into the WORKING-STORAGE topic of the main program and pass this 01-level data to all subprograms using the SQL interface. This member defines data needed by the SQL interface and supports communication between the SQL interface and the application program.

The following is a list of parameter descriptions.

1. Action

This is a one-character code representing one of the eight functions supported. Use one of the data names with pattern "ACTION-" from copy member PTCSQLRT.

Example

ACTION-SELECT OF SQLRT

These are the actions provided:

Action Name

Service Provided

ACTION-SELECT

Process a SELECT statement.

ACTION-FETCH

Fetch from a previous SELECT answer set.

ACTION-UPDATE

Process an UPDATE, INSERT, or DELETE statement.

ACTION-COMMIT

Commit a unit of work.

ACTION-ROLLBACK

Roll back the changes since the last COMMIT.

ACTION-DISCONNECT

Disconnect a cursor.

ACTION-DISCONNECT-ALL

Disconnect all cursors.

ACTION-CONNECT

Create a database connection and establish a cursor.

ACTION-ERROR

Process an error condition.

ACTION-CLEAR-STMT

Clear common statement (when program CANCELED).

2. SQLRT

This is the 01-level of data division copy member PTCSQLRT and is used to send and return several sub-parameters and to provide work space.

The individual elements in PTCSQLRT are described in the topic Interface Data.

3. Cursor

This is a four-digit computational number representing a resource connection unit. Copy data division SQLRT contains a common cursor for use when resources do not have to be saved for reuse.

Examples

SQL-CURSOR-COMMON OF SQLRT
SQL-CURSOR OF S-CHECK

4. Statement

The 18-character name of a stored SQL statement must conform to the following pattern:

Item

Description

Char 1-8

Program Name

Char 9

Constant "_" (underscore)

Char 10

Constant specifying SQL statement type:

 

S for select

 

D for delete

 

I for insert

 

U for update

Char 11

Constant "_" (underscore)

Char 12-17

Unique Statement Name within program

Example

01  S-CHECK.
  02  STMT-NAMEPIC X(18)   VALUE ‘PSPRPRNT_S_CHECK'.


CALL ‘PTPSQLRT' USING ACTION-SELECT OF SQLRT
  SQLRT
  SQL-CURSOR-COMMON OF SQLRT
  STMT-NAME OF S-CHECK
....

5. Bind-Setup

This is a list of descriptors for the data that is used by the SQL statement in the WHERE, HAVING, SET, and VALUES clauses. These descriptors tell the API the sizes and types of the corresponding bind variables. The descriptors exactly match the memory layout of the bind variables themselves. Setup strings are the same for both bind and select setup lists.

For details, see the topic Setup List.

Example

BIND-SETUP OF S-CHECK

6. Bind-Data

This is a list of data elements defined by BIND-SETUP and is described subsequently for both bind and select data lists.

Example

BIND-DATA OF S-CHECK

7. Select-Setup

This is a list of specifications for the data that is returned by the SQL statement - SELECT.

For details on both bind and select setup lists, see the topic Setup List.

Example

SELECT-SETUP OF S-CHECK

8. Select-Data

This is a list of data elements defined by SELECT-SETUP. Setup lists for both bind and select data are described in the Setup List topic. Select-Data is the buffer area into which data is returned by the Fetch action. Be sure to initialize this area before each Fetch, because character fields are not blank-filled on all platforms. If you do not clear the buffer, a short character value might only partially replace a longer value from a previous fetch.

Example

SELECT-DATA OF S-CHECK

A setup list is a string of codes, terminated with a "Z," fully specifying both the logical and physical characteristics of the data elements in a Data List. Specifications include data type, physical data storage bytes, and decimal places for decimal numbers. Each data element is specified with a character string whose length represents the actual bytes of storage the data element occupies and whose value includes data type codes and decimal positions. All data types except decimal numbers use alphabetic characters preceded a number or special character. Consecutive data elements of the same type alternate one of the two characters representing the data type.

The following table summarizes information for the data types supported:

Data Type

Codes

Length (bytes)

Data List Picture

Character

C, H

1 to 255

X through X(255)

Date

D, A

10

X(10)

Time

T, E

26

X(26)

Small Integer

S, M

2

[S]999 or [S]9999 COMP

Large Integer

I, N

4

[S]9(8) or [S]9(9) COMP

Decimal Number

d[P...]

1 to 8

[S]9(w)[V9(d)], where d is the number of decimal places, and w is the remaining number of whole number digits, deduced from the total length of the field and the number of decimals. See Examples.

d = 0-9 for 0-9 decimal places, |0-|5 for 10-15 decimal places. (The vertical bar character represents the tens digit).

Note: Packed decimal numbers are stored two digits (including the sign) per byte. For example, the number PIC S9(9)V9(2) occupies 6 bytes.

Examples:

This table provides examples of setup lists and their corresponding data lists.

SETUP List

DATA List

PIC X(5) VALUE ALL 'C'

PIC X(5)

PIC X(10) VALUE ALL 'D'

PIC X(10)

PIC XX VALUE ALL 'S'

PIC S9999 COMP

PIC XXXX VALUE ALL 'I'

PIC S9(8) COMP

PIC XX VALUE '0P'

PIC S999 COMP-3

PIC X(5) VALUE '3PPPP'

PIC S9(6)V999 COMP-3

PIC X(8) VALUE '|3PPPPPP'

PIC S99V9(13) COMP-3

This is a list of data elements with COBOL name and pictures. The list must be concluded with a one-character filler containing the value "Z." The Setup List and the Data List must be equal in length.

SQL statements must conform to a subset of ISO/ANSI standards common to all vendors. The basic standard used is DB2:

  • Use only statements SELECT, DELETE, INSERT, and UPDATE.

  • Always use the Fetch Function following a Select Statement, even when only one row is expected.

  • No SELECT INTO.

  • No SELECT FOR FETCH ONLY.

  • LONG VARCHAR columns are not supported.

  • Program (Host) variables must be preceded by a colon (":") and represented by numbers ascending from 1 (one) without gaps in the order of specification within the statement and without repetition of any number.

  • Code the stored SQL name for the select as the cursor name when using DELETE or UPDATE with positioning. For example: WHERE CURRENT OF CURSOR PSPRPRNT_S_CHECK

    Note: A separate SQL select with FOR UPDATE OF must be coded for DELETE and UPDATE with positioning in DB2.

  • The internal (COBOL) select list might be shorter than the external (SQL) select list. Only those columns identified internally are retrieved. An example where this is useful is the requirement that ORDER BY columns be included in the select list. Add the columns to the end of the SQL select list, but do not include in the COBOL source.

Copy member PTCSQLRT contains the following sub-parameters:

Sub-parameter

Description

RTNCD

A four (4) digit computational number returned with each call indicating results of processing. A zero value means no errors were detected.

ERR-SECTION

A thirty (30) character field used to send the name of the COBOL SECTION issuing a call to process a fatal application error.

OPERID

An eight (8) character field that contains the user ID used to initiate this run.

BATCH-RUN-ID

A thirty (30) character field that contains the batch run ID used to initiate this run or a value of "N" if no batch run ID was required.

SQL-CURSOR-COMMON

A four (4) digit computational number representing a shared resource connection unit.

CURSOR-CNT

Work field—not used by application program.

SQL-CURSOR-SAVES

Work field—not used by application program.

ACTION

Constants described previously in ACTION parameter.

OPTION-SW

A one (1) character code used with the process select statement function to indicate that positioning is required for subsequent UPDATE and DELETE statements.

ERROR-DISC-SW

This field is used for ROLLBACK processing and is not used by application program.

DBTYPE-SW

An eight (8) digit computational number used to define the current database type being accessed.

 

00 Not set

 

01 SQLBase

 

02 DB2

 

04 Oracle

 

08 SQL Server

 

10 ALLBASE

 

11 RDB

DB2-WORK-AREA

Work field—not used by application program.

SQLRT-CHECK

Work field—not used by application program.

If it is necessary for the application program to construct SQL statements on the fly at run time, the BIND-SETUP and SELECT-SETUP methods of describing bind and select data are not appropriate. For this case, the SQL API provides an alternative interface in which the bind and select data items are passed in arrays of descriptors, with a data type, length, and pointer for each item. When using this interface, the CALL interface is different:

CALL ‘PTPSQLRT' USING action,
  sqlrt,
  cursor,
  statement,
  bind-table,
  bind-table[place-keeper],
  select-table

The parameters correspond to the CALL used for executing predefined statements, but different values and formats for the following parameters indicate that this is a dynamic statement.

1. Action

This is a one (1) character code that indicates the type of statement. Use one of the data names with pattern "ACTION-" from copy member PTCSQLRT.

Example

ACTION-SELECT OF SQLRT

These are the dynamic actions provided:

Action Name

Service Provided

ACTION-SELECT

Process a SELECT statement.

ACTION-UPDATE

Process an UPDATE, INSERT, or DELETE statement.

Other actions, such as ACTION-FETCH, use the same calls as for predefined SQL, as documented previously.

2. SQLRT

This is the 01-level of copy data division PTCSQLRT used to send and return several sub-parameters and to provide work space.

The individual elements in PTCSQLRT are described in the "Interface Data" topic previously.

3. SQL-Cursor

A four (4) digit computational number that represents a resource connection unit. Copy data division SQLRT contains a common cursor for use when resources do not have to be saved for reuse.

Examples

SQL-CURSOR-COMMON OF SQLRT
SQL-CURSOR OF S-CHECK

4. Statement

The first three characters of the statement parameter are used to determine if the current statement is a dynamic statement, rather than the name of a predefined statement.

These are the allowable dynamic statements:

SELECT
INSERT
UPDATE
DELETE

5. Bind-Table

Use this parameter to specify a table form of bind setup information. This has the same format as the following Select-Table.

6. Bind-Table (place-keeper)

Because the bind data is supplied through pointers, the address of a bind data area is not applicable to dynamic calls. However, you must pass a parameter as a place-keeper, so provide the bind table a second time.

7. Select-Table

Use this parameter to specify the table form of select setup information. The first character indicates that the table form of setup list is in use. The SETUP-COUNT variable gives the number of entries, that is, the number of bind or select items. Each SETUP-ENTRY gives the address, length, scale (number of decimal places), and type of the corresponding data field.

 01  SQLSI.
     02  SETUP-FORMPIC X.
   88  SETUP-FORM-TBL   VALUE 'Y'.
     02  SETUP-COUNT     PIC 999  COMP.
   88  SETUP-COUNT-MAX  VALUE 100.
     02  SETUP-ENTRY  OCCURS 100
INDEXED BY
SQLSI-IDX.
   03  SETUP-DATA-PTR    POINTER.
   03  SETUP-LENGTHPIC 999  COMP.
   03  SETUP-SCALE PIC 99   COMP.
   03  SETUP-TYPE  PIC X.
88  SETUP-TYPE-CHAR    VALUE 'C'.
88 SETUP-TYPE-SMALLINT VALUE 'S'.
88 SETUP-TYPE-INTVALUE 'I'.
88 SETUP-TYPE-DECVALUE 'P'.
88 SETUP-TYPE-DATE     VALUE 'D'.
88 SETUP-TYPE-TIME     VALUE 'T'.