#! =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 "[permanent link]")
(display (string-append "" tag ">")))
(define (sql-error-handler err descr)
(format #t "
~A
\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))))
(defmacro assert-article (expr)
`(if article
(if (null? article)
(format #t "~A
\n"
(_ "Κάμια καταχώρηση"))
,expr)))
(define (summary)
(catch-sql
(let ((result (sql-query
conn "SELECT date,header,ident FROM news ORDER BY date")))
(cond
((null? result)
(display "")
(display (_ "Κανένα νέα"))
(display "
"))
(else
(display "\n")
(let ((ctr 0))
(for-each
(lambda (entry)
(display "\n")
(set! ctr (1+ ctr))
(display "")
(display (list-ref entry 0))
(display " | ")
(display "")
(display (list-ref entry 1))
(display " | ")
(display "\n
\n"))
result))
(display "
"))))))
(define (display-article-header item)
(format #t "~A\n" (car item))
(display "\n")
(display (list-ref item 2))
(display " "))
(define (display-article-text item . rest)
(let ((class (and (not (null? rest)) (car rest))))
(cond
(class
(display "\n\n")
(display (list-ref item 3))
(display "
\n"))
(else
(display (list-ref item 3))))))
(define (main)
(catch-sql
(assert-article
(for-each
(lambda (item)
(display-article-header item)
(if (not (cgi:value "timestamp"))
(permalink "span" (list-ref item 1)))
(display-article-text item "itemtext"))
article))))
(define (title)
(if article
(display (if (null? article)
(string-append
""
(_ "Κάμια καταχώρηση")
"
")
(list-ref (car article) 2)))))
(define (nea-html)
(let ((explist (list (cons "@@main@@" main)
(cons "@@summary@@" summary)
(cons "@@title@@" title)
(cons "@@article-text@@"
(lambda ()
(catch-sql
(assert-article
(display-article-text (car article))))))
(cons "@@article-date@@"
(lambda ()
(catch-sql
(assert-article
(display (caar article))))))
(cons "@@article-header@@"
(lambda ()
(catch-sql
(assert-article
(display (list-ref (car article) 2))))))
(cons "@@full-header@@"
(lambda ()
(catch-sql
(assert-article
(display-article-header
(car article)))))))))
(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 "@@article-text@@"
(lambda ()
(sql-error-handler err descr)))
(cons "@@summary@@" (lambda () #f))
(cons "@@title@@" (lambda () #f))
(cons "@@article-date@@" (lambda () #f))
(cons "@@article-header@@" (lambda () #f))
(cons "@@full-header@@" (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: