sqld-i-psql.scm
(module sqld-i-psql mzscheme
        (require (planet "spgsql.ss" ("schematics" "spgsql.plt" 1 2)))
        (require (planet "private/connection-structures.ss" ("schematics" "spgsql.plt" 1 2)))
        (require (lib "pregexp.ss"))
        (require (lib "class.ss"))
        (provide    c-psql-version
                    c-psql-open
                    c-psql-close
                    c-psql-query
                    c-psql-nrows
                    c-psql-ncols
                    c-psql-cell
                    c-psql-lasterr
                    c-psql-string2db)
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; PSQL types
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; PSQL interfacing
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; Scheme interfacing
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define-struct psql-result (fields ncols nrows handle))
        (define-struct psql-handle (conn err-message err))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; Scheme interfacing - exported functions
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                    
        (define (c-psql-open connection-string)
          (let ((items (pregexp-split "[ \t]+" connection-string)))
            (let ((host     "localhost")
                  (port     5432)
                  (database #f)
                  (user     #f)
                  (password #f))
              (for-each (lambda (item)
                          (let ((keyval (pregexp-split "[ \t]*=[ \t]*" item)))
                            (let ((key (string->symbol (car keyval)))
                                  (val (cadr keyval)))
                              (cond ((eq? key 'host)     (set! host val))
                                    ((eq? key 'port)     (set! port (string->number val)))
                                    ((eq? key 'dbname)   (set! database val))
                                    ((eq? key 'user)     (set! user val))
                                    ((eq? key 'password) (set! password val))
                                    (else (error (format "sqld-psql:connect:unknown keyword: ~a" key)))))))
                        items)
              (if (and (eq? database #f) (not (eq? user #f))) (set! database user))
              (if (eq? user #f) (error "sqld-psql:connect:the user keyword is mandatory"))
              
              (with-handlers ((exn:fail? (lambda (exn)
                                           (make-psql-handle #f (exn-message exn) #t))))
                (make-psql-handle 
                 (if (eq? password #f)
                     (connect host port database user)
                     (connect host port database user password))
                 ""
                 #f)))))
        
        (define (c-psql-close handle)
          (if (not (eq? (psql-handle-conn handle) #f))
              (send (psql-handle-conn handle) disconnect)))
        
        (define (c-psql-query handle query)
          (if (eq? (psql-handle-conn handle) #f)
              (error "sqld-psql:c-psql-query:invalid connection"))
          (set-psql-handle-err! handle #f)
          (set-psql-handle-err-message! handle "")
          (let ((res (send (psql-handle-conn handle) query-general query)))
            (let ((R (if (list? res) (car res) res)))
              (if (Recordset? R)
                  (make-psql-result (list->vector (Recordset-rows R))
                                    (if (null? (Recordset-rows R))
                                        0
                                        (length (Recordset-fields R)))
                                    (length (Recordset-rows R))
                                    handle)
                  (if (ErrorResult? R)
                      (begin
                        (set-psql-handle-err-message! handle (ErrorResult-message R))
                        (set-psql-handle-err!         handle #t)
                        (make-psql-result (vector) 0 0 handle))
                      (make-psql-result (vector) 0 0 handle))))))
        
        (define (c-psql-nrows resultset)
          (psql-result-nrows resultset))
        
        (define (c-psql-ncols resultset)
          (psql-result-ncols resultset))
        
        (define (c-psql-cell resultset row col)
          (vector-ref (vector-ref (psql-result-fields resultset) row) col))
        
        (define (c-psql-version)
          100)
        
        (define (c-psql-lasterr handle)
          (if (psql-result? handle)
              (c-psql-lasterr (psql-result-handle handle))
              (psql-handle-err-message handle)))
        
        (define re-quote (regexp "[']"))
        (define (c-psql-string2db s)
          (regexp-replace* re-quote s "''"))
        
        )