;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
;;;; This is copyrighted software.  See documentation for terms.
;;;; 
;;;; entity.cl --- Entity Handling
;;;; 
;;;; Checkout Tag: $Name$
;;;; $Id$

(in-package :CLASH)

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

(defclass entity ()
  ())

(defgeneric render-entity-headers (entity stream))

(defgeneric render-entity-body (entity stream))

(defclass entity-header-mixin/1.1 ()
  ((allow :initarg :allow :reader entity-allow)
   (content-encoding :initarg :content-encoding
		     :reader entity-content-encoding)
   (content-language :initarg :content-language
		     :reader entity-content-language)
   (content-length :initarg :content-length :reader entity-content-length)
   (content-location :initarg :content-location
		     :reader entity-content-location)
   (content-md5 :initarg :content-md5 :reader entity-content-md5)
   (content-range :initarg :content-range :reader entity-content-range)
   (content-type :initarg :content-type :reader entity-content-type)
   (expires :initarg :expires :reader entity-expires)
   (last-modified :initarg :last-modified :reader entity-last-modified)))

(defmethod render-entity-headers ((e entity-header-mixin/1.1) stream)
  (render-slots (e stream)
    (allow "Allow"
      (write-http-element-list-1 allow stream))
    (content-encoding "Content-Encoding"
      (write-http-element-list-1 content-encoding stream))
    (content-language "Content-Language"
      (write-http-element-list-1 content-language stream))
    (content-length "Content-Length"
      (format stream "~D" content-length))
    (content-location "Content-Location"
      (princ content-location stream))
    #+NIL
    (content-md5 "Content-MD5"
      (write-string (base64-encode-string content-md5) stream))
    #+NIL
    (content-range "Content-Range"
      (princ content-range stream))
    (content-type "Content-Type"
      (princ content-type stream))
    (expires "Expires"
      (write-string (rfc1123-format-time expires) stream))
    (last-modified "Last-Modified"
      (write-string (rfc1123-format-time last-modified) stream))))

(defclass stream-entity-mixin ()
  ())

(defgeneric stream-entity-stream (entity))

(defgeneric stream-entity-length (entity))

(defmethod render-entity-headers :before ((e stream-entity-mixin) stream)
  (declare (ignore stream))
  (setf (slot-value e 'content-length) (stream-entity-length e)))

(defmethod render-entity-body ((entity stream-entity-mixin) stream)
  (with-open-stream (in-stream (stream-entity-stream entity))
    (with-io-buffer (buffer)
      (loop for length = (read-sequence buffer in-stream)
	    until (zerop length)
	    do
	    (write-sequence buffer stream :end length)))))

(defclass string-entity (entity stream-entity-mixin entity-header-mixin/1.1)
  ((body :initarg :body :reader entity-body)))

(defmethod stream-entity-length ((entity string-entity))
  (length (entity-body entity)))

(defmethod stream-entity-stream ((entity string-entity))
  (make-string-input-stream (entity-body entity)))

(defclass file-entity (entity stream-entity-mixin entity-header-mixin/1.1)
  ((pathname :initarg :pathname :reader entity-pathname)
   (file-stream :initform nil)))

(defmethod stream-entity-length ((entity file-entity))
  (file-length (stream-entity-stream entity)))

(defmethod stream-entity-stream ((entity file-entity))
  (let ((file-stream (slot-value entity 'file-stream)))
    (if (and (streamp file-stream) (open-stream-p file-stream))
	file-stream
	(setf (slot-value entity 'file-stream)
	      (open (entity-pathname entity) :direction :input)))))

(defclass cached-entity-mixin ()
  ((body-cache)))

(defmethod render-entity-body :around ((entity cached-entity-mixin) stream)
  (prog1 nil
    (if (slot-boundp entity 'body-cache)
	(write-sequence (slot-value entity 'body-cache) stream)
	(setf (slot-value entity 'body-cache)
	      (with-output-to-string (cache-stream)
		(with-open-stream (combined-stream
				   (make-broadcast-stream stream cache-stream))
		  (call-next-method entity combined-stream)))))))

(defclass cached-file-entity (cached-entity-mixin file-entity)
  ())