aboutsummaryrefslogtreecommitdiff
path: root/cgi-bin/dico-ellinika.scm4
blob: 9bb92e441955ab49ecf6f27b2eea0e2f4b2ad18d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
;;;; 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/>.
;;;;

;;; Tailor this statement to your needs if necessary.
(set! %load-path (cons "GUILE_SITE" %load-path))

(use-modules (guile-user)
	     (ice-9 rdelim)
	     (gamma sql)
	     (xmltools dict)
	     (ellinika xlat)
	     (ellinika cgi))

;; FIXME: These belong to a common module, which should be used by cgi.scm
;; as well.
(define sql-iface "mysql")       ;; SQL interface ("mysql" or "postgres")
(define sql-host "localhost")    ;; SQL server hostname or a path to the UNIX
                                 ;; socket
(define sql-port 3306)           ;; SQL port number (0 for sockaddr_un
                                 ;; connection)
(define sql-database "ellinika") ;; Name of the database
(define sql-username "gray")     ;; Database user name
(define sql-password "")         ;; Password for that user name

(define-public sysconf-dir "SYSCONFDIR")
(define-public config-file-name "ellinika.conf")

(define (ellinika-config-setup)
  ;;; Load the site defaults
  (let ((rc-file (string-append sysconf-dir "/" config-file-name)))
    (if (file-exists? rc-file)
	(load rc-file))))

;; These are defined in dict.scm4

(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))))  

(defmacro catch-sql-failure (expr)
  `(catch 'gsql-error
	  (lambda () ,expr)
	  (lambda (key err descr)
	    (sql-error-handler err descr))))

(defmacro ignore-sql-failure (expr)
  `(catch 'gsql-error
	  (lambda () ,expr)
	  (lambda (key err descr)
	    #f)))

(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"))
    (for-each (lambda (arg)
		(let ((av (string-split arg #\=)))
		  (case (length av)
		    ((2) (if (string=? (car av) "lang")
			     (set! target-language (cadr av))
			     (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")
      (cons db-connection target-language))))

(defmacro dbh:conn (dbh) `(car ,dbh))
(defmacro dbh:lang (dbh) `(cdr ,dbh))

(define (close-module name dbh)
  (sql-connect-close (dbh:conn dbh)))

(define descr-list
  '(("pl" . "Słownik grecko-polski")
    ("uk" . "Грецько-украЇнський словник")
    ("ru" . "Греческо-русский словарь")))

(define (descr name dbh)
  (let ((res (assoc (dbh:lang dbh) descr-list)))
    (if res
	(cdr res)
	"Ellinika (no description available)")))

(define (info name 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 name dbh word)
  (let ((key (ellinika:translate-input word)))
    (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 #t (reverse result)))))

(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 name 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)))
    (cond
     (type
      (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)))
     (else
      (display contents)))))

(define (result-count res)
  (length (cdr res)))

;;
;; Setup
(ellinika-config-setup)


  

Return to:

Send suggestions and report system problems to the System administrator.