aboutsummaryrefslogtreecommitdiff
path: root/src/ellinika/sql.scm
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-14 14:20:39 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-14 14:20:39 +0300
commit8c1de36d1f8b27fb946dac15e725c93ec57c1538 (patch)
tree17babe745cf794a7485fc2bc0b9c9e0c9120d893 /src/ellinika/sql.scm
parentce29f168ed52f08228b99a789785271a4a3c9b0e (diff)
downloadellinika-8c1de36d1f8b27fb946dac15e725c93ec57c1538.tar.gz
ellinika-8c1de36d1f8b27fb946dac15e725c93ec57c1538.tar.bz2
Improve SQL interface.
* src/ellinika/sql.scm (ellinika:sql-verbose) (ellinika:sql-dry-run,ellinika:sql-conn): New public vars. (ellinika:format-sql-query): New function. (ellinika:sql-query): Rewrite. * scm/verbop.scm: Use (ellinika sql). * src/ellinika/conjugator.scm: Likewise. * src/ellinika/test-conjugation.scm: Likewise. * data/irregular-verbs.xml: Update. * src/ellinika/tests/conj/apomenv.scm: New file.
Diffstat (limited to 'src/ellinika/sql.scm')
-rw-r--r--src/ellinika/sql.scm116
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)))))
+

Return to:

Send suggestions and report system problems to the System administrator.