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. --- 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 + 5 files changed, 151 insertions(+), 84 deletions(-) create mode 100644 src/ellinika/tests/conj/apomenv.scm (limited to 'src/ellinika') 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