#! =GUILE_BINDIR=/guile -s
=AUTOGENERATED=
!#
;;;; News page for Ellinika
;;;; Copyright (C) 2004, 2005 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
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;;;

;;; Tailor this statement to your needs if necessary.
;=GUILE_COMMENT=;(set! %load-path (cons "=GUILE_SITE=" %load-path))

(use-modules (www cgi)
	     (gamma sql)
	     (gamma gettext)
	     (xmltools dict)
	     (ellinika xlat)
	     (ellinika cgi))
(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 (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)
  (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
      (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")

(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
;;;; End: