;;;; 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 . ;;;; (define-module (ellinika sql)) (use-modules (srfi srfi-1) (ellinika elmorph) (gamma sql)) (re-export sql-catch-failure sql-ignore-failure) (define-public ellinika:sql-verbose #f) (define-public ellinika:sql-conn #f) (define-public ellinika:sql-dry-run #f) (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-public (ellinika:sql-disconnect) (if ellinika:sql-conn (sql-close-connection ellinika:sql-conn))) (define (->string arg) (cond ((string? arg) arg) ((elstr? arg) (elstr->string arg)) ((number? arg) (number->string arg)) ((boolean? 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 ;; ~ - (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 #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)))))