diff options
Diffstat (limited to 'ellinika/cgi.scm4')
-rw-r--r-- | ellinika/cgi.scm4 | 169 |
1 files changed, 0 insertions, 169 deletions
diff --git a/ellinika/cgi.scm4 b/ellinika/cgi.scm4 deleted file mode 100644 index 38fd3de..0000000 --- a/ellinika/cgi.scm4 +++ /dev/null @@ -1,169 +0,0 @@ -;;;; -*- 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 |