[Update repo to modern changes
clinton@unknownlamer.org**20071231042429] {
addfile ./src/database.lisp
hunk ./src/database.lisp 1
-
+(in-package :com.tee-it-up-golf.db)
+
+;;; Interview Database
+
+(setf (logical-pathname-translations "golf")
+      '(("bdb;*"   "/home/clinton/misc/bdb/golf/*")
+	("audio;*" "/home/clinton/misc/audio-files/golf/*")))
+
+;; Database
+
+(defvar *db-spec* (list :bdb (translate-logical-pathname "golf:bdb;"))
+  "Location of the Elephant Database")
+
+(defvar *db-store* nil
+  "Connection to the Elephant database")
+
+(defun connect ()
+  (unless *db-store*
+    (setq *db-store* (open-store *db-spec*))))
+
+(defun disconnect ()
+  (when *db-store* 
+    (close-store *db-store*)
+    (if (eq *store-controller* *db-store*)
+	(setq *store-controller* nil))
+    (setq *db-store* nil)))
+
+(defun delete-database-objects (&rest objects)
+  (drop-instances objects))
+
+(defun delete-database-object (object)
+  (delete-database-objects object))
+
+;;; Audio Files
+
+;; TODO: check audio-file-type against list of known audio file types
+(defpclass audio-file ()
+  ((type :initarg :type :accessor audio-file-type)
+   (data :initarg :data :accessor raw-audio-data)
+   (path-name)))
+
+;; Audio File Protocol
+(defgeneric audio-data (audio-file)
+  (:documentation "Return the unsigned-byte array representing
+   the data of the audio-file"))
+
+(defgeneric (setf audio-data) (new-value audio-file)
+  (:documentation "Set the audio-data of the audio-file. The
+  new-value may be a stream, byte array, or file name."))
+
+(defgeneric audio-stream (audio-file)
+  (:documentation "Returns an unsigned-byte stream attached to
+  the audio-data of the audio-file"))
+
+(defgeneric audio-file-length (audio-file)
+  (:documentation "Return the length in bytes of the audio-file"))
+
+;; Protocol Implementation
+
+;; ;;; Elephant has issues with storing large byte streams so for now the
+;; ;;; original trivial implementation is not working, and the data must be
+;; ;;; stored in a file
+;; (defmethod audio-data ((file audio-file))
+;;   (raw-audio-data file))
+
+;; (defmethod (setf audio-data) ((new-value stream) (file audio-file))
+;;   (setf (audio-data file) (stream->bytes new-value)))
+
+;; (defmethod (setf audio-data) ((new-value simple-vector) (file audio-file))
+;;   (setf (raw-audio-data file) new-value))
+
+;; (defmethod (setf audio-data) ((new-value pathname) (file audio-file))
+;;   (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))
+
+;; (defmethod (setf audio-data) ((new-value string) (file audio-file))
+;;   (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))
+
+;; (defmethod audio-stream ((file audio-file))
+;;   (make-in-memory-input-stream (raw-audio-data file)))
+
+;; (defmethod audio-file-length ((file audio-file))
+;;   (length (raw-audio-data file)))
+
+;; Utilities
+
+(defun stream->bytes (stream)
+  (let ((byte-buffer (make-array
+		      (file-length stream)
+		      :element-type 'unsigned-byte)))
+    (read-sequence byte-buffer stream)
+    byte-buffer))
+
+;; Temporary utils
+
+(defun generate-audio-path-name ()
+  "Generate path name for audio files"
+  (make-pathname :host "golf"
+		 :directory "audio"
+		 :name (metabang.utilities:unique-file-name-from-date
+			"audio"
+			:type nil)))
+
+(defun audio-path-name (audio-file)
+  "Return pathname of audio file. Generates a new pathname if it does
+  not exist yet. The second return value is t if the pathname existed
+  before, and nil otherwise"
+  (if (slot-boundp audio-file 'path-name)
+      (values (slot-value audio-file 'path-name) t)
+      (values (setf (slot-value audio-file 'path-name)
+		    (generate-audio-path-name))
+	      nil)))
+
+(defun open-audio-file-stream (audio-file &rest keys)
+  (apply #'open (audio-path-name audio-file) keys))
+
+;;; Protocol Implementation (for current store data in a file scheme)
+
+(defmethod raw-audio-data ((file audio-file))
+  (stream->bytes (open-audio-file-stream)))
+
+(defmethod audio-data ((file audio-file))
+  (stream->bytes (open-audio-file-stream)))
+
+(defmethod (setf audio-data) ((new-value stream) (file audio-file))
+  (metabang.utilities:copy-file
+   (pathname new-value)
+   ;; Have to translate the pathname
+   ;; first because SBCL's
+   ;; ensure-directories-exist barfs on
+   ;; all logical pathnames for some
+   ;; reason
+   (translate-logical-pathname (audio-path-name file))
+   :if-exists :supersede))
+
+(defmethod (setf audio-data) ((new-value simple-vector) (file audio-file))
+  (fad:copy-stream (make-in-memory-input-stream new-value)
+		   (open-audio-file-stream file :direction :output
+					        :if-exists :overwrite
+						:if-does-not-exist :create)))
+
+(defmethod (setf audio-data) ((new-value pathname) (file audio-file))
+  (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))
+
+(defmethod (setf audio-data) ((new-value string) (file audio-file))
+  (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))
+
+(defmethod audio-stream ((file audio-file))
+  (open-audio-file-stream file))
+
+(defmethod audio-file-length ((file audio-file))
+  (file-length (open-audio-file-stream file)))
+
+;;; Shows
+
+(defpclass radio-show ()
+  ((show-title :initarg :title :accessor show-title
+	       :index t)
+   (show-date :initarg :date :accessor show-date
+	      :index t       :initform nil #|(get-universal-time)|#)
+   (audio :initarg :audio :accessor audio-data
+	  :initform nil   :type (or nil audio-file))
+   (transcript :initarg :transcript :accessor transcript :initform "")))
hunk ./src/packages.lisp 14
-   :content-length
-   :content-type
+   :audio-file-length
+   :audio-file-type
hunk ./tee-it-up.asd 16
-  :depends-on (:elephant :ucw :cms :flexi-streams :metatilities))
+  :depends-on (:elephant :ucw :flexi-streams :metatilities))
}