Mostly rewritten

git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@330 941c8c0f-9102-463b-b60b-cd22ce0e6858

1 files changed, 75 insertions, 85 deletions

diff --git a/cgi-bin/nea.cgi.in b/cgi-bin/nea.cgi.in
index 56e8bc5..b26714f 100644
--- a/cgi-bin/nea.cgi.in
+++ b/cgi-bin/nea.cgi.in
@@ -1,7 +1,7 @@
 #! =GUILE_BINDIR=/guile -s
 =AUTOGENERATED=
 !#
-;;;; Greek Dictionary Web Engine
+;;;; News page for Ellinika
 ;;;; Copyright (C) 2004, 2005 Sergey Poznyakoff
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -30,15 +30,27 @@
 	     (ellinika cgi))
 (cgi:init)
 
-(ellinika-cgi-init)
+(define tmpl (if (and monima-nea-template-file-name
+		      (cgi:value "timestamp"))
+		 monima-nea-template-file-name
+		 nea-template-file-name))
+
+(ellinika-cgi-init tmpl)
+
+(define conn #f)
+(define article #f)
+
+(define (permalink tag timestamp)
+  (display (string-append "<" tag " class=\"permalink\">"))
+  (display "<a href=\"")
+  (display (make-cgi-name nea-cgi-path "timestamp" timestamp))
+  (display "\">[permanent link]</a>")
+  (display (string-append "</" tag ">")))
 
 (define (summary)
-  (let ((conn (sql-connect
-	       sql-iface sql-host sql-port sql-database
-	       sql-username sql-password)))
-    (cond
-     (conn
-      (let ((result (sql-query conn "SELECT date,header,ident FROM news ORDER BY date")))
+  (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>"))
@@ -54,94 +66,72 @@
 	     (display (make-cgi-name nea-cgi-path "id" (list-ref entry 2)))
 	     (display "\">")
 	     (display (list-ref entry 1))
-	     (display "</a></td>\n")
-	     (display "</tr>\n"))
+	     (display "</a></td>")
+	     (display "\n</tr>\n"))
 	   result)
 	  (display "</table>"))))
-      (sql-connect-close conn))
-     (else
       (format #t "<H1>~A</H1>\n"
-	      "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))))
+	      "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")))
 
 (define (main)
-  (cond
-   ((cgi:value "id") =>
-    (lambda (id)
-      (let ((conn (sql-connect
-		   sql-iface sql-host sql-port sql-database
-		   sql-username sql-password)))
-	(cond
-	 (conn
-	  (let ((result (sql-query conn
-				   (string-append
-				    "SELECT date,header,text FROM news WHERE ident="
-				    id))))
-	    (if (null? result)
-		(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 (cadr item))
-		   (display "</span>")
-
-		   (display "<div class=\"itemtext\">")
-		   (display (caddr item)))
-		 result))))
-	 (else
-	  (format #t "<H1>~A</H1>\n"
-		  "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))))))))
-
-
-(define explist
-  (list (cons "@@program-name@@"  (lambda (id)
-				    (make-cgi-name nea-cgi-path)))
-	(cons "@@main@@"          main)
-	(cons "@@summary@@"	  summary)))
-
-; FIXME: Again, share it with dict.cgi
-(define (expand-template template)
-  (let loop ((template template))
-    (cond
-     ((string-index template #\@) =>
-      (lambda (w)
-	(display (substring template 0 w))
-	(if (and (< (+ w 2) (string-length template))
-		 (char=? (string-ref template (1+ w)) #\@))
-	    (let ((end-pos (string-index template #\@ (+ w 2))))
-	      (if (and end-pos
-		       (< (1+ end-pos) (string-length template))
-		       (char=? (string-ref template (1+ end-pos)) #\@))
-		  (let* ((name (substring template w (+ end-pos 2)))
-			 (entry (assoc name explist)))
-		    (cond
-		     (entry
-		      ((cdr entry))
-		      (loop (substring template (+ end-pos 2))))
-		     (else
-		      (display "@@")
-		      (loop (substring template (+ w 2))))))
-		  (begin
-		    (display "@")
-		    (loop (substring template (+ w 1))))))
-	    (begin
-	      (display "@")
-	      (loop (substring template (1+ w)))))))
-     (else
-      (display template)))))
-
-(define (dict-html)
-  (do ((line (read-line) (read-line)))
-      ((eof-object? line) #f)
-    (expand-template line)))
+  (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
+      (display (if (null? article) "No item" (list-ref (car article) 2)))))
+      
+
+(define (nea-html)
+  (let ((explist (list (cons "@@main@@"     main)
+		       (cons "@@summary@@"  summary)
+		       (cons "@@title@@"    title))))
+  
+    (do ((line (read-line) (read-line)))
+	((eof-object? line) #f)
+      (expand-template explist line)
+      (newline))))
 
 ;;; 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 nea-template-file-name)
-  dict-html)
+    (template-file target-language tmpl)
+  nea-html)
 
+(sql-connect-close conn)
 
 ;;;; Local variables:
 ;;;; mode: Scheme