aboutsummaryrefslogtreecommitdiff
path: root/cgi-bin/nea.cgi.in
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2005-06-26 08:23:48 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2005-06-26 08:23:48 +0000
commit0ee878334cf55052d6c820b4e9208b5ad1e46368 (patch)
tree0a8bb14ed5443fe139cfadbde41240ebb658a8ff /cgi-bin/nea.cgi.in
parentc667219a86bb00f7007be9e9935fbf668f58e8e9 (diff)
downloadellinika-0ee878334cf55052d6c820b4e9208b5ad1e46368.tar.gz
ellinika-0ee878334cf55052d6c820b4e9208b5ad1e46368.tar.bz2
Mostly rewritten
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@330 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'cgi-bin/nea.cgi.in')
-rw-r--r--cgi-bin/nea.cgi.in160
1 files changed, 75 insertions, 85 deletions
diff --git a/cgi-bin/nea.cgi.in b/cgi-bin/nea.cgi.in
index 56e8bc5..b26714f 100644
--- a/cgi-bin/nea.cgi.in
+++ b/cgi-bin/nea.cgi.in
@@ -1,7 +1,7 @@
#! =GUILE_BINDIR=/guile -s
=AUTOGENERATED=
!#
-;;;; Greek Dictionary Web Engine
+;;;; News page for Ellinika
;;;; Copyright (C) 2004, 2005 Sergey Poznyakoff
;;;;
;;;; This program is free software; you can redistribute it and/or modify
@@ -30,15 +30,27 @@
(ellinika cgi))
(cgi:init)
-(ellinika-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 "<a href=\"")
+ (display (make-cgi-name nea-cgi-path "timestamp" timestamp))
+ (display "\">[permanent link]</a>")
+ (display (string-append "</" tag ">")))
(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")))
+ (if 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>"))
@@ -54,94 +66,72 @@
(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"))
+ (display "</a></td>")
+ (display "\n</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)))
+ (if article
+ (if (null? article)
+ (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 (list-ref item 2))
+ (display "</span> ")
+
+ (if (not (cgi:value "timestamp"))
+ (permalink "span" (list-ref item 1)))
+
+ (display "<div class=\"itemtext\">")
+ (display (list-ref item 3))
+ (display "</div>"))
+ article))))
+
+(define (title)
+ (if article
+ (display (if (null? article) "No item" (list-ref (car article) 2)))))
+
+
+(define (nea-html)
+ (let ((explist (list (cons "@@main@@" main)
+ (cons "@@summary@@" summary)
+ (cons "@@title@@" title))))
+
+ (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")
+(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 nea-template-file-name)
- dict-html)
+ (template-file target-language tmpl)
+ nea-html)
+(sql-connect-close conn)
;;;; Local variables:
;;;; mode: Scheme

Return to:

Send suggestions and report system problems to the System administrator.