aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--cgi-bin/dict.cgi.in256
1 files changed, 132 insertions, 124 deletions
diff --git a/cgi-bin/dict.cgi.in b/cgi-bin/dict.cgi.in
index d323c5a..a414ffe 100644
--- a/cgi-bin/dict.cgi.in
+++ b/cgi-bin/dict.cgi.in
@@ -35,25 +35,63 @@
;; Τα μέρη του λογου
(define part-of-speech '())
+(define (sql-error-handler err descr)
+ (format #t "<h1 class=\"error\">~A</h1>\n"
+ (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
+ (with-output-to-port
+ (current-error-port)
+ (lambda ()
+ (display err)
+ (display ": ")
+ (display descr))))
+
+(define (mk-dict-connect)
+ (let ((db-connection #f))
+ (lambda (. rest)
+ (cond
+ ((null? rest)
+ (if (not db-connection)
+ (begin
+ (set! db-connection
+ (sql-connect
+ sql-iface sql-host sql-port sql-database
+ sql-username sql-password))
+ ;(sql-query db-connection "SET NAMES utf8")
+ )))
+ (else
+ (if db-connection
+ (sql-connect-close db-connection))
+ (set! db-connection #f)))
+ db-connection)))
+
+(define dict-connect (mk-dict-connect))
+
+(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 (load-pos)
- (let ((conn (sql-connect
- sql-iface sql-host sql-port sql-database
- sql-username sql-password)))
- (cond
- (conn
- (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
- (cons
- (cons "κανένα μέρος του λόγου" #f)
- (map
- (lambda (x)
- (cons (car x) (cadr x)))
- plist))))
- (sql-connect-close conn)))))
-
+ (ignore-sql-failure
+ (let ((conn (dict-connect)))
+ (let ((plist (my-sql-query
+ conn
+ "SELECT name,id FROM pos WHERE canonical='Y' order by id")))
+ (set! part-of-speech
+ (cons
+ (cons "κανένα μέρος του λόγου" #f)
+ (map
+ (lambda (x)
+ (cons (car x) (cadr x)))
+ plist)))))))
+
;; Protect occurences of " in a string.
;; Usual backslash escapes do not work in INPUT widgets, so I
;; change all quotation marks to &#34;
@@ -72,34 +110,27 @@
(let ((categories #f))
(letrec ((getcat
(lambda ()
- (let ((conn (sql-connect sql-iface sql-host sql-port sql-database
- sql-username sql-password)))
- (cond
- (conn
- (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 (my-sql-query
- conn
- (string-append
- "SELECT ident,title FROM topic WHERE category="
- (car category)
- " ORDER BY title"))))
- (append category (if (null? topics)
- '()
- (list topics)))))
- categories))))
- (sql-connect-close conn)
- result)))
- (else
- '()))))))
+ (ignore-sql-failure
+ (let ((conn (dict-connect)))
+ (let ((ctg (my-sql-query
+ conn
+ "SELECT category, title, description FROM category ORDER BY category")))
+ (if (null? ctg)
+ '()
+ (map
+ (lambda (category)
+ (let ((topics (my-sql-query
+ conn
+ (string-append
+ "SELECT ident,title FROM topic WHERE category="
+ (car category)
+ " ORDER BY title"))))
+ (append category (if (null? topics)
+ '()
+ (list topics)))))
+ ctg))))))))
(if (not categories)
- (set! categories (getcat)))
+ (set! categories (or (getcat) '())))
categories)))
(define (join-widget widget-id tabindex)
@@ -451,99 +482,75 @@
v))))))))
(pos (or (cgi:value "POS") "0")))
- (cond
- ((and keyval
- (not (string-null? keyval))
- (null? theme)
- (= (string->number pos) 0))
-
- (let ((conn (sql-connect
- sql-iface sql-host sql-port sql-database
- sql-username sql-password)))
- (cond
- ((not conn)
- (format #t "<H1>~A</H1>\n"
- (_"ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))
- (else
- (sql-query conn "SET NAMES utf8")
- (display "<HR>")
- (let* ((key (ellinika:translate-input keyval))
- (result (my-sql-query
+ (catch-sql-failure
+ (let ((conn (dict-connect)))
+ (cond
+ ((and keyval
+ (not (string-null? keyval))
+ (null? theme)
+ (= (string->number pos) 0))
+ (display "<HR>")
+ (let* ((key (ellinika:translate-input keyval))
+ (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=\""
+ key
+ "\" and dict.ident=articles.ident and dict.pos=pos.id and pos.canonical='Y' order by dict.ident, articles.subindex"))))
+
+ (cond
+ ((null? result)
+ (fuzzy-search conn key theme pos))
+ (else
+ (for-each
+ (lambda (entry)
+ (display-results entry)
+ (let ((ant (my-sql-query
+ conn
+ (string-append
+ "SELECT dict.word FROM dict,links WHERE links.type='ANT' AND links.ident="
+ (cadr (car entry))
+ " AND dict.ident=links.xref ORDER BY word"))))
+ (if (and ant (not (null? ant)))
+ (display-xref ant
+ (if (= (length ant) 1)
+ (_"Антоним: ") (_"Антонимы: ")))))
+ (display "<P>")
+ (let ((x (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=\""
- key
- "\" and dict.ident=articles.ident and dict.pos=pos.id and pos.canonical='Y' order by dict.ident, articles.subindex"))))
-
- (cond
- ((null? result)
- (fuzzy-search conn key theme pos))
- (else
- (for-each
- (lambda (entry)
- (display-results entry)
- (let ((ant (my-sql-query
- conn
- (string-append
- "SELECT dict.word FROM dict,links WHERE links.type='ANT' AND links.ident="
- (cadr (car entry))
- " AND dict.ident=links.xref ORDER BY word"))))
- (if (and ant (not (null? ant)))
- (display-xref ant
- (if (= (length ant) 1)
- (_"Антоним: ") (_"Антонимы: ")))))
- (display "<P>")
- (let ((x (my-sql-query
- conn
- (string-append
- "SELECT dict.word FROM dict,links WHERE links.type='XREF' AND links.ident="
- (cadr (car entry))
- " AND dict.ident=links.xref ORDER BY word"))))
- (if (and x (not (null? x)))
- (display-xref x (_"См. также ")))))
- (sort-result result))))
- (sql-connect-close conn))))))
- ((or (not (null? theme)) (> (string->number pos) 0))
- (let ((conn (sql-connect
- sql-iface sql-host sql-port sql-database
- sql-username sql-password)))
- (cond
- ((not conn)
- (format #t "<H1></H1>\n"
- (_"ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))
- (else
- (display "<HR>")
- (sql-query conn "SET NAMES utf8")
- (fuzzy-search conn (ellinika:translate-input (or keyval "")) theme pos)
- (sql-connect-close conn))))))))
+ "SELECT dict.word FROM dict,links WHERE links.type='XREF' AND links.ident="
+ (cadr (car entry))
+ " AND dict.ident=links.xref ORDER BY word"))))
+ (if (and x (not (null? x)))
+ (display-xref x (_"См. также ")))))
+ (sort-result result))))))
+ ((or (not (null? theme)) (> (string->number pos) 0))
+ (display "<HR>")
+ (fuzzy-search conn
+ (ellinika:translate-input (or keyval "")) theme pos)))))))
;;;
(define (stat key)
(let ((stat-data #f))
(if (not stat-data)
- (set! stat-data (let ((conn (sql-connect
- sql-iface sql-host sql-port sql-database
- sql-username sql-password)))
- (cond
- (conn
- (sql-query conn "SET NAMES utf8")
- (let ((x (my-sql-query conn
- "SELECT count,updated from stat")))
- (sql-connect-close conn)
- x))
- (else
- '())))))
+ (set! stat-data
+ (or
+ (ignore-sql-failure
+ (my-sql-query (dict-connect)
+ "SELECT count,updated from stat"))
+ '())))
(if (null? stat-data)
"<>"
(case key
- ((#:updated)
+ ((#:updated)
(list-ref (car stat-data) 1))
- ((#:count)
+ ((#:count)
(list-ref (car stat-data) 0))
- (else
- "<>")))))
+ (else
+ "<>")))))
;;;
@@ -579,6 +586,7 @@
(template-file target-language dict-template-file-name)
dict-html)
+(dict-connect #t)
;;;; Local variables:
;;;; mode: Scheme

Return to:

Send suggestions and report system problems to the System administrator.