aboutsummaryrefslogtreecommitdiff
path: root/cgi-bin/nea.cgi.in
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2005-02-13 23:07:13 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2005-02-13 23:07:13 +0000
commit543b8a04841f1e4f526b1b12e329e9ec2a9d3063 (patch)
tree836fbbfd0f5086a93357543842e004d39edd41a3 /cgi-bin/nea.cgi.in
parentbf108549b699e7c9893afba441d69ec5e3c91faa (diff)
downloadellinika-543b8a04841f1e4f526b1b12e329e9ec2a9d3063.tar.gz
ellinika-543b8a04841f1e4f526b1b12e329e9ec2a9d3063.tar.bz2
Added to the repository
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@299 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'cgi-bin/nea.cgi.in')
-rw-r--r--cgi-bin/nea.cgi.in149
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:

Return to:

Send suggestions and report system problems to the System administrator.