验证中...
Languages: Lisp
Categories: 常用工具包
Latest update 2018-12-09 10:06
ftype-example-sqlite.ss
Raw Copy
(define-ftype char* (* char))
(define-ftype db-handle void*)
(define-ftype db-handle* (* db-handle))
(define-ftype cb-t
(function (void* int (* char*) (* char*)) int))
(define-ftype open-t
(function (string (* db-handle*)) int))
(define-ftype close-t
(function ((* db-handle)) int))
(define-ftype exec-t
(function
((* void*) string (* cb-t) void* (* char*)) int))
(load-shared-object "libsqlite3.so.0")
(define db-open
(ftype-ref open-t ()
(make-ftype-pointer open-t "sqlite3_open")))
(define db-close
(ftype-ref close-t ()
(make-ftype-pointer close-t "sqlite3_close")))
(define db-exec
(ftype-ref exec-t ()
(make-ftype-pointer exec-t "sqlite3_exec")))
(define (char*->string fptr)
(let f ([i 0])
(let ([c (ftype-ref char () fptr i)])
(if (char=? c #\nul)
(make-string i)
(let ([str (f (fx+ i 1))])
(string-set! str i c)
str)))))
(define (callback ignore cnt vals cols)
(do ([i 0 (fx+ i 1)])
((fx= i cnt))
(printf "~a:~a " (char*->string (ftype-ref char* () cols i))
(char*->string (ftype-ref char* () vals i))
))
(printf "\n") 0)
(define cb (make-ftype-pointer cb-t callback))
(define db*
(make-ftype-pointer db-handle*
(foreign-alloc (ftype-sizeof db-handle*))))
(delete-file "test.db")
(db-open "test.db" db*)
(define zerr
(make-ftype-pointer char*
(foreign-alloc (ftype-sizeof char*))))
(define (run-sql sql)
(db-exec (ftype-ref db-handle* () db*)
sql cb 0 zerr)
(ftype-pointer->sexpr zerr))
(run-sql "create table example(name varchar unique, email varchar);")
(run-sql "insert into example(name, email) values('ludi', 'ludi@abc.com');")
(run-sql "insert into example(name, email) values('eva', 'eva@abc.com');")
(run-sql "select * from example;")
(unlock-object
(foreign-callable-code-object
(ftype-pointer-address cb)))
(db-close (ftype-ref db-handle* () db*))

Comment list( 1 )

ludi 2018-02-11 22:15
> (load "ss/ftype-example-sqlite.ss")
name:ludi email:ludi@abc.com 
name:eva email:eva@abc.com 
>

You need to Sign in for post a comment

Help Search