×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

COBOL with embedded DB2/SQL on open source cobol

COBOL with embedded DB2/SQL on open source cobol

COBOL with embedded DB2/SQL on open source cobol

(OP)
pre-compile, compile. linkedit & bind. Life as usual for a mainframe programmer. But when you want that to work in the outside world..
The ingredients are there:
O.S.: linux
DBMS: DB2 express C
compiler: open-cobol
All for free and yes: DB2 still carries the cobol-pre-compiler. The link/edit part was the hardest part to figure out because linux is soooo different from MVS on that part (for me that is).
But I figured it out and here is the result
COBOL source to access the standard sample database

CODE

       identification division.
       program-id.     cblsql2.
       environment    division.
       input-output    section.
       file-control.
       data           division.
       file            section.
      *
       working-storage section.
       77   w-start-ws            pic X(08) value 'Start WS'.
       77   w-sqlcode             pic z(8)9+.
       77   w-dis-count           pic z(8)9+.
       77   displ-salary                pic -Z,ZZZ,ZZ9.99.   
       01   switsjes.
            03 sw-800-curs         pic   9.
            88 sw-800-curs-open     value 1.
            88 sw-800-curs-fets     value 2.
            88 sw-800-curs-clos     value 3.
 
      /     DB2 thingies  
       EXEC SQL
            include sqlca
       END-EXEC.
       EXEC SQL begin declare section        END-EXEC.
       01   w-userid            pic  x(08).
       01   w-password          pic  x(08).
       01   w-count             pic S9(04)     comp-5.
       01   w-empno             pic  x(06)     value space.
       01   w-1st-name.
            49 w-1st-name-len           pic S9(04)     comp-5
                                                       value zero.
            49 w-1st-name-dat           pic  x(12)     value space.
       01   w-birthdate         pic  x(10)     value space.
       01   w-workdept                  pic  x(03)     value space.
       01   w-workdept-NULL             pic S9(04)     comp-5.
       01   w-salary                    pic S9(7)V9(2) comp-3.
  
       01   k-empno-start             pic  x(06) value  low-value.
       01   k-empno-stop              pic  x(06) value high-value.
       EXEC SQL end    declare section        END-EXEC.
      /
       PROCEDURE DIVISION.
       000-000-main               section.
      ************************************
       000-010.
           perform 020-000-init-connect.
           perform 100-000-main-process.
           perform 090-000-exit-reset.
    000-090.
           stop run.
      /
       020-000-init-connect       section.
      ************************************
       020-010.
           EXEC SQL
                connect to sample
           END-EXEC.
           if SQLCODE not equal zero
           then move SQLCODE                   to w-sqlcode
                display 'CONNECT failed with rc ' w-sqlcode
           else display 'CONNECT :)'
           end-if.            
       020-090.
           exit.
      *
       090-000-exit-reset         section.
      ************************************
       0090-010.
           EXEC SQL
                connect reset  
           END-EXEC.
           if SQLCODE not equal zero
           then move SQLCODE                         to w-sqlcode
                display 'reset CONNECT failed with rc ' w-sqlcode
           else display 'reset CONNECT :)'
           end-if.            

       0090-090.
           exit.

       100-000-main-process       section.
      ************************************
       100-010.
           set  sw-800-curs-open            to true.
           perform 800-000-process-emply-cursor.
           if SQLCODE equal zero
           then set  sw-800-curs-fets       to true
                perform 800-000-process-emply-cursor
                perform until SQLCODE  not  equal zero
                    perform 110-000-process-emply-row  
                    perform 800-000-process-emply-cursor
                end-perform
           end-if
           if SQLCODE equal +100  
           then set  sw-800-curs-clos  to true
                perform 800-000-process-emply-cursor
           end-if.
       100-090.
           exit.

       110-000-process-emply-row  section.
      ************************************
       110-010.
           if w-workdept-NULL less
           than zero
           then move space             to w-workdept
           end-if
           move w-salary               to displ-salary
           display      w-empno        space
                        w-1st-name-dat space
                        w-workdept     space
                        w-birthdate    space
                        displ-salary.  
       110-090.
           exit.

      /  CURSOR
       800-000-process-emply-cursor section.
      *************************************
      * Declare
       EXEC SQL declare c8000 cursor for
                select           empno
                     ,           firstnme
                     ,           workdept  
                     ,           birthdate
                     ,  coalesce(salary,-1)  
                  from  employee
                 where  empno between :k-empno-start
                                  and :k-empno-stop
                 order by firstnme  
       END-EXEC.
       800-010.
           evaluate true
      * Open
              when sw-800-curs-open
                   EXEC SQL
                       open c8000
                   END-EXEC
      * Fetch
              when sw-800-curs-fets
                   initialize w-1st-name
                   EXEC SQL
                      fetch c8000
                       into :w-empno
                          , :w-1st-name
                          , :w-workdept
                            :w-workdept-NULL
                          , :w-birthdate
                          , :w-salary
                   END-EXEC
      * Close  
              when other
                   EXEC SQL
                      close  c8000
                   END-EXEC                
           end-evaluate.
           if SQLCODE equal zero or +100
           then continue
           else move SQLCODE           to w-sqlcode
                display 'sqlCode     : '  w-sqlcode   space
                display 'sw-800-curs : '  sw-800-curs space
                display 'sqlerrm     : '  sqlerrm     space
           end-if.
       800-090.
           exit.

The script (or compile job)

CODE

#!/bin/sh -x
#
rm  ./${1}.cbl
rm  ./${1}
db2 connect to sample
db2 prep ${1}.sqb bindfile target ANSI_COBOL
/usr/bin/cobc ${1}.cbl -t ${1}.lst -Wall -L${HOME}/sqllib/lib -ldb2 -v -x -save-temps
db2 bind ${1}.bnd
db2 connect reset
./${1}
Mind you, to make this work you're cobol source file must have the extension of ".sqb" and you run this as the db2-instance-owner user.
   

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close