re-factor to move all "file" operations into streams.lisp

base-file.lisp

@@ -1,96 +0,0 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: BASE-FILE; -*-
-;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
-
-(in-package #:base-file)
-
-(log5:defcategory cat-log-base-file)
-(defmacro log-base-file (&rest log-stuff) `(log5:log-for (cat-log-base-file) ,@log-stuff))
-
-(deftype octet () '(unsigned-byte 8))
-(defmacro make-octets (len) `(make-array ,len :element-type 'octet))
-
-(defclass base-file ()
-  ((filename  :accessor filename  :initarg :filename)
-   (instream  :accessor instream  :initform nil)
-   (endian    :accessor endian    :initarg :endian :initform nil)   ; controls endian-ness of read/writes
-   (modified  :accessor modified  :initform nil)					; for when we implement writing tags
-   (file-size :accessor file-size))
-  (:documentation "Base class for all audio file types"))
-
-(defmethod initialize-instance :after ((me base-file) &key read-only &allow-other-keys)
-  (log5:with-context "base-file-initializer"
-  (with-slots (instream filename file-size endian) me
-	(setf instream (if read-only
-					   (open filename :direction :input :element-type 'octet)
-					   (open filename :direction :io :if-exists :overwrite :element-type 'octet)))
-	(setf binary-types:*endian* endian)
-	(setf file-size (file-length instream))
-	(log-base-file "stream = ~a, name = ~a, size = ~:d~%endian = ~a"
-				   instream filename file-size endian))))
-
-(defmethod close-audio-file ((me base-file))
-  "Close an open file"
-  (with-slots (instream modified) me
-	(when modified
-	  (warn "at some point, should I add code to auto-write modified audio-files?")
-	  (setf modified nil))
-	(when instream
-	  (close instream)
-	  (setf instream nil))))
-
-(defmethod seek ((me base-file) offset from)
-  "C-library like seek function. from can be one of :current, :start, :end.
-Returns the current offset into the stream"
-  (assert (member from '(:current :start :end)) () "seek takes one of :current, :start, :end")
-  (with-slots (instream file-size) me
-	(ecase from
-	  (:start (file-position instream offset))
-	  (:current
-	   (let ((current (file-position instream)))
-		 (file-position instream (+ current offset))))
-	  (:end
-	   (file-position instream (- file-size offset))))))
-
-(defmethod read-u8 ((me base-file))
-  "read 1 byte from file"
-  (multiple-value-bind (value size) (binary-types:read-binary 'u8 (slot-value me 'instream))
-	(assert (= size 1) () "Expected to read 1 byte, got ~d instead" size)
-	value))
-
-(defmethod read-u16 ((me base-file))
-  "read 2 bytes from file"
-  (multiple-value-bind (value size) (binary-types:read-binary 'u16 (slot-value me 'instream))
-	(assert (= size 2) () "Expected to read 2 bytes, got ~d instead" size)
-	value))
-
-;;; read 3-bytes
-(binary-types:define-unsigned u24 3)
-
-(defmethod read-u24 ((me base-file))
-  "read 3 bytes from file"
-  (multiple-value-bind (value size) (binary-types:read-binary 'u24 (slot-value me 'instream))
-	(assert (= size 3) () "Expected to read 3 bytes, got ~d instead" size)
-	value))
-
-(defmethod read-u32 ((me base-file))
-  "read 4 bytes from file"
-  (multiple-value-bind (value size) (binary-types:read-binary 'u32 (slot-value me 'instream))
-	(assert (= size 4) () "Expected to read 4 bytes, got ~d instead" size)
-	value))
-
-(defmethod read-string ((me base-file) &key size (terminators nil))
-  "Read normal string from file. If size is provided, read exactly that many octets.
-If terminators is supplied, it is a list of characters that can terminate a string (and hence stop read)"
-  (multiple-value-bind (value read-size)
-	  (binary-types:read-binary-string (slot-value me 'instream) :size size :terminators terminators)
-	(declare (ignore read-size))
-	;; what checks should happen here?
-	value))
-
-(defmethod read-octets ((me base-file) size)
-  "Read SIZE octets from input-file"
-  (let* ((octets (make-octets size))
-		 (read-len (read-sequence octets (slot-value me 'instream))))
-	(assert (= read-len size))
-	octets))
-

logging.lisp

@@ -15,10 +15,9 @@
 
 
 (defparameter *logging-categories* '(mp4-atom::cat-log-mp4-atom
-									 mp4-file::cat-log-mp4-file
-									 base-file::cat-log-base-file
-									 mp3-frame::cat-log-mp3-frame
-									 mp3-file::cat-log-mp3-file))
+									 audio-streams::cat-log-stream
+									 mp3-frame::cat-log-mp3-frame))
+
 
 (defmacro with-logging ((&key (file nil) (categories *logging-categories*)) &body body)
   (alexandria:with-gensyms (output-stream)

mp3-file.lisp

@@ -1,40 +0,0 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: MP3-FILE; -*-
-;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
-
-(in-package :mp3-file)
-
-(log5:defcategory cat-log-mp3-file)
-
-(defmacro log-mp3-file (&rest log-stuff) `(log5:log-for (cat-log-mp3-file) ,@log-stuff))
-
-(defclass mp3-file (base-file:base-file)
-  ((header :accessor header :initform nil))
-  (:documentation "Class to access mp3 files"))
-
-(defun make-mp3-file (filename read-only &key)
-  "Convenience function to create an instance of MP3-FILE with appropriate init args.
-NB: we assume non-syncsafe as default"
-  (log5:with-context "make-mp3-file"
-	(log-mp3-file "opening ~a" filename)
-	(let (handle)
-	  (handler-case 
-		  (progn
-			(setf handle (make-instance 'mp3-file :filename filename :endian :little-endian :read-only read-only))
-			(with-slots (header) handle
-			  (log-mp3-file "getting frames")
-			  (setf header (mp3-frame:find-mp3-frames handle))))
-		(condition (c)
-		  (warn "make-mp3-file got condition: ~a" c)
-		  (when handle (base-file:close-audio-file handle))
-		  (setf handle nil)))
-	  handle)))
-
-(defmethod read-sync-safe-u32 ((me mp3-file))
-  "Read a sync-safe integer from file.  Used by mp3 files"
-  (let* ((ret 0))
-	(setf (ldb (byte 7 21) ret) (base-file:read-u8 me))
-	(setf (ldb (byte 7 14) ret) (base-file:read-u8 me))
-	(setf (ldb (byte 7 7) ret)  (base-file:read-u8 me))
-	(setf (ldb (byte 7 0) ret)  (base-file:read-u8 me))
-	ret))
-

mp3-frame.lisp

@@ -38,13 +38,13 @@
 (defun is-valid-mp3-file (mp3-file)
   "Make sure this is an MP3 file. Look for frames at begining and/or end"
   (log5:with-context "is-valid-mp3-file"
-	(seek mp3-file 0 :start)
-	(let* ((id3 (read-string mp3-file :size 3))
-		   (version (read-u8 mp3-file))
+	(stream-seek mp3-file 0 :start)
+	(let* ((id3 (stream-read-string mp3-file :size 3))
+		   (version (stream-read-u8 mp3-file))
 		   (tag))
-	  (seek mp3-file 128 :end)
-	  (setf tag (read-string mp3-file :size 3))
-	  (seek mp3-file 0 :start)
+	  (stream-seek mp3-file 128 :end)
+	  (setf tag (stream-read-string mp3-file :size 3))
+	  (stream-seek mp3-file 0 :start)
 
 	  (log-mp3-frame "id3 = ~a, version = ~d" id3 version)
 
@@ -74,16 +74,16 @@
 				songname artist album year comment genre))))
 
 (defmethod initialize-instance ((me v21-tag-header) &key instream)
-  "Read in a V2.1 tag.  Caller will have seek'ed file to correct location and ensured that TAG was present"
+  "Read in a V2.1 tag.  Caller will have stream-seek'ed file to correct location and ensured that TAG was present"
   (log5:with-context "v21-frame-initializer"
 	(log-mp3-frame "reading v2.1 tag")
 	(with-slots (songname artist album year comment genre) me
-	  (setf songname (read-string instream :size 30 :terminators '(0)))
-	  (setf artist   (read-string instream :size 30 :terminators '(0)))
-	  (setf album    (read-string instream :size 30 :terminators '(0)))
-	  (setf year     (read-string instream :size 4  :terminators '(0)))
-	  (setf comment  (read-string instream :size 30 :terminators '(0)))
-	  (setf genre    (read-u8 instream))
+	  (setf songname (stream-read-string instream :size 30 :terminators '(0)))
+	  (setf artist   (stream-read-string instream :size 30 :terminators '(0)))
+	  (setf album    (stream-read-string instream :size 30 :terminators '(0)))
+	  (setf year     (stream-read-string instream :size 4  :terminators '(0)))
+	  (setf comment  (stream-read-string instream :size 30 :terminators '(0)))
+	  (setf genre    (stream-read-u8 instream))
 	  (log-mp3-frame "v21 tag: ~a" (vpprint me nil)))))
 
 (defclass mp3-ext-header ()
@@ -101,13 +101,13 @@
 (defmacro ext-header-crc-p (flags)	 `(logbitp 15 ,flags))
 
 (defmethod initialize-instance ((me mp3-ext-header) &key instream)
-  "Read in the extended header.  Caller will have seek'ed to correct location in file."
+  "Read in the extended header.  Caller will have stream-seek'ed to correct location in file."
   (with-slots (size flags padding crc) me
-	(setf size (read-u32 instream))
-	(setf flags (read-u16 instream))
-	(setf padding (read-u32 instream))
+	(setf size (stream-read-u32 instream))
+	(setf flags (stream-read-u16 instream))
+	(setf padding (stream-read-u32 instream))
 	(when (ext-header-crc-p flags)
-	  (setf crc (read-u32 instream)))))
+	  (setf crc (stream-read-u32 instream)))))
 
 (defmethod print-object ((me mp3-ext-header) stream)
   (if (null *pprint-mp3-frame*)
@@ -148,20 +148,20 @@
   "Fill in an mp3-header from file."
   (log5:with-context "mp3-id3-header-initializer"
 	(with-slots (version revision flags size ext-header frames v21-tag-header) me
-	  (seek instream 128 :end)
-	  (when (string= "TAG" (read-string instream :size 3))
-		(log-mp3-frame "looking at last 128 bytes at ~:d to try to read id3v21 header" (seek instream 0 :current))
+	  (stream-seek instream 128 :end)
+	  (when (string= "TAG" (stream-read-string instream :size 3))
+		(log-mp3-frame "looking at last 128 bytes at ~:d to try to read id3v21 header" (stream-seek instream 0 :current))
 		(handler-case
 			(setf v21-tag-header (make-instance 'v21-tag-header :instream instream))
 		  (condition (c)
 			(log-mp3-frame "reading v21 got condition: ~a" c))))
 
-	  (seek instream 0 :start)
-	  (when (string= "ID3" (read-string instream :size 3))
-		(setf version (read-u8 instream))
-		(setf revision (read-u8 instream))
-		(setf flags (read-u8 instream))
-		(setf size (mp3-file:read-sync-safe-u32 instream))
+	  (stream-seek instream 0 :start)
+	  (when (string= "ID3" (stream-read-string instream :size 3))
+		(setf version (stream-read-u8 instream))
+		(setf revision (stream-read-u8 instream))
+		(setf flags (stream-read-u8 instream))
+		(setf size (stream-read-sync-safe-u32 instream))
 		(when (header-unsynchronized-p flags) (log-mp3-frame "unsync"))
 		(assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet")
 		(when (header-extended-p flags)
@@ -232,8 +232,8 @@
 (defmethod initialize-instance :after ((me raw-frame) &key instream)
   (log5:with-context "raw-frame"
 	(with-slots (len octets) me
-	  (log-mp3-frame "reading ~:d bytes from position ~:d" len (seek instream 0 :current))
-	  (setf octets (read-octets instream len)))))
+	  (log-mp3-frame "reading ~:d bytes from position ~:d" len (stream-seek instream 0 :current))
+	  (setf octets (stream-read-octets instream len)))))
 
 (defmethod print-object :after ((me raw-frame) stream)
   (if (null *pprint-mp3-frame*)
@@ -244,40 +244,6 @@
 			   (printable-array (make-array print-len :displaced-to (slot-value me 'octets))))
 		  (format stream "[~:d of ~:d bytes] <~x>" print-len len printable-array)))))
 
-(defun find-id3-frames (header instream)
-  "Loop thru all the frames in INSTREAM based on information from HEADER"
-  (labels ((read-and-de-sync (instream len)
-			 "Used to undo sync-safe when the header says false syncs have been removed from the tags"
-			 (let* ((last-byte-was-FF nil)
-					(byte nil)
-					(synced-frame-data (with-binary-output-to-vector (out)
-										 (dotimes (i len)
-										   (setf byte (read-byte instream))
-										   (if last-byte-was-FF
-											   (if (not (zerop byte))
-												   (write-byte byte out))
-											   (write-byte byte out))
-										   (setf last-byte-was-FF (= byte #xFF))))))
-			   synced-frame-data)))
-
-	(log5:with-context "find-id3-frames"
-	  nil)))
-
-;; 	  (let ((mem-stream)
-;; 			(first-byte))
-;; 		(if (header-unsynchronized-p header)
-;; 			(setf mem-stream (read-and-desync instream (size header)))
-;; 	   (log-mp3-frame "Looking for frames: header = ~a, starting position = ~:d" (mp3-frame:vpprint header nil) (seek instream 0 :current))
-;; 	 (loop
-;; 	   (let ((first-byte (read-u8 instream)))
-;; 		 (when (
-;; ;	 (if (header-unsynchronized-p (flags header))
-;; 	 (do* ((pos (seek instream 0 :current))
-;; 		   (frame)
-;; 		   (end (+ pos (size header))))
-;; 		  ((>= pos end))
-
-;; 	nil))
 
 (defun find-mp3-frames (mp3-file)
   "With an open mp3-file, make sure it is in fact an MP3 file, then read it's header and frames, returning both"
@@ -286,10 +252,27 @@
 	  (log-mp3-frame "~a is not an mp3 file" (filename mp3-file))
 	  (error 'mp3-frame-condition :location "find-mp3-frames" :object (filename mp3-file) :message "is not an mp3 file"))
 
- 	(log-mp3-frame "~a is a valid mp3 file" (filename mp3-file))
-
-	(let* ((header (make-instance 'mp3-id3-header :instream mp3-file))
-		   (frames (find-id3-frames header mp3-file)))
-	  (log-mp3-frame "Header: ~a, frames = ~a" header frames)
-	  (setf (slot-value header 'frames) frames))))
-
+	(log-mp3-frame "~a is a valid mp3 file" (filename mp3-file))
+
+	(let ((header (make-instance 'mp3-id3-header :instream mp3-file))
+		  (mem-stream)
+		  (this-frame)
+		  (frames))
+	  (declare (ignore mem-stream this-frame frames))
+	  (setf (slot-value mp3-file 'mp3-header) header)
+	  (assert header () "Must have a header to continue!")
+	  header)))
+
+	  ;; (if (header-unsynchronized-p header)
+	  ;; 	  (setf mem-stream (stream-read-sync-safe-octets instream (size header)))
+	  ;; 		(setf mem-stream instream))
+
+	  ;; 	;; NB from this point, always read from mem-stream (see IF above)
+	  ;; 	(block read-loop
+	  ;; 	  (loop
+	  ;; 		(setf this-frame (make-frame header mem-stream))
+	  ;; 		(when (null this-frame)
+	  ;; 		  (return-from read-loop nil))
+	  ;; 		(push this-frame frames)))
+	  ;; 	(setf (slot-value (slot-value mp3-header 'header) 'frames) frames)
+	  ;; 	(log-mp3-frame "~a" (vpprint (slot-value mp3-header 'header) nil))))))

mp3-tag.lisp

@@ -2,5 +2,5 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:mp3-tag)
 
-(defmethod show-tags ((me mp3-file:mp3-file))
-  (format t "~a:~a~%" (base-file:filename me) (mp3-frame:vpprint (mp3-file:header me) nil)))
+(defmethod show-tags ((me mp3-stream))
+  (format t "~a:~a~%" (filename me) (mp3-frame:vpprint (audio-streams:mp3-header me) nil)))

mp4-atom.lisp

@@ -123,7 +123,7 @@
 	(let ((methods))
 	  (dolist (type *itunes-text-atom-types*)
 		(push `(defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql ,type)) mp4-file)
-				 (read-string mp4-file :size (- (atom-size atom) 16))) methods))
+				 (stream-read-string mp4-file :size (- (atom-size atom) 16))) methods))
 	  `(progn ,@methods)))
   )
 
@@ -132,50 +132,50 @@
 (defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-disk+)) mp4-file)
   "decode itunes DISK atom"
   (declare (ignore atom))
-  (read-u16 mp4-file)					; throw away
+  (stream-read-u16 mp4-file)					; throw away
   (let ((a) (b))
-	(setf a (read-u16 mp4-file))
-	(setf b (read-u16 mp4-file))
+	(setf a (stream-read-u16 mp4-file))
+	(setf b (stream-read-u16 mp4-file))
 	(list a b)))
 
 (defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-track+)) mp4-file)
   "decode itunes TRK atom"
   (declare (ignore atom))
-  (read-u16 mp4-file)					; throw away
+  (stream-read-u16 mp4-file)					; throw away
   (let ((a) (b))
-	(setf a (read-u16 mp4-file))
-	(setf b (read-u16 mp4-file))
-	(read-u16 mp4-file)					; throw away
+	(setf a (stream-read-u16 mp4-file))
+	(setf b (stream-read-u16 mp4-file))
+	(stream-read-u16 mp4-file)					; throw away
 	(list a b)))
 
 (defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-track-n+)) mp4-file)
   "decode itunes TRKN atom"
   (declare (ignore atom))
-  (read-u16 mp4-file)					; throw away
+  (stream-read-u16 mp4-file)					; throw away
   (let ((a) (b))
-	(setf a (read-u16 mp4-file))
-	(setf b (read-u16 mp4-file))
-	(read-u16 mp4-file)					; throw away
+	(setf a (stream-read-u16 mp4-file))
+	(setf b (stream-read-u16 mp4-file))
+	(stream-read-u16 mp4-file)					; throw away
 	(list a b)))
 
 (defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-tempo+)) mp4-file)
   "decode itunes TMPO atom"
   (declare (ignore atom))
-  (read-u16 mp4-file))
+  (stream-read-u16 mp4-file))
 
 (defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-genre+)) mp4-file)
   "decode itunes GNRE atom"
   (declare (ignore atom))
-  (read-u16 mp4-file))
+  (stream-read-u16 mp4-file))
 
 (defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-compilation+)) mp4-file)
   "decode itunes CPIL atom"
   (declare (ignore atom))
-  (read-u8 mp4-file))
+  (stream-read-u8 mp4-file))
 
 (defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-cover-art+)) mp4-file)
   (let ((blob (make-instance 'mp4-unhandled-data)))
-	(setf (slot-value blob 'blob) (read-octets mp4-file (- (atom-size atom) 16)))
+	(setf (slot-value blob 'blob) (stream-read-octets mp4-file (- (atom-size atom) 16)))
 	blob))
 
 
@@ -194,13 +194,13 @@
   (log5:with-context "mp4-ilst-atom-initializer"
 	(assert (not (null mp4-file)) () "Must pass a stream into this method")
 	(with-slots (atom-size atom-type atom-children) me
-	  (let* ((start (seek mp4-file 0 :current))
+	  (let* ((start (stream-seek mp4-file 0 :current))
 			 (end (+ start (- atom-size 8))))
 		(log-mp4-atom "mp4-ilst-atom-initializer:entry, start = ~:d, end = ~:d" start end)
 		(do* ()
-			 ((>= (seek mp4-file 0 :current) end))
+			 ((>= (stream-seek mp4-file 0 :current) end))
 		  (log-mp4-atom "ilst atom top of loop: start = ~:d, current = ~:d, end = ~:d"
-						start (seek mp4-file 0 :current) end)
+						start (stream-seek mp4-file 0 :current) end)
 		  (let ((child (make-mp4-atom mp4-file atom-type)))
 			 (log-mp4-atom "adding new child ~a" (vpprint child nil))
 			 (add atom-children child)))))
@@ -218,10 +218,10 @@
 	 (assert (not (null mp4-file)) () "Must pass a stream into this method")
 	 (log-mp4-atom "mp4-ilst-generic-data-atom-initializer:entry")
 	 (with-slots (atom-size atom-type atom-version atom-flags atom-value atom-parent-type) me
-	   (setf atom-version (read-u8 mp4-file))
-	   (setf atom-flags (read-u24 mp4-file))
+	   (setf atom-version (stream-read-u8 mp4-file))
+	   (setf atom-flags (stream-read-u24 mp4-file))
 	   (if (= atom-type +itunes-ilst-data+)
-		   (assert (= 0 (read-u32 mp4-file)) () "a data atom lacks the required null field"))
+		   (assert (= 0 (stream-read-u32 mp4-file)) () "a data atom lacks the required null field"))
 	   (log-mp4-atom "size = ~:d, name = ~a, version = ~d, flags = ~x"
 					 atom-size (as-string atom-type) atom-version atom-flags)
 	   (setf atom-value (decode-ilst-data-atom atom-type me atom-parent-type mp4-file))
@@ -243,18 +243,18 @@
 	  (log-mp4-atom "type ~a is container atom of interest; read the nested atoms" (as-string atom-type))
 	  (cond ((= atom-type +mp4-atom-meta+)
 			 (log-mp4-atom "got META, moving file position forward 4 bytes") ;null field
-			 (seek mp4-file 4 :current)))
+			 (stream-seek mp4-file 4 :current)))
 
 	  ;; we are now at the file-position we are need to be at, so start reading those atoms!
-	  (block read-file
-		(log-mp4-atom "starting read-file block with file-position = ~:d and end = ~:d" atom-file-position (+ atom-file-position atom-size))
+	  (block stream-read-file
+		(log-mp4-atom "starting stream-read-file block with file-position = ~:d and end = ~:d" atom-file-position (+ atom-file-position atom-size))
 		(do ()
-			((>= (seek mp4-file 0 :current) (+ atom-file-position atom-size)))
-		  (log-mp4-atom "Top of loop: currently at file-position ~:d (reading up to ~:d)" (seek mp4-file 0 :current) (+ atom-file-position atom-size))
+			((>= (stream-seek mp4-file 0 :current) (+ atom-file-position atom-size)))
+		  (log-mp4-atom "Top of loop: currently at file-position ~:d (reading up to ~:d)" (stream-seek mp4-file 0 :current) (+ atom-file-position atom-size))
 		  (let ((child (make-mp4-atom mp4-file)))
 			(log-mp4-atom "adding new child ~a" (vpprint child nil))
 			(add atom-children child))))
-	  (log-mp4-atom "ended read-file block, file position now ~:d" (seek mp4-file 0 :current)))))
+	  (log-mp4-atom "ended stream-read-file block, file position now ~:d" (stream-seek mp4-file 0 :current)))))
 
 (defun make-mp4-atom (mp4-file &optional atom-parent-type)
   "Get current file position, read in size/type, then construct the correct atom.
@@ -262,9 +262,9 @@
  leave file position as is, since caller will want to read in nested atoms.  Otherwise,
  seek forward past end of this atom."
   (log5:with-context "make-mp4-atom"
-	(let* ((pos (seek mp4-file 0 :current))
-		   (siz (read-u32 mp4-file))
-		   (typ (read-u32 mp4-file))
+	(let* ((pos (stream-seek mp4-file 0 :current))
+		   (siz (stream-read-u32 mp4-file))
+		   (typ (stream-read-u32 mp4-file))
 		   (atom))
 	  (declare (type integer pos siz typ))
 	  (when (= 0 siz)
@@ -283,7 +283,7 @@
 			(t
 			 (log-mp4-atom "~a is an atom we are NOT interested in; seek past it" (as-string typ))
 			 (setf atom (make-instance 'mp4-atom :atom-size siz :atom-type typ :atom-file-position pos))
-			 (seek mp4-file (- siz 8) :current)))
+			 (stream-seek mp4-file (- siz 8) :current)))
 	  (log-mp4-atom "returning ~a" (vpprint atom nil))
 	  atom)))
 
@@ -350,11 +350,11 @@
 
 (defun is-valid-m4-file (mp4-file)
   "Make sure this is an MP4 file.  Quick check: is first atom (at file-offset 4) == FSTYP?"
-  (seek mp4-file 0 :start)
-  (let* ((size (read-u32 mp4-file))
-		 (header (read-u32 mp4-file)))
+  (stream-seek mp4-file 0 :start)
+  (let* ((size (stream-read-u32 mp4-file))
+		 (header (stream-read-u32 mp4-file)))
 	(declare (ignore size))
-	(seek mp4-file 0 :start)
+	(stream-seek mp4-file 0 :start)
 	(= header +m4-ftyp+)))
 
 (defun find-mp4-atoms (mp4-file)
@@ -367,11 +367,11 @@ The 'right' atoms are those in *atoms-of-interest*"
 	(let ((atom-collection (make-mp4-atom-collection))
 		  (new-atom))
 
-	  (log-mp4-atom "before read-file loop, file-position = ~:d, end = ~:d" (seek mp4-file 0 :current) (file-size mp4-file))
-	  (block read-file
+	  (log-mp4-atom "before read-file loop, file-position = ~:d, end = ~:d" (stream-seek mp4-file 0 :current) (file-size mp4-file))
+	  (block stream-read-file
 		(do ()
-			((> (+ 8 (seek mp4-file 0 :current)) (file-size mp4-file)))
-		  (log-mp4-atom "top of read-file loop, current file-position = ~:d, end = ~:d" (seek mp4-file 0 :current) (file-size mp4-file))
+			((> (+ 8 (stream-seek mp4-file 0 :current)) (file-size mp4-file)))
+		  (log-mp4-atom "top of read-file loop, current file-position = ~:d, end = ~:d" (stream-seek mp4-file 0 :current) (file-size mp4-file))
 		  (setf new-atom (make-mp4-atom mp4-file))
 		  (add atom-collection new-atom)))
 	  (log-mp4-atom "returning atom-collection of size ~d" (size atom-collection))

mp4-file.lisp

@@ -1,27 +0,0 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: MP4-FILE; -*-
-;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
-(in-package #:mp4-file)
-
-(log5:defcategory cat-log-mp4-file)
-(defmacro log-mp4-file (&rest log-stuff) `(log5:log-for (cat-log-mp4-file) ,@log-stuff))
-
-(defclass mp4-file (base-file:base-file)
-  ((atoms :accessor atoms :initform nil))
-  (:documentation "Class to access m4a/mp4 files"))
-
-(defun make-mp4-file (filename read-only &key)
-  "Convenience function to create an instance of MP4-FILE with appropriate init args"
-  (log5:with-context "make-mp4-file"
-	(log-mp4-file "opening ~a" filename)
-	(let (handle)
-	  (handler-case 
-		  (progn
-			(setf handle (make-instance 'mp4-file :filename filename :endian :big-endian :read-only read-only))
-			(with-slots (atoms) handle
-			  (log-mp4-file "getting atoms")
-			  (setf atoms (mp4-atom:find-mp4-atoms handle))))
-		(condition (c)
-		  (warn "make-mp4-file got condition: ~a" c)
-		  (when handle (base-file:close-audio-file handle))
-		  (setf handle nil)))
-	  handle)))

mp4-tag.lisp

@@ -2,44 +2,44 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:mp4-tag)
 
-(defmethod album ((me mp4-file:mp4-file))          (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-album+))
-(defmethod album-artist ((me mp4-file:mp4-file))   (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-album-artist+))
-(defmethod artist ((me mp4-file:mp4-file))         (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-artist+))
-(defmethod comment ((me mp4-file:mp4-file))        (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-comment+))
-(defmethod composer ((me mp4-file:mp4-file))       (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-composer+))
-(defmethod copyright ((me mp4-file:mp4-file))      (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-copyright+))
-(defmethod year ((me mp4-file:mp4-file))           (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-year+))
-(defmethod encoder ((me mp4-file:mp4-file))        (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-encoder+))
-(defmethod groups ((me mp4-file:mp4-file))         (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-groups+))
-(defmethod lyrics ((me mp4-file:mp4-file))         (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-lyrics+))
-(defmethod purchased-date ((me mp4-file:mp4-file)) (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-purchased-date+))
-(defmethod title ((me mp4-file:mp4-file))          (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-title+))
-(defmethod tool ((me mp4-file:mp4-file))           (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-tool+))
-(defmethod writer ((me mp4-file:mp4-file))         (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-writer+))
+(defmethod album ((me mp4-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album+))
+(defmethod album-artist ((me mp4-stream))   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album-artist+))
+(defmethod artist ((me mp4-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-artist+))
+(defmethod comment ((me mp4-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-comment+))
+(defmethod composer ((me mp4-stream))       (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-composer+))
+(defmethod copyright ((me mp4-stream))      (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-copyright+))
+(defmethod year ((me mp4-stream))           (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-year+))
+(defmethod encoder ((me mp4-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-encoder+))
+(defmethod groups ((me mp4-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-groups+))
+(defmethod lyrics ((me mp4-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-lyrics+))
+(defmethod purchased-date ((me mp4-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-purchased-date+))
+(defmethod title ((me mp4-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-title+))
+(defmethod tool ((me mp4-stream))           (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-tool+))
+(defmethod writer ((me mp4-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-writer+))
 
-(defmethod compilation ((me mp4-file:mp4-file))    (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-compilation+))
-(defmethod disk  ((me mp4-file:mp4-file))          (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-disk+))
-(defmethod tempo ((me mp4-file:mp4-file))          (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-tempo+))
-(defmethod genre ((me mp4-file:mp4-file))
-  (let ((genre   (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-genre+))
-		(genre-x (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-genre-x+)))
+(defmethod compilation ((me mp4-stream))    (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-compilation+))
+(defmethod disk  ((me mp4-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-disk+))
+(defmethod tempo ((me mp4-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-tempo+))
+(defmethod genre ((me mp4-stream))
+  (let ((genre   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre+))
+		(genre-x (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre-x+)))
 	(assert (not (and genre genre-x)))
 	(cond
 	  (genre (tag:get-genre-text genre))
 	  (genre-x (tag:get-genre-text genre-x))
 	  (t nil))))
 
-(defmethod track ((me mp4-file:mp4-file))
-  (let ((track   (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-track+))
-		(track-n (mp4-atom:tag-get-value (mp4-file:atoms me) mp4-atom:+itunes-track-n+)))
+(defmethod track ((me mp4-stream))
+  (let ((track   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track+))
+		(track-n (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track-n+)))
 	(assert (not (and track track-n)))
 	(if track
 		track
 		track-n)))
 
-(defmethod show-tags ((me mp4-file:mp4-file))
+(defmethod show-tags ((me mp4-stream))
   "Show the understood tags for MP4-FILE"
-  (format t "~a~%" (base-file:filename me))
+  (format t "~a~%" (filename me))
   (let ((album (album me))
 		(album-artist (album-artist me))
 		(artist (artist me))

packages.lisp

@@ -2,21 +2,18 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:cl-user)
 
-(defpackage #:base-file
-  (:export #:close-audio-file #:octets #:make-octets #:base-file
+(defpackage #:audio-streams
+  (:export #:octets #:make-octets
+		   #:base-stream
 		   #:filename #:instream #:file-size #:endian
-		   #:read-u8 #:read-u16 #:read-u24 #:read-u32
-		   #:read-string #:read-octets #:seek)
+		   #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32
+		   #:stream-read-string #:stream-read-octets
+		   #:stream-seek #:stream-close
+		   #:mp4-stream #:make-mp4-stream #:mp4-atoms
+		   #:mp3-stream #:make-mp3-stream #:mp3-header
+		   #:stream-read-sync-safe-u32 #:stream-read-sync-safe-octets)
   (:use #:common-lisp #:binary-types))
 
-(defpackage #:mp4-file
-  (:export #:mp4-file #:make-mp4-file #:atoms)
-  (:use #:common-lisp))
-
-(defpackage #:mp3-file
-  (:export #:mp3-file #:make-mp3-file #:header #:read-sync-safe-u32)
-  (:use #:common-lisp))
-
 (defpackage #:mp4-atom
   (:export #:mp4-atom #:map-mp4-atom #:find-mp4-atoms #:traverse #:mp4-atom-condition
 		   #:atom-file-position #:atom-children #:atom-size #:atom-of-interest #:atom-decoded
@@ -43,15 +40,15 @@
 		   #:+itunes-tempo+
 		   #:+itunes-track+
 		   #:+itunes-track-n+)
-  (:use #:common-lisp #:binary-types #:base-file))
+  (:use #:common-lisp #:binary-types #:audio-streams))
 
 (defpackage :mp3-frame
   (:export :mp3-frame #:find-mp3-frames #:mp3-frame-condition #:vpprint #:header)
-  (:use :common-lisp :binary-types :base-file))
+  (:use :common-lisp :binary-types :audio-streams))
 
 (defpackage :mp3-tag
   (:export :show-tags)
-  (:use :common-lisp :binary-types :base-file))
+  (:use :common-lisp :binary-types :audio-streams))
 
 (defpackage #:tag
   (:export #:get-genre-text)
@@ -60,7 +57,7 @@
 (defpackage #:mp4-tag
   (:export #:show-tags #:album #:album-artist #:artist #:comment #:composer #:copyright #:created
 		   #:encoder #:groups #:lyrics #:purd #:title #:tool #:writer)
-  (:use #:common-lisp))
+  (:use #:common-lisp #:audio-streams))
 
 (defpackage #:logging
   (:export #:with-logging)

streams.lisp

@@ -0,0 +1,172 @@
+;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: STREAMS; -*-
+;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
+
+(in-package #:audio-streams)
+
+(log5:defcategory cat-log-stream)
+(defmacro log-stream (&rest log-stuff) `(log5:log-for (cat-log-stream) ,@log-stuff))
+
+(deftype octet () '(unsigned-byte 8))
+(defmacro make-octets (len) `(make-array ,len :element-type 'octet))
+
+(defclass base-stream ()
+  ((filename  :accessor filename  :initarg :filename)
+   (instream  :accessor instream  :initform nil)
+   (endian    :accessor endian    :initarg :endian :initform nil)   ; controls endian-ness of read/writes
+   (modified  :accessor modified  :initform nil)					; for when we implement writing tags
+   (file-size :accessor file-size))
+  (:documentation "Base class for all audio file types"))
+
+(defmethod initialize-instance :after ((me base-stream) &key read-only &allow-other-keys)
+  (log5:with-context "base-stream-initializer"
+  (with-slots (instream filename file-size endian) me
+	(setf instream (if read-only
+					   (open filename :direction :input :element-type 'octet)
+					   (open filename :direction :io :if-exists :overwrite :element-type 'octet)))
+	(setf binary-types:*endian* endian)
+	(setf file-size (file-length instream))
+	(log-stream "stream = ~a, name = ~a, size = ~:d~%endian = ~a"
+				   instream filename file-size endian))))
+
+(defmethod stream-close ((me base-stream))
+  "Close an open stream."
+  (with-slots (instream modified) me
+	(when modified
+	  (warn "at some point, should I add code to auto-write modified audio-files?")
+	  (setf modified nil))
+	(when instream
+	  (close instream)
+	  (setf instream nil))))
+
+(defmethod stream-seek ((me base-stream) offset from)
+  "C-library like seek function. from can be one of :current, :start, :end.
+Returns the current offset into the stream"
+  (assert (member from '(:current :start :end)) () "seek takes one of :current, :start, :end")
+  (with-slots (instream file-size) me
+	(ecase from
+	  (:start (file-position instream offset))
+	  (:current
+	   (let ((current (file-position instream)))
+		 (file-position instream (+ current offset))))
+	  (:end
+	   (file-position instream (- file-size offset))))))
+
+(defmethod stream-read-u8 ((me base-stream))
+  "read 1 byte from file"
+  (multiple-value-bind (value size) (binary-types:read-binary 'u8 (slot-value me 'instream))
+	(assert (= size 1) () "Expected to read 1 byte, got ~d instead" size)
+	value))
+
+(defmethod stream-read-u16 ((me base-stream))
+  "read 2 bytes from file"
+  (multiple-value-bind (value size) (binary-types:read-binary 'u16 (slot-value me 'instream))
+	(assert (= size 2) () "Expected to read 2 bytes, got ~d instead" size)
+	value))
+
+;;; read 3-bytes
+(binary-types:define-unsigned u24 3)
+
+(defmethod stream-read-u24 ((me base-stream))
+  "read 3 bytes from file"
+  (multiple-value-bind (value size) (binary-types:read-binary 'u24 (slot-value me 'instream))
+	(assert (= size 3) () "Expected to read 3 bytes, got ~d instead" size)
+	value))
+
+(defmethod stream-read-u32 ((me base-stream))
+  "read 4 bytes from file"
+  (multiple-value-bind (value size) (binary-types:read-binary 'u32 (slot-value me 'instream))
+	(assert (= size 4) () "Expected to read 4 bytes, got ~d instead" size)
+	value))
+
+(defmethod stream-read-string ((me base-stream) &key size (terminators nil))
+  "Read normal string from file. If size is provided, read exactly that many octets.
+If terminators is supplied, it is a list of characters that can terminate a string (and hence stop read)"
+  (multiple-value-bind (value read-size)
+	  (binary-types:read-binary-string (slot-value me 'instream) :size size :terminators terminators)
+	(declare (ignore read-size))
+	;; what checks should happen here?
+	value))
+
+(defmethod stream-read-octets ((me base-stream) size)
+  "Read SIZE octets from input-file"
+  (let* ((octets (make-octets size))
+		 (read-len (read-sequence octets (slot-value me 'instream))))
+	(assert (= read-len size))
+	octets))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MP4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(log5:defcategory cat-log-mp4-stream)
+(defmacro log-mp4-stream (&rest log-stuff) `(log5:log-for (cat-log-mp4-stream) ,@log-stuff))
+
+(defclass mp4-stream (base-stream)
+  ((mp4-atoms :accessor mp4-atoms :initform nil))
+  (:documentation "Class to access m4a/mp4 files"))
+
+(defun make-mp4-stream (filename read-only &key)
+  "Convenience function to create an instance of MP4-FILE with appropriate init args"
+  (log5:with-context "make-mp4-stream"
+	(log-mp4-stream "opening ~a" filename)
+	(let (handle)
+	  (handler-case 
+		  (progn
+			(setf handle (make-instance 'mp4-stream :filename filename :endian :big-endian :read-only read-only))
+			(with-slots (mp4-atoms) handle
+			  (log-mp4-stream "getting atoms")
+			  (setf mp4-atoms (mp4-atom:find-mp4-atoms handle))))
+		(condition (c)
+		  (warn "make-mp4-stream got condition: ~a" c)
+		  (when handle (stream-close handle))
+		  (setf handle nil)))
+		handle)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MP3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(log5:defcategory cat-log-mp3-stream)
+
+(defmacro log-mp3-stream (&rest log-stuff) `(log5:log-for (cat-log-mp3-stream) ,@log-stuff))
+
+(defclass mp3-stream (base-stream)
+  ((mp3-header :accessor mp3-header :initform nil))
+  (:documentation "Class to access mp3 files"))
+
+(defun make-mp3-stream (filename read-only &key)
+  "Convenience function to create an instance of MP3-FILE with appropriate init args.
+NB: we assume non-syncsafe as default"
+  (log5:with-context "make-mp3-stream"
+	(log-mp3-stream "opening ~a" filename)
+	(let (handle)
+	  (handler-case 
+		  (progn
+			(setf handle (make-instance 'mp3-stream :filename filename :endian :little-endian :read-only read-only))
+			(with-slots (mp3-header) handle
+			  (log-mp3-stream "getting frames")
+			  (setf mp3-header (mp3-frame:find-mp3-frames handle))))
+		(condition (c)
+		  (warn "make-mp3-stream got condition: ~a" c)
+		  (when handle (stream-close handle))
+		  (setf handle nil)))
+	  handle)))
+
+(defmethod stream-read-sync-safe-u32 ((me mp3-stream))
+  "Read a sync-safe integer from file.  Used by mp3 files"
+  (let* ((ret 0))
+	(setf (ldb (byte 7 21) ret) (stream-read-u8 me))
+	(setf (ldb (byte 7 14) ret) (stream-read-u8 me))
+	(setf (ldb (byte 7 7) ret)  (stream-read-u8 me))
+	(setf (ldb (byte 7 0) ret)  (stream-read-u8 me))
+	ret))
+
+(defmethod stream-read-sync-safe-octets ((me mp3-stream) len)
+  "Used to undo sync-safe read of file"
+  (let* ((last-byte-was-FF nil)
+		 (byte nil)
+		 (de-synced-data (binary-types:with-binary-output-to-vector (out)
+						   (dotimes (i len)
+							 (setf byte (stream-read-u8 me))
+							 (if last-byte-was-FF
+								 (if (not (zerop byte))
+									 (write-byte byte out))
+								 (write-byte byte out))
+							 (setf last-byte-was-FF (= byte #xFF))))))
+	de-synced-data))
+

taglib-tests.lisp

@@ -3,7 +3,7 @@
 (in-package #:cl-user)
 
 (defpackage #:taglib-tests
-  (:use #:common-lisp #:logging))
+  (:use #:common-lisp #:logging #:audio-streams))
 
 (in-package #:taglib-tests)
 
@@ -34,8 +34,8 @@
 (defun mp4-test0 (file)
   (let (foo)
 	(unwind-protect 
-		 (setf foo (mp4-file:make-mp4-file file t))
-	  (when foo (base-file:close-audio-file foo)))
+		 (setf foo (make-mp4-stream file t))
+	  (when foo (stream-close foo)))
 	foo))
 
 (defun mp4-test1 ()
@@ -51,8 +51,8 @@
 (defun mp3-test0 (file)
   (let (foo)
 	(unwind-protect 
-		 (setf foo (mp3-file:make-mp3-file file t))
-	  (when foo (base-file:close-audio-file foo)))
+		 (setf foo (make-mp3-stream file t))
+	  (when foo (stream-close foo)))
 	foo))
 
 (defun mp3-test1 ()

taglib.asd

@@ -8,12 +8,11 @@
   :depends-on (#:log5 #:binary-types #:alexandria)
   :components ((:file "packages")
 			   (:file "tag"       :depends-on ("packages"))
-			   (:file "base-file" :depends-on ("packages"))
-			   (:file "mp3-file"  :depends-on ("packages" "base-file" "mp3-frame"))
+			   (:file "streams"   :depends-on ("packages"))
 			   (:file "mp3-frame" :depends-on ("packages"))
-			   (:file "mp3-tag"   :depends-on ("packages" "mp3-frame" "mp3-file"))
-			   (:file "logging"   :depends-on ("packages" "mp4-atom" "mp4-file" "base-file"))
+			   (:file "mp3-tag"   :depends-on ("packages" "mp3-frame" "streams"))
+			   (:file "logging"   :depends-on ("packages" "mp4-atom" "streams"))
 			   (:file "mp4-atom"  :depends-on ("packages"))
-			   (:file "mp4-tag"   :depends-on ("packages"))
-			   (:file "mp4-file"  :depends-on ("packages" "base-file" "mp4-atom"))))
+			   (:file "mp4-tag"   :depends-on ("packages"))))
+