diff options
Diffstat (limited to 'cgi-bin')
-rw-r--r-- | cgi-bin/nea.cgi.in | 217 |
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) |