diff options
-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,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 "&") - (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)))) (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) |