diff options
Diffstat (limited to 'cgi-bin')
-rw-r--r-- | cgi-bin/nea.cgi.in | 162 |
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 |