diff options
Diffstat (limited to 'src/ellinika/cgi.scm4')
| -rw-r--r-- | src/ellinika/cgi.scm4 | 169 |
1 files changed, 169 insertions, 0 deletions
diff --git a/src/ellinika/cgi.scm4 b/src/ellinika/cgi.scm4 new file mode 100644 index 0000000..38fd3de --- /dev/null +++ b/src/ellinika/cgi.scm4 @@ -0,0 +1,169 @@ +;;;; -*- scheme -*- +;;;; Greek Dictionary Web Engine +;;;; Copyright (C) 2005, 2007 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 <http://www.gnu.org/licenses/>. +;;;; +(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 + sql-iface sql-host sql-port sql-database + sql-username sql-password + 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 |