diff options
Diffstat (limited to 'ellinika/cgi.scm4')
-rw-r--r-- | ellinika/cgi.scm4 | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/ellinika/cgi.scm4 b/ellinika/cgi.scm4 new file mode 100644 index 0000000..dc7c05d --- /dev/null +++ b/ellinika/cgi.scm4 | |||
@@ -0,0 +1,164 @@ | |||
1 | ;;;; -*- scheme -*- | ||
2 | ;;;; Greek Dictionary Web Engine | ||
3 | ;;;; Copyright (C) 2005 Sergey Poznyakoff | ||
4 | ;;;; | ||
5 | ;;;; This program is free software; you can redistribute it and/or modify | ||
6 | ;;;; it under the terms of the GNU General Public License as published by | ||
7 | ;;;; the Free Software Foundation; either version 2 of the License, or | ||
8 | ;;;; (at your option) any later version. | ||
9 | ;;;; | ||
10 | ;;;; This program is distributed in the hope that it will be useful, | ||
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
13 | ;;;; GNU General Public License for more details. | ||
14 | ;;;; | ||
15 | ;;;; You should have received a copy of the GNU General Public License | ||
16 | ;;;; along with this program; if not, write to the Free Software | ||
17 | ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | ||
18 | ;;;; | ||
19 | (define-module (ellinika cgi)) | ||
20 | |||
21 | (use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user)) | ||
22 | (gamma gettext) | ||
23 | (ellinika i18n)) | ||
24 | |||
25 | ifelse(IFACE,[CGI],,dnl | ||
26 | (define form-data | ||
27 | (append | ||
28 | (parse-form-data | ||
29 | (table:get (request-rec:subprocess-env Request) "QUERY_STRING")) | ||
30 | (if (= (request-rec:method-number Request) 2) | ||
31 | (parse-form-data (read-post-data Request)) | ||
32 | '()))) | ||
33 | |||
34 | (define-public (cgi:value name) | ||
35 | (assoc-ref form-data name)) | ||
36 | |||
37 | (define-public (cgi:names) | ||
38 | (map car form-data)) | ||
39 | |||
40 | (define-public cgi-script-name | ||
41 | (table:get (request-rec:subprocess-env Request) | ||
42 | "SCRIPT_NAME")) | ||
43 | ) | ||
44 | |||
45 | |||
46 | ;;; User-definable variables | ||
47 | (define-public base-dir "PREFIX") | ||
48 | (define-public html-dir "HTMLDIR") | ||
49 | (define-public sysconf-dir "SYSCONFDIR") | ||
50 | (define-public locale-path "LOCALEDIR:/usr/share/locale:/usr/local/share/locale") | ||
51 | (define-public ref-loc #f) | ||
52 | |||
53 | (define-public config-file-name "ellinika.conf") | ||
54 | (define-public dict-template-file-name "dict.html") | ||
55 | (define-public nea-template-file-name "nea.html") | ||
56 | (define-public monima-nea-template-file-name "monima.html") | ||
57 | (define-public target-language "el_GR") | ||
58 | |||
59 | (define-public word-forms-reference '()) | ||
60 | |||
61 | (define-public sql-iface "mysql") ;; SQL interface ("mysql" or "postgres") | ||
62 | (define-public sql-host "localhost") ;; SQL server hostname or a path to the UNIX | ||
63 | ;; socket | ||
64 | (define-public sql-port 3306) ;; SQL port number (0 for sockaddr_un | ||
65 | ;; connection) | ||
66 | (define-public sql-database "ellinika") ;; Name of the database | ||
67 | (define-public sql-username "gray") ;; Database user name | ||
68 | (define-public sql-password "") ;; Password for that user name | ||
69 | |||
70 | (define-public match-list-columns 4) ;; Number of colums in fuzzy search output | ||
71 | ;;; End of user-definable variables | ||
72 | |||
73 | (define-public (language-code lang) | ||
74 | (cond | ||
75 | ((string-index lang #\_) => | ||
76 | (lambda (len) | ||
77 | (substring lang 0 len))) | ||
78 | (else | ||
79 | lang))) | ||
80 | |||
81 | (define-public (template-file lang template-file-name) | ||
82 | (string-append html-dir "/" (language-code lang) "/" template-file-name)) | ||
83 | |||
84 | (define-public (make-cgi-name cgi-path . rest) | ||
85 | (apply | ||
86 | string-append | ||
87 | (cons | ||
88 | cgi-path | ||
89 | (let ((arglist (let ((lang (cgi:value "LANG"))) | ||
90 | (do ((ilist (if lang | ||
91 | (cons "LANG" (cons lang rest)) | ||
92 | rest) (cdr ilist)) | ||
93 | (i 1 (1+ i)) | ||
94 | (olist '())) | ||
95 | ((null? ilist) (if (null? olist) | ||
96 | olist | ||
97 | (reverse (cdr olist)))) | ||
98 | (set! olist (cons (car ilist) olist)) | ||
99 | (set! olist (cons | ||
100 | (if (odd? i) "=" "&") | ||
101 | olist)))))) | ||
102 | (if (null? arglist) | ||
103 | arglist | ||
104 | (cons "?" arglist)))))) | ||
105 | |||
106 | (define-public (expand-template explist template) | ||
107 | "(expand-template EXPLIST TEMPLATE) | ||
108 | |||
109 | Expands string TEMPLATE in accordance with EXPLIST. EXPLIST is a list | ||
110 | of elements: | ||
111 | |||
112 | (cons WORD THUNK) | ||
113 | |||
114 | Each occurrence of WORD in TEMPLATE is replaced with the return value of | ||
115 | THUNK. | ||
116 | " | ||
117 | (let loop ((template template)) | ||
118 | (cond | ||
119 | ((string-index template #\@) => | ||
120 | (lambda (w) | ||
121 | (display (substring template 0 w)) | ||
122 | (if (and (< (+ w 2) (string-length template)) | ||
123 | (char=? (string-ref template (1+ w)) #\@)) | ||
124 | (let ((end-pos (string-index template #\@ (+ w 2)))) | ||
125 | (if (and end-pos | ||
126 | (< (1+ end-pos) (string-length template)) | ||
127 | (char=? (string-ref template (1+ end-pos)) #\@)) | ||
128 | (let* ((name (substring template w (+ end-pos 2))) | ||
129 | (entry (assoc name explist))) | ||
130 | (cond | ||
131 | (entry | ||
132 | ((cdr entry)) | ||
133 | (loop (substring template (+ end-pos 2)))) | ||
134 | (else | ||
135 | (display "@@") | ||
136 | (loop (substring template (+ w 2)))))) | ||
137 | (begin | ||
138 | (display "@") | ||
139 | (loop (substring template (+ w 1)))))) | ||
140 | (begin | ||
141 | (display "@") | ||
142 | (loop (substring template (1+ w))))))) | ||
143 | (else | ||
144 | (display template))))) | ||
145 | |||
146 | |||
147 | (define-public (ellinika-cgi-init template-file-name) | ||
148 | ;;; Load the site defaults | ||
149 | (let ((rc-file (string-append sysconf-dir "/" config-file-name))) | ||
150 | (if (file-exists? rc-file) | ||
151 | (load rc-file))) | ||
152 | |||
153 | ;;; Load the language-specific defaults | ||
154 | (cond | ||
155 | ((cgi:value "LANG") => | ||
156 | (lambda (x) | ||
157 | (if (file-exists? (template-file x template-file-name)) | ||
158 | (set! target-language x))))) | ||
159 | ;;; Initialize i18n | ||
160 | (let ((x (locale-setup target-language "PACKAGE" locale-path))) | ||
161 | (if x | ||
162 | (set! target-language x)))) | ||
163 | |||
164 | ;;; End of cgi.scmi | ||