diff options
Diffstat (limited to 'cgi-bin/nea.cgi.in')
-rw-r--r-- | cgi-bin/nea.cgi.in | 149 |
1 files changed, 149 insertions, 0 deletions
diff --git a/cgi-bin/nea.cgi.in b/cgi-bin/nea.cgi.in new file mode 100644 index 0000000..56e8bc5 --- /dev/null +++ b/cgi-bin/nea.cgi.in @@ -0,0 +1,149 @@ +#! =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 "<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>\n") + (display "</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))) + +;;; 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: |