From 8c1de36d1f8b27fb946dac15e725c93ec57c1538 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Tue, 14 Jun 2011 14:20:39 +0300 Subject: 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. --- data/irregular-verbs.xml | 19 ++++- scm/verbop.scm | 149 +++++++++++++++--------------------- src/ellinika/conjugator.scm | 106 ++++++++++++------------- src/ellinika/sql.scm | 116 +++++++++++++++++++++++----- src/ellinika/test-conjugation.scm | 8 +- src/ellinika/tests/conj/apomenv.scm | 4 + src/ellinika/tests/conj/blepv.scm | 1 + 7 files changed, 230 insertions(+), 173 deletions(-) create mode 100644 src/ellinika/tests/conj/apomenv.scm diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml index e53e9fd..ac0e7a5 100644 --- a/data/irregular-verbs.xml +++ b/data/irregular-verbs.xml @@ -149,7 +149,14 @@ ανέβηκ ανέβ + + +

ανέβε

+

ανεβείτε

+ + + @@ -159,6 +166,7 @@ απένειμ απονείμ + @@ -212,10 +220,15 @@ βλέπω A - 000000 + είδ δ + + + 000000 + +

δες

@@ -223,6 +236,10 @@ + + ειδώθ + ιδωθ + diff --git a/scm/verbop.scm b/scm/verbop.scm index ff30892..5192b87 100644 --- a/scm/verbop.scm +++ b/scm/verbop.scm @@ -20,14 +20,12 @@ (use-modules (srfi srfi-1) (xmltools xmltrans) (ellinika elmorph) - (gamma sql) + (ellinika sql) (ellinika tenses) (ice-9 getopt-long)) (define cleanup-option #f) (define force-option #f) -(define verbose-option #f) -(define dry-run-option #f) (define debug-level 0) (define input-files '()) (define flect-ident 0) @@ -38,8 +36,6 @@ (define class-list '()) ; List of defined verb classes. -(define connection #f) ; SQL connection - (define sysconf-dir "=SYSCONFDIR=") (define config-file-name "ellinika.conf") @@ -62,31 +58,13 @@ rest) (newline)))) -(define (sql-val val) - ;; FIXME: quote - (if (not val) - "NULL" - (string-append "\"" val "\""))) - -(define (run-query . rest) - (debug 100 rest) - (let ((q (apply format (cons #f rest)))) - (if verbose-option - (format #t "QUERY: ~A\n" q)) - (cond - (connection - (let ((res (sql-query connection q))) - (if verbose-option - (format #t "RESULT: ~A\n" res)) - res)) - (else - #f)))) - (define (query-number q) - (let ((res (run-query q))) - (if (null? res) - #f - (string->number (caar res))))) + (if ellinika:sql-dry-run + 0 + (let ((res (ellinika:sql-query q))) + (if (null? res) + #f + (string->number (caar res)))))) (define (check-parent elt . rest) (call-with-current-continuation @@ -179,9 +157,6 @@ (else (list-ref verbdef (verbdef:index what))))) -(define (verb-get-sql what) - (sql-val (verb-get what))) - (define (verb-set what val) (if (null? verbdef) (verb-init)) @@ -229,23 +204,25 @@ (return #t)))) (define (insert-individual-verb voice mood tense ident) - (run-query "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \ -VALUES (~A,~A,~A,~A,~A);~%" - (verb-get-sql #:verb) - (sql-val voice) - (sql-val mood) - (sql-val tense) - (number->string ident))) + (ellinika:sql-query + "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \ +VALUES (~Q,~Q,~Q,~Q,~Q)" + (verb-get #:verb) + voice + mood + tense + ident)) (define (flush-mood mood vstr) (if (eq? (car mood) #:root) (let ((val (cdr mood))) - (run-query "INSERT INTO irregular_root (verb,voice,thema,root) \ -VALUES (~A,~A,~A,~A)" - (verb-get-sql #:verb) - (sql-val vstr) - (sql-val (car val)) - (sql-val (cdr val)))) + (ellinika:sql-query + "INSERT INTO irregular_root (verb,voice,thema,root) \ +VALUES (~Q,~Q,~Q,~Q)" + (verb-get #:verb) + vstr + (car val) + (cdr val))) (let ((mood-str (car mood))) (let ((lst (cdr mood))) (cond @@ -268,32 +245,30 @@ VALUES (~A,~A,~A,~A)" (else (let ((num (next-flect-ident)) (l (cdr p))) - (run-query - "INSERT INTO verbflect VALUES (~A,~A,~A,~A,~A,~A,~A)" + (ellinika:sql-query + "INSERT INTO verbflect VALUES (~Q,~Q,~Q,~Q,~Q,~Q,~Q)" num - (sql-val (list-ref l 0)) - (sql-val (list-ref l 1)) - (sql-val (list-ref l 2)) - (sql-val (list-ref l 3)) - (sql-val (list-ref l 4)) - (sql-val (list-ref l 5))) + (list-ref l 0) + (list-ref l 1) + (list-ref l 2) + (list-ref l 3) + (list-ref l 4) + (list-ref l 5)) (insert-individual-verb vstr mood-str tense num) ))) (for-each (lambda (prop) ; (format #t "PROP ~A~%" prop) (let ((key (car prop))) - (cond - ((string=? key "default")) - (else - (run-query - "INSERT INTO verbtense VALUES (~A,~A,~A,~A,~A,~A)" - (verb-get-sql #:verb) - (sql-val vstr) - (sql-val mood-str) - (sql-val tense) - (sql-val (car prop)) - (sql-val (cdr prop))))))) + (if (not (string=? key "default")) + (ellinika:sql-query + "INSERT INTO verbtense VALUES (~Q,~Q,~Q,~Q,~Q,~Q)" + (verb-get #:verb) + vstr + mood-str + tense + (car prop) + (cdr prop))))) (list-tail p 7)))) lst))))))) @@ -371,9 +346,10 @@ VALUES (~A,~A,~A,~A)" ;; (case (verb-get #:action) ((insert) - (run-query "INSERT INTO verbclass (verb,conj) VALUES (~A,~A)" - (verb-get-sql #:verb) - (verb-get-sql #:class)) + (ellinika:sql-query + "INSERT INTO verbclass (verb,conj) VALUES (~Q,~Q)" + (verb-get #:verb) + (verb-get #:class)) (flush-voice "act" (preprocess-voice (verb-get #:act) @@ -790,10 +766,11 @@ Informational options: ((preserve) (set! preserve-option #t)) ((debug) - (set! debug-level (string->number (cdr x)))) + (set! debug-level (string->number (cdr x))) + (set! ellinika:sql-verbose #t)) ((dry-run) - (set! verbose-option #t) - (set! dry-run-option #t)) + (set! ellinika:sql-dry-run #t) + (set! ellinika:sql-verbose #t)) ((help) (usage) (exit 0)))) @@ -806,31 +783,27 @@ Informational options: (display "Input files not specified\n" (current-error-port)) (exit 1))) -(cond - ((not dry-run-option) - (set! connection (sql-open-connection ellinika-sql-connection)) - (if (not connection) - (begin - (display "Cannot connect to the database\n" (current-error-port)) - (exit 1))) - (run-query "SET NAMES utf8") - (set! flect-ident (query-number "SELECT MAX(ident) FROM verbflect")))) +(if (not (ellinika:sql-connect ellinika-sql-connection)) + (begin + (display "Cannot connect to the database\n" (current-error-port)) + (exit 1))) +(set! flect-ident (query-number "SELECT MAX(ident) FROM verbflect")) (cond (cleanup-option - (run-query "DELETE FROM verbflect where ident > 99") - (run-query "DELETE FROM verbclass") - (run-query "DELETE FROM verbtense") - (run-query "DELETE FROM irregular_root") - (run-query "DELETE FROM individual_verb"))) + (ellinika:sql-query "DELETE FROM verbflect where ident > 99") + (ellinika:sql-query "DELETE FROM verbclass") + (ellinika:sql-query "DELETE FROM verbtense") + (ellinika:sql-query "DELETE FROM irregular_root") + (ellinika:sql-query "DELETE FROM individual_verb"))) (set! class-list (cons "I" - (if dry-run-option + (if ellinika:sql-dry-run (list "A" "B1" "B2") (map car - (run-query + (ellinika:sql-query "SELECT DISTINCT conj FROM conjugation ORDER BY 1"))))) @@ -840,8 +813,8 @@ Informational options: (exit 1))) input-files) -(if connection - (sql-close-connection connection)) +(ellinika:sql-disconnect) + 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,4 +1,4 @@ -;;;; Modern Greek Verb Conjugator. +;;;; Verb Conjugator for modern Greek (δημοτική). ;;;; This file is part of Ellinika project. ;;;; Copyright (C) 2011 Sergey Poznyakoff ;;;; @@ -21,15 +21,10 @@ (ellinika elmorph) (ellinika i18n) (ellinika tenses) - (gamma sql)) + (ellinika sql)) (use-syntax (ice-9 syncase)) -(define (my-sql-query conn query) -; (format #t "Q: ~A~%" query) - (let ((res (sql-query conn query))) -; (format #t "R: ~A~%" res) - res)) ;; Verb info ;; #:verb - Verb in dictionary form @@ -80,36 +75,33 @@ ;; FIXME: deponentia? (else "A"))) -(define (create-basic-verb-info conn verb proplist . rest) +(define (create-basic-verb-info verb proplist . rest) ; (format #t "PROPLIST ~A~%" proplist) (let ((class (if (null? rest) "" - (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) (list (guess-verb-class verb) verb proplist '())) (else (list (car rest) verb '() '())))))) -(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) '() (map @@ -173,12 +165,11 @@ (else (elstr-append root "ηθ"))))) -(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)) (define (verb-A-root verb) (cond @@ -189,12 +180,12 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))) (else (error "cannot handle ~A~%" verb)))) -(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)))) (verb-set! vinfo #:root (cond @@ -235,7 +226,7 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))) (thema-aoristoy-mesapathitikis-B root (list-ref - (conjugate conn verb "act" "ind" "Αόριστος") + (conjugate verb "act" "ind" "Αόριστος") 0))) (else #f)))) @@ -292,15 +283,15 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))) ((conj-info-set! #:accmap v) (list-set! v 2 val)) )) -(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,\ 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) #f answer))) @@ -439,14 +430,13 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood forms) (map force-string forms))))) -(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)) (append (car res) (list "I" @@ -459,15 +449,14 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (or a b)) lista listb)) -(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) (list res))) (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))) (if (not conj-list) (list (list #f #f #f #f #f #f) #f #f) @@ -496,7 +485,7 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (cond ((string=? (conj-info #:thema conj) "synt") (let* ((verb-conj - (car (conjugate conn verb voice "sub" "Αόριστος" + (car (conjugate verb voice "sub" "Αόριστος" #:nopart))) (form (list-ref verb-conj 2)) (part (conj-info #:particle conj))) @@ -513,8 +502,7 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (elstr-append part " " aux " " form) (elstr-append aux " " form))))) (conjugation:table - (car (conjugate conn - (conj-info #:aux conj) "act" "ind" + (car (conjugate (conj-info #:aux conj) "act" "ind" (conj-info #:auxtense conj)))) (string->list (or (verb-get vinfo #:accmap) (conj-info #:accmap conj) @@ -526,7 +514,7 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (else (let ((thema (string-split (conj-info #:thema conj) #\:))) ; (format #t "THEMA ~A~%" thema) - (complement-verb-info conn vinfo verb + (complement-verb-info vinfo verb (if (null? (cdr thema)) voice (car (cdr thema))) @@ -538,8 +526,8 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (conj-info #:fold conj))) conj-list)))))))) -(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)) (define-public (conjugation:table conj) (cond 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 . +;;;; (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 +;; ~ - +(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 @@ -22,12 +22,10 @@ (ellinika cgi) (ellinika tenses) (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) (define transtab '(("act" . "Ενεργητηκή φωνή") @@ -59,7 +57,7 @@ (display "!")))) (display conj))))) (newline)) - (conjugator db-connection verb voice mood tense)) + (conjugator verb voice mood tense)) (gc)) (define-public (test-conjugation:voice voice verb) 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 @@ -1,3 +1,4 @@ (use-modules ((ellinika test-conjugation))) (test-conjugation:verb "βλέπω") +;(test-conjugation:tense "βλέπω" "pas" "sub" "Αόριστος") -- cgit v1.2.1