Please note: The transaction functions can be called recursively, but one must not intermix commits and rollbacks!

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

(-> o disconnect)

(-> o query . args)

(-> o register name query . conv-func|types)

(-> o exec name . args)

(-> o begin-work)

(-> o commit)

(-> o rollback)

(-> o fetchrow)

(-> o fetch n)

(-> o fetchall)

(-> o error?)

(-> o errmsg) | (-> o error-message)

(-> o driver-name)

(-> o driver-version)

(-> o version)

(-> o last-query)

(-> o -><type> string-from-db)

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

  (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

Initialize the SQLite driver with DSN=<filename of database>. E.g.:

 (sqld-sqlite-new "test.db")

Initialize the PostgreSQL driver with a PostgreSQL connection string. E.g.:

 (sqld-psql-new "dbname=test user=test password=test host=localhost")

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

Initialize the Oracle driver with an Oracle dsn, e.g.:

 (sqld-oracle-new "scott/tiger")

Initialize the DB2 driver with a DB2 dsn, e.g.:

 (sqld-db2-new "alias=test user=me passwd=mypassword")

This SQLI module has been designed for use with mzscheme. The sqli module begins with a module description.

(module sqli mzscheme
        (require (lib "time.ss" "srfi" "19"))

In the module description, all exported functions are defined.

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 sql-driver that has been given to the sqli-connect function. This is a closure that handles commands. See the interface description 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 'nil-converter indicates that there is no conversion function.

The sqli? function returns true, if obj is a list, not null and the car of this list is equal to 'sqli.

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

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.

(define (sqli-connect sql-driver)
  (list 'sqli (sql-driver 'connect) (list) 'nil-converter "" 0 
        (sql-driver 'name) (sql-driver 'version) "" #f))

(define (sqli-disconnect handle)
  (check-handle 'sqli-disconnect handle)
  ((cadr handle) 'disconnect))

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

Error handling is very simple. The 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.

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

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

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.

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

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 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.

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

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 #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 #f, the fetchall function will fail to retreive all rows.

The functions for fetching all rows or count rows are simply implemented by subsequental calls to sqli-fetchrow.

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

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 sqli-query or 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 (sqli-query sqli-handle "SELECT $1 FROM test WHERE $1>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 sqli-exec. For two different queries, that are registered subsequently under the same symbol, only the last one can be retreived.

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

The 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 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.

;#+ 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))
        )))))

The sqli-last-query function returns the last query executed by the sqlid driver.

(define (sqli-last-query handle)
  (check-handle 'sqli-last-query handle)
  (cadddr (cdr handle)))

The sqli-version function returns the current version of SQLI.

(define (sqli-version)
  (let* ((V "1.3"))
    (inexact->exact (round (* V 100)))))

The sqli-debug? function returns if sqli is currently in debugging mode. With sqli-debug! one can set debugging mode.

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

With the 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-<function>, are replaced by 'function. Example:

For (define a (sqli-closure sqli-handle)): (a 'exec 'test) does the same as (sqli-exec sqli-handle 'test).

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

These functions are used to facilitate exported functions.

The 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.

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

The sqli-split-query function is used to split a query with $n arguments in components.

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

The ierr function prints an error and returns #f. This function is used to report errornous use of functions or other problems.

(define (ierr . args)
  (define (f args)
    (if (null? args)
        (display "")
        (begin
          (display (car args))
          (f (cdr args)))))
  (display "ERROR: ")
  (f args)
  (newline)
  #f)