;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Package   : sqld-psql.scm
;;; Author    : Hans Oesterholt-Dijkema.
;;; Copyright : HOD 2004/2005.
;;; License   : The Elemental Programming Artistic License.
;;; CVS       : $Id: sqld-psql-internal.scm,v 1.2 2007/01/14 22:49:08 hoesterholt Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=pod
;
;=head1 Name
;
;sqld-psql - SQL Driver for PostgreSQL
;
;=head1 Description
;
;This is a PostgreSQL driver for SQLI. It is a simple
;driver, that has no optimizations like cursor operations,
;connection pools, etc.
;
;This driver conforms to
;L<the interface description for drivers|SQLD - Interface description for SQLI drivers>.
;
;The driver must be used through SQLI.
;
;=head1 API
;
;=head2 C<(sqld-psql-new connection-info) : closure>
;
;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.
;
;=head1 Synopsis
;
;=syn scm,8
;
; (module test
; 	(import sqli)
; 	(import sqld-psql)
; 	(main main))
;
; (define (main argv)
;   (let* ((sqld    (sqld-psql-new "user=test hostname=localhost dbname=test"))
; 	   (sqlh    (sqli-connect sqld))
;
; (...)
;
;=head1 Literate section
;
;This module L<interfaces with a C part|SQLD-PSQL C part> that interfaces to the
;psql library. The interface is built for PostgreSQL version E<gt>=7.4.
;
;=head2 Module definition
;
;The module definition is as follows:
;
;=verbatim scm,8
(module sqld-psql-internal mzscheme
	(require (lib "time.ss" "srfi" "19"))
	(require "sqld-i-psql.scm")
;=verbatim
;
;As can be seen, only one function is exported, the C<sqld-psql-new> function.
;All other function definitions are interface definitions for C functions that
;are called from this module.
;
;=head2 Supportive functions
;
;In the next section, supportive functions and definitions are described.
;
;The C<ierr> function displays a message and returns C<#f>. This function is
;simply used to report errors to the current output port.
;
;=verbatim scm,8
(define (ierr msg)
  (display msg)
  (newline)
  #f)
;=verbatim
;
;=head2 Conversion functions
;
;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 C<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.
;
;=verbatim scm,8
(define (string2db s)
  (string-append "'" (c-psql-string2db s) "'"))
;=verbatim
;
;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.
;
;=verbatim scm,8

;#+ 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")
)
;=verbatim
;
;All other conversions are done using the standard scheme primitives.
;
;=head2 Connecting
;
;The connection function is called from the closure provided
;by C<sqld-psql-new>, when it is called with the C<'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 C<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.
;
;=verbatim scm,8
(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")))))))
;=verbatim
;
;=head2 The main entry function
;
;Now for the main function that this driver provides: C<sqld-psql-new>.
;This function takes C<connection-info> as an argument, which must be
;an Psql database. It returns a closure that handles the C<'connect>,
;C<'clean>, C<'name> and C<'version> calls. It is a very simple function.
;
;The C<'version> call returns the major version number of PostgreSQL * 100 +
;the middle version number * 10  + the minor version number.
;
;=verbatim scm,8
(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"))))))
;=verbatim
;
;=cut

(provide sqld-psql-new))