[Slight source reorganization
clinton@unknownlamer.org**20070823202959] {
addfile ./start.lisp
hunk ./src/golf.lisp 2
+
+;;; Interview Database
+
+;; Database
+
+(defvar *db-spec* '(:bdb #P"/home/clinton/misc/bdb/golf/")
+  "Location of the Elephant Database")
+
+(defvar *db-store* nil
+  "Connection to the Elephant database")
+
+(defun connect ()
+  (setq *db-store* (open-store *db-spec*)))
+
+(defun disconnect ()
+  (setq *db-store* (close-store *db-spec*)))
+
+;; Audio Files
+
+;; TODO: check content-type against list of known audio file types
+(defpclass audio-file ()
+  ((type :initarg :type :accessor content-type)
+   (data :initarg :data :accessor raw-audio-data)))
+
+(defmethod content-length ((file audio-file))
+  (length (raw-audio-data file)))
+
+(defmethod audio-file-stream ((file audio-file))
+  (make-in-memory-input-stream (raw-audio-data file)))
+
+;; Shows
+
+(defpclass radio-show ()
+  ((date :initarg :date :accessor show-date :index t :initform (get-universal-time))
+   (audio :initarg :audio :accessor audio-data
+	  :initform nil   :type (or nil audio-file))
+   (transcript :initarg :transcript :accessor transcript :initform "")))
+
+;;; Web Application
+
+(defclass golf-application (modular-application
+			    cookie-session-application-module
+			    cms:lame-cms-application-module)
+  ())
+
+;; Chooser
+
+(defcomponent choose-show ()
+  ((shows :initarg :shows :accessor shows)))
+
+(defmethod render ((self choose-show))
+  (<:ul
+   (mapc #'(lambda (show)
+	     (<:li (<ucw:a :action (call 'show-view :show show)
+			   (<:as-html (show-date show)))))
+	 (shows self))))
+
+;; Individual Viewer
+
+(defcomponent show-view ()
+  ((show :initarg :show :accessor radio-show)))
+
+(defaction edit-show ((show-viewer show-view))
+  (call 'show-editor-window
+   :editor (make-instance 'show-editor :show (radio-show show-viewer))))
+
+(defmethod render ((self show-view))
+  (<:div 
+   (<:h1
+    (<:as-html
+     (metabang.utilities:date-string (show-date (radio-show self)))))
+   (<:p (<:as-html (transcript (radio-show self))))
+   (<:p (format nil "Type: ~S" (content-type (audio-data (radio-show self)))))
+   (<:p (<ucw:a :action (edit-show self)
+		 (<:as-html "edit")))
+   (<:p (<ucw:a :action (play-file self (radio-show self))
+		 (<:as-html "play")))
+   (<:p (<ucw:a :action (ok self)
+		(<:as-html "answer")))))
+
+(defcomponent file-upload-form (simple-form)
+  ())
+
+(defmethod render :wrapping ((form simple-form))
+  (<ucw:form :id (ucw::dom-id form)
+	     :method (ucw::submit-method form)
+             :action (refresh-component form)
+             :class (ucw::css-class form)
+	     :style (ucw::css-style form)
+	     :enctype "multipart/form-data"
+    (call-next-method)))
+
+(defcomponent show-editor (file-upload-form)
+  ((show :initarg :show :accessor radio-show
+			:initform (make-instance 'radio-show))
+   (date :initform (make-instance 'mdy-date-field))
+   (audio-file :initform (make-instance 'file-upload-field))
+   (transcript :initform (make-instance 'textarea-field))))
+
+(defcomponent show-editor-window (simple-window-component)
+  ((show-editor :initarg :editor :initform (make-instance 'show-editor))))
+
+(defmethod render ((editor show-editor-window))
+  (render (slot-value editor 'show-editor))
+  (ok editor))
+
+(defmethod (setf value) ((new-time integer) (date date-field))
+  "Set date field from a universal-time"
+  (setf (value (ucw::year date)) (time-year new-time))
+  (setf (value (ucw::month date)) (time-month new-time))
+  (setf (value (ucw::day date)) (time-date new-time)))
+
+(defmethod initialize-instance :after ((editor show-editor) &rest keys)
+  (when (radio-show editor)
+    (with-slots (show date audio-file transcript)
+	editor
+      (setf (value date) (show-date show))
+      (setf (value transcript) (transcript show)))))
+
+(defaction update-show ((editor show-editor))
+  (with-slots (show date audio-file transcript)
+      editor
+    (setf (show-date show) (value date))
+    (if (value audio-file)
+	(setf (audio-data show) (make-instance 'audio-file
+				 :type (cdr (assoc "Content-Type" (mime-part-headers (value audio-file))
+					     :test #'string=))
+				 :data (stream->bytes (mime-part-body (value audio-file))))))
+    (setf (transcript show) (value transcript))))
+
+(defmethod render ((editor show-editor))
+  (with-slots (date audio-file transcript)
+      editor
+    (render date)
+    (render audio-file)
+    (render transcript)
+    (<ucw:submit :action (update-show editor))))
+
+;; Audio file streaming
+
+(defcomponent audio-file-window (window-component)
+  ((audio-file :initarg :audio-file :accessor audio-file)))
+
+(defmethod initialize-instance :after ((window audio-file-window)
+				       &rest keys)
+  (declare (ignore keys))
+  (setf (window-component.content-type window)
+	(content-type (audio-file window))))
+
+(defmethod render ((audio-window audio-file-window))
+  (setf (get-header (context.response *context*) "Content-Length")
+        (format nil "~D" (content-length (audio-file audio-window))))
+  (send-headers (context.response *context*))
+  (write-sequence (raw-audio-data (audio-file audio-window))
+		  (ucw::network-stream (context.response *context*))))
+
+(defaction play-file ((c t) (show radio-show))
+  (call 'audio-file-window
+   :audio-file (audio-data show)))
hunk ./src/packages.lisp 2
-  (:use :common-lisp)
-  (:nicknames :golf-web))
+  (:use :common-lisp :ucw :elephant)
+  (:import-from :flexi-streams :make-in-memory-input-stream)
+  (:import-from :metatilities :time-year :time-month :time-date)
+  (:nicknames :golf-web)
+  (:export
+   ;; Types
+   :golf-application
+   :choose-show
+   :show-editor-window
+   :audio-file-window
+   :audio-file
+   :connect
+   :disconnect))
+
+(defpackage :com.tee-it-up-golf.golf-user
+  (:use :common-lisp :golf-web :ucw)
+  (:nicknames :golf-user))
hunk ./src/packages.lisp 21
-  (:use :common-lisp :fiveam)
+  (:use :common-lisp)
hunk ./start.lisp 1
-
+(in-package :com.tee-it-up-golf.golf-user)
+
+;;; Initialize Application
+
+(defvar *golf-test-app*
+  (make-instance 'golf-application
+		 :url-prefix "/golf/"
+		 :www-roots (list '("dojo/"
+				    . #P"/home/clinton/src/ucw/darcs/ucw_ajax/wwwroot/dojo/"))))
+
+(defentry-point "^(choose.ucw|)$" (:application *golf-test-app*
+				   :class regexp-dispatcher)
+    ()
+  (call 'choose-show :shows (elephant:get-instances-by-class 'radio-show)))
+
+(defentry-point "^(edit.ucw|)$" (:application *golf-test-app*
+				 :class regexp-dispatcher)
+    ()
+  (call 'show-editor-window))
+
+(defun stream->bytes (stream)
+  (let ((byte-buffer (make-array
+		      (file-length stream)
+		      :element-type 'unsigned-byte)))
+    (read-sequence byte-buffer stream)
+    byte-buffer))
+
+(defentry-point "^(audio.ucw|)$" (:application *golf-test-app*
+				  :class regexp-dispatcher)
+    (file)
+  (call 'audio-file-window
+   :audio-file (make-instance 'audio-file
+		:type :vorbis
+		:data (file->bytes (open
+				    file
+				    :element-type 'unsigned-byte)))))
+
+(defentry-point "dojo/dojo.js" (:application *golf-test-app*
+				:class url-dispatcher)
+    ()
+  (ucw::serve-file #p"/home/clinton/local/var/wwwroot/dojo/dojo.js"
+		   (context.request *context*)
+		   (context.response *context*)))
+
+
+(defun start-site ()
+  (connect)
+  (ucw:create-server :backend '(:mod-lisp :port 3001
+					  :host "0.0.0.0")
+		     :applications (list *golf-test-app*)
+		     :log-level ucw::+dribble+))
hunk ./tee-it-up.asd 12
-			 (:file "tee-it-up")
+			 (:file "golf")
hunk ./tee-it-up.asd 15
-  :depends-on (:fiveam :elephant :ucw))
+  :depends-on (:elephant :ucw :cms :flexi-streams :metatilities))
}