aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2005-03-29 16:19:34 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2005-03-29 16:19:34 +0000
commita8de7ec2c5672f84fe99aeae989c3fa4bd66e940 (patch)
tree1b5e4c36fbd68242bf26bc8568f359266f784e36
parent2b3fc109fa25f337e4512d4cd0ed317389028538 (diff)
downloadellinika-a8de7ec2c5672f84fe99aeae989c3fa4bd66e940.tar.gz
ellinika-a8de7ec2c5672f84fe99aeae989c3fa4bd66e940.tar.bz2
Set utf8 mode (for mysql >= 4.1.10)
(my-sql-query): New function. Wrapper over sql-query. All callers updated (fuzzy-search): Rewritten git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@319 941c8c0f-9102-463b-b60b-cd22ce0e6858
-rw-r--r--cgi-bin/dict.cgi.in176
1 files changed, 105 insertions, 71 deletions
diff --git a/cgi-bin/dict.cgi.in b/cgi-bin/dict.cgi.in
index 04eccd1..d323c5a 100644
--- a/cgi-bin/dict.cgi.in
+++ b/cgi-bin/dict.cgi.in
@@ -41,7 +41,8 @@
sql-username sql-password)))
(cond
(conn
- (let ((plist (sql-query
+ (sql-query conn "SET NAMES utf8")
+ (let ((plist (my-sql-query
conn
"SELECT name,id FROM pos WHERE canonical='Y' order by id")))
(set! part-of-speech
@@ -75,14 +76,15 @@
sql-username sql-password)))
(cond
(conn
- (let ((categories (sql-query
+ (sql-query conn "SET NAMES utf8")
+ (let ((categories (my-sql-query
conn
"SELECT category, title, description FROM category ORDER BY category")))
(let ((result (if (null? categories)
'()
(map
(lambda (category)
- (let ((topics (sql-query
+ (let ((topics (my-sql-query
conn
(string-append
"SELECT ident,title FROM topic WHERE category="
@@ -334,74 +336,103 @@
(format #t (_"Συγγνώμη, η λέξη \"~A\" δεν βρέθηκε στο λέξικο.") key)
(display "</H2>"))
+(define (my-sql-query conn query)
+ (catch #t
+ (lambda ()
+ (sql-query conn query))
+ (lambda args
+ '())))
+
(define (fuzzy-search conn key theme pos)
- (let* ((query (string-append
- "SELECT DISTINCT dict.word FROM dict,topic_tab WHERE "
-
- (if (not (null? theme))
- " topic_tab.word_ident=dict.ident "
- "")
-
- (cond
- ((not (string-null? key))
- (string-append
- (if (not (null? theme))
- "AND" "")
- " dict.sound LIKE \""
- (ellinika:sounds-like key)
- "%\" "))
- (else
- " "))
-
- (cond
- ((> (string->number pos) 0)
- (let ((pos-entry
- (list-ref part-of-speech (string->number pos))))
- (string-append
- (if (or (not (string-null? key)) (not (null? theme)))
- (if (string=? (cgi:value "joinpos") "0")
- "AND"
- "OR")
- "")
- " (dict.pos & "
- (cdr pos-entry)
- ") = "
- (cdr pos-entry))))
- (else
- " "))
-
- (apply
- string-append
- (map
- (lambda (x)
- (cond
- ((boolean? x)
- (if x "AND " "OR "))
- (else
- (string-append "topic_tab.topic_ident=" x " "))))
- theme))
-
- " ORDER BY dict.word"))
- (result (sql-query conn query)))
+ (let ((where-cond (list "WHERE"))
+ (select-stmt "SELECT DISTINCT dict.word FROM ")
+ (from-list (list "dict")))
+
+ (cond
+ ((not (null? theme))
+ (set! where-cond (cons " topic_tab.word_ident=dict.ident"
+ where-cond))
+ (set! from-list (cons ",topic_tab" from-list))))
(cond
- ((null? result)
- (search-failure key))
- (else
- (display "<TABLE WIDTH=\"100%\">")
- (let* ((result-length (length result))
- (lim (1+ (inexact->exact (/ result-length match-list-columns)))))
- (do ((i 0 (1+ i)))
- ((= i lim) #f)
- (display "<TR>")
- (do ((j i (+ j lim)))
- ((>= j result-length) #f)
- (display "<TD>")
- (display-cross-reference (car (list-ref result j)))
- (display "</TD>"))
- (display "</TR>")))
- (display "</TABLE>")))))
+ ((not (string-null? key))
+ (if (not (null? theme))
+ (set! where-cond (cons " AND" where-cond)))
+ (set! where-cond (cons (string-append
+ " dict.sound LIKE \""
+ (ellinika:sounds-like key)
+ "%\"")
+ where-cond))))
+ (cond
+ ((> (string->number pos) 0)
+ (let ((pos-entry
+ (list-ref part-of-speech (string->number pos))))
+ (if (or (not (string-null? key)) (not (null? theme)))
+ (set! where-cond (cons
+ (if (string=? (cgi:value "joinpos") "0")
+ " AND"
+ " OR")
+ where-cond)))
+
+ (set! where-cond (cons
+ (string-append " (dict.pos & "
+ (cdr pos-entry)
+ ") = "
+ (cdr pos-entry))
+ where-cond)))))
+
+ (let ((result
+ (my-sql-query conn
+ (string-append
+ select-stmt
+
+ " "
+
+ (apply
+ string-append
+ (reverse from-list))
+
+ " "
+
+ (apply
+ string-append
+ (append
+ (reverse where-cond)
+ (map
+ (lambda (x)
+ (cond
+ ((boolean? x)
+ (if x " AND" " OR"))
+ (else
+ (if (not (member ",topic_tab" from-list))
+ (set! from-list
+ (cons ",topic_tab"
+ from-list)))
+ (string-append
+ " topic_tab.topic_ident=" x))))
+ theme)))
+
+ " ORDER BY dict.word"))))
+
+ (cond
+ ((null? result)
+ (search-failure key))
+ (else
+ (display "<TABLE WIDTH=\"100%\">")
+ (let* ((result-length (length result))
+ (lim (1+ (inexact->exact (/ result-length match-list-columns)))))
+ (do ((i 0 (1+ i)))
+ ((= i lim) #f)
+ (display "<TR>")
+ (do ((j i (+ j lim)))
+ ((>= j result-length) #f)
+ (display "<TD>")
+ (display-cross-reference (car (list-ref result j)))
+ (display "</TD>"))
+ (display "</TR>")))
+ (display "</TABLE>"))))))
+
(define (dict-search)
(let ((keyval (if (cgi:value "IDENT")
@@ -434,9 +465,10 @@
(format #t "<H1>~A</H1>\n"
(_"ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))
(else
+ (sql-query conn "SET NAMES utf8")
(display "<HR>")
(let* ((key (ellinika:translate-input keyval))
- (result (sql-query
+ (result (my-sql-query
conn
(string-append
"SELECT dict.word,dict.ident,pos.abbr,dict.forms,articles.subindex,articles.meaning FROM dict,articles,pos WHERE dict.word=\""
@@ -450,7 +482,7 @@
(for-each
(lambda (entry)
(display-results entry)
- (let ((ant (sql-query
+ (let ((ant (my-sql-query
conn
(string-append
"SELECT dict.word FROM dict,links WHERE links.type='ANT' AND links.ident="
@@ -461,7 +493,7 @@
(if (= (length ant) 1)
(_"Антоним: ") (_"Антонимы: ")))))
(display "<P>")
- (let ((x (sql-query
+ (let ((x (my-sql-query
conn
(string-append
"SELECT dict.word FROM dict,links WHERE links.type='XREF' AND links.ident="
@@ -481,6 +513,7 @@
(_"ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))
(else
(display "<HR>")
+ (sql-query conn "SET NAMES utf8")
(fuzzy-search conn (ellinika:translate-input (or keyval "")) theme pos)
(sql-connect-close conn))))))))
@@ -494,7 +527,8 @@
sql-username sql-password)))
(cond
(conn
- (let ((x (sql-query conn
+ (sql-query conn "SET NAMES utf8")
+ (let ((x (my-sql-query conn
"SELECT count,updated from stat")))
(sql-connect-close conn)
x))

Return to:

Send suggestions and report system problems to the System administrator.