;; @module sqlite3.lsp
;; @description SQLite3 database interface routines
;; @version 1.6 - comments redone for automatic documentation
;; @version 1.7 - a fix getting types when null values are present (thanks Dmitry)
;; @version 1.8 - a fix to make 64-Bit integers work (thanks Dmitry)
;; @author Lutz Mueller, 2004-7
;;
;; <h2>Module for SQLite3 database bindings</h2>
;; To use this module include the following 'load' statement at the
;; beginning of the program file:
;; <pre>
;; (load "/usr/local/share/newlisp/sqlite3.lsp")
;; </pre>
;;
;; SQLite version 3.0 introduced a new database format and is incompatible
;; whith the previous 2.1 to 2.8 format. Old SQLite 2.x based databases can
;; be converted using the old and new sqlite client application:
;;
;; sqlite OLD.DB .dump | sqlite3 NEW.DB
;;
;; While in sqlite 2.8 all returned fields where of string type, SQLite3
;; returns, text, integer or float. Blobs are returned as text and NULLs
;; are returned as nil.
;;
;; See also the documentation at @link http://sqlite.org sqlite.org
;;
;; <h2>Requirements:</h2>
;; One of the libraries sqlite3.dll for Win32 or libsqlite3.so for UNIX like
;; operating systems is required from http://www.sqlite.org.
;;
;; SQLite is an <in-process> database. The library contains the whole database
;; system. An extra database server is not required. SQLite also has limited
;; mutiuser capabilities for accessing a common database from several programs
;; at the same time. See the documentaion at @link http://sqlite.org sqlite.org
;; for details.
;;
;; The following is a short example how to use SQLite3:
;;
;; @example
;; (sql3:open "MYDB") ; opens/creates a database returns a handle (ignore)
;; ; or 'nil' on failure
;;
;; (sql3:sql "select * from mytable;") ; make a SQL query, return result
;;
;; (sql3:error) ; return error text
;;
;; (sql3:close) ; close the database
;; Function calls returning 'nil' signal that an error has occurred. The
;; function 'sql3:error' can then be used to get details about the error
;; as a text string.
;;
;; At the bottom of the source file 'sqlite3.lsp' a test routine called
;; 'test-sqlite3' can be found to test for correct installation of SQLite.
(context 'sql3)
; set library to path-name of the library on your platform OS
;
(if
; LINUX and BSDs
(< (& 0xF (last (sys-info))) 3) (set 'library "/usr/local/lib/libsqlite.so")
; Mac OSX / Darwin
(= (& 0xF (last (sys-info))) 3) (set 'library "/usr/lib/libsqlite3.0.dylib")
; Solaris
(= (& 0xF (last (sys-info))) 4) (set 'library "/usr/local/lib/libsqlite.so")
; MinGW, Win32
(> (& 0xF (last (sys-info))) 4)
(set 'library (string (env "PROGRAMFILES") "/sqlite3/sqlite3.dll"))
true (println "Cannot load library OS not supported"))
(import library "sqlite3_open" "cdecl")
(import library "sqlite3_close" "cdecl")
(import library "sqlite3_prepare" "cdecl")
(import library "sqlite3_step" "cdecl")
(import library "sqlite3_column_count" "cdecl")
(import library "sqlite3_column_name" "cdecl")
(import library "sqlite3_column_type" "cdecl")
(import library "sqlite3_column_int" "cdecl")
(import library "sqlite3_column_double" "cdecl")
(import library "sqlite3_column_text" "cdecl")
(import library "sqlite3_column_blob" "cdecl")
(import library "sqlite3_column_bytes" "cdecl")
(import library "sqlite3_finalize" "cdecl")
(import library "sqlite3_get_table" "cdecl")
(import library "sqlite3_last_insert_rowid" "cdecl")
(import library "sqlite3_changes" "cdecl")
(import library "sqlite3_busy_timeout" "cdecl")
(import library "sqlite3_errmsg" "cdecl")
; gloablly used vars and constants
(define db nil) ; database handle
(define dbp "\000\000\000\000") ; ptr to database handle
(define error-message nil) ; error message
(define col-names '()) ; list of column headers
(define col-types '()) ; list of column types
(define pstm "\000\000\000\000") ; ptr to compiled sql
(constant 'SQLITE_OK 0)
(constant 'SQLITE_ROW 100)
(constant 'SQLITE_DONE 101)
(constant 'SQLITE_TYPES '(
0
SQLITE_INTEGER
SQLITE_FLOAT
SQLITE_TEXT
SQLITE_BLOB
SQLITE_NULL))
;; @syntax (sql3:open <str-db-name>)
;; @param <str-db-name> The name of the database.
;; @return A database handle (discard), or 'nil' on failure.
;;
;; Opens or creates a database. If the database does exist it gets opened,
;; else a new database with the name given is created.
;; If trying to open a database that already has been opened 'nil' is returned
;; and an error text can be retrieved using 'sql3:error'.
(define (sql3:open db-name)
; only open if not alrady done
(if (not db)
(begin
(set 'result (sqlite3_open db-name dbp))
(if (!= result SQLITE_OK)
(set 'db nil)
(set 'db (get-int dbp))))
(begin
(set 'error-message "A database is already open")
nil))
)
; close the currently open database ;;;
;
;
(define (sql3:close) ;; overwrite the close in MAIN
(if db (begin
(sqlite3_close db)
(set 'db nil)
true)))
;; @syntax (sql3:sql <str-sql>)
;; @param <str-sql> The SQL statement.
;;
;; Executes the SQL statement in <str-sql>. For 'select' statements an array
;; of the result set is returned or '()' for the empty set. For other statements
;; 'true' is returned for a successful outcome. On failure 'nil' is returened
;; and 'sql3:error' can be used to retrieve the error text.
(define (sql sql-str)
(set 'result nil 'done nil 'error-message nil)
(set 'sqarray '());
(set 'col-names '());
(set 'col-types '());
; set up parameters for sqlite3_prepare() call
(set 'ppstm "\000\000\000\000") ; pointer to statement ptr
(set 'pptail "\000\000\000\000") ; pointer to statement tail
; compile the sql statment
(if db (set 'result (sqlite3_prepare db sql-str -1 ppstm pptail)))
; set up parameters for sqlite3_step() call
(set 'pstm (get-int ppstm))
; execute the compiled statement
(if (= result SQLITE_OK)
(while (not done)
;; execute statement until done/101 or
(set 'result (sqlite3_step pstm))
(set 'num-cols (sqlite3_column_count pstm))
(if (empty? col-names) (set 'col-names (get-names pstm num-cols)))
(set 'col-types (get-types pstm num-cols))
(if (= result SQLITE_ROW)
(push (get-values pstm num-cols) sqarray -1)
(set 'done true) ;; received done/101 or error
))
)
; if done/101 finalize
(if (= result SQLITE_DONE)
(begin
(set 'result (sqlite3_finalize pstm))
; for 'select' statements return the array else 'true'
(if (> num-cols 0) sqarray true))
(if (= result 0) true (set-error))))
(define (get-values pstm cols)
(set 'row '())
(dotimes (idx cols)
(set 'i (int idx)) ; all loop vars are float
(case (nth idx col-types idx)
; (SQLITE_INTEGER
; (push (sqlite3_column_int pstm i) row -1))
; fixed for 64-bit, thanks Dmitry
(SQLITE_INTEGER
(set 'pstr (sqlite3_column_text pstm i))
(if (= pstr 0)
(push nil row -1)
(push (int (get-string pstr)) row -1)))
(SQLITE_FLOAT
(set 'pstr (sqlite3_column_text pstm i))
(if (= pstr 0)
(push nil row -1)
(push (float (get-string pstr)) row -1)))
(SQLITE_TEXT
(set 'pstr (sqlite3_column_text pstm i))
(if (= pstr 0)
(push "" row -1)
(push (get-string pstr) row -1)))
; not tested yet
(SQLITE_BLOB
(set 'pstr (sqlite3_column_blob pstm i))
(set 'len (sqlite3_column_bytes pstm i))
(set 'buff (dup "\000" len))
(if (= pstr 0)
(push "" row -1)
(begin
(cpymem pstr buff len)
(push buff row -1))))
(SQLITE_NULL
(push nil row -1))))
row)
(define (get-names pstm cols)
(set 'row '())
(dotimes (idx cols)
(set 'i (int idx)) ; all loop vars are float
(set 'ps (sqlite3_column_name pstm i))
(if (= ps 0) ;; check for null pointer to result
(push "" row -1)
(push (get-string ps) row -1)))
row)
(define (get-types pstm cols)
(set 'row '())
(dotimes (idx cols)
(set 'i (int idx)) ; all loop vars are float
(push (nth (sqlite3_column_type pstm i) SQLITE_TYPES) row -1))
row)
;; @syntax (sql3:rowid)
;; @return The last row id from last 'insert'.
(define (rowid)
(if db (sqlite3_last_insert_rowid db)))
;; @syntax (sql3:tables)
;; @return A list of tables in the database.
;
(define (tables)
(if db (begin
(set 'lst (sql "select tbl_name from sqlite_master")) ))
(if lst (set 'lst (first (transpose lst)))))
;; @syntax (sql3:columns <str-tabel-name>)
;; @return A list of column names for a table.
(define (columns aTable)
(if (list? (sql (append "select * from " aTable " where 0;")))
col-names))
;; @syntax (sql3:changes)
;; @return The Number of rows changed/affected by the last SQL statement.
(define (changes)
(if db (sqlite3_changes db)))
;; @syntax (sql3:timeout <num-milli-seconds>)
;; @return 'true' on success or 'nil' on failure.
;;
;; Sets busy timeout in milliseconds.
(define (timeout ms)
(if db (zero? (sqlite3_busy_timeout db (int ms)))))
;; @syntax (sql3:error)
;; @return The error text of the last error occured in 'sql3:sql'.
(define (error) error-message)
(define (set-error)
(set 'result (sqlite3_errmsg db))
(if (= result 0)
(set 'error-message nil)
(set 'error-message (get-string result))
nil
)
)
(context 'MAIN)
; -------------------------------------------------------------------------
;
; test the database routines
;
; if there is an old "TEST" db from an earlier sqlite 2.8 delete it first
;
(define (test-sqlite3)
(if (sql3:open "TEST")
(println "database opened/created, ... Ok")
(println "problem opening/creating database"))
(if (sql3:sql "create table fruits (name CHAR(20), qty INT(3), price FLOAT(10), blobtext BLOB);")
(println "created table fruits, ... Ok")
(println "problem creating table fruits"))
(if (sql3:sql "insert into fruits values ('apples', 11, 1.234, X'41424300010101');")
(println "inserted, last row id: " (sql3:rowid) ", ... Ok")
(println "problem inserting row"))
(if (sql3:sql "insert into fruits values ('oranges', 22, 2.345, X'42434400020202');")
(println "inserted, last row id: " (sql3:rowid) ", ... Ok")
(println "problem inserting row"))
(if (sql3:sql "insert into fruits values ('bananas', 33, 3.456, X'44454600030303');")
(println "inserted, last row id: " (sql3:rowid) ", ... Ok")
(println "problem inserting row"))
(if (sql3:sql
"insert into fruits values ('grapes', 123456789012345678, 7.89, X'47484900040404');")
(println "inserted, last row id: " (sql3:rowid) ", ... Ok")
(println "problem inserting row"))
(set 'sqarray (sql3:sql "select * from fruits;"))
(if sqarray
(begin
(println "selected rows: ")
(map println sqarray)
(println "column names: ")
(map println sql3:col-names)
(println "... Ok")
)
(println "problem with select"))
(if (sql3:sql "delete from fruits where 1;")
(println "deleted, rows affected: " (sql3:changes) ", ... Ok")
(println "problem deleting rows"))
(if (list? (sql3:tables) )
(println "tables: " (sql3:tables) ", ... Ok")
(println "problem in sql3:tables"))
(if (list? (sql3:columns "fruits") )
(println "columns: " (sql3:columns "fruits") ", ... Ok")
(println "problem in sql3:columns"))
(if (sql3:sql "drop table fruits;")
(println "table fruits dropped, ... Ok")
(println "problem dropping table fruits"))
(sql3:close)
)
; eof ;
syntax highlighted by Code2HTML, v. 0.9.1