;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Package   : sqli.scm
;;; Author    : Hans Oesterholt-Dijkema.
;;; Copyright : HOD 2004/2005.
;;; License   : LGPL.
;;; CVS       : $Id: sqli.scm,v 1.13 2007/07/16 19:55:09 hoesterholt Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=pod
;
;=head1 Name
;
;SQLI - SQL Interface module
;
;=head1 Description
;
;This SQL Interface module for mzscheme provides a simple interface
;to connect to databases. It works by connecting to a database
;through a given SQL Driver closure; and provides functions
;for handling SQL.
;
;=head1 Author
;
;Hans Oesterholt-Dijkema <hans-at-elemental-programming%dt#org>.
;
;=head1 License
;
;This module is distributed under the LGPL.
;(c) 2004/2005 Hans Oesterholt-Dijkema.
;
;=head1 Version
;
;$Id: sqli.scm,v 1.13 2007/07/16 19:55:09 hoesterholt Exp $
;
;=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))
;          (sqli    (sqli-closure sqlh))
;          (results (list)))
;
;     (print (sqli 'driver-name) " - " (sqli 'driver-version))
;
;     (sqli 'query "SELECT * FROM test_table;")
;   
;     (do
; 	((a (sqli 'fetchrow) (sqli 'fetchrow)))
; 	((eq? a #f) #t)
;       (print a))
;
;     (sqli 'begin)
;     (do
; 	((i 1 (+ i 1)))
; 	((> i 10) #t)
;       (sqli 'query
;             "INSERT INTO test_table VALUES ($1, $2)"
;             (string-append "row'" (number->string i)) i))
;     (sqli 'commit)
;
;     (sqli 'register
; 	  'a-selection
; 	  "SELECT $1 FROM test_table WHERE age $2 $3"
; 	  (lambda (a) (list (car a) "cvt" (string->number (cadr a)))))
;     (print (sqli 'exec 'select 'name '> 2))
;     (print (sqli 'fetchall))
;
;     (sqli 'register 'count
;           "SELECT COUNT(*) FROM test_table"
;           (lambda (row) (car row)))
;     (sqli 'exec 'count)
;     (print (sqli 'fetchrow))
;   
;     (sqli 'register 'some
;           "SELECT name FROM test_table WHERE name LIKE '$1%'")
;     (print (sqli 'exec 'some (list "John")))
;     (print (sqli 'fetchall))
;
;     (sqli 'disconnect)
;   0))
;
;=head1 API
;
;=head2 Connection handling
;
;=over 1
;
;=head3 C<(sqli-connect sql-driver) : sqli-handle>
;
;This function connects to the database represented by C<sql-driver>.
;It returns a handle to the driver, or C<#f>, if something went
;wrong.
;
;=head3 C<(sqli-disconnect sqli-handle) : unspecified>
;
;This function disconnects a given sqli-handle from the database.
;This function must always be called before a variable goes out
;of scope.
;
;=back
;
;=head2 Queries
;
;=over 1
;
;=head3 C<(sqli-query sqli-handle query . args) : boolean>
;
;F<sqli-query> executes an SQL query to the sqli-handle. An SQL
;statement can contain arguments of form '$n', where C<1E<lt>=nE<lt>=(length args)>
;Arguments are interpreted:
;
;=over 1
;
;=item *
;
;C<Symbols> are converted to strings, without quotes (usefull for
;column names, operations, etc.).
;
;=item *
;
;C<strings> are converted to quoted strings ((var)char, etc. in
;SQL).
;
;=item *
;
;C<a list of a string> is converted to a string, without quotes.
;This construct can be used when one wants to use strings in
;expressions, etc.
;
;=item *
;C<a vector of a string> is taken literally, i.e. not converted.
;
;=item *
;
;C<integers> and C<numbers> are converted accordingly.
;
;=item *
;
;C<date> types are converted to Database dependent timestamps.
;
;=item *
;
;C<boolean> types are converted to Database dependent booleans.
;
;=back
;
;This function returns C<#t>, if an error occured, C<#f>, otherwise.
;
;=head3 C<(sqli-register sqli-handle name query . conversion-function) : unspecified>
;
;With this function an SQL statement, with the same possibilties as
;with the sqli-query function, can be registered for later processing.
;The advantage of this approach, is that a conversion function can
;be registered along with the registered query. This conversion function
;is called for each fetched row of a query.
;
;Note! If the conversion function converts a list of elements to a
;single atom, and this atom equals #f, the fetchall function will
;fail to retreive all rows.
;
;=head3 C<(sqli-register sqli-handle name query . types) : unspecified>
;
;With this function an SQL statement, with the same possibilties as
;with the sqli-query function, can be registered for later processing.
;With this function, the expected types can be given as symbols. Fetched
;rows are converted to the expected types. The following types can be used:
;
;=over 1
;
;=item 'string
;
;Type string is expected.
;
;=item 'int
;
;Type integer (exact number) is expected.
;
;=item 'number
;
;Type number (exact or inexact) is expected.
;
;=item 'date
;
;Type date is expected.
;
;=item 'bool
;
;Type boolean is expected.
;
;=back
;
;=head3 C<(sqli-exec sqli-handle name . args) : boolean>
;
;With this function a previously registered SQL statement can be
;executed (using arguments 'args'). Arguments are interpreted the
;same way as with F<sqli-query>.
;
;=back
;
;=head2 Transaction processing
;
;Please note: The transaction functions can be called recursively,
;but one must not intermix commits and rollbacks!
;
;=over 1
;
;=head3 C<(sqli-begin sqli-handle) : boolean>
;
;This function starts a transaction on the given sqli-handle. It
;returns C<#t>, if something went wrong, C<#f>, othwerwise.
;This function can be called recursively. Only the first begin
;will be given to the sqld driver.
;
;=head3 C<(sqli-commit sqli-handle) : boolean>
;
;This function commits a transaction on the given sqli-handle. It
;returns C<#t>, if something went wrong, C<#f>, othwerwise.
;This function can be called recursively. Only the last commit
;will be given to the sqld driver.
;
;=head3 C<(sqli-rollback sqli-handle) : boolean>
;
;This function rolls back a transaction on the given sqli-handle. It
;returns C<#t>, if something went wrong, C<#f>, othwerwise.
;This function can be called recursively. Only the last rollback
;will be given to the sqld driver.
;
;=head3 c<sqli-transaction-count sqli-handle) : integer>
;
;Returns the sqli-begin depth for this handle.
;
;=back
;
;=head2 Fetching
;
;=over 1
;
;=head3 C<(sqli-fetchrow sqli-handle) : list>
;
;F<sqli-fetchrow> fetches a row from the last query executed.
;It returns C<#f>, if no (more) rows can be fetched, returns
;a list of results (depending on the conversion function,
;this can be different) otherwise (see L<synopsis|/Synopsis>).
;
;=head3 C<(sqli-fetch sqli-handle count) : list>
;
;F<sqli-fetch> fetches at most C<count> rows from the last
;query for C<sqli-handle>. Returns a list of rows (or the
;empty list, if no row could be fetched).
;
;=head3 C<(sqli-fetchall sqli-handle) : list>
;
;F<sqli-fetchall> fetches all rows from the last query
;for C<sqli-handle>. Returns a list of rows like F<sqli-fetch>.
;If the first F<sqli-fetch> returns #f, the list will be empty
;(null? property).
;
;=back
;
;=head2 Closure interface
;
;=over 1
;
;=head3 C<(sqli-closure sqli-handle) : procedure>
;
;Makes a closure from C<sqli-handle>, that can be treated like
;an object interface for the C<sqli-handle>. All functions
;are called through this closure, using a symbol that denotes
;the function. E.g.:
;
;C<(sqli-closure 'fetchrow)>, fetches a row.
;
;=back
;
;=head2 Predicates, error handling and conversions
;
;=over 1
;
;=head3 C<(sqli? obj) : boolean>
;
;Returns C<#t>, if C<obj> is of type C<sqli>. Note:
;C<(list? sqli-handle)> will return C<#t> also.
;
;=head3 C<(sqli-error? handle)>
;
;Returns C<#t>, if the last query reported an error.
;Returns C<#f>, otherwise.
;SQL error: database is locked

;=head3 C<(sqli-error-message handle)>
;
;Returns the error message that complements the C<sqli-error?>
;indication.
;
;=head3 C<(sqli-convert handle string T) : object of type T>
;
;Converts string as returned from the database query
;to type; where type is a symbol indicating the scheme type
;to convert to. Currently, 'date, 'boolean, 'string, 'number
;and 'integer are supported.
;
;=head3 C<(sqli-driver-name sql-driver) : string>
;
;Returns the driver name in lower case (e.g. sqlite). Refer to the
;driver documentation to get more information on this.
;
;Note! This function works on both the B<sql-driver> and the
;sqli connection handle.
;
;=head3 C<(sqli-driver-version sql-driver) : integer>
;
;Returns the driver version as an integer (e.g. 307 or 285 (for sqlite)).
;Refer to the driver documentation for more information on this.
;
;Note! This function works on both the B<sql-driver> and the
;sqli connection handle.
;
;=head3 C<(sqli-last-query) : string>
;
;Returns the last query that has been executed by the sqlid driver.
;
;=head3 C<(sqli-version) : integer>
;
;Returns the version of SQLI as an integer. Major part*100+minor part.
;
;=back
;
;=wikiwikiwiki
;
;==ROOS Interface
;
; >(require (planet "sqli-oo.scm" ("oesterholt" "sqlid.plt" 1 0)))
; >(require (planet "sqld-sqlite.scm" ("oesterholt" "sqlid.plt" 1 0)))
; >(define d (sqld-sqlite "test.db"))
; >(define o (sqli-oo d))
; >(-> o connect)
; >(-> o error?)
; #f
; >(-> o query "select * from test")
; #f
; >(-> o fetchall)
; (("3"))
; >
;
;#sqli-oo# forms a ROOS layer on top of #sqli#.
;
;===#(-> o connect)#
;
;Equivalent to #sqli-connect#.
;
;===#(-> o disconnect)#
;
;Equivalent to #sqli-disconnect#.
;
;===#(-> o query . args)#
;
;Equivalent to #sqli-query#.
;
;===#(-> o register name query . conv-func|types)#
;
;Equivalent to #sqli-register#.
;
;===#(-> o exec name . args)#
;
;Equivalent to #sqli-exec#.
;
;===#(-> o begin-work)#
;
;Equivalent to #sqli-begin#.
;
;===#(-> o commit)#
;
;Equivalent to #sqli-commit#.
;
;===#(-> o rollback)#
;
;Equivalent to #sqli-rollback#.
;
;===#(-> o fetchrow)#
;
;Equivalent to #sqli-fetchrow#.
;
;===#(-> o fetch n)#
;
;Equivalent to #sqli-fetch#.
;
;===#(-> o fetchall)#
;
;Equivalent to #sqli-fetchall#.
;
;===#(-> o error?)#
;
;Equivalent to #sqli-error?#.
;
;===#(-> o errmsg) | (-> o error-message)#
;
;Equivalent to #sqli-error-message#.
;
;===#(-> o driver-name)#
;
;Equivalent to #sqli-driver-name#.
;
;===#(-> o driver-version)#
;
;Equivalent to #sqli-driver-version#.
;
;===#(-> o version)#
;
;Equivalent to #sqli-version#.
;
;===#(-> o last-query)#
;
;Equivalent to #sqli-last-query#.
;
;===#(-> o -><type> string-from-db)#
;
;Equivalent to #sqli-convert# with the given type:
;
; (-> o ->date dbstr)          <=> (sqli-convert handle dbstr 'date)
; (-> o ->bool dbstr)          <=> (sqli-convert handle dbstr 'boolean)
; (-> o ->boolean dbstr)       <=> (sqli-convert handle dbstr 'boolean)
; (-> o ->integer dbstr)       <=> (sqli-convert handle dbstr 'integer)
; (-> o ->number dbstr)        <=> (sqli-convert handle dbstr 'number)
; (-> o ->symbol dbstr)        <=> (sqli-convert handle dbstr 'symbol)
; (-> o ->string dbstr)        <=> (sqli-convert handle dbstr 'string)
; (-> o ->scheme-data dbstr)   <=> (sqli-convert handle dbstr 'scheme-object)
; (-> o ->scheme-object dbstr) <=> (sqli-convert handle dbstr 'scheme-object)
;
;===#(-> o ->var string-from-db var)#
;
;Determines from the type of var, which conversion to use.
;Returns the converted string. Doesn't set #var#
;
;  (srfi:date? var)                   => ->date
;  (boolean? var)                     => ->bool
;  (and (number? var) (exact? var))   => ->integer
;  (and (number? var) (inexact? var)) => ->number
;  (symbol? var)                      => ->symbol
;  (string? var)                      => ->string
;  else                               => ->scheme-object
;
;=Drivers

;==SQLite driver
;
;Initialize the SQLite driver with #DSN=<filename of database>#.
;E.g.:
;
; (sqld-sqlite-new "test.db")
;
;==PostgreSQL driver
;
;Initialize the PostgreSQL driver with a PostgreSQL connection string.
;E.g.:
;
; (sqld-psql-new "dbname=test user=test password=test host=localhost")
;
;==MySQL driver
;
;Initialize the MySQL driver with #DSN=![<user>] ![<password>] <database> ![<hostname>] ![<port>]#, E.g.:
;
; (sqld-mysql-new "db=test user=test passwd=test host=localhost port=3306")
; (sqld-mysql-new "db=test user=me passwd=mypassword")
;
;==Oracle driver
;
;Initialize the Oracle driver with an Oracle dsn, e.g.:
;
; (sqld-oracle-new "scott/tiger")
;
;==DB2 driver
;
;Initialize the DB2 driver with a DB2 dsn, e.g.:
;
; (sqld-db2-new "alias=test user=me passwd=mypassword")
;
;=wikiwikiwiki
;
;=head1 Literate part
;
;=head2 Module descriptor
;
;This SQLI module has been designed for use with
;mzscheme. The sqli module begins with a module description.
;
;=verbatim scm,8
(module sqli mzscheme
	(require (lib "time.ss" "srfi" "19"))
;=verbatim
;
;In the module description, all exported functions are defined.
;
;=head2 The definition of a handle
;
;The SQLI module uses a handle to a database connection
;for transportation of connection- and status information.
;The handle is build as follows:
;
; (list 'sqli
;        E<lt>driver closureE<gt>
;        E<lt>list of registered queriesE<gt>
;        E<lt>conversion function for the last queryE<gt>)
;
;The driver is the C<sql-driver> that has been given to
;the F<sqli-connect> function. This is a closure that handles
;commands. See the
;L<interface description|SQLD - Interface description for SQLI drivers>
;for a description of the functionality that a driver must implement.
;
;The list of registered queries contains all query-templates and
;conversion functions currently registered.
;
;The conversion function is conversion function for the last
;query executed by the sql driver. A value of B<'nil-converter>
;indicates that there is no conversion function.
;
;=head2 Exported functions
;
;The F<sqli?> function returns true, if obj is a list, not null
;and the car of this list is equal to 'sqli.
;
;=verbatim scm,8
(define (sqli? obj)
  (if (list? obj)
      (if (null? obj)
          #f
          (eq? (car obj) 'sqli))
      #f))

(define (check-handle F handle)
  (if (sqli? handle)
      #t
      (error (format "~a: given handle: '~s' is not an sqli handle" F handle))))
;=verbatim
;
;Connection to the sql driver is simply done by constructing
;a sqli handle. Disconnecting is done by calling the sql driver
;with symbol 'disconnect. The driver must then invalidate itself.
;
;=verbatim scm,8

(define (sqli-connected? handle)
  (check-handle 'sqli-connected? handle)
  (cadddr (cddddr (cdddr handle))))

(define (sqli-connected! handle jn)
  (check-handle 'sqli-connected! handle)
  (set-car! (cdddr (cddddr (cdddr handle))) jn)
  handle)
  
(define FINALIZER (make-will-executor))
(define FINALIZE  (thread (lambda () 
                            (letrec ((f (lambda ()
                                          (will-execute FINALIZER)
                                          (f))))
                              (f)))))
(define (FIN-HANDLE handle)
  (if (> (sqli-transaction-count handle) 0)
      (error (format "Finalizing sqli connection. SQLI handle is in the middle of a transaction (count=~a)"
                     (sqli-transaction-count handle))))
  (if (sqli-connected? handle)
      ((cadr handle) 'disconnect)))
  
(define (sqli-connect sql-driver)
  (let ((R (list 'sqli (sql-driver 'connect) (list) 'nil-converter "" 0 
                 (sql-driver 'name) (sql-driver 'version) "" #f #t)))
    (if (sqli-error? R)
        (sqli-connected! R #f)
        (will-register FINALIZER R FIN-HANDLE))
    R))

(define (sqli-disconnect handle)
  (check-handle 'sqli-disconnect handle)
  (if (> (sqli-transaction-count handle) 0)
      (error (format "Disconnecting an sqli handle in the middle of a transaction (count=~a)" 
                     (sqli-transaction-count handle))))
  (let ((R ((cadr handle) 'disconnect)))
    (sqli-connected! handle #f)
    R))

(define (_sqli-error-message handle . args)
  (let ((L (cddddr (cddddr handle))))
    (if (not (null? args)) (set-car! L (car args)))
    (car L)))

;=verbatim
;
;Error handling is very simple. The F<sqli-error-message> function
;queries the last error of the sql driver. This last error is a
;string reporting an error. If this string equals "" (the empty
;string), there is no error.
;
;=verbatim scm,8
(define (my-string=? a b)
  (and (string? a) (string? b) (string=? a b)))

(define (sqli-error-message handle)
  (check-handle 'sqli-error-message handle)
  (if (not (my-string=? (_sqli-error-message handle) ""))
      (_sqli-error-message handle)
      ((cadr handle) 'lasterr)))

(define (sqli-error? handle)
  (check-handle 'sqli-error? handle)
  (or (not (my-string=? (_sqli-error-message handle) ""))
      (not (my-string=? (sqli-error-message handle) ""))))

;=verbatim
;
;Driver name and version are simply calls wirh the equivalent commands
;to the SQL Driver. Works for both the sql driver handle and the sqli handle
;after connect.
;
;=verbatim scm,8
(define (sqli-driver-name sqlh)
  (if (sqli? sqlh)
      (caddr (cddddr sqlh))
      (sqlh 'name)))

(define (sqli-driver-version sqlh)
  (if (sqli? sqlh)
      (cadddr (cddddr sqlh))
      (sqlh 'version)))
;=verbatim
;
;Transactions are simply left to the sql driver to handle. The sqli
;driver is called with the symbols 'begin, 'commit or 'rollback.
;Each function returns F<sqli-error?>, which then reports about
;this last "query" to the driver.
;
;These functions can be called recursively. Only the first begin will
;be given to the driver. Only the last commit will be given to the
;driver. Only the last rollback will be given to the driver.
;
;=verbatim scm,8
(define-syntax gcount
  (syntax-rules ()
    ((_ handle)
     (cdr (cddddr handle)))))

(define (sqli-begin handle)
  (check-handle 'sqli-begin handle)
  (let ((count (gcount handle)))
    (if (= (car count) 0)
        ((cadr handle) 'begin))
    (if (not (sqli-error? handle))
        (set-car! count (+ (car count) 1)))
    (sqli-error? handle)))

(define (sqli-commit handle)
  (check-handle 'sqli-commit handle)
  (let ((count (gcount handle)))
    (set-car! count (- (car count) 1))
    (if (= (car count) 0)
        ((cadr handle) 'commit)
        (if (< (car count) 0)
            (set-car! count 0)))
    (sqli-error? handle)))

(define (sqli-rollback handle)
  (check-handle 'sqli-rollback handle)
  (let ((count (gcount handle)))
    (set-car! count (- (car count) 1))
    (if (= (car count) 0)
        ((cadr handle) 'rollback)
        (if (< (car count) 0)
            (set-car! count 0)))
    (sqli-error? handle)))

(define (sqli-transaction-count handle)
  (car (gcount handle)))

;=verbatim
;
;Fetching rows from a last query is done by calling the sql driver
;using symbol 'fetchrow. A conversion function is conditionally
;called for the fetched row, but only if the call to the sql driver
;does not return C<#f> and the conversion function does not equal
;'nil-converter. I.e., the procedure? predicate must apply to
;the converter.
;
;Note! The default format for rows is a list of elements. If the
;conversion function converts a list of elements to a single atom,
;and this atom equals C<#f>, the C<fetchall> function will fail
;to retreive all rows.
;
;The functions for fetching all rows or C<count> rows are simply
;implemented by subsequental calls to F<sqli-fetchrow>.
;
;=verbatim scm,8
(define (sqli-fetchrow handle)
  (check-handle 'sqli-fetchrow handle)
  (if (eq? (cadddr handle) 'nil-converter)
      ((cadr handle) 'fetchrow)
      (let ((row ((cadr handle) 'fetchrow)))
	(if (eq? row #f) 
	    #f
	    ((cadddr handle) row)))))

(define (sqli-fetchall handle)
  (check-handle 'sqli-all handle)
  (do
      ((l (list))
       (r (sqli-fetchrow handle) (sqli-fetchrow handle)))
      ((eq? r #f) (reverse l))
    (set! l (cons r l))))

(define (sqli-fetch handle count)
  (check-handle 'sqli-fetch handle)
  (do
      ((l (list))
       (i 0 (+ i 1))
       (row (sqli-fetchrow handle) (sqli-fetchrow handle)))
      ((or (>= i count) (eq? row #f)) (reverse l))
    (set! l (cons row l))))
;=verbatim
;
;There are two types of queries. Direct queries, which by default
;don't have ;conversion functions attached to them; and registered
;queries, which can have conversion functions attached to them.
;
;Queries are SQL statements with numbered arguments ($1, $2, ...).
;Arguments given to the F<sqli-query> or F<sqli-exec> functions
;are used to substitute the numbered arguments with. The first
;argument being $1 and counting onwards. Note: arguments are not
;substituted on a positional basis. Multiple $i's are substituted
;all at the same time. E.g.:
;
;In S<C<(sqli-query sqli-handle "SELECT $1 FROM test WHERE $1E<gt>0" 'age)>>,
;all $1 fields are substituted with "age".
;
;Queries can be registered using a name. This name must be a symbol.
;Registered queries are executed using F<sqli-exec>. For two different queries,
;that are registered subsequently under the same symbol, only the last one can
;be retreived.
;
;=verbatim scm,8
(define (sqli-internal-query handle query args)
  ((cadr handle) 'query (sqli-make-query handle (sqli-split-query query) 'nil-converter args))
  (sqli-error? handle))

(define (sqli-query handle query . args)
  (check-handle 'sqli-query handle)
  (_sqli-error-message handle "")
  (sqli-internal-query handle query args))

(define (sqli-standard-converter handle row types)
  (define (convert row types)
    (if (null? row)
        (list)
        (if (null? types)
            row
            (cons (sqli-convert handle (car row) (car types))
                  (convert (cdr row) (cdr types))))))

  (convert row types))
      
(define (sqli-register handle name _query . _converter_or_types)
  (check-handle 'sqli-register handle)
  (let ((converter (if (null? _converter_or_types)
                       'nil-converter
                       (if (symbol? (car _converter_or_types))
                           (lambda (row) (sqli-standard-converter handle row _converter_or_types))
                           (car _converter_or_types))))
        (query (sqli-split-query _query)))

    (define (update queries)
      (if (null? queries)
          (list)
          (if (equal? (caar queries) name)
              (update (cdr queries))
              (cons (car queries) (update (cdr queries))))))

    (begin
      (set-car! (cddr handle)
                (cons (list name converter query) (update (caddr handle))))
      handle)))

(define (sqli-internal-exec handle name args)
  
  (define (get queries)
    (if (null? queries)
        #f
        (if (equal? (caar queries) name)
            (car queries)
            (get (cdr queries)))))

  (define (copy query)
    (if (null? query)
	(list)
	(cons (car query) (copy (cdr query)))))

  (let ((Q (get (caddr handle))))
    (if (eq? Q #f)
        (begin
          (_sqli-error-message handle (format "Cannot find query ~s" name))
          #f)
        (let* ((converter (cadr Q))
               (query (caddr Q)))
          ((cadr handle) 'query (sqli-make-query handle (copy query) converter args))))
    
    (sqli-error? handle)))

(define (sqli-exec handle name . args)
  (check-handle 'sqli-exec handle)
  (_sqli-error-message handle "")
  (sqli-internal-exec handle name args))
;=verbatim
;
;The F<sqli-convert> function can be used to
;convert results from queries from database format to
;scheme format. It currently converts for the
;scheme type 'date, 'boolean, 'integer, 'number and 'string,
;'symbol and 'scheme-object. A 'scheme-object type can be
;made with a write to a string port.
;
;The F<sqli-2db> function can be used to
;convert values to database format. It supports
;all scheme types in a generic way, but has
;special arrangements for 'data, 'boolean, 'number, 'string
;and 'symbol.
;
;=verbatim scm,8

;#+ mzscheme
(define-syntax string->integer
  (syntax-rules ()
    ((_ s) (inexact->exact (round (string->number s))))))
;##

(define (sqli-convert handle str type)
  (cond
   ((eq? type 'date) ((cadr handle) 'db2date str))
   ((eq? type 'boolean) ((cadr handle) 'db2bool str))
   ((eq? type 'integer) (string->integer str))
   ((eq? type 'number) (string->number str))
   ((eq? type 'symbol) (string->symbol str))
   ((eq? type 'string) str)
   ((eq? type 'scheme-object) (let ((fh (open-input-string str)))
                                (let ((scheme-object (read fh)))
                                  (close-input-port fh)
                                  scheme-object)))
   (else (ierr "Unknown type given to sqli-convert"))))

(define (sqli-2db handle arg)
  (let ((sqld (cadr handle)))
    (cond
     ((symbol? arg) (symbol->string arg))    ; A not portable way to distinguish
					; between fields and strings
     ((boolean? arg) (sqld 'bool2db arg))
     ((string? arg) (sqld 'string2db arg))
     ((list? arg)
      (let ((s (sqld 'string2db (car arg))))
        (substring s 1 (- (string-length s) 1))))
     ((vector? arg)
      (vector-ref arg 0))
     ((integer? arg) (sqld 'int2db arg))
     ((number? arg) (sqld 'number2db arg))
     ((srfi:date? arg) (sqld 'date2db arg))
     (else
      (let ((str (open-output-string)))
        (write arg str)
        (let ((s (get-output-string str)))
          (close-output-port str)
          (sqli-2db handle s))
        )))))
;=verbatim
;
;The C<sqli-last-query> function returns the last query executed by the sqlid driver.
;
;=verbatim scm,8
(define (sqli-last-query handle)
  (check-handle 'sqli-last-query handle)
  (cadddr (cdr handle)))
;=verbatim
;
;The C<sqli-version> function returns the current version
;of SQLI.
;
;=verbatim scm,8
(define (sqli-version)
  (let* ((V "1.3"))
    (inexact->exact (round (* V 100)))))
;=verbatim
;
;The C<sqli-debug?> function returns if sqli is currently
;in debugging mode. With C<sqli-debug!> one can set debugging
;mode.
;
;=verbatim scm,8
(define (sqli-debug? handle)
  (cadr (cddddr (cddddr handle))))

(define (sqli-debug! handle d)
  (set-car! (cdr (cddddr (cddddr handle))) d)
  (sqli-debug? handle))

(define-syntax debug
  (syntax-rules ()
    ((_ handle str) (if (sqli-debug? handle)
                        (begin
                          (display "SQLI<debug>:")
                          (display str)
                          (newline))))))
;=verbatim
;
;With the F<sqli-closure> function, a closure can be made from the
;sqli-handle. This can be convenient, if one wants to have a more
;object oriented interface to the SQLI handle. For the sqli closure,
;all functions in sqli-E<lt>functionE<gt>, are replaced by 'function.
;Example:
;
;For C<(define a (sqli-closure sqli-handle))>: C<(a 'exec 'test)> does
;the same as C<(sqli-exec sqli-handle 'test)>.
;
;=verbatim scm,8
(define (sqli-closure handle)
  (check-handle 'sqli-closure handle)
  (let ((sqli handle))
    (lambda (cmd . args)
      (cond
       ((eq? cmd 'convert) (sqli-convert handle (car args) (cadr args)))

       ((eq? cmd 'fetchrow) (sqli-fetchrow handle))
       ((eq? cmd 'fetch) (sqli-fetch handle (car args)))
       ((eq? cmd 'fetchall) (sqli-fetchall handle))
       ((eq? cmd 'error?) (sqli-error? handle))

       ((eq? cmd 'exec) (sqli-internal-exec handle (car args) (cdr args)))
       ((eq? cmd 'query) (sqli-internal-query handle (car args) (cdr args)))

       ((eq? cmd 'begin) (sqli-begin handle))
       ((eq? cmd 'commit) (sqli-commit handle))
       ((eq? cmd 'rollback) (sqli-rollback handle))
	   ((eq? cmd 'register) (sqli-register handle 
                                               (car args)
                                               (cadr args)
                                               (caddr args)))

           ((eq? cmd 'error-message) (sqli-error-message handle))

           ((eq? cmd 'disconnect) (sqli-disconnect handle))

           (else (ierr (string-append "sqli-closure: Unknown command "
                                      (symbol->string cmd)
                                      " given")))))))
;=verbatim
;
;=head2 Internal functions
;
;These functions are used to facilitate exported functions.
;
;The F<sqli-make-query> function prepares a query by substituting
;all numbered arguments using the provided arguments. Also, it
;converts strings, integers, numbers and dates to database
;format. It works on a previously splitted query.
;
;=verbatim scm,8
(define (sqli-make-query handle query converter args)

  (let ((sqld (cadr handle)))

    (define (replace l i val)
      (if (null? l)
          #t
          (begin
            (if (number? (car l))
                (if (= (car l) i)
                    (set-car! l val)))
            (replace (cdr l) i val))))

    (define (convert arg)
      (let ((R (sqli-2db handle arg)))
        (debug handle (format "converting from ~s to ~s" arg R))
        R))

    (define (make-string l)
      (if (null? l)
          ""
          (string-append (car l) (make-string (cdr l)))))

    (define (make-query query args i)
      (if (null? args)
          (make-string query)
          (begin
            (replace query i (convert (car args)))
            (make-query query (cdr args) (+ i 1)))))

    (begin
      (set-car! (cdddr handle) converter)
      (set-car! (cddddr handle) (make-query query args 1))
      (car (cddddr handle)))))
;=verbatim
;
;The C<sqli-split-query> function is used to split a query
;with $n arguments in components.
;
;=verbatim scm,8
(define (sqli-split-query query)
  (do
	  ((l (list))
           (s 0)
           (k 0)
           (j 0)
           (N (string-length query))
           (i 0 (+ i 1)))
          ((>= i N)
           (reverse
            (if (= s 2)
                (cons (string->number (substring query (+ k 1) i)) (cons (substring query j k) l))
                (cons (substring query j i) l))))
          (let ((c (string-ref query i)))

            (if (= s 1)
                (if (and (char>=? c #\0) (char<=? c #\9))
                    (set! s 2)
                    (set! s 0))
                (if (= s 2)
                    (if (not (and (char>=? c #\0) (char<=? c #\9)))
                        (begin
                          (set! l (cons (string->number (substring query (+ k 1) i)) (cons (substring query j k) l)))
                          (set! s 0)
                          (set! j i)))))

            (if (= s 0)
              (if (char=? c #\$)
                  (begin
                    (set! s 1)
                    (set! k i)))))))
;=verbatim
;
;The F<ierr> function prints an error and returns C<#f>. This
;function is used to report errornous use of functions or
;other problems.
;
;=verbatim scm,8
(define (ierr . args)
  (define (f args)
    (if (null? args)
	(display "")
	(begin
	  (display (car args))
	  (f (cdr args)))))
  (display "ERROR: ")
  (f args)
  (newline)
  #f)
;=verbatim
;
;=cut

(provide  sqli-connect
	  sqli-disconnect
	  sqli-begin
	  sqli-query
	  sqli-fetchrow
	  sqli-fetchall
	  sqli-fetch
	  sqli-commit
	  sqli-rollback
      sqli-transaction-count
	  sqli? 
	  sqli-register
	  sqli-exec
	  sqli-closure
	  sqli-error-message
	  sqli-error? 
	  sqli-driver-name
	  sqli-driver-version
      sqli-last-query
      sqli-version
	  sqli-convert
      sqli-debug!
      sqli-debug?
	  sqli-2db))
;##