#lang scheme/base
(require (planet bzlib/base)
(planet bzlib/dbi)
(prefix-in dbd: (planet jaz/mysql)))
(define (mysql-connect driver . attrs)
(let-values (((loader attrs)
(filter-file-loader/attrs attrs)))
(let ((handle (make-handle driver (apply* dbd:connect attrs)
(make-immutable-hash-registry)
0)))
(load-files! handle (if (list? loader) loader
(list loader)))
handle)))
(define (mysql-disconnect handle)
(dbd:close-connection! (handle-conn handle)))
(define (mysql-query handle stmt (args '()))
(if-it (registry-ref (handle-query handle) stmt) (let ((query (prepared-query it))
(stmt (prepared-inner it)))
(convert-result
(dbd:execute stmt (map cell->sql-cell (phq-map-values query args)))))
(begin
(mysql-prepare handle stmt stmt)
(mysql-query handle stmt args))))
(define (mysql-prepare dbh key stmt)
(define (helper query)
(registry-set! (handle-query dbh)
key
(make-prepared query
(dbd:prepare #:connection
(handle-conn dbh)
(phq-converted query)))))
(helper (make-place-holder-query question-converter stmt)))
(define (mysql-query/effect handle stmt (args '()))
(define (helper rs)
(cond ((dbd:side-effect? rs)
(make-effect (dbd:side-effect-affected-rows rs)
(dbd:side-effect-insert-id rs)
(dbd:side-effect-server-status rs)
(dbd:side-effect-warning-count rs)
(dbd:side-effect-message rs)
#f))
(else rs)))
(helper (mysql-query handle stmt args)))
(define (mysql-query/effect-set handle stmt (args '()))
(result-set-or-effect->result-set (mysql-query/effect handle stmt args)))
(define (convert-result rs)
(cond ((dbd:side-effect? rs)
rs)
((dbd:result-set? rs)
(cons (vector->list (dbd:result-set-field-names rs))
(map vector->list (dbd:result-set-rows rs))))))
(define (cell->sql-cell cell)
(cond ((null? cell) dbd:sql-null)
(else cell)))
(define (sql-cell->cell cell)
(cond ((dbd:sql-null? cell) '())
(else cell)))
(registry-set! drivers 'jazmysql/pass-thru-effect
(make-driver mysql-connect
mysql-disconnect
mysql-query
mysql-prepare
default-begin
default-commit
default-rollback))
(registry-set! drivers 'jazmysql/effect
(make-driver mysql-connect
mysql-disconnect
mysql-query/effect
mysql-prepare
default-begin
default-commit
default-rollback))
(registry-set! drivers 'jazmysql/effect-set
(make-driver mysql-connect
mysql-disconnect
mysql-query/effect-set
mysql-prepare
default-begin
default-commit
default-rollback))
(registry-set! drivers 'jazmysql (registry-ref drivers 'jazmysql/effect))
(provide (rename-out (dbd:side-effect? side-effect?)
(dbd:side-effect side-effect)
(dbd:side-effect-insert-id side-effect-insert-id)
(dbd:side-effect-affected-rows side-effect-affected-rows)
(dbd:side-effect-warning-count side-effect-warning-count)
(dbd:side-effect-message side-effect-message)
))