#! =GUILE_BINDIR=/guile -s =AUTOGENERATED= !# ;;;; Greek Dictionary Web Engine ;;;; 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) (ellinika-cgi-init) (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"))) (cond ((null? result) (display "
No news
")) (else (display "\n") (for-each (lambda (entry) (display "\n") (display "") (display "\n") (display "\n")) result) (display "
") (display (list-ref entry 0)) (display "") (display (list-ref entry 1)) (display "
")))) (sql-connect-close conn)) (else (format #t "

~A

\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 "

No item found

\n") (for-each (lambda (item) (format #t "~A\n" (car item)) (display "\n") (display (cadr item)) (display "") (display "
") (display (caddr item))) result)))) (else (format #t "

~A

\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))) ;;; Main (display "Content-type: text/html; charset=utf-8\r\n\r\n") (with-input-from-file (template-file target-language nea-template-file-name) dict-html) ;;;; Local variables: ;;;; mode: Scheme ;;;; buffer-file-coding-system: utf-8 ;;;; End: