summaryrefslogtreecommitdiffabout
path: root/src
Unidiff
Diffstat (limited to 'src') (more/less context) (ignore whitespace changes)
-rw-r--r--src/cgi-bin/conj.scm49
-rw-r--r--src/cgi-bin/dict.scm428
-rw-r--r--src/cgi-bin/nea.scm422
-rw-r--r--src/ellinika/cgi.scm425
-rw-r--r--src/ellinika/i18n.scm6
5 files changed, 55 insertions, 35 deletions
diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4
index 83fb846..6a49c62 100644
--- a/src/cgi-bin/conj.scm4
+++ b/src/cgi-bin/conj.scm4
@@ -1,5 +1,5 @@
1;;;; Greek Dictionary Web Engine 1;;;; Greek Dictionary Web Engine
2;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 Sergey Poznyakoff 2;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011, 2015 Sergey Poznyakoff
3;;;; 3;;;;
4;;;; This program is free software; you can redistribute it and/or modify 4;;;; This program is free software; you can redistribute it and/or modify
5;;;; it under the terms of the GNU General Public License as published by 5;;;; it under the terms of the GNU General Public License as published by
@@ -18,6 +18,7 @@
18;;; Tailor this statement to your needs if necessary. 18;;; Tailor this statement to your needs if necessary.
19(set! %load-path (cons "GUILE_SITE" %load-path)) 19(set! %load-path (cons "GUILE_SITE" %load-path))
20 20
21(setlocale LC_ALL "")
21(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user)) 22(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
22 (srfi srfi-1) 23 (srfi srfi-1)
23 (ice-9 rdelim) 24 (ice-9 rdelim)
@@ -61,7 +62,7 @@ ifelse(IFACE,[CGI],(cgi:init))
61 </td> 62 </td>
62 <td> 63 <td>
63 <input size=\"36\" name=\"key\" tabindex=\"1\"") 64 <input size=\"36\" name=\"key\" tabindex=\"1\"")
64 (let ((value (cgi:value "key"))) 65 (let ((value (cgi:value-u8 "key")))
65 (if value 66 (if value
66 (begin 67 (begin
67 (display " value=\"") 68 (display " value=\"")
@@ -350,7 +351,7 @@ ifelse(IFACE,[CGI],(cgi:init))
350 351
351 352
352(define (do-conj) 353(define (do-conj)
353 (let ((keyval (cgi:value "key"))) 354 (let ((keyval (cgi:value-u8 "key")))
354 (if (and keyval (not (string-null? keyval))) 355 (if (and keyval (not (string-null? keyval)))
355 (let ((input (ellinika:translate-input 356 (let ((input (ellinika:translate-input
356 (let ((keyval keyval)) 357 (let ((keyval keyval))
@@ -400,7 +401,7 @@ ifelse(IFACE,[CGI],(cgi:init))
400 (cond 401 (cond
401 ((string=? name "lang")) 402 ((string=? name "lang"))
402 (else 403 (else
403 (let ((v (cgi:value name))) 404 (let ((v (cgi:value-u8 name)))
404 (cond ((and v (not (string-null? v))) 405 (cond ((and v (not (string-null? v)))
405 (display "&amp;") 406 (display "&amp;")
406 (display name) 407 (display name)
diff --git a/src/cgi-bin/dict.scm4 b/src/cgi-bin/dict.scm4
index 77c1b3a..3b24367 100644
--- a/src/cgi-bin/dict.scm4
+++ b/src/cgi-bin/dict.scm4
@@ -1,5 +1,5 @@
1;;;; Greek Dictionary Web Engine 1;;;; Greek Dictionary Web Engine
2;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 Sergey Poznyakoff 2;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011, 2015 Sergey Poznyakoff
3;;;; 3;;;;
4;;;; This program is free software; you can redistribute it and/or modify 4;;;; This program is free software; you can redistribute it and/or modify
5;;;; it under the terms of the GNU General Public License as published by 5;;;; it under the terms of the GNU General Public License as published by
@@ -18,10 +18,13 @@
18;;; Tailor this statement to your needs if necessary. 18;;; Tailor this statement to your needs if necessary.
19(set! %load-path (cons "GUILE_SITE" %load-path)) 19(set! %load-path (cons "GUILE_SITE" %load-path))
20 20
21(setlocale LC_ALL "")
22
21(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user)) 23(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
22 (ice-9 rdelim) 24 (ice-9 rdelim)
23 (xmltools dict) 25 (xmltools dict)
24 (gamma sql) 26 (gamma sql)
27 (gamma syslog)
25 (ellinika elmorph) 28 (ellinika elmorph)
26 (ellinika sql) 29 (ellinika sql)
27 (ellinika i18n) 30 (ellinika i18n)
@@ -79,7 +82,7 @@ ifelse(IFACE,[CGI],(cgi:init))
79 82
80(define (join-widget widget-id tabindex) 83(define (join-widget widget-id tabindex)
81 (let* ((name (string-append "join" widget-id)) 84 (let* ((name (string-append "join" widget-id))
82 (selected-choice (or (let ((s (cgi:value name))) 85 (selected-choice (or (let ((s (cgi:value-u8 name)))
83 (if s 86 (if s
84 (string->number s) 87 (string->number s)
85 #f)) 88 #f))
@@ -112,7 +115,7 @@ ifelse(IFACE,[CGI],(cgi:init))
112 </td> 115 </td>
113 <td> 116 <td>
114 <input size=\"36\" name=\"key\" tabindex=\"1\"") 117 <input size=\"36\" name=\"key\" tabindex=\"1\"")
115 (let ((value (cgi:value "key"))) 118 (let ((value (cgi:value-u8 "key")))
116 (if value 119 (if value
117 (begin 120 (begin
118 (display " value=\"") 121 (display " value=\"")
@@ -132,7 +135,7 @@ ifelse(IFACE,[CGI],(cgi:init))
132 (display (_"Επιλέξτε το μέρος του λόγου")) 135 (display (_"Επιλέξτε το μέρος του λόγου"))
133 (display "</td><td>") 136 (display "</td><td>")
134 137
135 (let ((selected-choice (or (let ((s (cgi:value "pos"))) 138 (let ((selected-choice (or (let ((s (cgi:value-u8 "pos")))
136 (if s 139 (if s
137 (string->number s) 140 (string->number s)
138 #f)) 141 #f))
@@ -166,7 +169,7 @@ ifelse(IFACE,[CGI],(cgi:init))
166 (display "<tr><td>") 169 (display "<tr><td>")
167 (display (list-ref category 1)) 170 (display (list-ref category 1))
168 (display "</td><td>") 171 (display "</td><td>")
169 (let ((selected-choice (or (let ((s (cgi:value (list-ref category 0)))) 172 (let ((selected-choice (or (let ((s (cgi:value-u8 (list-ref category 0))))
170 (if s 173 (if s
171 (string->number s) 174 (string->number s)
172 #f)) 175 #f))
@@ -353,7 +356,7 @@ ifelse(IFACE,[CGI],(cgi:init))
353 (list-ref part-of-speech (string->number pos)))) 356 (list-ref part-of-speech (string->number pos))))
354 (if (or (not (string-null? key)) (not (null? theme))) 357 (if (or (not (string-null? key)) (not (null? theme)))
355 (set! where-cond (cons 358 (set! where-cond (cons
356 (if (string=? (cgi:value "joinpos") "0") 359 (if (string=? (cgi:value-u8 "joinpos") "0")
357 " AND" 360 " AND"
358 " OR") 361 " OR")
359 where-cond))) 362 where-cond)))
@@ -418,21 +421,20 @@ ifelse(IFACE,[CGI],(cgi:init))
418 421
419 422
420(define (dict-search) 423(define (dict-search)
421 (let ((keyval (if (cgi:value "ident") 424 (let ((keyval (or (cgi:value-u8 "ident")
422 (dict:decode-string (cgi:value "ident")) 425 (cgi:value-u8 "key")))
423 (cgi:value "key")))
424 (theme (do ((catlist (get-topic-list) (cdr catlist)) 426 (theme (do ((catlist (get-topic-list) (cdr catlist))
425 (ret '())) 427 (ret '()))
426 ((null? catlist) ret) 428 ((null? catlist) ret)
427 (let ((name (caar catlist))) 429 (let ((name (caar catlist)))
428 (let ((v (cgi:value name))) 430 (let ((v (cgi:value-u8 name)))
429 (if (and v (> (string->number v) 0)) 431 (if (and v (> (string->number v) 0))
430 (set! ret (append 432 (set! ret (append
431 ret 433 ret
432 (list (= (string->number 434 (list (= (string->number
433 (cgi:value (string-append "join" name))) 0) 435 (cgi:value-u8 (string-append "join" name))) 0)
434 v)))))))) 436 v))))))))
435 (pos (or (cgi:value "pos") "0"))) 437 (pos (or (cgi:value-u8 "pos") "0")))
436 438
437 (sql-catch-failure 439 (sql-catch-failure
438 (cond 440 (cond
@@ -521,7 +523,7 @@ dict.forms,articles.subindex,articles.meaning,(dict.pos & conv(\"100000\",16,10)
521 (cond 523 (cond
522 ((string=? name "lang")) 524 ((string=? name "lang"))
523 (else 525 (else
524 (let ((v (cgi:value name))) 526 (let ((v (cgi:value-u8 name)))
525 (cond ((and v (not (string-null? v))) 527 (cond ((and v (not (string-null? v)))
526 (display "&amp;") 528 (display "&amp;")
527 (display name) 529 (display name)
diff --git a/src/cgi-bin/nea.scm4 b/src/cgi-bin/nea.scm4
index f64aca2..e366a7c 100644
--- a/src/cgi-bin/nea.scm4
+++ b/src/cgi-bin/nea.scm4
@@ -1,5 +1,5 @@
1;;;; News page for Ellinika 1;;;; News page for Ellinika
2;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 Sergey Poznyakoff 2;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011, 2015 Sergey Poznyakoff
3;;;; 3;;;;
4;;;; This program is free software; you can redistribute it and/or modify 4;;;; This program is free software; you can redistribute it and/or modify
5;;;; it under the terms of the GNU General Public License as published by 5;;;; it under the terms of the GNU General Public License as published by
@@ -30,7 +30,7 @@
30ifelse(IFACE,[CGI],(cgi:init)) 30ifelse(IFACE,[CGI],(cgi:init))
31 31
32(define tmpl (if (and monima-nea-template-file-name 32(define tmpl (if (and monima-nea-template-file-name
33 (cgi:value "timestamp")) 33 (cgi:value-u8 "timestamp"))
34 monima-nea-template-file-name 34 monima-nea-template-file-name
35 nea-template-file-name)) 35 nea-template-file-name))
36 36
@@ -177,13 +177,13 @@ ifelse(IFACE,[CGI],(cgi:init))
177 0))) 177 0)))
178 (from (catch #t 178 (from (catch #t
179 (lambda () 179 (lambda ()
180 (let ((x (string->number (cgi:value "from")))) 180 (let ((x (string->number (cgi:value-u8 "from"))))
181 (if (< x count) 181 (if (< x count)
182 x 182 x
183 0))) 183 0)))
184 (lambda args 184 (lambda args
185 0))) 185 0)))
186 (fwd (let ((dir (cgi:value "dir"))) 186 (fwd (let ((dir (cgi:value-u8 "dir")))
187 (or (not dir) 187 (or (not dir)
188 (string=? dir "1")))) 188 (string=? dir "1"))))
189 (entries (collect-entries from fwd))) 189 (entries (collect-entries from fwd)))
@@ -199,7 +199,7 @@ ifelse(IFACE,[CGI],(cgi:init))
199 (let ((num-entries (length result)) 199 (let ((num-entries (length result))
200 (begin (if fwd from start)) 200 (begin (if fwd from start))
201 (end (if fwd start from)) 201 (end (if fwd start from))
202 (id (cgi:value "id"))) 202 (id (cgi:value-u8 "id")))
203 203
204 (cond 204 (cond
205 ((not (and (= from 0) (< num-entries nea-max-rows))) 205 ((not (and (= from 0) (< num-entries nea-max-rows)))
@@ -273,7 +273,7 @@ ifelse(IFACE,[CGI],(cgi:init))
273 (display "<span class=\"itemsubject\">\n") 273 (display "<span class=\"itemsubject\">\n")
274 (display (list-ref item 2)) 274 (display (list-ref item 2))
275 (display "</span>") 275 (display "</span>")
276 (if (not (cgi:value "timestamp")) 276 (if (not (cgi:value-u8 "timestamp"))
277 (permalink "span" (list-ref item 1))) 277 (permalink "span" (list-ref item 1)))
278 (display "</div><!-- news-header -->")) 278 (display "</div><!-- news-header -->"))
279 279
@@ -337,7 +337,7 @@ ifelse(IFACE,[CGI],(cgi:init))
337 (cond 337 (cond
338 ((string=? name "lang")) 338 ((string=? name "lang"))
339 (else 339 (else
340 (let ((v (cgi:value name))) 340 (let ((v (cgi:value-u8 name)))
341 (cond ((and v (not (string-null? v))) 341 (cond ((and v (not (string-null? v)))
342 (display "&amp;") 342 (display "&amp;")
343 (display name) 343 (display name)
@@ -435,7 +435,7 @@ ifelse(IFACE,[CGI],(cgi:init))
435;;; Main 435;;; Main
436 436
437(cond 437(cond
438 ((cgi:value "rss") 438 ((cgi:value-u8 "rss")
439 ifelse(IFACE,[CGI], 439 ifelse(IFACE,[CGI],
440 (display ["Content-type: text/xml; charset=utf-8\r\n\r\n"]), 440 (display ["Content-type: text/xml; charset=utf-8\r\n\r\n"]),
441 (request-rec:set-content-type! Request ["text/xml; charset=UTF-8"])) 441 (request-rec:set-content-type! Request ["text/xml; charset=UTF-8"]))
@@ -447,15 +447,15 @@ ifelse(IFACE,[CGI],(cgi:init))
447 (display ["Content-type: text/html; charset=utf-8\r\n\r\n"])) 447 (display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
448 (ellinika:sql-connect ellinika-sql-connection) 448 (ellinika:sql-connect ellinika-sql-connection)
449 (cond 449 (cond
450 ((or (cgi:value "timestamp") (cgi:value "id")) 450 ((or (cgi:value-u8 "timestamp") (cgi:value-u8 "id"))
451 (let ((tuples 451 (let ((tuples
452 (cond 452 (cond
453 ((cgi:value "timestamp") => 453 ((cgi:value-u8 "timestamp") =>
454 (lambda (ts) 454 (lambda (ts)
455 (ellinika:sql-query 455 (ellinika:sql-query
456 "SELECT date,unix_timestamp(date),ident\ 456 "SELECT date,unix_timestamp(date),ident\
457 FROM news WHERE unix_timestamp(date)=~Q" ts))) 457 FROM news WHERE unix_timestamp(date)=~Q" ts)))
458 ((cgi:value "id") => 458 ((cgi:value-u8 "id") =>
459 (lambda (id) 459 (lambda (id)
460 (ellinika:sql-query 460 (ellinika:sql-query
461 "SELECT date,unix_timestamp(date),ident\ 461 "SELECT date,unix_timestamp(date),ident\
diff --git a/src/ellinika/cgi.scm4 b/src/ellinika/cgi.scm4
index 8c9b54d..51f9570 100644
--- a/src/ellinika/cgi.scm4
+++ b/src/ellinika/cgi.scm4
@@ -1,6 +1,5 @@
1;;;; -*- scheme -*- 1;;;; Greek Dictionary Web Engine -*- scheme -*-
2;;;; Greek Dictionary Web Engine 2;;;; Copyright (C) 2005, 2007, 2010, 2015 Sergey Poznyakoff
3;;;; Copyright (C) 2005, 2007, 2010 Sergey Poznyakoff
4;;;; 3;;;;
5;;;; This program is free software; you can redistribute it and/or modify 4;;;; 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 5;;;; it under the terms of the GNU General Public License as published by
@@ -19,12 +18,28 @@
19 #:use-module (ellinika config) 18 #:use-module (ellinika config)
20 #:use-module (ellinika i18n) 19 #:use-module (ellinika i18n)
21 #:use-module ifelse(IFACE,[CGI],(www cgi),(guile-user)) 20 #:use-module ifelse(IFACE,[CGI],(www cgi),(guile-user))
21 #:use-module (ice-9 iconv)
22 #:use-module (rnrs bytevectors)
22 #:re-export (base-dir html-dir sysconf-dir locale-path 23 #:re-export (base-dir html-dir sysconf-dir locale-path
23 ellinika-sql-connection 24 ellinika-sql-connection
24 config-file-name )) 25 config-file-name ))
25 26
26 27
27ifelse(IFACE,[CGI],,dnl 28ifelse(IFACE,[CGI],[
29(define-public cgi-script-name
30 (cgi:getenv 'script-name))
31(define-public cgi-server-hostname
32 (cgi:getenv 'server-hostname))
33(define-public cgi-server-protocol-name
34 (cgi:getenv 'server-protocol-name))
35(define-public cgi-server-protocol-version
36 (cgi:getenv 'server-protocol-version))
37(define-public (cgi:value-u8 key)
38 (let ((x (cgi:value key)))
39 (if x
40 (utf8->string (string->bytevector x "ISO-8859-1"))
41 x)))
42],[
28(define form-data 43(define form-data
29 (append 44 (append
30 (parse-form-data 45 (parse-form-data
@@ -59,7 +74,7 @@ ifelse(IFACE,[CGI],,dnl
59 (set! cgi-server-protocol-version (substring server-protocol 74 (set! cgi-server-protocol-version (substring server-protocol
60 (1+ slash)))))) 75 (1+ slash))))))
61 76
62) 77])
63 78
64 79
65;;; User-definable variables 80;;; User-definable variables
diff --git a/src/ellinika/i18n.scm b/src/ellinika/i18n.scm
index c05d727..40cb47d 100644
--- a/src/ellinika/i18n.scm
+++ b/src/ellinika/i18n.scm
@@ -1,5 +1,5 @@
1;;;; This file is part of Greek Dictionary Web Engine 1;;;; This file is part of Greek Dictionary Web Engine
2;;;; Copyright (C) 2006, 2007 Sergey Poznyakoff 2;;;; Copyright (C) 2006, 2007, 2015 Sergey Poznyakoff
3;;;; 3;;;;
4;;;; This program is free software; you can redistribute it and/or modify 4;;;; This program is free software; you can redistribute it and/or modify
5;;;; it under the terms of the GNU General Public License as published by 5;;;; it under the terms of the GNU General Public License as published by
@@ -15,10 +15,12 @@
15;;;; along with this program. If not, see <http://www.gnu.org/licenses/>. 15;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
16 16
17(define-module (ellinika i18n) 17(define-module (ellinika i18n)
18 #:use-syntax (ice-9 syncase)
19 #:export-syntax (_) 18 #:export-syntax (_)
20 #:export (locale-setup)) 19 #:export (locale-setup))
21 20
21(if (= (string->number (major-version)) 1)
22 (use-modules (ice-9 syncase)))
23
22(define-syntax _ 24(define-syntax _
23 (syntax-rules () 25 (syntax-rules ()
24 ((_ msg) (gettext msg)))) 26 ((_ msg) (gettext msg))))

Return to:

Send suggestions and report system problems to the System administrator.