From 47fcbb5637ae12e58d283a7b4409677da0446b4c Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Sun, 26 Jun 2005 10:35:30 +0000
Subject: Catch SQL errors

git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@334 941c8c0f-9102-463b-b60b-cd22ce0e6858
---
 cgi-bin/nea.cgi.in | 162 ++++++++++++++++++++++++++++++++---------------------
 1 file changed, 97 insertions(+), 65 deletions(-)

(limited to 'cgi-bin/nea.cgi.in')

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
-- 
cgit v1.2.1