Pgcobol.cbl
This is the compplete source code of the Cobol program, which contains the high level SQL statements.
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.
Terug naar: Cobol and PostgreSQL
