aboutsummaryrefslogtreecommitdiff
path: root/cgi-bin/dico-ellinika.scm4
blob: b2eabf3182160cf93c04637ea64cf0ba57ab6c1c (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
;;;; 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)
	     (gamma gettext)
	     (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 target-language "ru")

(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 ((db-connection (sql-connect
			sql-iface sql-host sql-port sql-database
			sql-username sql-password)))
    (sql-query db-connection "SET NAMES utf8")
    db-connection))

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

(define (descr name handle)
  "GreekTest dict")

(define (info name handle)
  (string-append name "Ellinika - A greek dictionary.\n\
Copyright © 2004, 2005, 2006, 2007 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
	(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='" target-language "' "
	 "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
   (string-append "SELECT DISTINCT word FROM dict WHERE word=\"" 
		  (ellinika:translate-input word)
		  "\" ORDER BY 1")))

(define (match-prefix dbh strat word)
  (my-sql-query
   dbh
   (string-append "SELECT DISTINCT word FROM dict WHERE word LIKE \"" 
		  (ellinika:translate-input word)
		  "%\" ORDER BY 1")))

(define (match-suffix dbh strat word)
  (my-sql-query
   dbh
   (string-append "SELECT DISTINCT word FROM dict WHERE word LIKE \"%" 
		  (ellinika:translate-input word)
		  "\" ORDER BY 1")))

(define (match-extnd-regex dbh strat word)
  (my-sql-query
   dbh
   (string-append "SELECT DISTINCT word FROM dict WHERE word regexp \"" 
		  (ellinika:translate-input word)
		  "\" ORDER BY 1")))

(define (match-basic-regex dbh strat word)
  #f) ;FIXME

(define (match-default dbh strat word)
  (my-sql-query
   dbh
   (string-append "SELECT DISTINCT word FROM dict WHERE sound LIKE \"" 
		  (ellinika:sounds-like word)
		  "%\"")))


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