;;;; -*- scheme -*- ;;;; Greek Dictionary Web Engine ;;;; Copyright (C) 2005, 2007, 2010 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 3 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, see . ;;;; (define-module (ellinika cgi) #:use-module (ellinika config) #:use-module (ellinika i18n) #:use-module ifelse(IFACE,[CGI],(www cgi),(guile-user)) #:re-export (base-dir html-dir sysconf-dir locale-path ellinika-sql-connection config-file-name )) ifelse(IFACE,[CGI],,dnl (define form-data (append (parse-form-data (table:get (request-rec:subprocess-env Request) "QUERY_STRING")) (if (= (request-rec:method-number Request) 2) (parse-form-data (read-post-data Request)) '()))) (define-public (cgi:value name) (assoc-ref form-data name)) (define-public (cgi:names) (map car form-data)) (define-public cgi-script-name (table:get (request-rec:subprocess-env Request) "SCRIPT_NAME")) (define-public cgi-server-hostname (table:get (request-rec:subprocess-env Request) "SERVER_NAME")) (define-public cgi-server-protocol-name #f) (define-public cgi-server-protocol-version #f) (let* ((server-protocol (table:get (request-rec:subprocess-env Request) "SERVER_PROTOCOL"))) (if server-protocol (let ((slash (string-index server-protocol #\/))) (set! cgi-server-protocol-name (substring server-protocol 0 slash)) (set! cgi-server-protocol-version (substring server-protocol (1+ slash)))))) ) ;;; User-definable variables (define-public dict-template-file-name "dict.html") (define-public nea-template-file-name "nea.html") (define-public monima-nea-template-file-name "monima.html") (define-public target-language "el_GR") (define-public word-forms-reference '()) (define-public ref-loc #f) ;; Number of colums in fuzzy search output (define-public match-list-columns 4) ;;; End of user-definable variables (define-public (language-code lang) (cond ((string-index lang #\_) => (lambda (len) (substring lang 0 len))) (else lang))) (define-public (template-file lang template-file-name) (string-append html-dir "/" (language-code lang) "/" template-file-name)) (define-public (make-cgi-name cgi-path . rest) (apply string-append (cons cgi-path (let ((arglist (let ((lang (cgi:value "LANG"))) (do ((ilist (if lang (cons "LANG" (cons lang rest)) rest) (cdr ilist)) (i 1 (1+ i)) (olist '())) ((null? ilist) (if (null? olist) olist (reverse (cdr olist)))) (set! olist (cons (car ilist) olist)) (set! olist (cons (if (odd? i) "=" "&") olist)))))) (if (null? arglist) arglist (cons "?" arglist)))))) (define-public (expand-template explist template) "(expand-template EXPLIST TEMPLATE) Expands string TEMPLATE in accordance with EXPLIST. EXPLIST is a list of elements: (cons WORD THUNK) Each occurrence of WORD in TEMPLATE is replaced with the return value of THUNK. " (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-public (ellinika-cgi-init template-file-name) ;;; Load the site defaults (ellinika-config-setup) ;;; Load the language-specific defaults (cond ((cgi:value "LANG") => (lambda (x) (if (file-exists? (template-file x template-file-name)) (set! target-language x))))) ;;; Initialize i18n (let ((x (locale-setup target-language "PACKAGE" locale-path))) (if x (set! target-language x)))) ;;; End of cgi.scmi