aboutsummaryrefslogtreecommitdiff
path: root/ellinika/dico.scm
diff options
context:
space:
mode:
Diffstat (limited to 'ellinika/dico.scm')
-rw-r--r--ellinika/dico.scm306
1 files changed, 306 insertions, 0 deletions
diff --git a/ellinika/dico.scm b/ellinika/dico.scm
new file mode 100644
index 0000000..9383d1f
--- /dev/null
+++ b/ellinika/dico.scm
@@ -0,0 +1,306 @@
+;;;; A Dico module for Greek Dictionary Web Engine -*- scheme -*-
+;;;; Copyright (C) 2008 Sergey Poznyakoff
+;;;;
+;;;; This program 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.
+;;;;
+;;;; This program 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 dico))
+
+(use-modules (guile-user)
+ (ice-9 rdelim)
+ (gamma sql)
+ (xmltools dict)
+ (ellinika xlat)
+ (ellinika config))
+
+(define (sql-error-handler err descr)
+ (format #t "cannot connect to the database")
+ (with-output-to-port
+ (current-error-port)
+ (lambda ()
+ (display err)
+ (display ": ")
+ (display descr))))
+
+(define (my-sql-query conn query)
+ (catch #t
+ (lambda ()
+ (sql-query conn query))
+ (lambda args
+ '())))
+
+;; END of FIXME
+
+(define (dico-error err . rest)
+ (with-output-to-port
+ (current-error-port)
+ (lambda ()
+ (display err)
+ (for-each
+ display
+ rest)
+ (newline))))
+
+;; Dico interface
+
+(define (open-module name . rest)
+ (let ((target-language "el")
+ (type 'dict))
+ (for-each (lambda (arg)
+ (let ((av (string-split arg #\=)))
+ (case (length av)
+ ((1) (cond
+ ((string=? (car av) "synonym")
+ (set! type 'synonim))
+ ((string=? (car av) "antonym")
+ (set! type 'antonym))
+ (else
+ (dico-error "Unknown option " (car av)))))
+ ((2) (cond
+ ((string=? (car av) "lang")
+ (set! target-language (cadr av)))
+ (else
+ (dico-error "Unknown option " (car av)))))
+ (else
+ (dico-error "Unknown option " (car av))))))
+ (cdr rest))
+ (let ((db-connection (sql-connect
+ sql-iface sql-host sql-port sql-database
+ sql-username sql-password)))
+ (sql-query db-connection "SET NAMES utf8")
+ (list db-connection target-language type))))
+
+(defmacro dbh:conn (dbh) `(list-ref ,dbh 0))
+(defmacro dbh:lang (dbh) `(list-ref ,dbh 1))
+(defmacro dbh:type (dbh) `(list-ref ,dbh 2))
+
+(define (close-module dbh)
+ (sql-connect-close (dbh:conn dbh)))
+
+(define descr-list
+ '(("pl" . "Słownik grecko-polski")
+ ("uk" . "Грецько-украЇнський словник")
+ ("ru" . "Греческо-русский словарь")))
+
+(define (descr dbh)
+ (case (dbh:type dbh)
+ ((dict)
+ (let ((res (assoc (dbh:lang dbh) descr-list)))
+ (if res
+ (cdr res)
+ "Ellinika (no description available)")))
+ ((antonym)
+ "Λέξικο αντωνύμων της Ελληνικής γλώσσας")
+ ((synonym)
+ "a")))
+
+(define (info dbh)
+ (string-append "Ellinika - A greek dictionary.\n\
+See http://ellinika.gnu.org.ua/cgi-bin/dict.cgi?LANG="
+ (dbh:lang dbh) "\n\
+Copyright © 2004, 2005, 2006, 2007, 2008 Sergey Poznyakoff\n\
+\n\
+Permission is granted to copy, distribute and/or modify this document\n\
+under the terms of the GNU Free Documentation License, Version 1.2 or\n\
+any later version published by the Free Software Foundation; with no\n\
+Invariant Sections, no Front-Cover and Back-Cover Texts"))
+
+(define (define-word-dict dbh key)
+ (let ((result '())
+ (last-id -1)
+ (word '())
+ (articles '()))
+ (for-each
+ (lambda (tuple)
+ (cond
+ ((not (= last-id (string->number (car tuple))))
+ (if (not (null? articles))
+ (set! result (cons
+ (cons word (reverse articles))
+ result)))
+ (set! last-id (string->number (car tuple)))
+ (set! word (cons (list-ref tuple 1)
+ (list-ref tuple 2))); FIXME: forms?
+ (set! articles '())))
+ (set! articles (cons
+ (cons (list-ref tuple 4)
+ (list-ref tuple 5))
+ articles)))
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT dict.ident,dict.word,pos.abbr,dict.forms,articles.subindex,articles.meaning "
+ "FROM dict,articles,pos WHERE dict.word=\""
+ key
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' "
+ "AND dict.pos=pos.id AND pos.canonical='Y' ORDER BY dict.ident, articles.subindex")))
+ (if (not (null? articles))
+ (set! result (cons
+ (cons word (reverse articles))
+ result)))
+ (cons 'define-word-dict (reverse result))))
+
+(define (define-word-x dbh word link-type)
+ (let ((res (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict,links,articles "
+ "WHERE links.type='" link-type "' AND links.ident IN "
+ "(SELECT ident FROM dict WHERE word=\"" word "\") "
+ "AND dict.ident=links.xref "
+ "AND dict.ident=articles.ident and articles.lang=\""
+ (dbh:lang dbh)
+ "\" ORDER BY word"))))
+ (if (and res (not (null? res)))
+ (cons 'define-word-x (list (cons word (map car res))))
+ #f)))
+
+(define (define-word-antonym dbh word)
+ (define-word-x dbh word "XREF"))
+
+(define (define-word-synonym dbh word)
+ (define-word-x dbh word "ANT"))
+
+(define define-list
+ (list (cons 'dict define-word-dict)
+ (cons 'synonym define-word-synonym)
+ (cons 'antonym define-word-antonym)))
+
+(define (define-word dbh word)
+ (let ((key (ellinika:translate-input word))
+ (x (assoc (dbh:type dbh) define-list)))
+ (if x
+ ((cdr x) dbh key)
+ #f)))
+
+(define (match-exact dbh strat word)
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word=\""
+ (ellinika:translate-input word)
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+
+(define (match-prefix dbh strat word)
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word LIKE \""
+ (ellinika:translate-input word)
+ "%\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+
+(define (match-suffix dbh strat word)
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word LIKE \"%"
+ (ellinika:translate-input word)
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+
+(define (match-extnd-regex dbh strat word)
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word regexp \""
+ (ellinika:translate-input word)
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+
+(define (match-basic-regex dbh strat word)
+ #f) ;FIXME
+
+(define (match-default dbh strat word)
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict,articles WHERE dict.sound LIKE \""
+ (ellinika:sounds-like word)
+ "%\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+
+
+(define strategy-list
+ (list (cons "exact" match-exact)
+ (cons "prefix" match-prefix)
+ (cons "suffix" match-suffix)
+ (cons "re" match-extnd-regex)
+ (cons "regexp" match-basic-regex)))
+
+(define (match-word dbh strat word)
+ (let ((sp (assoc (dico-strat-name strat) strategy-list)))
+ (let ((res (if sp
+ ((cdr sp) dbh strat word)
+ (match-default dbh strat word))))
+ (if res
+ (cons #f (map car res))
+ #f))))
+
+(define (output res n)
+ (let ((type (car res))
+ (contents (list-ref (cdr res) n)))
+ (case type
+ ((define-word-dict)
+ (let ((word-pair (car contents))
+ (defn (cdr contents)))
+ (display (car word-pair))
+ (display ", <")
+ (display (cdr word-pair))
+ (display ">")
+ (for-each
+ (lambda (article)
+ (newline)
+ (display (1+ (string->number (car article))))
+ (display ". ")
+ (display (cdr article))
+ (display ";"))
+ defn)))
+ ((define-word-x)
+ (let ((word (car contents))
+ (defn (cdr contents)))
+ (display word)
+ (display " -- ")
+ (display (car defn))
+ (if (cdr defn)
+ (for-each
+ (lambda (elt)
+ (display ", ")
+ (display elt))
+ (cdr defn)))))
+ (else
+ (display contents)))))
+
+(define (result-count res)
+ (length (cdr res)))
+
+(define-public (dico-ellinika-init arg)
+ (list (cons "open" open-module)
+ (cons "close" close-module)
+ (cons "descr" descr)
+ (cons "info" info)
+ (cons "define" define-word)
+ (cons "match" match-word)
+ (cons "output" output)
+ (cons "result-count" result-count)))
+
+;;
+;; Setup
+(ellinika-config-setup)
+(dico-register-strat "suffix" "Match word suffixes")
+
+
+

Return to:

Send suggestions and report system problems to the System administrator.