(in-package araneida)

(defclass legacy-handler (handler) ())

(defgeneric dispatch-request (request handlers &optional discriminator)
  (:documentation "Find the best match for REQUEST in the list HANDLERS"))
(defmethod dispatch-request ((request request) handlers &optional discriminator)
  (unless discriminator (setf discriminator (request-url request)))
  (destructuring-bind
        (method match prefix func &optional needs-discriminator)
      (find-export (urlstring discriminator) handlers (request-method request))
    (declare (ignore match))
    (unless method (return-from dispatch-request nil))
    (setf (request-base-url request) (parse-urlstring prefix))
    (let ((rest-of-url
           (subseq (urlstring discriminator)
                   (length (urlstring (request-base-url request)))
                   nil)))
      (cond ((and needs-discriminator (consp func))
             (apply (car func) request handlers discriminator
                    rest-of-url (cdr func)))
            ((consp func)
             (apply (car func) request rest-of-url (cdr func)))
            (needs-discriminator
             (funcall func request handlers discriminator rest-of-url))
            (t
             (funcall func request rest-of-url))))))


(defmethod handle-request-response ((handler legacy-handler) method request)
  (catch 'done
    (handler-bind ((stream-error
		    (lambda (c)
		      (format t "peer probably hung up:~A ~%" c)
		      (throw 'done nil)))
		   (error
		    (lambda (c)
		      (block nil
			(format t "got error! url=~A c=~A~%"
				(request-url request) c)
			(setf (slot-value request 'condition) c)
			(dispatch-request request :error)
			(throw 'done nil)))))
      (progn
	(dispatch-request request :authentication)
	(unless (open-stream-p (request-stream request)) (throw 'done nil))
	(dispatch-request request :authorization)
	(unless (open-stream-p (request-stream request))  (throw 'done nil))
	(dispatch-request request :response))))
  (let* ((s (request-stream request)))
    (forcibly-close-stream s))
  (dispatch-request request :log)
  t)