diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-14 23:56:45 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-14 23:56:45 +0300 |
commit | 1ffd88231386c104474103fe641cad7fa535f3ec (patch) | |
tree | fab5115a97e63cc59d9bf5bfd38b6d60cf9509c6 /src | |
parent | 8c1de36d1f8b27fb946dac15e725c93ec57c1538 (diff) | |
download | ellinika-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.scm4 | 311 | ||||
-rw-r--r-- | src/cgi-bin/nea.scm4 | 192 | ||||
-rw-r--r-- | src/ellinika/sql.scm | 2 |
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 "&") - (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 "&") + (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) |