[bknr-cvs] r2027 - in branches/xml-class-rework/bknr/src: . web

[bknr at bknr.net]

Author: hhubner
Date: 2006-10-22 12:45:33 -0400 (Sun, 22 Oct 2006)
New Revision: 2027

Modified:
   branches/xml-class-rework/bknr/src/bknr.asd
   branches/xml-class-rework/bknr/src/web/tags.lisp
   branches/xml-class-rework/bknr/src/web/web-utils.lisp
Log:
Convert incoming paramter values to utf-8.
Do not create base href tag in generated html


Modified: branches/xml-class-rework/bknr/src/bknr.asd
===================================================================
--- branches/xml-class-rework/bknr/src/bknr.asd	2006-10-22 16:43:35 UTC (rev 2026)
+++ branches/xml-class-rework/bknr/src/bknr.asd	2006-10-22 16:45:33 UTC (rev 2027)
@@ -35,6 +35,7 @@
 		 :bknr-datastore
 		 :bknr-data-impex
 		 :kmrcl
+		 :iconv
 		 #+(not allegro)
 		 :acl-compat)
 

Modified: branches/xml-class-rework/bknr/src/web/tags.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/tags.lisp	2006-10-22 16:43:35 UTC (rev 2026)
+++ branches/xml-class-rework/bknr/src/web/tags.lisp	2006-10-22 16:45:33 UTC (rev 2027)
@@ -183,7 +183,7 @@
 <link rel=\"stylesheet\" href=\"/static/css/dynastyle_01.css\" ....
 "
   (html
-   ((:base :href (website-base-href *website*)))
+   #+(or) ((:base :href (website-base-href *website*)))
    (loop for stylesheet in (website-style-sheet-urls *website*)
 	 do (html ((:link :rel "stylesheet" :type "text/css" :href stylesheet))))
    (loop for javascript in (website-javascript-urls *website*)

Modified: branches/xml-class-rework/bknr/src/web/web-utils.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/web-utils.lisp	2006-10-22 16:43:35 UTC (rev 2026)
+++ branches/xml-class-rework/bknr/src/web/web-utils.lisp	2006-10-22 16:45:33 UTC (rev 2027)
@@ -60,12 +60,12 @@
 	    (get-all-multipart-data request :limit *upload-file-size-limit*)))))
       (when file-size-limit-reached
 	(error "upload file size limit exceeded"))
-      (setf (getf (request-reply-plist request) 'bknr-parsed-parameters) parameters)
+      (setf (getf (request-reply-plist request) 'bknr-parsed-body-parameters) parameters)
       (setf (getf (request-reply-plist request) 'uploaded-files) uploaded-files))))
 
 (defun get-urlencoded-form-data (request)
   (loop for name-value in (form-urlencoded-to-query (get-request-body request))
-	do (push name-value (getf (request-reply-plist request) 'bknr-parsed-parameters))))
+	do (push name-value (getf (request-reply-plist request) 'bknr-parsed-body-parameters))))
 
 (defun parse-request-body (request &key uploads)
   (let ((content-type (header-slot-value request :content-type)))
@@ -89,7 +89,7 @@
 
 (defmethod get-parameters-from-body ((request bknr-request))
   (unless (getf (request-reply-plist request) 'body-parsed)
-    (setf (getf (request-reply-plist request) 'bknr-parsed-parameters) nil)
+    (setf (getf (request-reply-plist request) 'bknr-parsed-body-parameters) nil)
     (parse-request-body request :uploads t)
     (setf (getf (request-reply-plist request) 'body-parsed) t)))
 
@@ -112,10 +112,17 @@
 body is present in the request, any uploaded files are saved in a temporary file and noted in the
 request's plist.  Uploaded files will be automatically deleted by the with-bknr-http-response
 macro after the request body has been executed."
-  (get-parameters-from-body request)
-  (remove "" (append (form-urlencoded-to-query (uri-query (request-uri request)))
-		     (getf (request-reply-plist request) 'bknr-parsed-parameters))
-	  :key #'cdr :test #'string-equal))
+  (unless (getf (request-reply-plist request) 'bknr-parsed-parameters)
+    (let ((request-charset (or (register-groups-bind (charset) (#?r".*charset=\"?([^\"; ]+).*" (header-slot-value request :content-type)) charset)
+			       "utf-8")))
+      (get-parameters-from-body request)
+      (setf (getf (request-reply-plist request) 'bknr-parsed-parameters)
+	    (mapcar (lambda (param) (cons (car param)
+					  (iconv:iconv request-charset "utf-8" (cdr param))))
+		    (remove "" (append (form-urlencoded-to-query (uri-query (request-uri request)))
+				       (getf (request-reply-plist request) 'bknr-parsed-body-parameters))
+			    :key #'cdr :test #'string-equal)))))
+  (getf (request-reply-plist request) 'bknr-parsed-parameters))
 
 (defun query-param (request param-name)
   (let ((value (cdr (assoc param-name (all-request-params request) :test #'string-equal))))