>>SOURCE FORMAT IS FREE
      *>****************************************************************
      *> OpenCobol/Postgresql engine
      *>
      *> Compile with:
      *>
      *>
      *>     cobc -m -free libpgsql.cbl -lpq
      *>
      *> Refer to libpq-fe.h for data definitions
      *> Refer to http://www.postgresql.org/docs/8.3/static/libpq.html
      *>
      *> Change History:
      *> 2008-Oct-3 gc Created from lessons learned in psqltest.cbl
      *> 2009-Nov   gc return a list of base tables
      *> 2009-Dec   gc Clean up libpq field translation errors
      *>
      *> Roger While says the USAGE BINARY-XXX [SIGNED/UNSIGNED] 
      *> where XXX is CHAR, SHORT, LONG, DOUBLE
      *> giving 1, 2, 4, 8 byte binary fields
      *>
      *> Copyright (c) 2008 Gerald Chudyk <gchudyk@ekotech.com>
      *>
      *> Permission to use, copy, modify, and distribute this software for any
      *> purpose with or without fee is hereby granted, provided that the above
      *> copyright notice and this permission notice appear in all copies.
      *>
      *> THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
      *> WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
      *> MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
      *> ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
      *> WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
      *> ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
      *> OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
      *>
      *>
      *>****************************************************************
       identification division.
       program-id. libpgsql.
       environment division.
       configuration section.
       special-names.
       crt status is crtStatus.
       Repository.
          Function all intrinsic. *> removes need for 'function' keyword
       input-output section.
       file-control.
       select log-file assign to "psqlog.txt"
           organization is line sequential.
       data division.
       file section.
       fd  log-file.
       01  log-rec                 pic x(80).
       01  filler redefines log-rec.
           05 log-date             pic 999/99/99.
           05 filler               pic x.
           05 log-text             pic x(70).
       working-storage section.
       01  sw-debug-switch         pic x value space.
           88 sw-debug             value "D" false space.

       01  charCommand             pic x(10).
       01  charConninfo            pic x(512).
       01  charConninfoStatus      pic x(128).
       01  charDate                pic 999/999/99.
       01  charFrom                pic x(1023).
       01  charPQerrorMessage      pic x(1024).
       01  charParameterStatus     pic x(128).
       01  charParamName           pic x(30).
       01  charSelectTables        pic x(100) value
           "SELECT table_name, table_type FROM INFORMATION_SCHEMA.TABLES where table_schema='public';" & x"00".
       01  charTo                  pic x(2048). 
       01  charVersion             pic x(4) value "v1.0".

       01  crtStatus.
            05 crtStatusKey1        pic 9.
            05 crtStatusKey2        pic 9.
            05 crtStatusFunctionKey redefines crtStatusKey2 pic 99 comp.
            05 crtStatusKey3        pic 99 comp.
            05 filler               pic x.

       01  vTemp                    pic x(1024)  based.

       01  ptrFieldName            usage pointer.
       01  ptrExecStatusType       usage pointer.
       01  ptrPQcmdStatus          usage pointer.
       01  ptrPQcmdTuples          usage pointer.
       01  ptrPGconn               usage pointer.
       01  ptrPQerrorMessage       usage pointer.
       01  ptrPQescapeByteaConn    usage pointer.
       01  ptrPGExecStatusType     usage pointer.
       01  ptrPQfname              usage pointer.
       01  ptrPQgetvalue           usage pointer.
       01  ptrPQoidStatus          usage pointer.
       01  ptrPQparameterStatus    usage pointer.
       01  ptrPQprint              usage pointer.
       01  ptrPQresStatus          usage pointer.
       01  ptrPGresult             usage pointer.
       01  intptrPGresult	   redefines ptrPGresult usage binary-long.
       01  ptrPQresultErrorMessage usage pointer.
       01  ptrPQresultErrorField   usage pointer.
       01  intptrPQresultErrorField redefines ptrPQresultErrorField usage binary-long.
       01  ptrPQftablecol          usage pointer.
       01  ptrReturn               usage pointer.
       01  ptrTableOID             usage pointer.


       01  dbName                  pic x(128) value "mentor".
       01  dbUser                  pic x(128) value "gc".
       01  dbPassword              pic x(128) value "2manysecrets".
       01  dbHost                  pic x(128) value "amnesiac.eko.lan".
       01  dbHostAddr              pic x(128) value "192.168.2.4".
       01  dbPort                  pic x(128) value "5432".
       01  dbOptions               pic x(128).
       01  dbServerVersion         usage binary-long.
       01  dbErrorMsg              pic x(1000).

       01  intCharCount                    usage binary-long.
       01  intColumnCount                  usage binary-long.
       01  intColumnNumber                 usage binary-long.
       01  intConnStatusType               usage binary-long. *> connection status.
           88 CONNECTION_OK                value 0.
           88 CONNECTION_BAD               value 1.
      *>   Additional asynchronous (nonblocking) connection status values follow:
      *>   The existence of these should never be relied upon.
      *>   They should only be used for user feedback or similar purposes.
           88 CONNECTION_STARTED           value 2. *> Waiting for connection to be made.
           88 CONNECTION_MADE              value 3. *> Connection OK; waiting to send.
           88 CONNECTION_AWAITING_RESPONSE value 4. *> Waiting for a response from the postmaster.
           88 CONNECTION_AUTH_OK           value 5. *> Received authentication; waiting for backend startup.
           88 CONNECTION_SETENV		   value 6. *> Negotiating SSL.
           88 CONNECTION_SSL_STARTUP       value 7. *> Negotiating SSL.
           88 CONNECTION_NEEDED		   value 8. *> Negotiating SSL.

       01  intDate                         pic 9(8) comp-5.

       01  intError                        usage binary-long.

       01  intExecStatusType               usage binary-long.
           88 PGRES_EMPTY_QUERY            value 0. *> Empty query string was executed
           88 PGRES_COMMAND_OK             value 1. *> A query command that doesn't return
                                                    *>   anything was executed properly by the
                                                    *>   backend
           88 PGRES_TUPLES_OK              value 2. *> A query command that returns tuples was
                                                    *>   executed properly by the backend, PGresult
                                                    *>   contains the result tuples
           88 PGRES_COPY_OUT               value 3. *> Copy Out data transfer in progress
           88 PGRES_COPY_IN                value 4. *> Copy In data transfer in progress
           88 PGRES_BAD_RESPONSE           value 5. *> An unexpected response was recv'd from the backend
           88 PGRES_NONFATAL_ERROR         value 6. *> Notice or warning message
           88 PGRES_FATAL_ERROR            value 7. *> Query failed

       01  intFieldCode                    usage binary-long.
           88 PG_DIAG_SEVERITY			value "S".
           88 PG_DIAG_SQLSTATE			value "C".
           88 PG_DIAG_MESSAGE_PRIMARY		value "M".
           88 PG_DIAG_MESSAGE_DETAIL		value "D".
           88 PG_DIAG_MESSAGE_HINT		value "H".
           88 PG_DIAG_STATEMENT_POSITION	value "P".
           88 PG_DIAG_INTERNAL_POSITION		value "p".
           88 PG_DIAG_INTERNAL_QUERY		value "q".
           88 PG_DIAG_CONTEXT			value "W".
           88 PG_DIAG_SOURCE_FILE		value "F".
           88 PG_DIAG_SOURCE_LINE		value "L".
           88 PG_DIAG_SOURCE_FUNCTION		value "R".

       01  intFromLength                     usage binary-long.

       01  intPGresult			      usage binary-long.

       01  intPostgresPollingStatusType      usage binary-long.
           88  PGRES_POLLING_FAILED          value 0.
           88  PGRES_POLLING_READING         value 1. *> These two indicate that one may
           88  PGRES_POLLING_WRITING         value 2. *> use select before polling again
           88  PGRES_POLLING_OK              value 3. *>
       01  intPGexecStatusType               usage binary-long.
       01  intPGTransactionStatusType        usage binary-long.
           88 PQTRANS_IDLE                   value 0. *> connection idle
           88 PQTRANS_ACTIVE                 value 1. *> command in progress
           88 PQTRANS_INTRANS                value 2. *> idle, within transaction block
           88 PQTRANS_INERROR                value 3. *> idle, within failed transaction
           88 PQTRANS_UNKNOWN                value 4. *> cannot determine status
       01  intPGVerbosity                    usage binary-long.
           88 PQERRORS-TERSE                 value 0. *> single-line error messages
           88 PQERRORS-DEFAULT               value 1. *> recommended style
           88 PQERRORS-VERBOSE               value 2. *> all the facts, ma'am
       01  intPQbackendPID                   usage binary-long.
       01  intPQconnectionNeedsPassword      usage binary-long.
       01  intPQconnectionUsedPassword       usage binary-long.
       01  intPQntuples                      usage binary-long.
       01  intPQnfields                      usage binary-long.
       01  intPQfnumber                      usage binary-long.
       01  intPQftablecol                    usage binary-long.
       01  intPQfformat                      usage binary-long.
           88 PQFFORMAT_TEXT                 value 0.
           88 PQFFORMAT_BINARY               value 1.
       01  intPQfsize                        usage binary-long.
       01  intPQbinaryTuples                 usage binary-long.
       01  intPQfmod                         usage binary-long.
       01  intPQgetisnull                    usage binary-long.
	   88 PQGETISNULL-TRUE		     value 1.
	   88 PQGETISNULL-FALSE		     value zero.
       01  intPQgetlength                    usage binary-long.
       01  intPQnparams                      usage binary-long.
       01  intPQsocket			     usage binary-long.
       01  intResult                         usage binary-long.
       01  intRowNumber                      usage binary-long.
       01  intToLength                       usage binary-long.

       01  lngFieldLength                    usage binary-long.

       01  oidPQftype                        usage binary-long.
       01  oidPQparamtype                    usage binary-long.
       01  oidPQoidValue                     usage binary-long.

       01  sqlCommand                        pic x(1024).
       01  sqlRequest                        pic x(50).
           88 sqlRequestConnect_timeout      value "connect_timeout".
           88 sqlRequestCreate               value "create".
           88 sqlRequestDelete               value "delete".
           88 sqlRequestDbname               value "dbname".
           88 sqlRequestGsslib               value "gsslib".
           88 sqlRequestHost                 value "host".
           88 sqlRequestHostaddr             value "hostaddr".
           88 sqlRequestKrbsrvname           value "krbsrvname".
           88 sqlRequestOptions              value "options".
           88 sqlRequestPassword             value "password".
           88 sqlRequestPort                 value "port".
           88 sqlRequestRequiressl           value "requiressl".
           88 sqlRequestSelect               value "sql".
           88 sqlRequestService              value "service".
           88 sqlRequestSslmode              value "sslmode".
           88 sqlRequestTty                  value "tty".
           88 sqlRequestUser                 value "user".

       01  sqlString                         pic x(1024).

       01  tblPGtype.
           05 tblPGtype-tuple                occurs 300 times.
             10 tblPGtypeOID                 pic x(4) comp-x.
             10 tblPGtypeName                pic x(23).

       Linkage Section.

	   copy '../cpy/lsrecord.cpy'.

       procedure division using lsRecord lsRequest lsReply.

       main.
           perform a-initialize
           evaluate true
           when DEBUG_COMMAND
	      perform b-set-debug
           when START_DB_COMMAND
              perform c-start-db
           when CLOSE_DB_COMMAND
              perform d-close-db
           when START_CONN_COMMAND
              perform e-start-connection
	   when POLL_COMMAND
	      perform f-poll-connection
           when CLOSE_CONN_COMMAND
              perform g-close-connection
           when GET_DBNAME_COMMAND
              perform h-get-db-name
           when GET_BASE_TABLES_COMMAND
              perform j-get-base-table-list
           when SQL_COMMAND
              perform x-sql-exec
           when MORE_COMMAND
              perform y-reply-to-select
           when other
              set LS_BAD_COMMAND to true
           end-evaluate
           exit program
           stop run
           .
       a-initialize.
           if lsConnHandle not = null
              set ptrPGconn to lsConnHandle
           end-if
           .
       b-set-debug.
           set SW-DEBUG to true
           open output log-file
           initialize log-rec
           accept intDate from date
           move intDate to log-date
           string charVersion " Debug started " delimited by size into log-text
           write log-rec
           .
       c-start-db.
           if lsConnHandle = null
              if lsRequest > space
                 move lsRequest to charConnInfo
		 initialize intCharCount
                 compute intCharCount = length(charConnInfo)
                 perform varying intCharCount from intCharCount by -1
                    until intCharCount = 1
                    or charConnInfo(intCharCount:1) > space
                 end-perform
                 add 1 to intCharCount
                 move low-value to charConnInfo(intCharCount:1)
                 perform pq-connect-db
                 set lsConnHandle to ptrPGconn
                 perform pq-status
                 if CONNECTION_OK
                    set LS_RESULT_OK to true
                 else
		 if CONNECTION_STARTED
		     display "Waiting for connection to be made"
		 else
		 if CONNECTION_MADE
		     display "Connection OK; waiting to send"
		 else
		 if CONNECTION_AWAITING_RESPONSE
		     display "Waiting for a response from the postmaster"
		 else
                     set LS_CONNECTION_ATTEMPT_FAILED to true
                 end-if
              else
                 set LS_CONNECTION_DATA_REQUIRED to true
              end-if
	   else
              set LS_CONNECTION_HANDLE_NOT_EMPTY to true
           end-if
           .
       d-close-db.
           perform pq-clear
           initialize lsRecordHandle
           .
       e-start-connection.
           if lsConnHandle = null
              if lsRequest > space
                 move lsRequest to charConnInfo
		 initialize intCharCount
                 compute intCharCount = length(charConnInfo)
                 perform varying intCharCount from intCharCount by -1
                    until intCharCount = 1
                    or charConnInfo(intCharCount:1) > space
                 end-perform
                 add 1 to intCharCount
                 move low-value to charConnInfo(intCharCount:1)
                 perform pq-connect-start
                 set lsConnHandle to ptrPGconn
                 perform pq-status
                 if CONNECTION_OK
                    set LS_RESULT_OK to true
                 else
		 if CONNECTION_STARTED
		     display "Waiting for connection to be made"
		 else
		 if CONNECTION_MADE
		     display "Connection OK; waiting to send"
		 else
		 if CONNECTION_AWAITING_RESPONSE
		     display "Waiting for a response from the postmaster"
		 else
                     set LS_CONNECTION_ATTEMPT_FAILED to true
                 end-if
              else
                 set LS_CONNECTION_DATA_REQUIRED to true
              end-if
	   else
              set LS_CONNECTION_HANDLE_NOT_EMPTY to true
           end-if
           .

       f-poll-connection.
           perform pq-connect-poll
	   if PGRES_POLLING_OK
              set LS_RESULT_OK to true
	   else if PGRES_POLLING_READING
	      set LS_CONNECTION_POLL_READING to true
	   else if PGRES_POLLING_WRITING
	      set LS_CONNECTION_POLL_WRITING to true
	   else if PGRES_POLLING_FAILED
              set LS_CONNECTION_ATTEMPT_FAILED to true
              set lsConnHandle to null
	   end-if
	   .
       g-close-connection.
           perform pq-finish
           initialize lsRecord
           .
       h-get-db-name.
           perform pq-db
	   move dbName to lsReply
           .
       j-get-base-table-list.
      *> This paragraph will return a list of base tables
      *> in the current database.
      *> 
      *> If this paragraph is called with lsRecordCount initialized
      *> to zero then the lsRecordCount will be set to the number
      *> of base tables in the list, lsRecordCusor will be set to 1,
      *>  lsFieldLength will give the length of the first record,
      *> and the first record will be in lsReply.
      *>
      *> Subsequent calls will result in lsRecordCursor being incremented
      *> by 1 until all valid records have been returned.
      *> 
      *> Fields in record will be separated by 1 low-value character.
      *>
      *>
	   Move charSelectTables to sqlCommand
           perform pq-exec
           perform pq-result-status
	   if (PGRES_BAD_RESPONSE
	   or PGRES_NONFATAL_ERROR
	   or PGRES_FATAL_ERROR)
              initialize lsReply vTemp
              perform pq-error-message
              set address of vTemp to ptrPQerrorMessage
              unstring vTemp delimited by low-value into lsReply
              set LS_RESULT_SELECT_FAILED to true
           else
              perform pq-n-tuples 				*> how many rows?
	      if lsRecordCursor > intPQntuples
	      or intPQntuples = zero
                 set LS_RESULT_AT_END to true
   		 initialize lsRecordCount
              else
                  move intPQntuples to lsRecordCount
	          perform pq-n-fields 				*> How many columns?
                  if intPQnfields = zero
                     set LS_RESULT_AT_END to true
                  else
                     move intPQnfields to lsColumnCount
		     move lsRecordCursor to intRowNumber
		     if intRowNumber > zero
		        subtract 1 from intRowNumber 	*> count starts at zero
		     end-if
		     move lsColumnCursor to intColumnNumber
		     if intColumnNumber > zero
		        subtract 1 from intColumnNumber 	*> count starts at zero
		     end-if
		     perform pq-get-length
		     move intPQgetlength to lsFieldLength
		     perform pq-f-format
		     move intPQfformat to lsFieldFormat
		     perform pq-get-is-null
		     if PQGETISNULL-TRUE
			set FIELD_IS_NULL to true
		     else
			set FIELD_IS_NULL to false
		        perform pq-f-name
		        initialize lsFieldName lsFieldNameLength
		        set address of vTemp to ptrPQfname
		        unstring vTemp delimited by low-value into lsFieldName
				count in lsFieldNameLength
		        perform pq-get-value 
		        initialize lsReply
		        set address of vTemp to ptrPQgetValue
		        unstring vTemp delimited by low-value into lsReply
		     end-if
                  end-if
              end-if
	   end-if
	   perform pq-clear 
	   .
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       x-sql-exec.
           if lsRecordHandle not = zero
              set LS_HANDLE_MISSING to true
              exit paragraph
           end-if

	   move lsRequest to sqlCommand
	   perform varying intCharCount from function length(sqlCommand) by -1
		until sqlCommand(intCharCount:1) > space
	   end-perform
	   add 1 to intCharCount
	   move low-value to sqlCommand(intCharCount:1)
           perform pq-exec
           perform pq-result-status
	   evaluate true
	   when PGRES_EMPTY_QUERY
	      set LS_PGRES_EMPTY_QUERY to true
           when PGRES_COMMAND_OK
              set LS_PGRES_COMMAND_OK to true
	   when PGRES_TUPLES_OK
	      set LS_PGRES_TUPLES_OK to true
	      perform x1-get-tuple-info
	      perform x2-get-field-info
	      perform x3-get-length-info 
	   when PGRES_COPY_OUT
	      set LS_PGRES_COPY_OUT to true
	   when PGRES_COPY_IN
	      set LS_PGRES_COPY_IN to true
	   when PGRES_BAD_RESPONSE
	      set LS_PGRES_BAD_RESPONSE to true
	   when PGRES_NONFATAL_ERROR
	      set LS_PGRES_NONFATAL_ERROR to true
	   when PGRES_FATAL_ERROR
	      set LS_PGRES_FATAL_ERROR to true
           end-evaluate

