;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
;;;; This is copyrighted software.  See documentation for terms.
;;;; 
;;;; utility.cl --- Utility functions and macros for CLASH users
;;;; 
;;;; Checkout Tag: $Name$
;;;; $Id$

(in-package :CLASH)

;;;; %File Description:
;;;; 
;;;; 
;;;; 

(defun export-files (server type base &rest files)
  "Export all the given files as static resources from the given base.
The files content-type is type and the files are exported as a
file-entity."
  (dolist (file files)
    (export-resource
     server
     (merge-urls (make-instance 'url-http :name (file-namestring file))
		 base)
     'static-resource
     :entity
     (make-instance 'file-entity :content-type type :pathname file))))

(defun export-directory (server type-map base directory &optional recursive-p)
  "Export the contents of a directory."
  (flet ((lookup-type (type)
	   (or (cdr (assoc type type-map :test #'equal))
	       (cdr (assoc t type-map :test #'equal)))))
    (dolist (file (directory directory))
      (if (null (pathname-name file))
	  (when recursive-p
	    (export-directory
	     server type-map
	     (merge-urls
	      (make-instance
	       'url-http
	       :directory (list* :relative (last (pathname-directory file))))
	      base)
	     file
	     recursive-p))
	  (export-resource
	   server
	   (merge-urls
	    (make-instance 'url-http :name
			   (concatenate 'string (pathname-name file)
					"." (pathname-type file)))
	    base)
	   'static-resource
	   :entity
	   (make-instance 'file-entity
			  :content-type (lookup-type (pathname-type file))
			  :pathname file))))))

(defmacro with-string-response
    (((stream request code &rest r-args) &rest e-args) &body body)
  `(create-response ,request ,code ,@r-args
                    :entity
	            (make-instance 'string-entity ,@e-args
		                   :body
		                   (with-output-to-string (,stream)
				     ,@body))))