aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-14 23:56:45 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-14 23:56:45 +0300
commit1ffd88231386c104474103fe641cad7fa535f3ec (patch)
treefab5115a97e63cc59d9bf5bfd38b6d60cf9509c6 /src
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 (limited to 'src')
-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,3 +1,3 @@
;;;; Greek Dictionary Web Engine
-;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010 Sergey Poznyakoff
+;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 Sergey Poznyakoff
;;;;
@@ -22,4 +22,6 @@
(ice-9 rdelim)
- (gamma sql)
(xmltools dict)
+ (gamma sql)
+ (ellinika elmorph)
+ (ellinika sql)
(ellinika i18n)
@@ -40,35 +42,13 @@ ifelse(IFACE,[CGI],(cgi:init))
-(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))))))
@@ -93,24 +73,18 @@ ifelse(IFACE,[CGI],(cgi:init))
(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)
@@ -356,13 +330,6 @@ ifelse(IFACE,[CGI],(cgi:init))
-(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")))
@@ -370,3 +337,3 @@ ifelse(IFACE,[CGI],(cgi:init))
(from-list (list ",articles" "dict")))
-
+
(cond
@@ -383,3 +350,3 @@ ifelse(IFACE,[CGI],(cgi:init))
" dict.sound LIKE \""
- (ellinika:sounds-like key)
+ (utf8-escape (ellinika:sounds-like key))
"%\"")
@@ -406,33 +373,33 @@ ifelse(IFACE,[CGI],(cgi:init))
(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"))))
@@ -475,51 +442,48 @@ ifelse(IFACE,[CGI],(cgi:init))
(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))))))
@@ -533,7 +497,5 @@ ifelse(IFACE,[CGI],(cgi:init))
(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)))
'())))
@@ -552,25 +514,31 @@ 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))))
@@ -578,2 +546,3 @@ ifelse(IFACE,[CGI],(cgi:init))
(lambda ()
+ (dict-connect)
(display
@@ -586,6 +555,7 @@ ifelse(IFACE,[CGI],(cgi:init))
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))))
@@ -598,3 +568,2 @@ ifelse(IFACE,[CGI],(display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
-(dict-connect #t)
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,3 +1,3 @@
;;;; News page for Ellinika
-;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010 Sergey Poznyakoff
+;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 Sergey Poznyakoff
;;;;
@@ -22,4 +22,5 @@
(ice-9 rdelim)
- (gamma sql)
(xmltools dict)
+ (ellinika elmorph)
+ (ellinika sql)
(ellinika xlat)
@@ -37,3 +38,2 @@ ifelse(IFACE,[CGI],(cgi:init))
-(define conn #f)
(define article #f)
@@ -88,12 +88,10 @@ ifelse(IFACE,[CGI],(cgi:init))
(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
@@ -125,7 +123,5 @@ ifelse(IFACE,[CGI],(cgi:init))
(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
@@ -139,12 +135,10 @@ ifelse(IFACE,[CGI],(cgi:init))
(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
@@ -179,3 +173,4 @@ ifelse(IFACE,[CGI],(cgi:init))
(string->number
- (caar (sql-query conn "SELECT count(*) FROM news"))))
+ (caar (ellinika:sql-query
+ "SELECT count(*) FROM news"))))
(lambda args
@@ -376,7 +371,2 @@ ifelse(IFACE,[CGI],(cgi:init))
-(define (nea-sql-connect)
- (let ((conn (sql-open-connection ellinika-sql-connection)))
- (sql-query conn "SET NAMES utf8")
- conn))
-
(define (nea-rss)
@@ -385,41 +375,35 @@ ifelse(IFACE,[CGI],(cgi:init))
(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)
@@ -430,5 +414,5 @@ ifelse(IFACE,[CGI],(cgi:init))
(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
@@ -436,10 +420,10 @@ ifelse(IFACE,[CGI],(cgi:init))
(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
@@ -463,32 +447,28 @@ ifelse(IFACE,[CGI],(cgi:init))
(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
@@ -502,3 +482,3 @@ ifelse(IFACE,[CGI],(cgi:init))
- (sql-close-connection conn))
+ (ellinika:sql-disconnect))
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
@@ -22,2 +22,4 @@
+(re-export sql-catch-failure sql-ignore-failure)
+
(define-public ellinika:sql-verbose #f)

Return to:

Send suggestions and report system problems to the System administrator.