>>SOURCE FORMAT IS FIXED
      *> ***************************************************************
      *><* ========================
      *><* OpenCOBOL SQLite example
      *><* ========================
      *><*
      *><* :Author:    Brian Tiffin 
      *><* :Date:      17-Sep-2008 
      *><* :Purpose:   Demonstrate SQLite in OpenCOBOL
      *><* :Requires:  SQLite3, libsqlite3 sqlite3-dev 
      *><* :Tectonics:
      *><*
      *><*     cobc -c ocsqlite.c
      *><*     cobc -x -lsqlite3 sqlcaller.cob ocsqlite.o
      *><*
      *><* -----
      *><* Usage
      *><* -----
      *><* This is strictly a demo.  Uses or creates **test.db** file
      *><+  and then drops and creates the table *trial*.
      *><*
      *><* ::
      *><*
      *><*     $ ./sqlcaller
      *><*
      *><* ------------
      *><* Requirements
      *><* ------------
      *><* Needs: libsqlite3-dev and sqlite3 packages along with an OC
      *><+  1.1 pre-release dated after 15-Sep-2008
      *><*
      *><* ---------------
      *><* Sample database
      *><* ---------------
      *><* ::
      *><*
      *><*  $ sqlite3 test.db
      *><*  sqlite3>
      *><*   CREATE TABLE trial(
      *><*     id integer primary key,
      *><*     field1 char(16),
      *><*     field2 date
      *><*   );
      *><*   INSERT TABLE trial values (null, "best", "20080101");
      *><*
      *> ***************************************************************
       identification division.
       program-id. sqlcaller.

       data division.
       working-storage section.
       01 name-length          pic 99 value 20 global.   *> constant 20.
       01 value-length         pic 99 value 80 global.   *> constant 80.
       01 database             pic x(8) value 'test.db' & x'00'.
       01 db                   usage pointer.
       01 callback-proc        usage procedure-pointer.
       01 errstr               pic x(80).
       01 result               pic s9(9).

       01 query                pic x(255).
       01 zquery               pic x(256).

      *> ***************************************************************
       procedure division.

       call "sqlopen"
           using db
               database
               by reference errstr
               by value function length(errstr)
           returning result
       end-call
       display "Open result:  " result end-display
       if result not equal zero
           display "Err:    " errstr end-display
       end-if

       move "select * from unknown;" & x"00" to zquery
       perform ocsql-exec

       move "drop table trial;" & x"00" to zquery
       perform ocsql-exec

       move "create table trial (first integer primary key, " &
           "second char(16), third date);" & x"00" to zquery
       perform ocsql-exec

       move "pragma count_changes=0;" & x"00" to zquery
       perform ocsql-exec

       move "pragma database_list;" & x"00" to zquery
       perform ocsql-exec

       move 'insert into trial (first, second, third) values ' &
           '(null, random(), datetime()); ' &
           'insert into trial values (random(), "something",' &
           ' datetime()); ' &
           'insert into trial values (null, "12345678901234567",' &
           ' "20081010");' &
           x"00" to zquery
       perform ocsql-exec

       move "select * from trial;" &
           x"00" to zquery
       perform ocsql-exec

       call "sqlclose"
           using
               by value db
           returning result
       end-call
       display "Close result: " result end-display

       goback.

      *> ***************************************************************
       ocsql-exec.
       move spaces to query
       string zquery delimited by low-value into query
       display "Attempting:   " end-display
       display function trim(query) end-display
       set callback-proc to entry "callback"
       call "sqlexec"
           using by value db
               callback-proc
               by reference zquery
               by value function length(zquery)
               by reference errstr
               by value function length(errstr)
               by value name-length
               by value value-length
           returning result
       end-call
       display "Exec result:  " result end-display
       if result not equal 0
           display "Err:    " errstr end-display
       end-if
       .
      *> ***************************************************************


      *> ***************************************************************
      *> Callback procedure.  C is called for each row with
      *>            void *, int fields, char **, char **
      *>  mapped to void *, int *, char *name, char *value 
      *>                  for each field
      *> ***************************************************************
       identification division.
       program-id. callback.

       data division.
       working-storage section.
       01 count-display        pic z9.
       01 index-display        pic z9.
       01 name-display         pic x(name-length).
       01 value-display        pic x(value-length).
       01 legend               pic x(13).

       linkage section.
       01 nada                 usage pointer.
       01 field-count          pic s9(9) usage comp-5.
       01 field-index          pic s9(9) usage comp-5.
       01 field-name           pic x(name-length).
       01 field-data           pic x(value-length).

      *> ***************************************************************
       procedure division using nada field-count field-index
                                     field-name field-data.

       add zero to field-count giving count-display
       add 1 to field-index giving index-display

       display index-display " of " count-display end-display
       move spaces to name-display
       string 
           field-name delimited by low-value
           into name-display
       end-string
       move spaces to value-display
       string
           field-data delimited by low-value
           into value-display
       end-string
       move name-display to legend
       display
           legend
      *    function trim(name-display trailing)
           " = |"
           function trim(value-display trailing)
           "|"
       end-display

       move 0 to return-code

       goback.
       end program callback.
       end program sqlcaller.