1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
-
+
+
+
-
+
-
-
-
+
+
+
+
+
+
-
+
-
-
+
-
-
-
+
+
-
+
-
+
-
-
+
+
-
+
-
+
-
-
+
+
|
;; Copyright 2007-2008, Matthew Welland.
;; Copyright 2007-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(declare (unit formdat))
(use regex)
(include "requirements.scm")
(require-extension srfi-69)
(define formdat:*debug* #f)
;; Old data format was something like this. BUT!
;; Forms do not have names so the hierarcy is
;; unnecessary (I think)
;;
;; hashtable
;; |-formname --> <formdat> 'form-name=formname
;; | 'form-data=hashtable
;; | | name => value
;;
;; New data format is only the <formdat> portion from above
(define-class <formdat> ()
(form-data
))
;; (define-class <formdat> ()
;; (form-data
;; ))
(define (make-formdat:formdat)(vector (make-hash-table)))
(define-inline (formdat:formdat-get-data vec) (vector-ref vec 0))
(define-inline (formdat:formdat-set-data! vec val)(vector-set! vec 0 val))
(define-method (initialize (self <formdat>) initargs)
(define (formdat:initialize self)
(call-next-method)
(slot-set! self 'form-data (make-hash-table))
(initialize-slots self initargs))
(define-method (formdat:get (self <formdat>) key)
(hash-table-ref/default (slot-ref self 'form-data) key #f))
(define (formdat:get self key)
(hash-table-ref/default (formdat:formdat-get-data self) key #f))
;; change to convert data to list and append val if already exists
;; or is a list
(define-method (formdat:set! (self <formdat>) key val)
(define (formdat:set! self key val)
(let ((prev-val (formdat:get self key))
(ht (slot-ref self 'form-data)))
(ht (formdat:formdat-get-data self)))
(if prev-val
(if (list? prev-val)
(hash-table-set! ht key (cons val prev-val))
(hash-table-set! ht key (list val prev-val)))
(hash-table-set! ht key val))
self))
(define-method (formdat:keys (self <formdat>))
(hash-table-keys (slot-ref self 'form-data)))
(define (formdat:keys self)
(hash-table-keys (formdat:formdat-get-data self)))
(define-method (formdat:printall (self <formdat>) printproc)
(define (formdat:printall self printproc)
(printproc "formdat:printall " (formdat:keys self))
(for-each (lambda (k)
(printproc k " => " (formdat:get self k)))
(formdat:keys self)))
(define-method (formdat:all->strings (self <formdat>))
(define (formdat:all->strings self)
(let ((res '()))
(for-each (lambda (k)
(set! res (cons (conc k "=>" (formdat:get self k)) res)))
(formdat:keys self))
res))
;; call with *one* of the lists in the list of lists created by CGI:url-unquote
(define-method (formdat:load (self <formdat>) formlist)
(let ((ht (slot-ref self 'form-data)))
(define (formdat:load self formlist)
(let ((ht (formdat:formdat-get-data self)))
(if (null? formlist) self ;; no values provided, return self for no good reason
(let loop ((head (car formlist))
(tail (cdr formlist)))
(let ((key (car head))
(val (cdr head)))
;; (err:log "key=" key " val=" val)
(if (> (length val) 1)
|
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
-
+
-
+
+
|
(define formdat:bin-data-name-rex (regexp "\\Wname=\"([^\"]+)\""))
(define formdat:bin-file-name-rex (regexp "\\Wfilename=\"([^\"]+)\""))
(define formdat:bin-file-type-rex (regexp "Content-Type:\\s+([^\\s]+)"))
(define formdat:delim-patt-rex (regexp "^\\-+[0-9]+\\-*$"))
;; returns a hash with entries for all forms - could well use a proplist?
(define (formdat:load-all)
(let ((request-method (getenv "REQUEST_METHOD")))
(let ((request-method (get-environment-variable "REQUEST_METHOD")))
(if (and request-method
(string=? request-method "POST"))
(formdat:load-all-port (current-input-port)))))
;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
(let* ((formdat (make <formdat>)))
(let* ((formdat (make-formdat:formdat)))
;; (debugp (open-output-file (conc (slot-ref s:session 'sroot) "/delme-" (current-user-id) ".log"))))
;; (write-string (read-string #f inp) #f debugp)
(formdat:initialize formdat)
(let ((alldats (formdat:dat->list inp 10e6)))
;; (format debugp "formdat : alldats: ~A\n" alldats)
(let ((firstitem (car alldats))
(multipass #f))
(if (not (null? firstitem))
(if (string-match formdat:delim-patt-rex (caar firstitem))
|