aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ellinika/conjugator.scm106
-rw-r--r--src/ellinika/sql.scm116
-rw-r--r--src/ellinika/test-conjugation.scm8
-rw-r--r--src/ellinika/tests/conj/apomenv.scm4
-rw-r--r--src/ellinika/tests/conj/blepv.scm1
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,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 <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)))))
+
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" "Αόριστος")

Return to:

Send suggestions and report system problems to the System administrator.