#lang scheme/base ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DBI.plt ;; ;; database interface abstraction. Inspired by Perl DBI. ;; ;; Bonzai Lab, LLC. All rights reserved. ;; ;; released under LGPL. ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; query.ss - handles the query conversions into statements. ;; yc 9/8/2009 - first version ;; (convert query) => phq (place holder query). ;; ;; example: select * from test where (?uuid is null or uuid = ?uuid) ;; => select * from test where ?1 is null or uuid = ?2 ;; the way to replace them are: ;; extract the list of the keys (question mark followed by alphanumeric word) ;; *unique* the list of the keys. ;; map the keys into their replacements (this is where the algorithm comes in) ;; transform the list of the keys into the replacements. ;; NOTE - this can be done with the help of the IQS (which uses $ as the notifier). (require (planet bzlib/base) (planet bzlib/template/iqs) "base.ss" ) ;; so what's customizable below? ;; just the converter... (define (make-place-holder-query converter s) (define (helper lst) (make-phq s (iqs-convert lst converter '()) (filter symbol? lst))) (parameterize ((iqs-symbol-start #\?)) (helper (read-iqs (open-input-string s))))) (define (default-converter args) (let ((i 0)) (lambda (s) (set! i (add1 i)) (format "$~a" i)))) (define (question-converter args) (lambda (s) "?")) (define (phq-map-values phq value (mapper (lambda (lst value) (map (lambda (key) (if-it (assoc key value) (cdr it) (error 'phq-map-values "missing key ~a" key))) lst)))) (mapper (phq-args phq) value)) ;; (trace phq-map-values) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; at this point we can actually generate a query by itself if we know how to ;; format the values to string!!... ;; we'll skip this for now... ?? ;; at this moment, we can handle regular prepare statement ;; but we still need to handle one more thing... and that is to ;; handle the data values into string. ;; basically - we have the following base types that we need to handle ;; number -> leave along ;; string -> add single quotes (and escape single quotes within) ;; date -> also add single quote (we'll handle date later) ;; '() => NULL (define (sql-escape-string x) (string-append "'" (regexp-replace* #px"\\'" x "''") "'")) (define (data->string x) (cond ((null? x) "NULL") ((number? x) (number->string x)) (else (sql-escape-string x)))) (define (map-value-converter args) (let ((args args)) (lambda (s) (begin0 (data->string (car args)) (set! args (cdr args)))))) ;; now to generate a statement - the values are assumed to be mapped... ?? (define (phq-merge-query phq value) (let ((lst (read-iqs (open-input-string (phq-converted phq))))) (if (not (= (length (filter symbol? lst)) (length value))) (error 'php-merge-query "missing args in ~a" value) (iqs-convert lst map-value-converter value)))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CONTRACT (provide/contract (make-place-holder-query (-> (-> (listof any/c) (-> any/c any)) string? phq?)) (default-converter (-> (listof any/c) (-> any/c any))) (question-converter (-> (listof any/c) (-> any/c any))) (phq-map-values (->* (phq? (listof any/c)) ((-> (listof any/c) (listof any/c) any)) any)) (phq-merge-query (-> phq? (listof any/c) string?)) )