;;;; 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)))))