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.

5 files changed, 151 insertions, 84 deletions

diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index 25ae255..0079d12 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -1,2 +1,2 @@
-;;;; Modern Greek Verb Conjugator.
+;;;; Verb Conjugator for modern Greek (δημοτική).
 ;;;; This file is part of Ellinika project.
@@ -23,3 +23,3 @@
 	     (ellinika tenses)
-	     (gamma sql))
+	     (ellinika sql))
 
@@ -27,7 +27,2 @@
 
-(define (my-sql-query conn query)
-;  (format #t "Q: ~A~%" query)
-  (let ((res (sql-query conn query)))
-;    (format #t "R: ~A~%" res)
-    res))
 
@@ -82,3 +77,3 @@
 
-(define (create-basic-verb-info conn verb proplist . rest)
+(define (create-basic-verb-info verb proplist . rest)
 ;  (format #t "PROPLIST ~A~%" proplist)
@@ -86,14 +81,13 @@
 		   ""
-		   (string-append " AND conj='" (car rest) "'"))))
-    (let ((vdb (my-sql-query
-		conn
-		(string-append
-		 "SELECT conj FROM verbclass WHERE verb='" (force-string verb) "'"
-		 class))))
+		   (string-append
+		    " AND conj=\"" (utf8-escape (car rest)) "\""))))
+    (let ((vdb (ellinika:sql-query
+		"SELECT conj FROM verbclass WHERE verb=\"~A\"~A"
+		verb class)))
       (cond
-       ((and vdb (not (null? vdb)));FIXME
+       ((and vdb (not (null? vdb)))
 	(list (caar vdb) verb proplist '(class)))
        ((elstr-suffix? verb "άω")
-	(create-basic-verb-info conn (elstr-append
-				      (elstr-trim verb -2) "ώ") "B1"))
+	(create-basic-verb-info (elstr-append
+				 (elstr-trim verb -2) "ώ") "B1"))
        ((null? rest)
@@ -103,11 +97,9 @@
 
-(define (load-verb-info conn verb voice mood tense)
+(define (load-verb-info verb voice mood tense)
 ;  (format #t "LOAD ~A~%" verb)
-  (let ((verbprop (my-sql-query
-		   conn
-		   (string-append
-		    "SELECT property,value FROM verbtense WHERE "
-		    "verb=\"" verb "\" AND voice=\"" voice
-		    "\" AND mood=\"" mood "\" AND tense=\"" tense "\""))))
-    (create-basic-verb-info conn verb
+  (let ((verbprop (ellinika:sql-query
+		   "SELECT property,value FROM verbtense WHERE \
+verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
+		   verb voice mood tense)))
+    (create-basic-verb-info verb
 			    (if (null? verbprop)
@@ -175,8 +167,7 @@
 
-(define (lookup-verb-info conn verb voice thema)
-  (my-sql-query
-   conn
-   (string-append
-		 "SELECT root FROM irregular_root \
-WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
+(define (lookup-verb-info verb voice thema)
+  (ellinika:sql-query
+   "SELECT root FROM irregular_root \
+WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
+   verb voice thema))
 
@@ -191,8 +182,8 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
 
-(define (complement-verb-info conn vinfo verb voice thema)
+(define (complement-verb-info vinfo verb voice thema)
 ;  (format #t "COMPLEMENT ~A~%" thema)
   (let ((elverb (string->elstr verb))
-	(result (let ((tmpres (lookup-verb-info conn verb voice thema)))
+	(result (let ((tmpres (lookup-verb-info verb voice thema)))
 		  (if (and (null? tmpres) (string=? thema "sub"))
-		      (lookup-verb-info conn verb voice "aor")
+		      (lookup-verb-info verb voice "aor")
 		      tmpres))))
@@ -237,3 +228,3 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
 		      (list-ref
-		       (conjugate conn verb "act" "ind" "Αόριστος")
+		       (conjugate verb "act" "ind" "Αόριστος")
 		       0)))
@@ -294,6 +285,4 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
 
-(define (get-conj-info conn conj voice mood tense)
-  (let ((answer (my-sql-query
-		 conn
-		 (string-append
+(define (get-conj-info conj voice mood tense)
+  (let ((answer (ellinika:sql-query
       "SELECT c.thema,c.suffix,c.accmap,c.particle,c.aux,c.auxtense,c.fold AS fold,\
@@ -301,4 +290,6 @@ f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
 FROM conjugation c, verbflect f \
-WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
-"' AND c.tense='" tense "' AND c.flect = f.ident ORDER by fold"))))
+WHERE c.conj=\"~A\" AND c.voice=\"~A\" AND c.mood=\"~A\" \
+AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
+      conj voice mood tense)))
+    
     (if (null? answer)
@@ -441,10 +432,9 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
 
-(define (individual-verb conn verb voice mood tense)
-  (let ((res (my-sql-query
-	      conn
-	      (string-append
-	       "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
+(define (individual-verb verb voice mood tense)
+  (let ((res (ellinika:sql-query
+	      "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
 FROM individual_verb i,verbflect f \
-WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
-"' AND i.tense = '" tense "' AND i.ident=f.ident"))))
+WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\
+AND i.tense=\"~A\" AND i.ident=f.ident"
+	      verb voice mood tense)))
     (if (not (null? res))
@@ -461,5 +451,5 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
 
-(define (conjugate conn verb voice mood tense . rest)
+(define (conjugate verb voice mood tense . rest)
   (cond
-   ((individual-verb conn verb voice mood tense) =>
+   ((individual-verb verb voice mood tense) =>
     (lambda (res)
@@ -467,5 +457,4 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
    (else
-    (let* ((vinfo (load-verb-info conn verb voice mood tense))
-	   (conj-list (get-conj-info conn
-				     (verb-get vinfo #:conj)
+    (let* ((vinfo (load-verb-info verb voice mood tense))
+	   (conj-list (get-conj-info (verb-get vinfo #:conj)
 				     voice mood tense)))
@@ -498,3 +487,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
 		  (let* ((verb-conj
-			  (car (conjugate conn verb voice "sub" "Αόριστος"
+			  (car (conjugate verb voice "sub" "Αόριστος"
 					  #:nopart)))
@@ -515,4 +504,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
 			(conjugation:table
-			 (car (conjugate conn
-					 (conj-info #:aux conj) "act" "ind"
+			 (car (conjugate (conj-info #:aux conj) "act" "ind"
 					 (conj-info #:auxtense conj))))
@@ -528,3 +516,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
 ;		    (format #t "THEMA ~A~%" thema)
-		    (complement-verb-info conn vinfo verb
+		    (complement-verb-info vinfo verb
 					  (if (null? (cdr thema))
@@ -540,4 +528,4 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
 
-(define-public (conjugator conn verb voice mood tense)
-  (conjugate conn verb voice mood tense))
+(define-public (conjugator verb voice mood tense)
+  (conjugate verb voice mood tense))
 
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 +1,17 @@
+;;;; 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))
@@ -3,31 +19,91 @@
 (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)))))
+
diff --git a/src/ellinika/test-conjugation.scm b/src/ellinika/test-conjugation.scm
index 83086bf..055138b 100644
--- a/src/ellinika/test-conjugation.scm
+++ b/src/ellinika/test-conjugation.scm
@@ -24,8 +24,6 @@
 	     (ellinika conjugator)
-	     (gamma sql))
+	     (ellinika sql))
 
 (ellinika-cgi-init dict-template-file-name)
-(define db-connection (sql-open-connection ellinika-sql-connection))
-(sql-query db-connection "SET NAMES utf8")
-
+(ellinika:sql-connect ellinika-sql-connection)
 
@@ -61,3 +59,3 @@
      (newline))
-   (conjugator db-connection verb voice mood tense))
+   (conjugator verb voice mood tense))
   (gc))
diff --git a/src/ellinika/tests/conj/apomenv.scm b/src/ellinika/tests/conj/apomenv.scm
new file mode 100644
index 0000000..850609c
--- /dev/null
+++ b/src/ellinika/tests/conj/apomenv.scm
@@ -0,0 +1,4 @@
+(use-modules ((ellinika test-conjugation)))
+
+(test-conjugation:verb "απομένω")
+;(test-conjugation:tense "βλέπω" "pas" "sub" "Αόριστος")
diff --git a/src/ellinika/tests/conj/blepv.scm b/src/ellinika/tests/conj/blepv.scm
index e7fbc8b..7e54734 100644
--- a/src/ellinika/tests/conj/blepv.scm
+++ b/src/ellinika/tests/conj/blepv.scm
@@ -3 +3,2 @@
 (test-conjugation:verb "βλέπω")
+;(test-conjugation:tense "βλέπω" "pas" "sub" "Αόριστος")