Pgcobol.cbl

From Webhuis wiki
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

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

Retrieved from "https://wiki.webhuis.nl:443/index.php?title=Pgcobol.cbl&oldid=4594"