Martin at 16:21, 7 November 2025

2025-11-07T16:21:24Z

← Older revision		Revision as of 16:21, 7 November 2025
Line 33:		Line 33:
	01 DATASRC PIC X(64) value		01 DATASRC PIC X(64) value
	* "pgsql://10.68.171.50:5432".		* "pgsql://10.68.171.50:5432".
	"pgsql://10.68.171.50:5432/cobol_gixsql".		* "pgsql://10.68.171.50:5432/cobol_gixsql".
	* "pgsql://localhost:5432/cobol_gixsql".		"pgsql://localhost:5432/cobol_gixsql".
	01 DBUSR PIC X(64) value "gix_user".		01 DBUSR PIC X(64) value "gix_user".
	01 DBPWD PIC X(64) value "gix_user".		01 DBPWD PIC X(64) value "gix_user".

Martin at 15:42, 7 November 2025

2025-11-07T15:42:42Z

← Older revision		Revision as of 15:42, 7 November 2025
Line 1:		Line 1:
			This is the compplete source code of the Cobol program, which contains the high level SQL statements.
	<pre>		<pre>
	IDENTIFICATION DIVISION.		IDENTIFICATION DIVISION.

Martin: Created page with "

        IDENTIFICATION DIVISION.         PROGRAM-ID. pgcobol.          ENVIRONMENT DIVISION.         CONFIGURATION SECTION.        source-computer. Linux-laptop.        o..."

2025-11-07T15:41:46Z

Created page with "<pre> IDENTIFICATION DIVISION. PROGRAM-ID. pgcobol. ENVIRONMENT DIVISION. CONFIGURATION SECTION. source-computer. Linux-laptop. o..."

New page

<pre>
IDENTIFICATION DIVISION.

PROGRAM-ID. pgcobol.

ENVIRONMENT DIVISION.

CONFIGURATION SECTION.
source-computer. Linux-laptop.
object-computer. Linux-laptop.
special-names.
console is scherm.

SOURCE-COMPUTER. IBM-AT.
OBJECT-COMPUTER. IBM-AT.

INPUT-OUTPUT SECTION.
FILE-CONTROL.
select fprinter assign to "pgcobol.prt";
ORGANIZATION LINE SEQUENTIAL.
DATA DIVISION.

FILE SECTION.
FD fprinter.
01 file-buffer PIC X(242).
WORKING-STORAGE SECTION.

* copy 'SQLCA.cpy'.
* copy 'EMPREC.cpy'.

01 DATASRC PIC X(64) value
* "pgsql://10.68.171.50:5432".
"pgsql://10.68.171.50:5432/cobol_gixsql".
* "pgsql://localhost:5432/cobol_gixsql".
01 DBUSR PIC X(64) value "gix_user".
01 DBPWD PIC X(64) value "gix_user".

01 CUR-STEP PIC X(16).
01 empcount PIC 9(5).
01 employee-record.
03 r-ENO PIC S9(4) COMP.
03 r-LNAME PIC X(10).
03 r-FNAME PIC X(10).
03 r-STREET PIC X(20).
03 r-CITY PIC X(15).
03 r-ST PIC XX.
03 r-ZIP PIC X(5).
03 r-DEPT PIC X(4).
* 03 a-PAYRATE PIC S9(13)V99 COMP-3 VALUE 0.
03 r-PAYRATE PIC S9(13)V99 COMP-3 VALUE 0.
03 r-COM PIC S9V99 COMP-3.
03 r-MISCDATA PIC X(132).
03 r-DNUM1 PIC S99V99 COMP-3.
03 r-DNUM2 PIC S99V99 COMP-3.
03 r-DNUM3 PIC S99V99 COMP-3.

01 employee-row.
03 p-ENO PIC z(3)9.
03 filler pic x value space.
03 p-LNAME PIC X(10).
03 filler pic x value space.
03 p-FNAME PIC X(10).
03 filler pic x value space.
03 p-STREET PIC X(20).
03 filler pic x value space.
03 p-CITY PIC X(15).
03 filler pic x value space.
03 p-ST PIC XX.
03 filler pic x value space.
03 p-ZIP PIC X(5).
03 filler pic x value space.
03 p-DEPT PIC X(4).
03 filler pic x value space.
03 p-PAYRATE PIC z(12)9.99.
03 filler pic x value space.
03 p-COM PIC 9v99.
03 filler pic x value space.
03 p-DNUM1 PIC z9.99.
03 filler pic x value space.
03 p-DNUM2 PIC z9.99.
03 filler pic x value space.
03 p-DNUM3 PIC z9.99.
03 filler pic x value space.
03 p-miscdata-text pic X(128).

01 employee-header.
03 h-ENO pic x(5) value 'Eno'.
03 h-LNAME PIC X(11) value 'Lname'.
03 h-FNAME PIC X(11) value 'Fname'.
03 h-STREET PIC X(21) value space.
03 h-CITY PIC X(16) value 'City'.
03 h-ST PIC X(3) value 'ST'.
03 h-ZIP PIC X(6) value 'zip'.
03 h-DEPT PIC X(5) value 'Dept'.
03 h-PAYRATE PIC x(17) value 'Payrate'.
03 h-COM PIC x(4) value 'Com'.
03 h-DNUM1 PIC x(6) value 'Dnum1'.
03 h-DNUM2 PIC x(6) value 'Dnum1'.
03 h-DNUM3 PIC x(6) value 'Dnum1'.
03 h-miscdata-text pic X(128) value 'Misc data'.

