Calling this function with a valid PostgreSQL connection string (containing host, dbname, user, etc.), will instantiate a new driver, that can be given to a new instance of SQLI.

The module definition is as follows:

(module sqld-psql-internal mzscheme
        (require (lib "time.ss" "srfi" "19"))
        (require "sqld-i-psql.scm")

As can be seen, only one function is exported, the sqld-psql-new function. All other function definitions are interface definitions for C functions that are called from this module.

In the next section, supportive functions and definitions are described.

The ierr function displays a message and returns #f. This function is simply used to report errors to the current output port.

(define (ierr msg)
  (display msg)
  (newline)
  #f)

Conversion functions are used to convert between database representations of types and scheme representations of types. They are all straightforward.

Psql is SQL92 compliant, so for all strings, the single quote must be escaped. A simple pregexp-replace* call is used to escape the single quotes. This function could be made more efficient, using a loop, or even a C function to do the same.

(define (string2db s)
  (string-append "'" (c-psql-string2db s) "'"))

A PostgreSQL date type is constructed from the bigloo date type, using a the predescribed PostgreSQL encoding, without a zone part.

The interpretation back from the database is done by expecting the same encoding. No checking is done for the parts of the strings; so, the precondition for the use of this function is, that the given string conforms to the previous definition.

;#+ mzscheme
(define-syntax integer->string
  (syntax-rules ()
    ((integer->string s) (number->string s))))

(define-syntax string->integer
  (syntax-rules ()
    ((string->integer s) (string->number s))))
;##


(define (pre-zero2 n)
  (if (< n 10) 
      (string-append "0" (integer->string n))
      (integer->string n)))

(define (date2db dt)
  (string-append "'"
  (date->string dt "~Y~m~dT~H~M~S")
  "'"))


(define (db2date dt)
  (string->date dt "~Y-~m-~d ~H:~M:~S")
)

All other conversions are done using the standard scheme primitives.

The connection function is called from the closure provided by sqld-psql-new, when it is called with the 'connect argument. It returns a closure that is used for further command processing and that has a connection to the Psql database.

The commands to be processed are placed in a cond structure, with the probably most commonly used commands at front.

Supportive functions are defined within the closure, to handle the interfacing for queries to the C part and fetches.

(define (sqld-psql-connect connection-info)
  (let ((db (c-psql-open connection-info))
        (current-query-result #f)
        (valid-handle #t)
        (nrows 0)
        (ncols 0)
        (row 0)
        (sem (make-semaphore 0)))

    (define (query q)
      
      (define (exec-query)
        (set! current-query-result (c-psql-query db q))
        (semaphore-post sem))
      
      (begin
        (set! current-query-result (c-psql-query db q))
        (set! row -1)
        (set! ncols (c-psql-ncols current-query-result))
        (set! nrows (c-psql-nrows current-query-result))))

    (define (fetch)

      (define (f i)
        (if (< i ncols)
            (cons (c-psql-cell current-query-result row i) (f (+ i 1)))
            (list)))
        
      (begin
        (set! row (+ row 1))
        (if (>= row nrows)
            #f
            (f 0))))

    (lambda (cmd . args)
      (if (eq? valid-handle #f)
          (ierr "ERROR: disconnected handle")
          (cond

           ((eq? cmd 'string2db) (string2db (car args)))
           ((eq? cmd 'int2db) (integer->string (car args)))
           ((eq? cmd 'number2db) (number->string (car args)))
           ((eq? cmd 'date2db) (date2db (car args)))
           ((eq? cmd 'bool2db) (if (eq? (car args) #t) "'t'" "'f'"))

           ((eq? cmd 'db2date) (db2date (car args)))
           ((eq? cmd 'db2bool) (if (string=? (car args) "t") #t #f))

           ((eq? cmd 'fetchrow)
            (if (eq? current-query-result #f)
                #f
                (fetch)))

           ((eq? cmd 'lasterr) (c-psql-lasterr (if (eq? current-query-result #f)
                                                   db
                                                   current-query-result)))

           ((eq? cmd 'begin) (query "BEGIN;"))
           ((eq? cmd 'commit) (query "COMMIT;"))
           ((eq? cmd 'rollback) (query "ROLLBACK;"))
           ((eq? cmd 'query) (query (car args)))

           ((eq? cmd 'disconnect)
            (begin
              (c-psql-close db)
              (set! valid-handle #f)))
           
           (else (ierr "Unknown command")))))))

Now for the main function that this driver provides: sqld-psql-new. This function takes connection-info as an argument, which must be an Psql database. It returns a closure that handles the 'connect, 'clean, 'name and 'version calls. It is a very simple function.

The 'version call returns the major version number of PostgreSQL * 100 + the middle version number * 10 + the minor version number.

(define (sqld-psql-new _connection-info)
  (let ((connection-info _connection-info))
    (lambda (cmd . args)
      (cond

       ((eq? cmd 'connect) (sqld-psql-connect connection-info))
       ((eq? cmd 'clean) #t)

       ((eq? cmd 'name) "psql")
       ((eq? cmd 'version) (c-psql-version))

       (else (ierr "ERROR: Connect to the datebase first"))))))