Contents

Name

SQLD-SQLite - SQL Driver for SQLite

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 the interface description for drivers.

The driver must be used through SQLI.

API

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

Synopsis

 (module test
        (import sqli)
        (import sqld-sqlite)
        (main main))

 (define (main argv)
   (let* ((sqld    (sqld-sqlite-new "test.db"))
           (sqlh    (sqli-connect sqld))

 (...)

Literate section

This module interfaces with a C part that interfaces to the sqlite library. The interface is built for SQLite version 3.

Module definition

The module definition is as follows:

(module sqld-sqlite-internal mzscheme
        (require (lib "time.ss" "srfi" "19"))
        (require "sqld-i-sqlite.scm")

As can be seen, only one function is exported, the sqld-sqlite-new function. All other function definitions are interface definitions for C functions that are called from this module.

Supportive functions

In the next section, supportive functions and definitions are described.

re-quote defines a precompiled regular expression. This expression is used to escape the single quotes in a string.

(define re-quote (regexp "[']"))

The ierr function displays a message and returns #f. This function is simply used to report errors to the current output port.

(define (ierr . msg)
  (define (d msg)
    (if (null? msg)
        (newline)
        (begin
          (display (car msg))
          (d (cdr msg)))))
  (begin
    (d msg)
    #f))

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

(define (string2db s)
  (string-append "'" (regexp-replace* re-quote s "''") "'"))

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.

;#+ 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 "'"
  (date->string dt "~Y~m~dT~H~M~S")
  "'"))


(define (db2date dt)
  (string->date dt "~Y~m~dT~H~M~S")
  )

All other conversions are done using the standard scheme primitives.

Connecting

The connection function is called from the closure provided by sqld-sqlite-new, when it is called with the '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 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.


(define SQLITE-SEM       (make-semaphore 1))
(define SQLITE-TRANS-SEM (make-semaphore 1))
(define IN-TRANSACTION   #f)
(define ID                0)

(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)
        (id   (begin (set! ID (+ ID 1)) ID)))

    (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                                                                                                                           
              ;(display (format "begin ~a\n" id))                                                                                            
              (letrec ((busywait (lambda ()                                                                                                  
                                   (semaphore-wait SQLITE-SEM)                                                                               
                                   (if IN-TRANSACTION                                                                                        
                                       (begin                                                                                                
                                         (semaphore-post SQLITE-SEM)                                                                         
                                         (busywait))                                                                                         
                                       (begin                                                                                                
                                         (set! IN-TRANSACTION #t)                                                                            
                                         (semaphore-wait SQLITE-TRANS-SEM)                                                                   
                                         (semaphore-post SQLITE-SEM))))))                                                                    
                (busywait))                                                                                                                  
              (if (not (eq? in-transaction #t))                                                                                              
                  (query "BEGIN;"))                                                                                                          
              (set! in-transaction #t)))                                                                                                     
                                                                                                                                             
           ((eq? cmd 'commit)                                                                                                                
            (begin                                                                                                                           
              ;(display (format "commit ~a\n" id))                                                                                           
              (if (eq? in-transaction #t)                                                                                                    
                  (query "COMMIT;"))                                                                                                         
              (set! IN-TRANSACTION #f)                                                                                                       
              (semaphore-post SQLITE-TRANS-SEM)                                                                                              
              (set! in-transaction #f)))                                                                                                     
                                                                                                                                             
           ((eq? cmd 'rollback)                                                                                                              
            (begin                                                                                                                           
              ;(display (format "rollback ~a\n" id))                                                                                         
              (if (eq? in-transaction #t)                                                                                                    
                  (query "ROLLBACK;"))                                                                                                       
              (set! IN-TRANSACTION #f)                                                                                                       
              (semaphore-post SQLITE-TRANS-SEM)                                                                                              
              (set! in-transaction #f)))                                                                                                     
                                                                                                                                             
           ((eq? cmd 'query)                                                                                                                 
            (begin                                                                                                                           
              ;(display (format "query ~a\n" id))                                                                                            
              (semaphore-wait SQLITE-SEM)                                                                                                    
              (let ((R (query (car args))))                                                                                                  
                (semaphore-post SQLITE-SEM)                                                                                                  
                R)))                                                                                                                         
 
           ((eq? cmd 'disconnect)
            (begin
              (c-sqlite-close db)
              (set! valid-handle #f)))

           (else (ierr "Unknown command")))))))

The main entry function

Now for the main function that this driver provides: sqld-sqlite-new. This function takes connection-info as an argument, which must be an SQLite database. It returns a closure that handles the 'connect, 'clean, 'name and 'version calls. It is a very simple function.

The 'version call returns the major version number of SQLite * 100 + the minor version number.

(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)   (begin
                             (set! IN-TRANSACTION #f)
                             (set! SQLITE-SEM       (make-semaphore 1))
                             (set! SQLITE-TRANS-SEM (make-semaphore 1))
                             ))

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

       (else (ierr "ERROR: Connect to the datebase first"))))))