aboutsummaryrefslogtreecommitdiff
path: root/cgi-bin
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2005-02-09 11:03:52 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2005-02-09 11:03:52 +0000
commitfd85c693fe2019a99695925efaf97e8aa5519bcb (patch)
tree9c9989e0ad43356277d83e7095238e36c630e2d2 /cgi-bin
parent0727cd721040c38d65b891a26fe4ea6ef09520be (diff)
downloadellinika-fd85c693fe2019a99695925efaf97e8aa5519bcb.tar.gz
ellinika-fd85c693fe2019a99695925efaf97e8aa5519bcb.tar.bz2
(get-topic-list,fuzzy-search): Rewritten following the new scheme
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@288 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'cgi-bin')
-rw-r--r--cgi-bin/dict.cgi.in258
1 files changed, 173 insertions, 85 deletions
diff --git a/cgi-bin/dict.cgi.in b/cgi-bin/dict.cgi.in
index 01eb926..3369db5 100644
--- a/cgi-bin/dict.cgi.in
+++ b/cgi-bin/dict.cgi.in
@@ -1,7 +1,8 @@
#! =GUILE_BINDIR=/guile -s
+=AUTOGENERATED=
!#
;;;; Greek Dictionary Web Engine
-;;;; Copyright (C) 2004 Sergey Poznyakoff
+;;;; Copyright (C) 2004, 2005 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
@@ -158,16 +159,58 @@
(string->list string)))))
(define (get-topic-list)
- (let ((conn (sql-connect sql-iface sql-host sql-port sql-database
- sql-username sql-password)))
- (cond
- (conn
- (let ((result (sql-query conn "SELECT ident,title FROM topic ORDER BY title")))
- (sql-connect-close conn)
- result))
- (else
- #f))))
-
+ (let ((categories #f))
+ (letrec ((getcat
+ (lambda ()
+ (let ((conn (sql-connect sql-iface sql-host sql-port sql-database
+ sql-username sql-password)))
+ (cond
+ (conn
+ (let ((categories (sql-query
+ conn
+ "SELECT category, title, description FROM category ORDER BY category")))
+ (let ((result (if (null? categories)
+ '()
+ (map
+ (lambda (category)
+ (let ((topics (sql-query
+ conn
+ (string-append
+ "SELECT ident,title FROM topic WHERE category="
+ (car category)))))
+ (append category (if (null? topics)
+ '()
+ (list topics)))))
+ categories))))
+ (sql-connect-close conn)
+ result)))
+ (else
+ '()))))))
+ (if (not categories)
+ (set! categories (getcat)))
+ categories)))
+
+(define (join-widget widget-id tabindex)
+ (let* ((name (string-append "join" widget-id))
+ (selected-choice (or (let ((s (cgi:value name)))
+ (if s
+ (string->number s)
+ #f))
+ 0)))
+ (display (string-append "<SELECT NAME=\""
+ name
+ "\" TABINDEX=\""
+ tabindex
+ "\">"))
+ (display "<OPTION VALUE=\"0\"")
+ (if (= selected-choice 0)
+ (display " selected"))
+ (display ">") (display (_"και")) (display "</OPTION>")
+ (display "<OPTION VALUE=\"1\"")
+ (if (= selected-choice 1)
+ (display " selected"))
+ (display ">") (display (_"ή")) (display "</OPTION>")
+ (display "</SELECT>")))
(define (main-form)
(load-pos)
@@ -190,10 +233,15 @@
(display "\""))))
(display ">
</TD>
-</TR>
+</TR>")
+
+ (display "<TR><TD COLSPAN=\"3\" ALIGN=\"center\">")
+ (display (_"Συμπληρωματικοί όροι"))
+ (display "</TD></TR>")
+
+ (display "
<TR>
<TD>")
-
(display (_"Επιλέξτε το μέρος του λόγου"))
(display "</TD><TD>")
@@ -219,49 +267,62 @@
part-of-speech)
(display "</SELECT>"))
- (display "
- </TD>
-</TR>
-<TR>
- <TD>")
-
- (display (_"Επιλέξτε το θέμα"))
(display "</TD><TD>")
- (let ((topic-list (get-topic-list)))
- (if topic-list
- (let ((selected-choice (or (let ((s (cgi:value "TOPIC")))
- (if s
- (string->number s)
- #f))
- 0)))
- (display "<SELECT NAME=\"TOPIC\" TABINDEX=\"3\">")
- (display "<OPTION VALUE=0>κανένα θέμα")
- (for-each
- (lambda (x)
- (let ((id (car x))
- (name (car (cdr x))))
- (display "<OPTION VALUE=")
- (display id)
- (if (eq? (string->number id) selected-choice)
- (display " selected"))
- (display ">")
- (display name)))
- topic-list)
- (display "</SELECT>"))))
+ (join-widget "pos" "3")
+ (display "</TD></TR>")
- (display "
- </TD>
-</TR>
+ (let ((tabindex 4))
+ (for-each
+ (lambda (category)
+ (display "<TR><TD>")
+ (display (list-ref category 1))
+ (display "</TD><TD>")
+ (let ((selected-choice (or (let ((s (cgi:value (list-ref category 0))))
+ (if s
+ (string->number s)
+ #f))
+ 0)))
+
+ (display (string-append
+ "<SELECT NAME=\""
+ (list-ref category 0)
+ "\" TABINDEX=\""
+ (number->string tabindex)
+ "\">"))
+ (set! tabindex (1+ tabindex))
+ (display "<OPTION VALUE=0>---")
+ (for-each
+ (lambda (x)
+ (let ((id (car x))
+ (name (car (cdr x))))
+ (display "<OPTION VALUE=")
+ (display id)
+ (if (eq? (string->number id) selected-choice)
+ (display " selected"))
+ (display ">")
+ (display name)
+ (display "</OPTION>")))
+ (list-ref category 3))
+ (display "</SELECT>")
+ (display "</TD><TD>")
+ (join-widget (list-ref category 0) (number->string tabindex))
+ (display "</TD></TR>")
+ (set! tabindex (1+ tabindex))))
+ (get-topic-list))
+
+ (display "
<TR>
<TD colspan=\"2\" align=center>
<INPUT TYPE=\"submit\" NAME=\"search\" VALUE=\"")
- (display (_"Αναζήτηση"))
- (display "\" TABINDEX=\"4\">
+ (display (_"Αναζήτηση"))
+ (display "\" TABINDEX=\"")
+ (display tabindex)
+ (display "\">
</TD>
</TR>
</TABLE>
</FORM>
-<P>"))
+<P>")))
;;
(define (replace-tilde word sentence)
@@ -364,40 +425,55 @@
(display "</H2>"))
(define (fuzzy-search conn key theme pos)
- (let ((result (sql-query conn
- (cond
- ((> (string->number theme) 0)
- (string-append
- "SELECT DISTINCT dict.word FROM dict,topic_tab WHERE "
- (cond
- ((not (string-null? key))
- (string-append "dict.sound LIKE \""
- (ellinika:sounds-like key)
- "%\" AND "))
- (else
- ""))
- "topic_tab.topic_ident="
- theme
- " AND topic_tab.word_ident=dict.ident "
- (if (> (string->number pos) 0)
- (let ((pos-entry
- (list-ref part-of-speech (string->number pos))))
- (string-append "AND dict.pos & "
- (cdr pos-entry)))
- "")
- " order by word"))
- (else
- (string-append
- "SELECT DISTINCT word FROM dict WHERE sound like \""
- (ellinika:sounds-like key)
- "%\" "
- (if (> (string->number pos) 0)
- (let ((pos-entry (list-ref part-of-speech
- (string->number pos))))
- (string-append "AND dict.pos &"
- (cdr pos-entry)))
- "")
- " ORDER BY WORD"))))))
+ (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)
+ " ")))
+ (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)))
+
(cond
((null? result)
(search-failure key))
@@ -421,13 +497,25 @@
(let ((keyval (if (cgi:value "IDENT")
(dict:decode-string (cgi:value "IDENT"))
(cgi:value "key")))
- (theme (or (cgi:value "TOPIC") "0"))
+ (theme (do ((catlist (get-topic-list) (cdr catlist))
+ (ret '()))
+ ((null? catlist) ret)
+ (let ((name (caar catlist)))
+ (let ((v (cgi:value name)))
+ (if (and v (> (string->number v) 0))
+ (set! ret (append
+ ret
+ (list (= (string->number
+ (cgi:value (string-append "join" name))) 0)
+ v))))))))
(pos (or (cgi:value "POS") "0")))
+
(cond
((and keyval
(not (string-null? keyval))
- (= (string->number theme) 0)
+ (null? theme)
(= (string->number pos) 0))
+
(let ((conn (sql-connect
sql-iface sql-host sql-port sql-database
sql-username sql-password)))
@@ -473,7 +561,7 @@
(display-xref x (_"См. также ")))))
(sort-result result))))
(sql-connect-close conn))))))
- ((or (> (string->number theme) 0) (> (string->number pos) 0))
+ ((or (not (null? theme)) (> (string->number pos) 0))
(let ((conn (sql-connect
sql-iface sql-host sql-port sql-database
sql-username sql-password)))
@@ -483,7 +571,7 @@
(_"ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))
(else
(display "<HR>")
- (fuzzy-search conn "" theme pos)
+ (fuzzy-search conn (ellinika:translate-input (or keyval "")) theme pos)
(sql-connect-close conn))))))))
;;;

Return to:

Send suggestions and report system problems to the System administrator.