;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Package   : sqld-sqlite.scm
;;; Author    : Hans Oesterholt-Dijkema.
;;; Copyright : HOD 2004/2005.
;;; License   : The Elemental Programming Artistic License.
;;; CVS       : $Id: sqld-sqlite-internal.scm,v 1.2 2006/01/05 00:19:25 HansOesterholt Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=pod
;
;=head1 Name
;
;SQLD-SQLite - SQL Driver for SQLite
;
;=head1 Description
;
;This is an SQLite 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-sqlite-new connection-info) : closure>
;
;Calling this function with a valid SQLite database filename,
;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-sqlite)
; 	(main main))
;
; (define (main argv)
;   (let* ((sqld    (sqld-sqlite-new "test.db"))
; 	   (sqlh    (sqli-connect sqld))
;
; (...)
;
;=head1 Literate section
;
;This module L<interfaces with a C part|SQLD-SQLite - C part> that interfaces to the
;sqlite library. The interface is built for SQLite version 3.
;
;=head2 Module definition
;
;The module definition is as follows:
;
;=verbatim scm,8
;;#+ bigloo
;(module sqld-sqlite-internal
;	(extern
;	 (type void* (pointer void) "void *")
;	 (c-sqlite-open::void* (::string) "c_sqlite_open")
;	 (c-sqlite-close::int (::void*) "c_sqlite_close")
;	 (c-sqlite-query::void* (::void* ::string) "c_sqlite_query")
;	 (c-sqlite-nrows::int (::void*) "c_sqlite_nrows")
;	 (c-sqlite-ncols::int (::void*) "c_sqlite_ncols")
;	 (c-sqlite-cell::string (::void* ::int ::int) "c_sqlite_cell")
;	 (c-sqlite-lasterr::string (::void*) "c_sqlite_lasterr")
;	 (c-sqlite-version::int () "c_sqlite_version"))
;	(export
;	 (sqld-sqlite-new connection-info)))
;#+ mzscheme
(module sqld-sqlite-internal mzscheme
	(require (lib "time.ss" "srfi" "19"))
	(require "c-sqld-sqlite.scm")
;##
;=verbatim
;
;As can be seen, only one function is exported, the C<sqld-sqlite-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.
;
;C<re-quote> defines a precompiled regular expression. This expression
;is used to escape the single quotes in a string.
;
;=verbatim scm,8
;;#+ bigloo
;(define re-quote (pregexp "[']"))
;#+ mzscheme
(define re-quote (regexp "[']"))
;##
;=verbatim
;
;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)
  (define (d msg)
    (if (null? msg)
	(newline)
	(begin
	  (display (car msg))
	  (d (cdr msg)))))
  (begin
    (d msg)
    #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.
;
;SQLite 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)
;;#+ bigloo
;  (string-append "'" (pregexp-replace* re-quote s "''") "'"))
;#+ mzscheme
  (string-append "'" (regexp-replace* re-quote s "''") "'"))
;##
;=verbatim
;
;The date types aren't known in SQLite, so a date type is constructed
;from the bigloo date type, using a broken ISO8601 encoding (the zone
;info part is not there).
;
;The interpretation back from the database is done by expecting the
;same broken ISO8601 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 n) (number->string n))))
(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
;  (make-date
;   (string->integer (substring dt 13 15))  ; seconds
;   (string->integer (substring dt 11 13))  ; minutes
;   (string->integer (substring dt  9 11))  ; hours
;   (string->integer (substring dt  6  8))  ; day
;   (string->integer (substring dt  4  6))  ; month
;   (string->integer (substring dt  0  4))  ; year
;   )
;#+mzscheme
  (string->date dt "~Y~m~dT~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-sqlite-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 SQLite
;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-sqlite-connect connection-info)
  (let ((db (c-sqlite-open connection-info))
	(current-query-result #f)
	(valid-handle #t)
	(nrows 0)
	(ncols 0)
	(row 0)
	(in-transaction #f))

    (define (query q)
      (set! current-query-result (c-sqlite-query db q))
      (set! row -1)
      (set! ncols (c-sqlite-ncols current-query-result))
      (set! nrows (c-sqlite-nrows current-query-result)))

    (define (fetch)

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


    (lambda (cmd . args)
;      (ierr "sqld-sqlite: " 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) "1" "0"))

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

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

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

	   ((eq? cmd 'begin) 
	    (begin
	      (if (not (eq? in-transaction #t)) 
		  (query "BEGIN;"))
	      (set! in-transaction #t)))

	   ((eq? cmd 'commit) 
	    (begin
	      (if (eq? in-transaction #t)
		  (query "COMMIT;"))
	      (set! in-transaction #f)))
	    
	   ((eq? cmd 'rollback) 
	    (begin
	      (if (eq? in-transaction #t)
		  (query "ROLLBACK;"))
	      (set! in-transaction #f)))

	   ((eq? cmd 'query) (query (car args)))

	   ((eq? cmd 'disconnect) 
	    (begin
	      (c-sqlite-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-sqlite-new>.
;This function takes C<connection-info> as an argument, which must be
;an SQLite 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 SQLite * 100 +
;the minor version number.
;
;=verbatim scm,8
(define (sqld-sqlite-new _connection-info)
  (let ((connection-info _connection-info))
    (lambda (cmd . args)
      (cond

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

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

       (else (ierr "ERROR: Connect to the datebase first"))))))
;=verbatim
;
;=cut


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