*>	This will return the above evaluate results in text form
	   perform pq-res-status
	   set address of vTemp to ptrPQresStatus
	   initialize lsReply
           unstring vTemp delimited by low-value into lsReply
           perform pq-result-error-message

	   perform pq-error-message
           set address of vTemp to ptrPQerrorMessage
           initialize lsReply
           unstring vTemp delimited by low-value into lsReply

	*> fieldcode is an error field identifier; 
	*> NULL is returned if the PGresult is not an error or warning result,
	*> or does not include the specified field.

	   set PG_DIAG_SEVERITY to true
	   perform pq-result-error-field
	   if ptrPQresultErrorField > null
              set address of vTemp to ptrPQresultErrorField
              initialize lsReply
              unstring vTemp delimited by low-value into lsReply
	   end-if

	   *> The SQLSTATE code identifies the type of error that has occurred;
	   *> it can be used by front-end applications to perform specific operations
	   *> (such as error handling) in response to a particular database error.
	   *> This field is not localizable, and is always present. 
	   set PG_DIAG_SQLSTATE to true
	   perform pq-result-error-field
	   if ptrPQresultErrorField > null
              set address of vTemp to ptrPQresultErrorField
              initialize lsState
              move vTemp(1:5) to lsState
	   end-if
           .
       x1-get-tuple-info.
           perform pq-n-tuples
           move intPQntuples to lsRecordCursor
	   .
       x2-get-field-info.
           perform pq-n-fields
	   subtract 1 from intPQnfields giving lsColumnCount
