#! =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 ""))) (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 "") (display "\n\n")) result)) (display "
") (display (list-ref entry 0)) (display "") (display (list-ref entry 1)) (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: