aboutsummaryrefslogtreecommitdiff
path: root/cgi-bin/nea.cgi.in
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2005-06-26 10:35:30 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2005-06-26 10:35:30 +0000
commit47fcbb5637ae12e58d283a7b4409677da0446b4c (patch)
tree633c9f402a93d6009ff1710a8fe8cdefc3c86d2c /cgi-bin/nea.cgi.in
parent626a335c3d1a50d47cf5465bb67a3c9b7da922a2 (diff)
downloadellinika-47fcbb5637ae12e58d283a7b4409677da0446b4c.tar.gz
ellinika-47fcbb5637ae12e58d283a7b4409677da0446b4c.tar.bz2
Catch SQL errors
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@334 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'cgi-bin/nea.cgi.in')
-rw-r--r--cgi-bin/nea.cgi.in162
1 files changed, 97 insertions, 65 deletions
diff --git a/cgi-bin/nea.cgi.in b/cgi-bin/nea.cgi.in
index b26714f..86bbeb0 100644
--- a/cgi-bin/nea.cgi.in
+++ b/cgi-bin/nea.cgi.in
@@ -47,51 +47,66 @@
(display "\">[permanent link]</a>")
(display (string-append "</" tag ">")))
-(define (summary)
- (if conn
- (let ((result (sql-query
- conn "SELECT date,header,ident FROM news ORDER BY date")))
- (cond
- ((null? result)
- (display "<div align=\"center\">No news</div>"))
- (else
- (display "<table class=\"newssummary\">\n")
- (for-each
- (lambda (entry)
- (display "<tr>\n")
- (display "<td class=\"date\">")
- (display (list-ref entry 0))
- (display "</td>")
- (display "<td class=\"subject\"><a href=\"")
- (display (make-cgi-name nea-cgi-path "id" (list-ref entry 2)))
- (display "\">")
- (display (list-ref entry 1))
- (display "</a></td>")
- (display "\n</tr>\n"))
- result)
- (display "</table>"))))
- (format #t "<H1>~A</H1>\n"
- "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))
+(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))))
+
+(defmacro catch-sql (expr)
+ `(catch 'gsql-error
+ (lambda () ,expr)
+ (lambda (key err descr)
+ (sql-error-handler err descr))))
+(define (summary)
+ (catch-sql
+ (let ((result (sql-query
+ conn "SELECT date,header,ident FROM news ORDER BY date")))
+ (cond
+ ((null? result)
+ (display "<div align=\"center\">No news</div>"))
+ (else
+ (display "<table class=\"newssummary\">\n")
+ (for-each
+ (lambda (entry)
+ (display "<tr>\n")
+ (display "<td class=\"date\">")
+ (display (list-ref entry 0))
+ (display "</td>")
+ (display "<td class=\"subject\"><a href=\"")
+ (display (make-cgi-name nea-cgi-path "id" (list-ref entry 2)))
+ (display "\">")
+ (display (list-ref entry 1))
+ (display "</a></td>")
+ (display "\n</tr>\n"))
+ result)
+ (display "</table>"))))))
+
(define (main)
- (if article
- (if (null? article)
- (format #t "<H1>No item found</H1>\n")
- (for-each
- (lambda (item)
- (format #t "<span class=\"itemdate\">~A</span>\n"
- (car item))
- (display "<span class=\"itemheader\">\n")
- (display (list-ref item 2))
- (display "</span> ")
-
- (if (not (cgi:value "timestamp"))
- (permalink "span" (list-ref item 1)))
-
- (display "<div class=\"itemtext\">")
- (display (list-ref item 3))
- (display "</div>"))
- article))))
+ (catch-sql
+ (if article
+ (if (null? article)
+ (format #t "<H1>No item found</H1>\n")
+ (for-each
+ (lambda (item)
+ (format #t "<span class=\"itemdate\">~A</span>\n"
+ (car item))
+ (display "<span class=\"itemheader\">\n")
+ (display (list-ref item 2))
+ (display "</span> ")
+
+ (if (not (cgi:value "timestamp"))
+ (permalink "span" (list-ref item 1)))
+
+ (display "<div class=\"itemtext\">")
+ (display (list-ref item 3))
+ (display "</div>"))
+ article)))))
(define (title)
(if article
@@ -111,28 +126,45 @@
;;; Main
(display "Content-type: text/html; charset=utf-8\r\n\r\n")
-(set! conn (sql-connect
- sql-iface sql-host sql-port sql-database
- sql-username sql-password))
-
-(if (or (cgi:value "timestamp") (cgi:value "id"))
- (set! article (sql-query conn
- (cond
- ((cgi:value "timestamp")
- (string-append
- "SELECT date,unix_timestamp(date),header,text FROM news WHERE unix_timestamp(date)="
- (cgi:value "timestamp")))
- ((cgi:value "id")
- (string-append
- "SELECT date,unix_timestamp(date),header,text FROM news WHERE ident="
- (cgi:value "id")))))))
-
-(with-input-from-file
- (template-file target-language tmpl)
- nea-html)
-
-(sql-connect-close conn)
-
+(catch 'gsql-error
+ (lambda ()
+ (set! conn (sql-connect
+ sql-iface sql-host sql-port sql-database
+ sql-username sql-password))
+
+ (if (or (cgi:value "timestamp") (cgi:value "id"))
+ (set! article (sql-query conn
+ (cond
+ ((cgi:value "timestamp")
+ (string-append
+ "SELECT date,unix_timestamp(date),header,text FROM news WHERE unix_timestamp(date)="
+ (cgi:value "timestamp")))
+ ((cgi:value "id")
+ (string-append
+ "SELECT date,unix_timestamp(date),header,text FROM news WHERE ident="
+ (cgi:value "id")))))))
+
+ (with-input-from-file
+ (template-file target-language tmpl)
+ nea-html)
+
+ (sql-connect-close conn))
+
+ (lambda (key err descr)
+ (with-input-from-file
+ (template-file target-language tmpl)
+ (lambda ()
+ (let ((explist
+ (list (cons "@@main@@"
+ (lambda ()
+ (sql-error-handler err descr)))
+ (cons "@@summary@@" (lambda () #f))
+ (cons "@@title@@" (lambda () #f)))))
+ (do ((line (read-line) (read-line)))
+ ((eof-object? line) #f)
+ (expand-template explist line)
+ (newline)))))))
+
;;;; Local variables:
;;;; mode: Scheme
;;;; buffer-file-coding-system: utf-8

Return to:

Send suggestions and report system problems to the System administrator.