summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-14 20:56:45 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2011-06-14 20:56:45 (GMT)
commit1ffd88231386c104474103fe641cad7fa535f3ec (patch) (side-by-side diff)
treefab5115a97e63cc59d9bf5bfd38b6d60cf9509c6
parent8c1de36d1f8b27fb946dac15e725c93ec57c1538 (diff)
downloadellinika-1ffd88231386c104474103fe641cad7fa535f3ec.tar.gz
ellinika-1ffd88231386c104474103fe641cad7fa535f3ec.tar.bz2
Use (ellinika sql) in dict and nea.
* src/cgi-bin/dict.scm4: Use (ellinika sql) * src/cgi-bin/nea.scm4: Likewise * src/ellinika/sql.scm: Re-export sql-catch-failure and sql-ignore-failure.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--src/cgi-bin/dict.scm4311
-rw-r--r--src/cgi-bin/nea.scm4192
-rw-r--r--src/ellinika/sql.scm2
3 files changed, 228 insertions, 277 deletions
diff --git a/src/cgi-bin/dict.scm4 b/src/cgi-bin/dict.scm4
index 534a735..1440454 100644
--- a/src/cgi-bin/dict.scm4
+++ b/src/cgi-bin/dict.scm4
@@ -1,5 +1,5 @@
;;;; Greek Dictionary Web Engine
-;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010 Sergey Poznyakoff
+;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 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
@@ -20,8 +20,10 @@
(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
(ice-9 rdelim)
- (gamma sql)
(xmltools dict)
+ (gamma sql)
+ (ellinika elmorph)
+ (ellinika sql)
(ellinika i18n)
(ellinika xlat)
(ellinika cgi))
@@ -38,39 +40,17 @@ ifelse(IFACE,[CGI],(cgi:init))
(_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
(apply format (current-error-port) fmt fmtargs))
-(define (mk-dict-connect)
- (let ((db-connection #f))
- (lambda (. rest)
- (cond
- ((null? rest)
- (if (not db-connection)
- (begin
- (set! db-connection
- (sql-open-connection
- ellinika-sql-connection))
- (sql-query db-connection "SET NAMES utf8")
- )))
- (else
- (if db-connection
- (sql-close-connection db-connection))
- (set! db-connection #f)))
- db-connection)))
-
-(define dict-connect (mk-dict-connect))
-
(define (load-pos)
(sql-ignore-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)))))))
+ (let ((plist (ellinika:sql-query
+ "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
@@ -91,28 +71,22 @@ ifelse(IFACE,[CGI],(cgi:init))
(letrec ((getcat
(lambda ()
(sql-ignore-failure
- (let ((conn (dict-connect)))
- (let ((ctg (my-sql-query
- conn
- (string-append
- "SELECT t.category, c.title, c.description "
- "FROM category c,topic t "
- "WHERE c.lang='" (language-code target-language) "' "
- "AND c.category=t.category GROUP BY 1 ORDER BY 1"))))
- (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))))))))
+ (let ((ctg (ellinika:sql-query
+ "SELECT t.category, c.title, c.description\
+ FROM category c,topic t\
+ WHERE c.lang=~Q AND c.category=t.category GROUP BY 1 ORDER BY 1"
+ (language-code target-language))))
+ (if (null? ctg)
+ '()
+ (map
+ (lambda (category)
+ (let ((topics (ellinika:sql-query
+ "SELECT ident,title FROM topic WHERE category=~Q ORDER BY title"
+ (car category))))
+ (append category (if (null? topics)
+ '()
+ (list topics)))))
+ ctg)))))))
(if (not categories)
(set! categories (or (getcat) '())))
categories)))
@@ -354,21 +328,14 @@ ifelse(IFACE,[CGI],(cgi:init))
(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)
+(define (fuzzy-search key theme pos)
(let ((where-cond (list (string-append
"WHERE dict.ident=articles.ident and articles.lang='"
- (language-code target-language)
+ (utf8-escape (language-code target-language))
"' AND")))
(select-stmt "SELECT DISTINCT dict.word FROM ")
(from-list (list ",articles" "dict")))
-
+
(cond
((not (null? theme))
(set! where-cond (cons " topic_tab.word_ident=dict.ident"
@@ -381,7 +348,7 @@ ifelse(IFACE,[CGI],(cgi:init))
(set! where-cond (cons " AND" where-cond)))
(set! where-cond (cons (string-append
" dict.sound LIKE \""
- (ellinika:sounds-like key)
+ (utf8-escape (ellinika:sounds-like key))
"%\"")
where-cond))))
@@ -404,37 +371,37 @@ ifelse(IFACE,[CGI],(cgi:init))
where-cond)))))
(let ((result
- (my-sql-query conn
- (string-append
- select-stmt
+ (sql-query ellinika:sql-conn
+ (string-append
+ select-stmt
- " "
+ " "
- (apply
- string-append
- (reverse from-list))
+ (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"))))
+ (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)
@@ -473,55 +440,52 @@ ifelse(IFACE,[CGI],(cgi:init))
(pos (or (cgi:value "POS") "0")))
(sql-catch-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 articles.lang='" (language-code target-language) "' "
- "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))))))
- ((or (not (null? theme)) (> (string->number pos) 0))
- (display "<hr>")
- (fuzzy-search conn
- (ellinika:translate-input (or keyval "")) theme pos)))))))
+ (cond
+ ((and keyval
+ (not (string-null? keyval))
+ (null? theme)
+ (= (string->number pos) 0))
+ (display "<hr>")
+ (let* ((key (ellinika:translate-input keyval))
+ (result (ellinika:sql-query
+ "SELECT dict.word,dict.ident,pos.abbr,\
+dict.forms,articles.subindex,articles.meaning\
+ FROM dict,articles,pos WHERE dict.word=~Q\
+ AND dict.ident=articles.ident\
+ AND articles.lang=~Q\
+ AND dict.pos=pos.id\
+ AND pos.canonical='Y' order by dict.ident, articles.subindex"
+ key
+ (language-code target-language))))
+
+ (cond
+ ((null? result)
+ (fuzzy-search key theme pos))
+ (else
+ (for-each
+ (lambda (entry)
+ (display-results entry)
+ (let ((ant (ellinika:sql-query
+ "SELECT dict.word FROM dict,links\
+ WHERE links.type='ANT' AND links.ident=~Q AND dict.ident=links.xref\
+ ORDER BY word"
+ (cadr (car entry)))))
+ (if (and ant (not (null? ant)))
+ (display-xref ant
+ (if (= (length ant) 1)
+ (_"Αντώνυμο: ") (_"Αντώνυμα: ")))))
+ (display "<p>")
+ (let ((x (ellinika:sql-query
+ "SELECT dict.word FROM dict,links\
+ WHERE links.type='XREF' AND links.ident=~Q\
+ AND dict.ident=links.xref ORDER BY word"
+ (cadr (car entry)))))
+ (if (and x (not (null? x)))
+ (display-xref x (_"Βλέπετε επίσης ")))))
+ (sort-result result))))))
+ ((or (not (null? theme)) (> (string->number pos) 0))
+ (display "<hr>")
+ (fuzzy-search (ellinika:translate-input (or keyval "")) theme pos))))))
;;;
@@ -531,11 +495,9 @@ ifelse(IFACE,[CGI],(cgi:init))
(set! stat-data
(or
(sql-ignore-failure
- (my-sql-query (dict-connect)
- (string-append
- "SELECT count,updated from stat WHERE lang='"
- (language-code target-language)
- "'")))
+ (ellinika:sql-query
+ "SELECT count,updated from stat WHERE lang=~Q"
+ (language-code target-language)))
'())))
(if (null? stat-data)
@@ -550,32 +512,39 @@ ifelse(IFACE,[CGI],(cgi:init))
;;;
+(define (dict-connect)
+ (if (not ellinika:sql-conn)
+ (ellinika:sql-connect ellinika-sql-connection)))
(define (dict-html)
- (let ((explist (list
- (cons "@@args@@"
- (lambda ()
- (for-each
- (lambda (name)
- (cond
- ((string=? name "LANG"))
- (else
- (let ((v (cgi:value name)))
- (cond ((and v (not (string-null? v)))
- (display "&amp;")
- (display name)
- (display "=")
- (display v)))))))
- (cgi:names))))
- (cons "@@dict@@"
- (lambda ()
- (main-form)
- (dict-search)))
+ (sql-catch-failure
+ (let ((explist (list
+ (cons "@@args@@"
+ (lambda ()
+ (for-each
+ (lambda (name)
+ (cond
+ ((string=? name "LANG"))
+ (else
+ (let ((v (cgi:value name)))
+ (cond ((and v (not (string-null? v)))
+ (display "&amp;")
+ (display name)
+ (display "=")
+ (display v)))))))
+ (cgi:names))))
+ (cons "@@dict@@"
+ (lambda ()
+ (dict-connect)
+ (main-form)
+ (dict-search)))
(cons "@@stat_updated@@"
(lambda ()
+ (dict-connect)
(display (stat #:updated))))
(cons "@@stat_count@@"
(lambda ()
+ (dict-connect)
(display
(let ((s (stat #:count)))
(if (string=? s "<>")
@@ -584,10 +553,11 @@ ifelse(IFACE,[CGI],(cgi:init))
(string-append s " "
(ngettext "λέξη" "λέξεις"
n)))))))))))
- (do ((line (read-line) (read-line)))
- ((eof-object? line) #f)
- (expand-template explist line)
- (newline))))
+ (do ((line (read-line) (read-line)))
+ ((eof-object? line) #f)
+ (expand-template explist line)
+ (newline))
+ (ellinika:sql-disconnect))))
;;; Main
ifelse(IFACE,[CGI],(display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
@@ -596,7 +566,6 @@ ifelse(IFACE,[CGI],(display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
(template-file target-language dict-template-file-name)
dict-html)
-(dict-connect #t)
;;;; Local variables:
;;;; mode: Scheme
diff --git a/src/cgi-bin/nea.scm4 b/src/cgi-bin/nea.scm4
index e7f14a4..9c940f6 100644
--- a/src/cgi-bin/nea.scm4
+++ b/src/cgi-bin/nea.scm4
@@ -1,5 +1,5 @@
;;;; News page for Ellinika
-;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010 Sergey Poznyakoff
+;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 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
@@ -20,8 +20,9 @@
(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
(ice-9 rdelim)
- (gamma sql)
(xmltools dict)
+ (ellinika elmorph)
+ (ellinika sql)
(ellinika xlat)
(ellinika cgi)
(ellinika i18n))
@@ -35,7 +36,6 @@ ifelse(IFACE,[CGI],(cgi:init))
(ellinika-cgi-init tmpl)
-(define conn #f)
(define article #f)
(define accepted-lang (map
(lambda (s)
@@ -86,16 +86,14 @@ ifelse(IFACE,[CGI],(cgi:init))
(string-append "(" str ")")
(loop (string-append str
(if (string-null? str) "'" ",'")
- (car input-list) "'")
+ (utf8-escape (car input-list)) "'")
(cdr input-list)))))
-(define (get-sql-lang conn ident langlist)
- (let ((res (map car (sql-query conn
- (string-append
- "SELECT lang "
- "FROM newsart "
- "WHERE ident=" ident " "
- "AND lang in " (make-sql-list langlist))))))
+(define (get-sql-lang ident langlist)
+ (let ((res (map car
+ (ellinika:sql-query
+ "SELECT lang FROM newsart WHERE ident=~N AND lang in ~N"
+ ident (make-sql-list langlist)))))
(cond
((null? res)
#f)
@@ -123,11 +121,9 @@ ifelse(IFACE,[CGI],(cgi:init))
(set! start 0))))
(call-with-current-continuation
(lambda (return)
- (let ((tuples (sql-query
- conn
- (format #f
- "SELECT date,ident FROM news ORDER BY 1 DESC LIMIT ~A,~A"
- start nea-max-rows))))
+ (let ((tuples (ellinika:sql-query
+ "SELECT date,ident FROM news ORDER BY 1 DESC LIMIT ~N,~N"
+ start nea-max-rows)))
(cond
((null? tuples)
(cons start (if fwd (reverse result) result)))
@@ -137,16 +133,14 @@ ifelse(IFACE,[CGI],(cgi:init))
(ctr 0))
(for-each
(lambda (entry)
- (let ((lang (get-sql-lang conn (list-ref entry 1) langlist)))
+ (let ((lang (get-sql-lang (list-ref entry 1) langlist)))
(set! ctr (1+ ctr))
(if lang
- (let ((hdr (sql-query conn
- (string-append
- "SELECT header,lang "
- "FROM newsart "
- "WHERE ident=" (list-ref entry 1) " "
- "AND lang='" lang "' "
- "LIMIT 1"))))
+ (let ((hdr (ellinika:sql-query
+ "SELECT header,lang\
+ FROM newsart\
+ WHERE ident=~N AND lang=~Q LIMIT 1"
+ (list-ref entry 1) lang)))
(cond
(hdr
(set! result (cons
@@ -177,7 +171,8 @@ ifelse(IFACE,[CGI],(cgi:init))
(let* ((count (catch #t
(lambda ()
(string->number
- (caar (sql-query conn "SELECT count(*) FROM news"))))
+ (caar (ellinika:sql-query
+ "SELECT count(*) FROM news"))))
(lambda args
0)))
(from (catch #t
@@ -374,74 +369,63 @@ ifelse(IFACE,[CGI],(cgi:init))
(display " </channel>
</rss>"))
-(define (nea-sql-connect)
- (let ((conn (sql-open-connection ellinika-sql-connection)))
- (sql-query conn "SET NAMES utf8")
- conn))
-
(define (nea-rss)
(nea-rss-header)
(catch 'gsql-error
(lambda ()
- (let ((conn (nea-sql-connect)))
- (for-each
- (lambda (tuple)
- (display "<item>\n")
- (display "<pubDate>")
- (display (list-ref tuple 0))
- (display "</pubDate>\n")
- (display "<title>")
- (let ((title (sql-query conn
- (string-append
- "SELECT header "
- "FROM newsart "
- "WHERE ident=" (list-ref tuple 2) " "
- "AND lang='"
- (get-sql-lang conn
- (list-ref tuple 2)
- (make-my-lang-list))
- "' "
- "LIMIT 1"))))
- (display (if (not (null? title))
- (caar title)
- (list-ref tuple 0))))
- (display "</title>\n")
- (display "<link>")
- (display (string-append
- (string-downcase cgi-server-protocol-name)
- "://"
- cgi-server-hostname
- "/"
- (make-cgi-name cgi-script-name
- "timestamp" (list-ref tuple 1))))
- (display "</link>\n")
- (display "</item>\n"))
- (sql-query
- conn
- (string-append
- "SELECT date,unix_timestamp(date),ident "
- "FROM news "
- "ORDER BY 1 DESC LIMIT 10")))))
+ (ellinika:sql-connect ellinika-sql-connection)
+ (for-each
+ (lambda (tuple)
+ (display "<item>\n")
+ (display "<pubDate>")
+ (display (list-ref tuple 0))
+ (display "</pubDate>\n")
+ (display "<title>")
+ (let ((title (ellinika:sql-query
+ "SELECT header\
+ FROM newsart\
+ WHERE ident=~N AND lang=~Q LIMIT 1"
+ (list-ref tuple 2)
+ (get-sql-lang (list-ref tuple 2)
+ (make-my-lang-list)))))
+ (display (if (not (null? title))
+ (caar title)
+ (list-ref tuple 0))))
+ (display "</title>\n")
+ (display "<link>")
+ (display (string-append
+ (string-downcase cgi-server-protocol-name)
+ "://"
+ cgi-server-hostname
+ "/"
+ (make-cgi-name cgi-script-name
+ "timestamp" (list-ref tuple 1))))
+ (display "</link>\n")
+ (display "</item>\n"))
+ (ellinika:sql-query
+ "SELECT date,unix_timestamp(date),ident\
+ FROM news\
+ ORDER BY 1 DESC LIMIT 10")))
(lambda (key err descr)
(sql-error-handler err descr)))
(nea-rss-footer))
(define (get-article-by-timestamp ts)
- (let ((tuples (sql-query
- conn
- "SELECT date,unix_timestamp(date),ident FROM news WHERE unix_timestamp(date)=" ts)))
+ (let ((tuples (ellinika:sql-query
+ "SELECT date,unix_timestamp(date),ident FROM news\
+ WHERE unix_timestamp(date)=~Q" ts)))
(cond
(tuples
(let* ((res (car tuples))
- (lang (get-sql-lang conn (list-ref res 2) (make-my-lang-list)))
- (art (sql-query conn
- (string-append
- "SELECT header,text,lang "
- "FROM newsart "
- "WHERE ident=" (list-ref res 2) " "
- "AND lang='" lang "' "
- "LIMIT 1"))))
+ (lang (get-sql-lang (list-ref res 2) (make-my-lang-list)))
+ (art (ellinika:sql-query
+ "SELECT header,text,lang\
+ FROM newsart\
+ WHERE ident=~N\
+ AND lang=~Q\
+ LIMIT 1"
+ (list-ref res 2) lang)))
(append
(list (list-ref res 0)
(list-ref res 1))
@@ -461,36 +445,32 @@ ifelse(IFACE,[CGI],(cgi:init))
(lambda ()
ifelse(IFACE,[CGI],dnl
(display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
- (set! conn (nea-sql-connect))
+ (ellinika:sql-connect ellinika-sql-connection)
(cond
((or (cgi:value "timestamp") (cgi:value "id"))
- (let ((tuples (sql-query
- conn
- (string-append
- "SELECT date,unix_timestamp(date),ident "
- "FROM news "
- "WHERE "
- (cond
- ((cgi:value "timestamp") =>
- (lambda (ts)
- (string-append "unix_timestamp(date)=" ts)))
- ((cgi:value "id") =>
- (lambda (id)
- (string-append "ident=" id))))))))
-
+ (let ((tuples
+ (cond
+ ((cgi:value "timestamp") =>
+ (lambda (ts)
+ (ellinika:sql-query
+ "SELECT date,unix_timestamp(date),ident\
+ FROM news WHERE unix_timestamp(date)=~Q" ts)))
+ ((cgi:value "id") =>
+ (lambda (id)
+ (ellinika:sql-query
+ "SELECT date,unix_timestamp(date),ident\
+ FROM news WHERE ident=~N" id))))))
+
(if (not (null? tuples))
(let* ((res (car tuples))
- (lang (get-sql-lang conn
- (list-ref res 2)
+ (lang (get-sql-lang (list-ref res 2)
(make-my-lang-list)))
- (art (sql-query
- conn
- (string-append
- "SELECT header,text,lang "
- "FROM newsart "
- "WHERE ident=" (list-ref res 2) " "
- "AND lang='" lang "' "
- "LIMIT 1"))))
+ (art (ellinika:sql-query
+ "SELECT header,text,lang\
+ FROM newsart\
+ WHERE ident=~N AND lang=~Q LIMIT 1"
+ (list-ref res 2)
+ lang)))
(set! article (append
(list (list-ref res 0)
(list-ref res 1))
@@ -500,7 +480,7 @@ ifelse(IFACE,[CGI],(cgi:init))
(template-file target-language tmpl)
nea-html)
- (sql-close-connection conn))
+ (ellinika:sql-disconnect))
(lambda (key err descr)
(with-input-from-file
diff --git a/src/ellinika/sql.scm b/src/ellinika/sql.scm
index f521049..f49ddf1 100644
--- a/src/ellinika/sql.scm
+++ b/src/ellinika/sql.scm
@@ -20,6 +20,8 @@
(ellinika elmorph)
(gamma sql))
+(re-export sql-catch-failure sql-ignore-failure)
+
(define-public ellinika:sql-verbose #f)
(define-public ellinika:sql-conn #f)
(define-public ellinika:sql-dry-run #f)

Return to:

Send suggestions and report system problems to the System administrator.