*>           move intPQnfields to lsColumnCount
	   .
       x3-get-length-info. *> length of first row
	   initialize lsFieldLength intPQgetlength intRowNumber intColumnNumber
	   perform with test after
		varying intColumnNumber from 0 by 1
		until intColumnNumber = lsColumnCount
		   perform pq-get-length
		   add intPQgetlength to lsFieldLength
	   end-perform
	   .
       y-reply-to-select.
           set ptrPGresult to lsRecordHandle
           perform pq-n-tuples
           if intPQntuples = zero
              set LS_RESULT_AT_END to true
           else
              if lsRecordCursor = zero
                 move intPQntuples to lsRecordCursor
              end-if
              perform pq-n-fields
              if intPQnfields = zero
                 set LS_RESULT_AT_END to true
              else
                 if lsColumnCount = zero
                    move intPQnfields to lsColumnCount
                 end-if
                 move lsColumnCount to intColumnNumber
                 perform pq-f-name     *> return current column name
                 set address of vTemp to ptrPQfname
                 unstring vTemp delimited by low-value into lsFieldName
                 set address of vTemp to null
                 perform pq-get-length *> length of current field
                 move intPQgetlength to lsFieldLength
                 perform pq-get-value  *> value of current field
                 set address of vTemp to ptrPQgetValue
                 unstring vTemp delimited by low-value into lsReply
                 perform pq-f-type     *> oid of current field data type
                 move oidPQftype to lsFieldFormat
              end-if
           end-if
           .

      *>****************************************************************
      *> Postgresql libpq library routines.
      *>
      *> see http://www.postgresql.org/docs/8.3/interactive/libpq.html
      *> (the PostgreSQL online documentation is very good)
      *>
      *>****************************************************************

      *>>>>>>>>>>>>>>>>>>>>>
      *> Status routines.
      *>
       pq-status.
           *> Returns the status of the connection.
           initialize intConnStatusType
           call "PQstatus"
                using by value ptrPGconn,
                returning intConnStatusType
           .
       pq-error-message.
           *>Returns the error message most recently
           *> generated by an operation on the connection.
           initialize ptrPQerrorMessage
           call "PQerrorMessage"
                using by value ptrPGconn
                returning ptrPQerrorMessage
           .
       pq-result-status.
           *> Returns the result status of the command.
           call "PQresultStatus"
                using by value ptrPGresult
                returning intExecStatusType
           .
       pq-res-status.
           *> Converts the enumerated type returned by PQresultStatus 
           *> into a string constant describing the status code. 
           *> The caller should not free the result.
           initialize ptrPQresStatus
           call "PQresStatus"
                using by value intExecStatusType
                returning ptrPQresStatus
           .
       pq-result-error-message.
           *> Returns the error message associated with the command 
           *> Returns an empty string if there was no error.
	   *>
	   *> Immediately following a PQexec or PQgetResult call,
	   *> PQerrorMessage (on the connection) will return the same
	   *> string as PQresultErrorMessage (on the result).
	   *> However, a PGresult will retain its error message until
	   *> destroyed, whereas the connection's error message will
	   *> change when subsequent operations are done.
	   *> Use PQresultErrorMessage when you want to know the status
	   *> associated with a particular PGresult; use PQerrorMessage
	   *> when you want to know the status from the latest operation
	   *> on the connection.
	   *>
           call "PQresultErrorMessage"
                using by value ptrPGresult
                returning ptrPQresultErrorMessage
           set address of vTemp to ptrPQresultErrorMessage
             .
       pq-result-error-field.
           *> Returns an individual field of an error report.
           call "PQresultErrorField"
                using by value ptrPGresult
                by value intFieldCode
                returning ptrPQresultErrorField
           .
       pq-transaction-status.
           *> Returns the current in-transaction status of the server.
           initialize intPGTransactionStatusType
           call "PQtransactionStatus"
                returning intPGTransactionStatusType
           display "dbExecErrorCode: " intPGTransactionStatusType
           .
       pq-parameter-status.
           *> Looks up a current parameter setting of the server.
           call "PQparameterStatus"
                using by value ptrPGconn
                by value charParamName
                returning ptrPQparameterStatus
           set address of vTemp to ptrPQparameterStatus
           unstring vTemp delimited by low-value into charParameterStatus
           .
       pq-backend-PID.
           *> Returns the process ID (PID) of the 
           *> backend server process handling this connection.
           call "PQbackendPID"
                 using by value ptrPGconn
                 returning intPQbackendPID
           .
       pq-connection-needs-password.
           *> Returns true (1) if the connection
           *>  authentication method required a password, 
           *>  but none was available. Returns false (0) if not.
           *> This function can be applied after a failed connection
           *> attempt to decide whether to prompt the user for a password.
           call "PQconnectionNeedsPassword"
                 using by value ptrPGconn
                 returning intPQconnectionNeedsPassword
           .
       pq-connection-used-password.
           *> Returns true (1) if the connection authentication
           *> method used a caller-supplied password. Returns false (0) if not.
           *> This function detects whether a password supplied 
           *> to the connection function was actually used.
           *> Passwords obtained from other sources (such as the .pgpass file)
           *> are not considered caller-supplied.
           call "PQconnectionUsedPassword"
                 using by value ptrPGconn
                 returning intPQconnectionUsedPassword
           .
      *>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      *> Database information
      *>
       pq-db.
           initialize ptrReturn dbName
           call "PQdb"
                using by value ptrPGconn
                returning ptrReturn
           set address of vTemp to ptrReturn
           unstring vTemp delimited by low-value into dbName
           .
        pq-user.
           initialize ptrReturn dbUser
           call "PQuser"
                using by value ptrPGconn
                returning ptrReturn
           set address of vTemp to ptrReturn
           unstring vTemp delimited by low-value into dbUser
           .
        pq-pass.
           initialize ptrReturn dbPassword
           call "PQpass"
                using by value ptrPGconn
                returning ptrReturn
           set address of vTemp to ptrReturn
           unstring vTemp delimited by low-value into dbPassword
           .
       pq-host.
           initialize ptrReturn dbHost
           call "PQhost"
                using by value ptrPGconn
                returning ptrReturn
           set address of vTemp to ptrReturn
           unstring vTemp delimited by low-value into dbHost
           .
       pq-port.
           initialize ptrReturn dbPort
           call "PQport"
                using by value ptrPGconn
                returning ptrReturn
           set address of vTemp to ptrReturn
           unstring vTemp delimited by low-value into dbPort
           .
       pq-options.
           initialize ptrReturn dbOptions
           call "PQoptions"
                using by value ptrPGconn
                returning ptrReturn
           set address of vTemp to ptrReturn
           unstring vTemp delimited by low-value into dbOptions
           .
       pq-server-version.
           initialize ptrReturn dbServerVersion
           call "PQserverVersion"
                using by value ptrPGconn
                returning dbServerVersion
           .

      *>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      *> Connection routines
      *>
       pq-connect-db.
           *> Connect to the db server in a Synchronous (blocking) manner.
           *> An application program can have several backend connections open at one time.
           *> Note that this function will always return a non-null object pointer,
           *> unless perhaps there is too little memory even to allocate the PGconn object.
           *> The PQstatus function should be called to check whether a connection was
           *> successfully made before queries are sent via the connection object.
           set ptrPGconn to null.
           call "PQconnectdb"
                 using by reference charConninfo
                 returning ptrPGconn
           .
       pq-connect-start.
           *> Connect to the db server in an Asynchronous (nonblocking) manner.
           *> An application program can have several backend connections open at one time.
           *> Note that this function will always return a non-null object pointer,
           *> unless perhaps there is too little memory even to allocate the PGconn object.
           *> The PQstatus function should be called to check whether a connection was
           *> successfully made before queries are sent via the connection object.
           set ptrPGconn to null.
           call "PQconnectStart"
                using by reference charConninfo
                returning ptrPGconn
           .
       pq-connect-poll.
           call "PQconnectPoll"
                using by value ptrPGconn,
                returning intPostgresPollingStatusType
           .
       pq-socket.
           call "PQsocket"
                using by value ptrPGconn,
                returning intPQsocket
           .
       pq-reset.
           *> Resets the communication channel to the server.
           call "PQreset"
                using by value ptrPGconn
           .
       pq-finish.
           *> Closes the connection to the server.
           *> Also frees memory used by the PGconn object.
           call "PQfinish"
                using by value ptrPGconn
            .

      *>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      *> Command execution routines
      *>
   *>    pw-escape-string.
   *>       *> PQescapeStringConn escapes a string for use within an SQL command.
   *>        initialize charTo intFromLength intToLength
   *>        inspect charFrom tallying intFromLength for trailing space
   *>        compute intFromLength = (length of charFrom) - intFromLength
   *>
   *>        call "PQescapeStringConn"
   *>             using by value ptrPGconn
   *>             by reference charTo
   *>             by reference charFrom
   *>             by value intFromLength
   *>             by value intError
   *>             returning intToLength
   *>        .
       pq-exec.
          *> Submits a command to the server and waits for the result.
           call "PQexec"
                using by value ptrPGconn
                by reference sqlCommand
                returning ptrPGresult
           .
       pq-make-empty-pg-result.
          *> Constructs an empty PGresult object with the given status.

           call "PQmakeEmptyPGresult"
                using by value ptrPGconn
                by reference ptrPGExecStatusType
                returning ptrPGresult
           .
       pq-clear.
          *> Frees the storage associated with a PGresult. 
          *> Every command result should be freed via PQclear 
          *> when it is no longer needed. 

           call "PQclear"
                using by value ptrPGresult
           set ptrPGresult to null
           .
      *>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      *> Replies to command execution.
      *>
       pq-n-tuples.
           *> Returns the number of rows (tuples) in the query result. 
           call "PQntuples"
                using by value ptrPGresult
                returning intPQntuples
           .
       pq-n-fields.
           *> Returns the number of Fields (fields)
           *> in each row of the query result. 
           call "PQnfields"
                using by value ptrPGresult
                returning intPQnfields
           .
       pq-f-name.
           *> Returns the Field name associated with the given Field number.
           *> Field numbers start at 0.
           call "PQfname"
                using by value ptrPGresult
                by value intColumnNumber
                returning ptrPQfname
           .
       pq-f-number.
           *> Returns the Field number associated with the given Field name.
           *> -1 is returned if the given name does not match any Field.
           call "PQfnumber"
                using by value ptrPGresult
                by value ptrFieldName
                returning intPQfnumber
           .
       pq-f-table-col.
           *> Returns the Field number (within its table)
           *> of the Field making up the specified query result Field.
           *> Query-result Field numbers start at 0,
           *> but table Fields have nonzero numbers.
           *> Zero is returned if the Field number is out of range,
           *> or if the specified Field is not a simple reference
           *> to a table Field, or when using pre-3.0 protocol.
           call "PQftablecol"
                using by value ptrPGresult
                by value intColumnNumber
            returning intPQftablecol
           .
       pq-f-format.
           *> Returns the Field number (within its table)
           *> of the Field making up the specified query result Field.
           *> Query-result Field numbers start at 0,
           *> but table Fields have nonzero numbers.
           *> Format code zero indicates textual data representation,
           *> while format code one indicates binary representation.
           call "PQfformat"
                using by value ptrPGresult
                by value intColumnNumber
            returning intPQfformat
           .
       pq-f-type.
           *> Returns the data type associated with the given Field number.
           *> The integer returned is the internal OID number of the type.
           *> Field numbers start at 0.
           *> You can query the system table pg_type to obtain the names
           *> and properties of the various data types. The OIDs of the built-in
           *> data types are defined in the file src/include/catalog/pg_type.h.
           call "PQftype"
                using by value ptrPGresult
                by value intColumnNumber
            returning oidPQftype
           .
       pq-f-mod.
           *> Returns the type modifier of the Field associated with the given Field number.
           *> Field numbers start at 0.
           *> The interpretation of modifier values is type-specific;
           *> they typically indicate precision or size limits.
           *> The value -1 is used to indicate "no information available".
           *> Most data types do not use modifiers, in which case the value is always -1.
           call "PQfmod"
                using by value ptrPGresult
                by value intColumnNumber
            returning intPQfmod
           .
       pq-get-value.
           *> Returns a single field value of one row of a PGresult.
           *> Row and Field numbers start at 0. 
           *> The caller should not free the result directly.
           *> It will be freed when the associated PGresult handle is passed to PQclear.
           *> For data in text format, the value returned by PQgetvalue
           *> is a null-terminated character string representation of the field value.
           *> An empty string is returned if the field value is null.
           *> See PQgetisnull to distinguish null values from empty-string values.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
	   call "PQgetvalue"
                using by value ptrPGresult
                by value intRowNumber
                by value intColumnNumber
                returning ptrPQgetValue
	   end-call
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           .
       pq-get-is-null.
           *> Tests a field for a null value. Row and Field numbers start at 0.
           *> This function returns 1 if the field is null
           *> and 0 if it contains a non-null value. 
           call "PQgetisnull"
                using by value ptrPGresult
                by value intRowNumber
                by value intColumnNumber
                returning intPQgetisnull
           .
       pq-get-length.
           *> Returns the actual length of a field value in bytes.
           *> Row and column numbers start at 0.
           *> This is the actual data length for the particular data value,
           *> that is, the size of the object pointed to by PQgetvalue.
           *> For text data format this is the same as strlen().
           *> For binary format this is essential information. 
           call "PQgetlength"
                using by value ptrPGresult
                by value intRowNumber
                by value intColumnNumber
            returning intPQgetlength
           .

      *>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      *> These functions are used to extract information from PGresult objects
      *> that are not SELECT results.
      *>
       pq-cmd-status.
           *> Returns the command status tag from the SQL command that generated the PGresult.
           *> Commonly this is just the name of the command,
           *> but it might include additional data such as the number of rows processed.
           *> The caller should not free the result directly.
           *> It will be freed when the associated PGresult handle is passed to PQclear.
           call "PQcmdStatus"
                using by value ptrPGresult
            returning ptrPQcmdStatus
           .
       pq-cmd-tuples.
           *> This function returns a string containing the number of rows
           *> affected by the SQL statement that generated the PGresult. 
           call "PQcmdTuples"
                using by value ptrPGresult
            returning ptrPQcmdTuples
           .
       end program libpgsql.