diff options
Diffstat (limited to 'src/ellinika/sql.scm')
| -rw-r--r-- | src/ellinika/sql.scm | 116 |
1 files changed, 96 insertions, 20 deletions
diff --git a/src/ellinika/sql.scm b/src/ellinika/sql.scm index c0301ad..f521049 100644 --- a/src/ellinika/sql.scm +++ b/src/ellinika/sql.scm @@ -1,33 +1,109 @@ +;;;; This file is part of Ellinika project. +;;;; Copyright (C) 2011 Sergey Poznyakoff +;;;; +;;;; Ellinika is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; Ellinika is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program. If not, see <http://www.gnu.org/licenses/>. +;;;; (define-module (ellinika sql)) (use-modules (srfi srfi-1) - (ellinika elmorph) + (ellinika elmorph) (gamma sql)) -(define ellinika:sql-verbose #f) -(define ellinika:sql-conn #f) +(define-public ellinika:sql-verbose #f) +(define-public ellinika:sql-conn #f) +(define-public ellinika:sql-dry-run #f) -(define (ellinika:sql-connect arg) - (set! ellinika:sql-conn (sql-open-connection args)) - (if ellinika:sql-conn - (sql-query ellinika:sql-conn "SET NAMES utf8")) - ellinika:sql-conn) +(define-public (ellinika:sql-connect arg) + (cond + (ellinika:sql-dry-run #t) + (else + (set! ellinika:sql-conn (sql-open-connection arg)) + (if ellinika:sql-conn + (sql-query ellinika:sql-conn "SET NAMES utf8")) + ellinika:sql-conn))) -(define (ellinika:sql-disconnect) +(define-public (ellinika:sql-disconnect) (if ellinika:sql-conn (sql-close-connection ellinika:sql-conn))) -(define (ellinika:sql-query format . rest) - (let ((query (apply format #f - (map (lambda (arg) - (if arg - "NULL" - (utf8-escape arg))) - rest)))) + +(define (->string arg) + (cond + ((string? arg) arg) + ((elstr? arg) (elstr->string? arg)) + ((number? arg) (number->string arg)) + ((bool? arg) (if arg "true" "false")) + (else + (error "Unhandled argument type: ~S" arg)))) + + +;; Format specifiers: +;; ~A - escaped string +;; ~Q - escaped and quoted string; NULL if argument is #f +;; ~N - unescaped number +;; ~<anychar> - <anychar> +(define-public (ellinika:format-sql-query fmt args) + (let* ((fmtlist (string-split fmt #\~)) + (segments (reverse + (fold + (lambda (elt prev) + (if (string-null? elt) + (cons (string-append (car prev) "~") (cdr prev)) + (let ((ch (string-ref elt 0))) + (case ch + ((#\A #\Q #\N) (cons elt prev)) + (else + (cons (string-append (car prev) elt) + (cdr prev))))))) + '() + (cdr fmtlist))))) + (let ((nseg (length segments)) + (narg (length args))) + (cond + ((> nseg narg) + (error "Too few arguments for format \"~S\": ~S/~S" + fmt nseg narg)) + ((< nseg narg) + (error "Too many arguments for format \"~S\": ~S/~S" + fmt nseg narg)) + (else + (apply + string-append + (car fmtlist) + (map + (lambda (seg arg) + (string-append + (case (string-ref seg 0) + ((#\A) (utf8-escape (->string arg))) + ((#\Q) (if (not arg) + "NULL" + (string-append "\"" (utf8-escape (->string arg)) + "\""))) + ((#\N) (->string arg))) + (substring seg 1))) + segments + args))))))) + +(define-public (ellinika:sql-query fmt . args) + (let ((query (ellinika:format-sql-query fmt args))) (cond (ellinika:sql-verbose - (format #f "QUERY: ~A~%" query) - (let ((res (sql-query ellinika:sql-conn query))) - (format #f "RES: ~A~%" res) - res)) + (format #t "QUERY: ~A~%" query) + (if (not ellinika:sql-dry-run) + (let ((res (sql-query ellinika:sql-conn query))) + (format #t "RES: ~A~%" res) + res))) + (ellinika:sql-dry-run) (else (sql-query ellinika:sql-conn query))))) + |