From 543b8a04841f1e4f526b1b12e329e9ec2a9d3063 Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Sun, 13 Feb 2005 23:07:13 +0000
Subject: Added to the repository

git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@299 941c8c0f-9102-463b-b60b-cd22ce0e6858
---
 cgi-bin/nea.cgi.in | 149 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 149 insertions(+)
 create mode 100644 cgi-bin/nea.cgi.in

(limited to 'cgi-bin')

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:
-- 
cgit v1.2.1