;;;; 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 . ;;;; (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")