mysql.ss
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DBD-JAZMYSQL.plt
;;
;; DBD Wrapper over jaz/mysql.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mysql.ss - the main driver/wrapper over jaz/mysql.
;; yc 9/10/2009 - first version
;; yc 9/30/2009 - now creates implicit stored procedure and no longer uses SQL escape
;; yc 10/1/2009 - expose side-effect from jaz/mysql
;; yc 11/4/2009 - create 3 separate drivers for jazmysql
;;                jazmysql/pass-thru-effect - returns jazmysql's side-effect
;;                jazmysql/effect - return effect instead of side-effect object
;;                jazmysql/effect-set - returns a result set instead of effect.
;; yc 11/5/2009 - default jazmysql to jazmysql/effect

(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) ;; yes it exists!!!...
         (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)
                     ))