;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: imho -*-
;;; $Id: classes.lisp,v 1.19 2001/11/27 17:30:53 jesse Exp $
;;;
;;; Copyright (c) 1999, 2000, 2001 onShore Development, Inc.
;;;
;;; See the file 'COPYING' in this directory for terms.

(in-package :imho)

;; ------------------------------------------------------------
;; framework-class: application
;;
;; The 'application' encapsulates information common to all sessions
;; of an application, such as the path to templates for rendering
;; its html elements, and the application's public base URL.

(defclass application ()
  ((base-url
    :reader base-url
    :initarg :base-url
    :documentation
    "URL fragment at which this application can be accessed below
the HTTPD's mount point")
   (session-class
    :accessor application-session-class
    :initform 'http-session
    :initarg :session-class
    :documentation
    "symbol which names the type of the application's session class")
   (sessions
    :accessor application-sessions
    :initform (make-hash-table :test 'equal)
    :documentation
    "hashtable which contains all active sessions")
   (initial-method
    :initform nil
    :initarg :initial-method
    :documentation
    "symbol which names the application's initial method.  This method will be invoked if no target element is specified in the request, and should return an HTML-ELEMENT instance")
   (initial-element
    :initform nil
    :initarg :initial-element
    :documentation
    "symbol which names the application's initial element")
   (doc-root
    :accessor application-doc-root
    :initform nil
    :initarg :doc-root
    :documentation
    "location of HTML docs for this application's html-element
instances")
   (template-root
    :initform nil
    :initarg :template-root
    :documentation
    "location of HTML templates for this application's html-element
instances")
   (script-root
    :initform nil
    :initarg :script-root
    :documentation
    "location of JavaScript functions for inclusion with components.")
   (style-sheet
    :accessor application-style-sheet
    :initform nil
    :initarg :style-sheet
    :documentation
    "Global style sheet for application.")
   (templates
    :initform (make-hash-table :test 'equal))
   (scripts
    :initform (make-hash-table :test 'equal))
   (html-elements
    :accessor html-elements
    :initform (make-hash-table :test 'equal)
    :documentation
    "hashtable which contains all active html-elements")
   (timeout :accessor application-session-timeout
	    :initarg :application-session-timeout
	    :initform (* 60 120)
	    :documentation "Idle Timeout in seconds"))
  (:documentation
   "encapsulates information common to all sessions of an application,
E.g. where to find templates for rendering its html-elements, the
application's public URL"))


;; ------------------------------------------------------------
;; framework class: http-session

(defclass http-session ()
  ((session-id
    :accessor session-id
    :initarg :id)
   (session-html-elements
    :accessor session-html-elements
    :initform (make-hash-table :test 'equal))
   (session-instances
    :accessor session-instances
    :initform (make-hash-table :test 'equal))
   (session-application
    :accessor session-application
    :initarg :application
    :initform nil)
   (active-response
    :initform nil)
   (last-url
    :accessor last-url
    :initarg :last-url
    :initform nil
    :documentation
    "The last URL visited by this session's client.  This is really
here to support a 'go back' link from a help system page. I wonder if
this is the right way to do it.")
   (help-target
    :accessor help-target
    :initarg :help-target
    :initform "help-main")
   (timeout
    :accessor session-timeout
    :initarg :session-timeout
    :initform 300
    :documentation
    "Idle Timeout in seconds")
   (timestamp
    :accessor session-timestamp
    :initarg :session-timestamp
    :initform (get-universal-time)
    :documentation
    "Used for determining if session has timed-out"))
  (:documentation
   "A session encapsulates all required information about a set of
interactions with a client browser.  Subclasses should store
authentication data and other objects that persist across requests."))

(defmethod destroy-session ((self http-session))
  (slot-makunbound self 'session-id)
  (slot-makunbound self 'session-application)
  (slot-makunbound self 'active-response)
  (with-slots (session-html-elements session-instances)
    self
    (maphash (lambda (k v)
               (declare (ignore k))
               (destroy-element v)) session-html-elements)
    (clrhash session-html-elements)
    (maphash (lambda (k v)
               (declare (ignore k))
               (destroy-element v)) session-instances)
    (clrhash session-instances)))

;; hook for application-specific session classes to do initialization

(defgeneric start-session (t)
  (:documentation "Method called when a session is created, suitable for
specialization by application-specifics session classes."))
  
(defmethod start-session ((session http-session))
  t)

;; ------------------------------------------------------------
;; framework-structure: request

(defstruct (request (:print-function print-http-request))
  "A request object"
  (stream)
  (rid)
  (http-method)

  (protocol)
  (headers-in)
  (cookies-in)
  
  (mount-point)
  (application)
  (session)
  (caller)
  (callee)
  (method)
  (args)

  (client-content)

  (response-type "text/html")
  (response-element)
  (response-length)
  (response-body)
  (response-callback (error "no response callback supplied"))
  
  (binary nil)
  (div-elements nil)
  (html-stream (make-string-output-stream))
  (binary-stream (make-byte-array-output-stream))
  (headers-out *default-headers*)
  (body-attrs '((:onload  . "imho_init_instances();")))
  (doc-title "Untitled Page")
  (css-entries nil)
  (scripted-instances nil))

(defun destroy-request (request)
  (setf (request-stream request) nil
        (request-rid request) nil
        (request-http-method request) nil
        (request-protocol request) nil
        (request-headers-in request) nil
        (request-cookies-in request) nil
        (request-mount-point request) nil
        (request-application request) nil
        (request-session request) nil
        (request-caller request) nil
        (request-callee request) nil
        (request-method request) nil
        (request-args request) nil
        (request-client-content request) nil
        (request-response-type request) nil
        (request-response-length request) nil
        (request-response-body request) nil
        (request-binary request) nil
        (request-div-elements request) nil
        (request-html-stream request) nil
        (request-binary-stream request) nil
        (request-headers-out request) nil
        (request-body-attrs request) nil
        (request-doc-title request) nil
        (request-css-entries request) nil
        (request-scripted-instances request) nil))

(defun print-http-request (request stream depth)
  (declare (ignore depth))
  (print-unreadable-object
   (request stream :type t)
   (ignore-errors
     (format stream "~a/~a"
             (if-bind (app (request-application request))
                 (base-url app)
                 "***")
             (or (request-method request)
                 "***")))))

;; ------------------------------------------------------------
;; framework class: html-element
;;
;; This is the root of the html-element inheritance graph.
;;
;; Some classes to derive their rendering behavior from HTML templates
;; residing in the filesystem, and others from overriding
;; 'render-html'.

(defclass html-element ()
  ((element-external-name
    :reader element-external-name
    :initarg :element-external-name
    :initform (symbol-name (gensym "C"))
    :documentation
    "The externalized name of this html-element, for use in URLs or
interhtml-element references in HTML or client-side code. Guaranteed
unique.")
   (element-internal-name
    :accessor element-internal-name
    :initarg :element-internal-name
    :documentation
    "The name used by this html-element's parent to refer to it.")
   (value
    :initarg :value
    :initform nil
    :documentation
    "application 'value' of this html-element, returned by IMHO public
object protocol")
   (session
    :initarg :session
    :initform nil)
   (parent
    :accessor element-parent
    :initarg :parent
    :initform nil)
   (children
    :initform (make-hash-table)
    :documentation
    "A hashtable of children that are dynamically rendered by this
html-element; keys are the internal names of these children."))
  (:documentation
   "Base display html-element for applications")
  )

(defmethod destroy-element ((self html-element))
  (with-slots (children)
    self
    (maphash (lambda (k v)
               (declare (ignore k))
               (destroy-element v)) children)
    (clrhash children))
  (slot-makunbound self 'value)
  (slot-makunbound self 'parent)
  (slot-makunbound self 'session))

(defmethod print-object ((self html-element) stream)
  (print-unreadable-object
   (self stream :type t)
   (format stream "~s"
           (element-value self))))