aboutsummaryrefslogtreecommitdiff
path: root/cgi-bin/nea.cgi.in
diff options
context:
space:
mode:
Diffstat (limited to 'cgi-bin/nea.cgi.in')
-rw-r--r--cgi-bin/nea.cgi.in217
1 files changed, 170 insertions, 47 deletions
diff --git a/cgi-bin/nea.cgi.in b/cgi-bin/nea.cgi.in
index 5805097..8c625e5 100644
--- a/cgi-bin/nea.cgi.in
+++ b/cgi-bin/nea.cgi.in
@@ -49,6 +49,7 @@
s)))
(string-split (getenv "HTTP_ACCEPT_LANGUAGE") #\,)))
+(define nea-max-rows 20) ;; FIXME: Move to the config
(define (permalink tag timestamp)
(display (string-append "<" tag " class=\"permalink\">"))
@@ -115,46 +116,165 @@
(map language-code (cons target-language
accepted-lang)))
+
+(define (collect-entries from fwd)
+ (let loop ((start from)
+ (result '()))
+ (cond
+ ((not fwd)
+ (set! start (- start nea-max-rows))
+ (if (< start 0)
+ (set! start 0))))
+ (call-with-current-continuation
+ (lambda (return)
+ (let ((tuples (sql-query
+ conn
+ (format #f
+ "SELECT date,ident FROM news ORDER BY 1 DESC LIMIT ~A,~A"
+ start nea-max-rows))))
+ (cond
+ ((null? tuples)
+ (cons start (if fwd (reverse result) result)))
+ (else
+ (let ((langlist (make-my-lang-list))
+ (rest (- nea-max-rows (length result)))
+ (ctr 0))
+ (for-each
+ (lambda (entry)
+ (let ((lang (get-sql-lang conn (list-ref entry 1) langlist)))
+ (set! ctr (1+ ctr))
+ (if lang
+ (let ((hdr (sql-query conn
+ (string-append
+ "SELECT header,lang "
+ "FROM newsart "
+ "WHERE ident=" (list-ref entry 1) " "
+ "AND lang='" lang "' "
+ "LIMIT 1"))))
+ (cond
+ (hdr
+ (set! result (cons
+ (cons (caar hdr) entry)
+ result))
+ (set! rest (1- rest))
+ (cond
+ ((= 0 rest)
+ (if fwd
+ (return (cons (+ ctr start) (reverse result)))
+ (return (cons (+ start (- nea-max-rows ctr))
+ result)))))))))))
+
+ (if fwd
+ tuples
+ (reverse tuples)))
+
+ (cond
+ ((and (not fwd) (= 0 start))
+ (cons start (if fwd (reverse result) result)))
+ (else
+ (if fwd
+ (set! start (+ ctr start)))
+ (loop start result)))))))))))
+
(define (summary)
(catch-sql
- (let ((result (sql-query
- conn "SELECT date,ident FROM news ORDER BY 1 DESC")))
- (cond
- ((null? result)
- (display "<div align=\"center\">")
- (display (_ "Κανένα νέα"))
- (display "</div>"))
- (else
- (display "<table class=\"news-summary frame\">\n")
- (let ((ctr 0)
- (langlist (make-my-lang-list)))
- (for-each
- (lambda (entry)
- (let* ((lang (get-sql-lang conn (list-ref entry 1) langlist))
- (hdr (sql-query conn
- (string-append
- "SELECT header,lang "
- "FROM newsart "
- "WHERE ident=" (list-ref entry 1) " "
- "AND lang='" lang "' "
- "LIMIT 1"))))
- (cond
- (hdr
+ (let* ((count (catch #t
+ (lambda ()
+ (string->number
+ (caar (sql-query conn "SELECT count(*) FROM news"))))
+ (lambda args
+ 0)))
+ (from (catch #t
+ (lambda ()
+ (let ((x (string->number (cgi:value "from"))))
+ (if (< x count)
+ x
+ 0)))
+ (lambda args
+ 0)))
+ (fwd (let ((dir (cgi:value "dir")))
+ (or (not dir)
+ (string=? dir "1"))))
+ (entries (collect-entries from fwd)))
+
+ (let ((start (car entries))
+ (result (cdr entries)))
+ (cond
+ ((null? result)
+ (display "<div align=\"center\">")
+ (display (_ "Κανένα νέα"))
+ (display "</div>"))
+ (else
+ (let ((num-entries (length result))
+ (begin (if fwd from start))
+ (end (if fwd start from))
+ (id (cgi:value "id")))
+
+ (cond
+ ((not (and (= from 0) (< num-entries nea-max-rows)))
+ (display "<p>")
+ (format #t (_ "Εγγραφείς ~A - ~A") begin end)
+ (display "</p>")))
+
+ (display "<table class=\"news-summary frame\">\n")
+ (let ((ctr 0)
+ (langlist (make-my-lang-list)))
+ (for-each
+ (lambda (entry)
(display "<tr class=\"")
(display (if (= (modulo ctr 2) 0) "even" "odd"))
(display "\">\n")
(set! ctr (1+ ctr))
(display "<td class=\"date\">")
- (display (list-ref entry 0))
+ (display (list-ref entry 1))
+ (display "</td>")
+ (display "<td class=\"subject")
+ (cond
+ ((and id (string=? (list-ref entry 2) id))
+ (display " current\">")
+ (display (list-ref entry 0)))
+ (else
+ (display "\"><a href=\"")
+ (display (make-cgi-name nea-cgi-path
+ "id" (list-ref entry 2)
+ "from" (number->string begin)))
+ (display "\">")
+ (display (list-ref entry 0))
+ (display "</a>")))
(display "</td>")
- (display "<td class=\"subject\"><a href=\"")
- (display (make-cgi-name nea-cgi-path "id" (list-ref entry 1)))
- (display "\">")
- (display (list-ref (car hdr) 0))
- (display "</a></td>")
- (display "\n</tr>\n")))))
- result))
- (display "</table>"))))))
+ (display "\n</tr>\n"))
+ result))
+ (display "</table>")
+
+ (display "<div class=\"menu-bar\" align=\"center\">")
+ (cond
+ ((> begin 0)
+ (display "<span class=\"menu-cell\"><a href=\"")
+ (display (apply make-cgi-name
+ nea-cgi-path
+ "from" (number->string begin)
+ "dir" "0"
+ (if id
+ (list "id" id)
+ '())))
+ (display "\">")
+ (display (_ "Προηγούμενες"))
+ (display "</a></span>")))
+
+ (cond
+ ((< end count)
+ (display "<span class=\"menu-cell\"><a href=\"")
+ (display (apply make-cgi-name
+ nea-cgi-path
+ "from" (number->string end)
+ "dir" "1"
+ (if id
+ (list "id" id)
+ '())))
+ (display "\">")
+ (display (_ "Ερχόμενες"))
+ (display "</a></span>")))
+ (display "</div>"))))))))
(define (display-article-header item)
(format #t "<span class=\"itemdate\">~A</span>\n" (car item))
@@ -359,21 +479,24 @@
((cgi:value "id") =>
(lambda (id)
(string-append "ident=" id))))))))
- (let* ((res (car tuples))
- (lang (get-sql-lang conn
- (list-ref res 2) (make-my-lang-list)))
- (art (sql-query
- conn
- (string-append
- "SELECT header,text,lang "
- "FROM newsart "
- "WHERE ident=" (list-ref res 2) " "
- "AND lang='" lang "' "
- "LIMIT 1"))))
- (set! article (append
- (list (list-ref res 0)
- (list-ref res 1))
- (car art)))))))
+
+ (if (not (null? tuples))
+ (let* ((res (car tuples))
+ (lang (get-sql-lang conn
+ (list-ref res 2)
+ (make-my-lang-list)))
+ (art (sql-query
+ conn
+ (string-append
+ "SELECT header,text,lang "
+ "FROM newsart "
+ "WHERE ident=" (list-ref res 2) " "
+ "AND lang='" lang "' "
+ "LIMIT 1"))))
+ (set! article (append
+ (list (list-ref res 0)
+ (list-ref res 1))
+ (car art))))))))
(with-input-from-file
(template-file target-language tmpl)

Return to:

Send suggestions and report system problems to the System administrator.