[Move `image-upload' into image-manager.lisp and add a customizable upload root
clinton@unknownlamer.org**20081230050027
 * :root initarg is a list of directory names under the site data root
 * Returns the full namestring of the uploaded file rather than just
   the name.type portion
] hunk ./beesknees.asd 16
+     (:file "image-manager" :depends-on ("packages"))
hunk ./beesknees.asd 19
-     (:file "web-admin" :depends-on ("packages" "web-common"))
+     (:file "web-admin" :depends-on ("packages" "web-common" "image-manager"))
addfile ./src/image-manager.lisp
hunk ./src/image-manager.lisp 1
+(in-package :beesknees.web)
+
+(define-html-form image-upload (file-upload-form)
+  ((image (file-upload-field)))
+  ((upload-root :initarg :root :initform `("wwwroot" "img" "uploaded"))))
+
+(defaction process-form ((form image-upload))
+  (with-slots (image upload-root) form
+    (let ((upload-stream
+	   (let ((original-file-name (rfc2388-binary:get-header-attribute
+				      (rfc2388-binary:get-header (value image)
+								 "Content-Disposition")
+				      "filename")))
+	     (open (make-pathname
+		    :directory `(:absolute ,beesknees.site-control::*bee-data-root*
+					   ,@upload-root)
+		    :name (pathname-name original-file-name)
+		    :type (pathname-type original-file-name))
+		   :direction :output
+		   :element-type 'unsigned-byte
+		   :if-exists :supersede))))
+      (fad:copy-stream (mime-part-body (value image)) upload-stream)
+      (answer (namestring upload-stream)))))
+
hunk ./src/web-admin.lisp 15
-(define-html-form image-upload (file-upload-form)
-  ((image (file-upload-field)))
-  ())
-
-(defaction process-form ((form image-upload))
-  (with-slots (image) form
-    (let ((upload-stream
-	   (let ((original-file-name (rfc2388-binary:get-header-attribute
-				      (rfc2388-binary:get-header (value image)
-								 "Content-Disposition")
-				      "filename")))
-	     (open (make-pathname
-		    :directory `(:absolute ,beesknees.site-control::*bee-data-root*
-					   "wwwroot" "img" "uploaded")
-		    :name (pathname-name original-file-name)
-		    :type (pathname-type original-file-name))
-		   :direction :output
-		   :element-type 'unsigned-byte
-		   :if-exists :supersede))))
-      (fad:copy-stream (mime-part-body (value image)) upload-stream)
-      (answer (file-namestring upload-stream)))))
-
hunk ./src/web-admin.lisp 30
-	    :action (setf *last-image-upload* (call 'image-upload)))
+	    :action (setf *last-image-upload*
+			  (let ((path (call 'image-upload)))
+			    (format nil "~A.~A" (pathname-name path)
+				                (pathname-type path)))))