01 employee-page.
03 filler pic x(118) value space.
03 filler pic x(10) value 'page'.
03 f-page-number PIC z(3)9.

*01 MISCDATA PIC X(132).

01 miscdata-group.
49 miscdata-len pic 9(8) comp-5.
49 miscdata-text pic X(128).

01 IDX PIC 9(2).
01 print-buffer PIC X(242).
01 line-number PIC 99 value 99.
01 page-number PIC 9999 value zero.

01 TMPNUM PIC 9(4).

EXEC SQL
INCLUDE employee-table
END-EXEC.

EXEC SQL
INCLUDE SQLCA
END-EXEC.

EXEC SQL AT cobol_sql
DECLARE employeecursor CURSOR FOR
SELECT * FROM emptable
END-EXEC.

PROCEDURE DIVISION.

r00-main.

perform r90-init.
perform r80-verwerk.
perform r99-exit.

r80-verwerk.

EXEC SQL AT cobol_sql
SELECT COUNT(*) INTO :empcount FROM emptable
END-EXEC.

display "Rijen in emptable" upon scherm.
display empcount upon scherm.

perform r81-init-cursor.

perform r85-verwerk-employee until
SQLCODE < 0 or SQLCODE = 100

perform r89-close-cursor.

r81-init-cursor.

EXEC SQL AT cobol_sql START TRANSACTION END-EXEC.
display "start transaction" upon scherm.
display SQLCODE upon scherm.

EXEC SQL OPEN employeecursor END-EXEC.

display "open cursor" upon scherm.
display SQLCODE upon scherm.

EXEC SQL FETCH employeecursor INTO :employee-table END-EXEC.

display "fetch cursor" upon scherm.
display SQLCODE upon scherm.

r85-verwerk-employee.

move ENO to r-ENO.
move LNAME to r-LNAME.
move FNAME to r-FNAME.
move STREET to r-STREET.
move CITY to r-CITY.
move ST to r-ST.
move ZIP to r-ZIP.
move DEPT to r-DEPT.
move PAYRATE to r-PAYRATE.
move COM to r-COM.
move DNUM1 to r-DNUM1.
move DNUM2 to r-DNUM2.
move DNUM3 to r-DNUM3.
move MISCDATA to miscdata-group.
* move miscdata-len to r-miscdata-len.
* move miscdata-text to r-miscdata-text.

move r-ENO to p-ENO.
move r-LNAME to p-LNAME.
move r-FNAME to p-FNAME.
move r-STREET to p-STREET.
move r-CITY to p-CITY.
move r-ST to p-ST.
move r-ZIP to p-ZIP.
move r-DEPT to p-DEPT.
move r-PAYRATE to p-PAYRATE.
move r-COM to p-COM.
move r-DNUM1 to p-DNUM1.
move r-DNUM2 to p-DNUM2.
move r-DNUM3 to p-DNUM3.
move miscdata-text to p-miscdata-text.

display employee-row upon scherm.
perform p00-print.

EXEC SQL FETCH employeecursor INTO :employee-table END-EXEC.

display "fetch cursor" upon scherm.
display SQLCODE upon scherm.

r89-close-cursor.

EXEC SQL CLOSE employeecursor END-EXEC.

r90-init.
perform s00-connect.
open output fprinter.

r99-exit.

perform s99-disconnect.
close fprinter.
perform z99-exit.

z99-exit.

stop run.

s00-connect.
display "DATASRC" upon scherm.
display "DBUSR" upon scherm.
display "DBPWD" upon scherm.

MOVE 'CONNECT' TO CUR-STEP.
EXEC SQL
* CONNECT :DBUSR IDENTIFIED BY :DBPWD USING :DATASRC
CONNECT TO :DATASRC AS cobol_sql USER :DBUSR USING :DBPWD
* CONNECT TO "pgsql://10.68.171.50:5432/cobol_gixsql"
* USER :DBUSR USING :DBPWD
END-EXEC.
display "connect to database" upon scherm.
display SQLCODE upon scherm.

s99-disconnect.
display "DATASRC" upon scherm.
display "DBUSR" upon scherm.
display "DBPWD" upon scherm.

MOVE 'DISCONNECT' TO CUR-STEP.
EXEC SQL CONNECT RESET cobol_sql END-EXEC.
EXEC SQL DISCONNECT cobol_sql END-EXEC.
display "disconnect from database" upon scherm.
display SQLCODE upon scherm.

p00-print.
if line-number > 50 then
move 1 to line-number
add 1 to page-number
move page-number to f-page-number
move employee-page to print-buffer
write file-buffer from print-buffer
move employee-header to print-buffer
write file-buffer from print-buffer
move employee-row to print-buffer
write file-buffer from print-buffer
else
add 1 to page-number
move employee-row to print-buffer
write file-buffer from print-buffer.

999-PRG-ERR.
display 'ERR - ' CUR-STEP ' : ' SQLCODE.
display 'ERR - ' CUR-STEP ' : ' SQLERRMC(1:SQLERRML).
MOVE -1 TO RETURN-CODE.

</pre>
<hr/>
Terug naar: [[Cobol and PostgreSQL]]

Pgcobol.cbl - Revision history

Martin at 16:21, 7 November 2025

Martin at 15:42, 7 November 2025

Martin: Created page with "
IDENTIFICATION DIVISION. PROGRAM-ID. pgcobol. ENVIRONMENT DIVISION. CONFIGURATION SECTION. source-computer. Linux-laptop. o..."