Differences From Artifact [556fae5e96]:

To Artifact [3d0d733457]:


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
-
+








+
-
+














-
-
-
+
+
+
+
+
+

-
+
-
-
+
-

-
-
+
+



-
+

-
+







-
-
+
+

-
+





-
+







-
-
+
+







;; 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))
(include "requirements.scm")
(use regex)

(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)(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-method (initialize (self <formdat>) initargs)
(define (formdat:initialize self)
  (call-next-method)
  (slot-set! self 'form-data (make-hash-table))
  (formdat:formdat-set-data! self (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
146
147
148
149
150
151
152

153
154
155
156
157
158
159

160
161
162
163
164
165
166
167







-
+






-
+







(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)
    (let ((alldats (formdat:dat->list inp 10e6)))
      
      ;; (format debugp "formdat : alldats: ~A\n" alldats)
      (let ((firstitem   (car alldats))
	    (multipass #f))