;;; 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 2006/01/05 00:32:56 HansOesterholt Exp $
;=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
;;#+ bigloo
;(module sqld-psql-internal
;	(extern
;	 (type void* (pointer void) "void *")
;	 (c-psql-open::void* (::string) "c_psql_open")
;	 (c-psql-close::int (::void*) "c_psql_close")
;	 (c-psql-query::void* (::void* ::string) "c_psql_query")
;	 (c-psql-nrows::int (::void*) "c_psql_nrows")
;	 (c-psql-ncols::int (::void*) "c_psql_ncols")
;	 (c-psql-cell::string (::void* ::int ::int) "c_psql_cell")
;	 (c-psql-lasterr::string (::void*) "c_psql_lasterr")
;	 (c-psql-string2db::string (::string) "c_psql_string2db")
;	 (c-psql-version::int () "c_psql_version"))
;	(export
;	 (sqld-psql-new connection-info)))
;#+ mzscheme
(module sqld-psql-internal mzscheme
	(require (lib "time.ss" "srfi" "19"))
	(require "c-sqld-psql.scm")
;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)
;=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) "'"))
;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 "'"
;;#+ bigloo
;   (integer->string (date-year dt))      ; 0-3
;   (pre-zero2 (date-month dt))           ; 4-5
;   (pre-zero2 (date-day dt))             ; 6-7
;   "T"                                   ; 8
;   (pre-zero2 (date-hour dt))            ; 9-10
;   (pre-zero2 (date-minute dt))          ; 11-12
;   (pre-zero2 (date-second dt))         ; 13-14
;#+ mzscheme
  (date->string dt "~Y~m~dT~H~M~S")

(define (db2date dt)
;;#+ bigloo  2005-05-06 10:20:30 0-4 5-7 8-10 11-13 14-16 17-20
;  (make-date
;   (string->integer (substring dt 17 19))  ; seconds
;   (string->integer (substring dt 14 16))  ; minutes
;   (string->integer (substring dt  11 13))  ; hours
;   (string->integer (substring dt  8  10))  ; day
;   (string->integer (substring dt  5  7))  ; month
;   (string->integer (substring dt  0  4))  ; year
;   )
  (string->date dt "~Y-~m-~d ~H:~M:~S")
;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
;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))
					;(thread exec-query)
					;(semaphore-wait sem)
	(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)))
	(set! row (+ row 1))
	(if (>= row nrows)
	    (f 0))))

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

	   ((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)

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

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

	   ((eq? cmd 'disconnect) 
	      (c-psql-close db)
	      (set! valid-handle #f)))
	   (else (ierr "Unknown command")))))))
;=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)

       ((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"))))))

;#+ mzscheme
(provide sqld-psql-new))