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
|
;; 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-method (initialize (self <formdat>) initargs)
(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))
;; change to convert data to list and append val if already exists
;; or is a list
(define-method (formdat:set! (self <formdat>) key val)
(let ((prev-val (formdat:get self key))
(ht (slot-ref self 'form-data)))
(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-method (formdat:printall (self <formdat>) 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>))
(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)))
(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)
|
|
|
|
>
>
>
|
<
|
<
|
|
|
|
|
|
|
|
|
|
|
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
|
;; 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 (make-formdat:formdat)(make-vector (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 (formdat:initialize self)
(formdat:formdat-set-data! self (make-hash-table)))
(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 (formdat:set! self key val)
(let ((prev-val (formdat:get self key))
(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 (formdat:keys self)
(hash-table-keys (formdat:formdat-get-data self)))
(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 (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 (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)
|
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
(let ((request-method (getenv "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>)))
;; (debugp (open-output-file (conc (slot-ref s:session 'sroot) "/delme-" (current-user-id) ".log"))))
;; (write-string (read-string #f inp) #f debugp)
(let ((alldats (formdat:dat->list inp 10e6)))
;; (format debugp "formdat : alldats: ~A\n" alldats)
(let ((firstitem (car alldats))
(multipass #f))
|
|
|
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
(let ((request-method (getenv "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:formdat)))
;; (debugp (open-output-file (conc (slot-ref s:session 'sroot) "/delme-" (current-user-id) ".log"))))
;; (write-string (read-string #f inp) #f debugp)
(let ((alldats (formdat:dat->list inp 10e6)))
;; (format debugp "formdat : alldats: ~A\n" alldats)
(let ((firstitem (car alldats))
(multipass #f))
|