Jelajahi Sumber

documentation, cleanup, reworking mpeg.lisp to be faster

Mark VandenBrink 12 tahun lalu
induk
melakukan
6d57a722aa
7 mengubah file dengan 156 tambahan dan 110 penghapusan
  1. 1 0
      README.md
  2. 59 14
      audio-streams.lisp
  3. 5 11
      mp4-atom.lisp
  4. 84 76
      mpeg.lisp
  5. 1 1
      packages.lisp
  6. 2 2
      taglib-tests.asd
  7. 4 6
      taglib-tests.lisp

+ 1 - 0
README.md

@@ -11,6 +11,7 @@ Note: There a lot of good (some great) audio file resources out there.  Here are
 * [mplayer](http://www.mplayerhq.hu): For me, the definitive tool on how to crack audio files.
 * [mplayer](http://www.mplayerhq.hu): For me, the definitive tool on how to crack audio files.
 * [eyeD3](http://eyed3.nicfit.net/): Great command line tool.
 * [eyeD3](http://eyed3.nicfit.net/): Great command line tool.
 * [MP3Diags](http://mp3diags.sourceforge.net/): Good GUI-based-tool.  Tends to slow, but very thorough.
 * [MP3Diags](http://mp3diags.sourceforge.net/): Good GUI-based-tool.  Tends to slow, but very thorough.
+* [MediaInfo](http://mediaarea.net/en/MediaInfo): C++, can dump out all the info to command line and also has a GUI.
 * [The MP4 Book](http://www.amazon.com/gp/search?index=books&linkCode=qs&keywords=0130616214): I actually didn't order this until well into writing this code.   What a maroon. 
 * [The MP4 Book](http://www.amazon.com/gp/search?index=books&linkCode=qs&keywords=0130616214): I actually didn't order this until well into writing this code.   What a maroon. 
   It would have saved me TONS of time.
   It would have saved me TONS of time.
 
 

+ 59 - 14
audio-streams.lisp

@@ -6,6 +6,17 @@
 (log5:defcategory cat-log-stream)
 (log5:defcategory cat-log-stream)
 (defmacro log-stream (&rest log-stuff) `(log5:log-for (cat-log-stream) ,@log-stuff))
 (defmacro log-stream (&rest log-stuff) `(log5:log-for (cat-log-stream) ,@log-stuff))
 
 
+(define-condition audio-stream-condition ()
+  ((location :initarg :location :reader location :initform nil)
+   (object   :initarg :object   :reader object   :initform nil)
+   (messsage :initarg :message  :reader message  :initform "Undefined Condition"))
+  (:report (lambda (condition stream)
+             (format stream "audio-stream condition at location: <~a> with object: <~a>: message: <~a>"
+                     (location condition) (object condition) (message condition)))))
+
+(defmethod print-object ((me audio-stream-condition) stream)
+  (format stream "location: <~a>, object: <~a>, message: <~a>" (location me) (object me) (message me)))
+
 (deftype octet () '(unsigned-byte 8))
 (deftype octet () '(unsigned-byte 8))
 (defmacro make-octets (len) `(make-array ,len :element-type 'octet))
 (defmacro make-octets (len) `(make-array ,len :element-type 'octet))
 
 
@@ -13,13 +24,20 @@
 ;;; A simple stream interface for parsing audio files.  Currently, we have two basic stream types:
 ;;; A simple stream interface for parsing audio files.  Currently, we have two basic stream types:
 ;;; file-based and in-memory based, both of which implement the stream protocol of read, seek, etc.
 ;;; file-based and in-memory based, both of which implement the stream protocol of read, seek, etc.
 ;;;
 ;;;
+
+;;; Not prefixing this with #+USE-MMAP so as to make stream seek easier
+(defclass mmap-stream-mixin ()
+  ((orig-vector :accessor orig-vector))
+  (:documentation "Use CCLs MMAP facility to get a stream."))
+
 (defclass base-stream ()
 (defclass base-stream ()
   ((stream :accessor stream))
   ((stream :accessor stream))
   (:documentation "Base class for audio-stream implementation"))
   (:documentation "Base class for audio-stream implementation"))
 
 
-(defclass base-file-stream (base-stream)
-  ((stream-filename :accessor stream-filename))
-  (:documentation "File-based audio stream"))
+(defclass base-file-stream #-USE-MMAP (base-stream) #+USE-MMAP (base-stream mmap-stream-mixin)
+          ((stream-filename :accessor stream-filename)
+           (orig-size   :accessor orig-size :documentation "ccl::stream-position let's you seek beyond EOF"))
+          (:documentation "File-based audio stream"))
 
 
 (defclass mp3-file-stream (base-file-stream)
 (defclass mp3-file-stream (base-file-stream)
   ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")
   ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")
@@ -34,14 +52,24 @@
 (defun make-file-stream (class-name filename &key (read-only t))
 (defun make-file-stream (class-name filename &key (read-only t))
   "Convenience function for creating a file stream."
   "Convenience function for creating a file stream."
   (let ((new-stream (make-instance (find-class class-name))))
   (let ((new-stream (make-instance (find-class class-name))))
-    (setf (stream new-stream) (if read-only
-                                  (open filename :direction :input :element-type 'octet)
-                                  (open filename :direction :io :if-exists :overwrite :element-type 'octet)))
+
+    #-USE-MMAP (progn
+                 (setf (stream new-stream) (if read-only
+                                               (open filename :direction :input :element-type 'octet)
+                                               (open filename :direction :io :if-exists :overwrite :element-type 'octet)))
+                 (setf (orig-size new-stream) (file-length (stream new-stream))))
+    #+USE-MMAP (progn
+                 (assert read-only () "Can not do read/write with MMAP files.")
+                 (setf (orig-vector new-stream) (ccl:map-file-to-octet-vector filename))
+                 (setf (orig-size new-stream) (length (orig-vector new-stream))) ; ccl::stream-position let's you seek beyond EOF
+                 (setf (stream new-stream) (ccl:make-vector-input-stream (orig-vector new-stream))))
+
     (setf (stream-filename new-stream) filename)
     (setf (stream-filename new-stream) filename)
     new-stream))
     new-stream))
 
 
-;;;   (:documentation "In-memory stream")))
-(defclass base-mem-stream (base-stream) ())
+(defclass base-mem-stream (base-stream)
+  ()
+  (:documentation "In-memory stream"))
 
 
 (defun make-mem-stream (vector)
 (defun make-mem-stream (vector)
   "Convenience function to turn a vector into a stream."
   "Convenience function to turn a vector into a stream."
@@ -49,11 +77,13 @@
     (setf (stream new-stream) (ccl:make-vector-input-stream vector))
     (setf (stream new-stream) (ccl:make-vector-input-stream vector))
     new-stream))
     new-stream))
 
 
+
 (defmethod stream-close ((in-stream base-file-stream))
 (defmethod stream-close ((in-stream base-file-stream))
   "Close the underlying file."
   "Close the underlying file."
   (with-slots (stream) in-stream
   (with-slots (stream) in-stream
     (when stream
     (when stream
-      (close stream)
+      #-USE-MMAP (close stream)
+      #+USE-MMAP (ccl:unmap-octet-vector (orig-vector in-stream))
       (setf stream nil))))
       (setf stream nil))))
 
 
 (defmethod stream-close ((in-stream base-mem-stream))
 (defmethod stream-close ((in-stream base-mem-stream))
@@ -65,17 +95,32 @@
   "Returns the length of the underlying stream"
   "Returns the length of the underlying stream"
   (ccl::stream-length (stream in-stream)))
   (ccl::stream-length (stream in-stream)))
 
 
+;;;
+;;; I'm using ccl::stream-position, which I really shouldn't here...
 (defmethod stream-seek ((in-stream base-stream) &optional (offset 0) (from :current))
 (defmethod stream-seek ((in-stream base-stream) &optional (offset 0) (from :current))
   "C-like stream positioner.  Takes an offset and a location (one of :start, :end, :current).
   "C-like stream positioner.  Takes an offset and a location (one of :start, :end, :current).
 If offset is not passed, then assume 0.  If from is not passed, assume from current location.
 If offset is not passed, then assume 0.  If from is not passed, assume from current location.
 Thus (stream-seek in) == (stream-seek in 0 :current)"
 Thus (stream-seek in) == (stream-seek in 0 :current)"
   (with-slots (stream) in-stream
   (with-slots (stream) in-stream
     (ecase from
     (ecase from
-      (:start (ccl::stream-position stream offset))
-      (:current (if (zerop offset)
-                    (ccl::stream-position stream)
-                    (ccl::stream-position stream (+ (ccl::stream-position stream) offset))))
-      (:end (ccl::stream-position stream (- (ccl::stream-length stream) offset))))))
+      (:start
+       (when (or (typep in-stream 'mmap-stream-mixin) (typep in-stream 'base-file-stream))
+         (if (> offset (orig-size in-stream))
+             (error 'audio-stream-condition :location "stream-seek" :object in-stream :message "Seeking beyond end of file")))
+       (ccl::stream-position stream offset))
+      (:current
+       (if (zerop offset)
+           (ccl::stream-position stream)
+           (progn
+             (when (or (typep in-stream 'mmap-stream-mixin) (typep in-stream 'base-file-stream))
+               (if (> (+ (ccl::stream-position stream) offset) (orig-size in-stream))
+                   (error 'audio-stream-condition :location "stream-seek" :object in-stream :message "Seeking beyond end of file")))
+             (ccl::stream-position stream (+ (ccl::stream-position stream) offset)))))
+       (:end
+        (when (or (typep in-stream 'mmap-stream-mixin) (typep in-stream 'base-file-stream))
+          (if (> (- (ccl::stream-length stream) offset) (orig-size in-stream))
+              (error 'audio-stream-condition :location "stream-seek" :object in-stream :message "Seeking beyond end of file")))
+        (ccl::stream-position stream (- (ccl::stream-length stream) offset))))))
 
 
 (defun stream-read-octets (instream bytes &key (bits-per-byte 8))
 (defun stream-read-octets (instream bytes &key (bits-per-byte 8))
   "Used to slurp in octets for the stream-read-* methods"
   "Used to slurp in octets for the stream-read-* methods"

+ 5 - 11
mp4-atom.lisp

@@ -226,26 +226,20 @@ Loop through this container and construct constituent atoms"
 (simple-text-decode +itunes-tool+)
 (simple-text-decode +itunes-tool+)
 (simple-text-decode +itunes-writer+)
 (simple-text-decode +itunes-writer+)
 
 
+;;; for reasons I'm not clear on, there may or may not be extra bytes after the data in these atoms
+;;; hence, the seek at the end to get us by any unread bytes.
 (defmacro simple-a-b-decode (type)
 (defmacro simple-a-b-decode (type)
   `(defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql ,type)) mp4-file)
   `(defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql ,type)) mp4-file)
-     (declare (ignore atom))
-     (stream-read-u16 mp4-file)                 ; throw away XXX Why?
+     (stream-read-u16 mp4-file)                 ; throw away XXX Why? 'Reserved', I think
      (let ((a) (b))
      (let ((a) (b))
        (setf a (stream-read-u16 mp4-file))
        (setf a (stream-read-u16 mp4-file))
        (setf b (stream-read-u16 mp4-file))
        (setf b (stream-read-u16 mp4-file))
-       (stream-read-u16 mp4-file)               ; throw away XXX Why?
+       (stream-seek mp4-file (- (atom-size atom) 16 6) :current) ; seek to end of atom: 16 == header; 4 is a, b, skip read above
        (list a b))))
        (list a b))))
 
 
 (simple-a-b-decode +itunes-track+)
 (simple-a-b-decode +itunes-track+)
 (simple-a-b-decode +itunes-track-n+)
 (simple-a-b-decode +itunes-track-n+)
-
-(defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql +itunes-disk+)) mp4-file)
-  (declare (ignore atom))
-  (stream-read-u16 mp4-file)                    ; throw away XXX Why?
-  (let ((a) (b))
-    (setf a (stream-read-u16 mp4-file))
-    (setf b (stream-read-u16 mp4-file))
-    (list a b)))
+(simple-a-b-decode +itunes-disk+)
 
 
 (defmacro simple-u16-decode (type)
 (defmacro simple-u16-decode (type)
   `(defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql ,type)) mp4-file)
   `(defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql ,type)) mp4-file)

+ 84 - 76
mpeg.lisp

@@ -78,7 +78,7 @@
 
 
 (defclass frame ()
 (defclass frame ()
   ((pos            :accessor pos :initarg :pos)
   ((pos            :accessor pos :initarg :pos)
-   (b-array        :accessor b-array :initarg :b-array)
+   (hdr-u32        :accessor hdr-u32 :initarg :hdr-u32)
    (samples        :accessor samples :initarg :samples)
    (samples        :accessor samples :initarg :samples)
    (sync           :accessor sync :initarg :sync)
    (sync           :accessor sync :initarg :sync)
    (version        :accessor version :initarg :version)
    (version        :accessor version :initarg :version)
@@ -96,12 +96,12 @@
    (size           :accessor size :initarg :size)
    (size           :accessor size :initarg :size)
    (vbr            :accessor vbr :initarg :vbr)
    (vbr            :accessor vbr :initarg :vbr)
    (payload        :accessor payload :initarg :payload))
    (payload        :accessor payload :initarg :payload))
-  (:default-initargs :pos nil :b-array nil :samples 0 :sync 0 :version 0 :layer 0 :protection 0 :bit-rate 0
+  (:default-initargs :pos nil :hdr-u32 nil :samples 0 :sync 0 :version 0 :layer 0 :protection 0 :bit-rate 0
                      :sample-rate 0 :padded 0 :private 0 :channel-mode 0 :mode-extension 0
                      :sample-rate 0 :padded 0 :private 0 :channel-mode 0 :mode-extension 0
                      :copyright 0 :original 0 :emphasis 0 :size nil :vbr nil :payload nil))
                      :copyright 0 :original 0 :emphasis 0 :size nil :vbr nil :payload nil))
 
 
 (defmacro with-frame-slots ((instance) &body body)
 (defmacro with-frame-slots ((instance) &body body)
-  `(with-slots (pos b-array samples sync version layer protection bit-rate sample-rate
+  `(with-slots (pos hdr-u32 samples sync version layer protection bit-rate sample-rate
                     padded private channel-mode mode-extension copyright
                     padded private channel-mode mode-extension copyright
                     original emphasis size vbr payload) ,instance
                     original emphasis size vbr payload) ,instance
      ,@body))
      ,@body))
@@ -172,64 +172,71 @@
 
 
 (defmethod load-frame ((me frame) &key instream (read-payload nil))
 (defmethod load-frame ((me frame) &key instream (read-payload nil))
   (log5:with-context "load-frame"
   (log5:with-context "load-frame"
-    (with-frame-slots (me)
-      (when (null b-array)              ; has header already been read in?
-        (setf pos (stream-seek instream))
-        (setf b-array (stream-read-sequence instream 4)))
-
-      (if (parse-header me)
-          (progn
-            (log-mpeg-frame "header parsed ok")
-            (setf size (get-frame-size version layer bit-rate sample-rate padded))
-            (when read-payload
-              (setf payload (stream-read-sequence instream (- size 4))))
-            t)
-          (progn
-            (log-mpeg-frame "header didn't parse!")
-            nil)))))
+    (handler-case
+        (with-frame-slots (me)
+          (log-mpeg-frame "loading frame from pos ~:d" (stream-seek instream))
+          (when (null hdr-u32)          ; has header already been read in?
+            (log-mpeg-frame "reading in header")
+            (setf pos (stream-seek instream))
+            (setf hdr-u32 (stream-read-u32 instream)))
+
+          (if (parse-header me)
+              (progn
+                (log-mpeg-frame "header parsed ok")
+                (setf size (get-frame-size version layer bit-rate sample-rate padded))
+                (when read-payload
+                  (setf payload (stream-read-sequence instream (- size 4))))
+                t)
+              (progn
+                (log-mpeg-frame "header didn't parse!")
+                nil)))
+      (end-of-file (c)
+        (declare (ignore c))
+        (log-mpeg-frame "Hit EOF")
+        nil))))
 
 
 (defmethod parse-header ((me frame))
 (defmethod parse-header ((me frame))
   (log5:with-context "parse-header"
   (log5:with-context "parse-header"
     (with-frame-slots (me)
     (with-frame-slots (me)
-
-      (setf (ldb (byte 8 8) sync) (aref b-array 0))
-      (setf (ldb (byte 3 5) sync) (ldb (byte 3 5) (aref b-array 1)))
+      (setf (ldb (byte 8 8) sync) (ldb (byte 8 24) hdr-u32))
+      (setf (ldb (byte 3 5) sync) (ldb (byte 3 5) (ldb (byte 8 16) hdr-u32)))
       (when (not (= sync +sync-word+))
       (when (not (= sync +sync-word+))
+        (log-mpeg-frame "bad sync ~x/~x" sync hdr-u32)
         (return-from parse-header nil))
         (return-from parse-header nil))
 
 
-      (setf version (ldb (byte 2 3) (aref b-array 1)))
+      (setf version (ldb (byte 2 3) (ldb (byte 8 16) hdr-u32)))
       (when (not (valid-version version))
       (when (not (valid-version version))
         (log-mpeg-frame "bad version ~d" version)
         (log-mpeg-frame "bad version ~d" version)
         (return-from parse-header nil))
         (return-from parse-header nil))
 
 
-      (setf layer (ldb (byte 2 1) (aref b-array 1)))
+      (setf layer (ldb (byte 2 1) (ldb (byte 8 16) hdr-u32)))
       (when (not (valid-layer layer))
       (when (not (valid-layer layer))
         (log-mpeg-frame "bad layer ~d" layer)
         (log-mpeg-frame "bad layer ~d" layer)
         (return-from parse-header nil))
         (return-from parse-header nil))
 
 
-      (setf protection (ldb (byte 1 0) (aref b-array 1)))
+      (setf protection (ldb (byte 1 0) (ldb (byte 8 16) hdr-u32)))
       (setf samples (get-samples-per-frame version layer))
       (setf samples (get-samples-per-frame version layer))
 
 
-      (let ((br-index (the fixnum (ldb (byte 4 4) (aref b-array 2)))))
+      (let ((br-index (the fixnum (ldb (byte 4 4) (ldb (byte 8 8) hdr-u32)))))
         (when (not (valid-bit-rate-index br-index))
         (when (not (valid-bit-rate-index br-index))
           (log-mpeg-frame "bad bit-rate index ~d" br-index)
           (log-mpeg-frame "bad bit-rate index ~d" br-index)
           (return-from parse-header nil))
           (return-from parse-header nil))
         (setf bit-rate (get-bit-rate version layer br-index)))
         (setf bit-rate (get-bit-rate version layer br-index)))
 
 
-      (let ((sr-index (the fixnum (ldb (byte 2 2) (aref b-array 2)))))
+      (let ((sr-index (the fixnum (ldb (byte 2 2) (ldb (byte 8 8) hdr-u32)))))
         (when (not (valid-sample-rate-index sr-index))
         (when (not (valid-sample-rate-index sr-index))
           (log-mpeg-frame "bad sample-rate index ~d" sr-index)
           (log-mpeg-frame "bad sample-rate index ~d" sr-index)
           (return-from parse-header nil))
           (return-from parse-header nil))
         (setf sample-rate (get-sample-rate version sr-index)))
         (setf sample-rate (get-sample-rate version sr-index)))
 
 
-      (setf padded (ldb (byte 1 1) (aref b-array 2)))
-      (setf private (ldb (byte 1 0) (aref b-array 2)))
+      (setf padded (ldb (byte 1 1) (ldb (byte 8 8) hdr-u32)))
+      (setf private (ldb (byte 1 0) (ldb (byte 8 8) hdr-u32)))
 
 
-      (setf channel-mode (ldb (byte 2 6) (aref b-array 3)))
-      (setf mode-extension (ldb (byte 2 4) (aref b-array 3)))
-      (setf copyright (ldb (byte 1 3) (aref b-array 3)))
-      (setf original (ldb (byte 1 2) (aref b-array 3)))
-      (setf emphasis (ldb (byte 2 0) (aref b-array 3)))
+      (setf channel-mode (ldb (byte 2 6) (ldb (byte 8 0) hdr-u32)))
+      (setf mode-extension (ldb (byte 2 4) (ldb (byte 8 0) hdr-u32)))
+      (setf copyright (ldb (byte 1 3) (ldb (byte 8 0) hdr-u32)))
+      (setf original (ldb (byte 1 2) (ldb (byte 8 0) hdr-u32)))
+      (setf emphasis (ldb (byte 2 0) (ldb (byte 8 0) hdr-u32)))
       (when (not (valid-emphasis emphasis))
       (when (not (valid-emphasis emphasis))
         (log-mpeg-frame "bad emphasis ~d" emphasis)
         (log-mpeg-frame "bad emphasis ~d" emphasis)
         (return-from parse-header nil))
         (return-from parse-header nil))
@@ -238,17 +245,19 @@
       t)))
       t)))
 
 
 (defmethod vpprint ((me frame) stream)
 (defmethod vpprint ((me frame) stream)
-  (with-frame-slots (me)
-    (format stream "MPEG Frame: position in file = ~:d, header in (hex) bytes = ~x, size = ~d, sync word = ~x, " pos b-array size sync)
-    (when vbr
-      (format stream "~&vbr-info: ~a~%" vbr))
-    (format stream "version = ~a, layer = ~a, crc protected? = ~[yes~;no~], bit-rate = ~:d bps, sampling rate = ~:d bps, padded? = ~[no~;yes~], private bit set? = ~[no~;yes~], channel mode = ~a, "
-            (get-mpeg-version-string version) (get-layer-string layer)
-            protection bit-rate sample-rate padded private (get-channel-mode-string channel-mode))
-    (format stream "mode extension = ~a, copyrighted? = ~[no~;yes~], original? = ~[no~;yes~], emphasis = ~a"
-            (get-mode-extension-string channel-mode layer mode-extension) copyright original (get-emphasis-string emphasis))
-    (when payload
-      (format stream "~%frame payload[~:d] = ~a~%" (length payload) payload))))
+  (format stream "~a"
+          (with-output-to-string (s)
+            (with-frame-slots (me)
+              (format s "MPEG Frame: position in file = ~:d, header in (hex) bytes = ~x, size = ~d, sync word = ~x, " pos hdr-u32 size sync)
+              (when vbr
+                (format s "~&vbr-info: ~a~%" vbr))
+              (format s "version = ~a, layer = ~a, crc protected? = ~[yes~;no~], bit-rate = ~:d bps, sampling rate = ~:d bps, padded? = ~[no~;yes~], private bit set? = ~[no~;yes~], channel mode = ~a, "
+                      (get-mpeg-version-string version) (get-layer-string layer)
+                      protection bit-rate sample-rate padded private (get-channel-mode-string channel-mode))
+              (format s "mode extension = ~a, copyrighted? = ~[no~;yes~], original? = ~[no~;yes~], emphasis = ~a"
+                      (get-mode-extension-string channel-mode layer mode-extension) copyright original (get-emphasis-string emphasis))
+              (when payload
+                (format s "~%frame payload[~:d] = ~a~%" (length payload) payload))))))
 
 
 (defclass vbr-info ()
 (defclass vbr-info ()
   ((tag    :accessor tag :initarg :tag)
   ((tag    :accessor tag :initarg :tag)
@@ -317,68 +326,65 @@
     (format stream "tag = ~a, flags = 0x~x, frames = ~:d, bytes = ~:d, tocs = ~d, scale = ~d, "
     (format stream "tag = ~a, flags = 0x~x, frames = ~:d, bytes = ~:d, tocs = ~d, scale = ~d, "
             tag flags frames bytes tocs scale)))
             tag flags frames bytes tocs scale)))
 
 
+;;;     if( (head & 0xffe00000) != 0xffe00000 ||
+
 (defun find-first-sync (in)
 (defun find-first-sync (in)
   (log5:with-context "find-first-sync"
   (log5:with-context "find-first-sync"
 
 
     (log-mpeg-frame "Looking for first sync, begining at file position ~:d" (stream-seek in))
     (log-mpeg-frame "Looking for first sync, begining at file position ~:d" (stream-seek in))
-    (let ((b-array (make-octets 4))
+    (let ((hdr-u32)
+          (count 0)
           (pos))
           (pos))
 
 
       (handler-case
       (handler-case
-          ;;
-          ;; loop through entire file if we have to
-          ;; XXX question: if we read FF E from the file (two bytes), but the
-          ;; parse fails (i.e. a false sync), do we skip forward, or try to parse
-          ;; the second byte as the FF?
           (loop
           (loop
-             (setf pos (stream-seek in))
-             (setf (aref b-array 0) (stream-read-u8 in))
-             (when (= (aref b-array 0) #xff)
-               (setf (aref b-array 1) (stream-read-u8 in))
-               (when (= (logand (aref b-array 1) #xe0) #xe0)
-                 (log-mpeg-frame "Potential sync bytes at ~:d: <~x>" pos b-array)
-                 (setf (aref b-array 2) (stream-read-u8 in))
-                 (setf (aref b-array 3) (stream-read-u8 in))
-
-                 (let ((hdr (make-instance 'frame :b-array b-array :pos pos)))
-                   (if (load-frame hdr :instream in :read-payload t)
-                       (progn
-                         (check-vbr hdr)
-                         (log-mpeg-frame "Valid header being returned: ~a" hdr)
-                         (return-from find-first-sync hdr))
-                       (progn
-                         (log-mpeg-frame "hdr wasn't valid: ~a" hdr)))))))
-        (end-of-file (c) (progn
-                           (log-mpeg-frame "got a condition while looking for first sync: ~a" c)
-                           (error c))))
+            (setf pos (stream-seek in))
+            (setf hdr-u32 (stream-read-u32 in))
+            (incf count)
+            ;;(log-mpeg-frame "pos = ~:d, count = ~:d, hdr-u32 = ~x" pos count hdr-u32)
+            (when (= (logand hdr-u32 #xffe00000) #xffe00000)
+              (log-mpeg-frame "Potential sync bytes at ~:d: <~x>" pos hdr-u32)
+              (let ((hdr (make-instance 'frame :hdr-u32 hdr-u32 :pos pos)))
+                (if (load-frame hdr :instream in :read-payload t)
+                    (progn
+                      (check-vbr hdr)
+                      (log-mpeg-frame "Valid header being returned: ~a, searched ~:d times" hdr count)
+                      (return-from find-first-sync hdr))
+                    (progn
+                        (log-mpeg-frame "hdr wasn't valid: ~a" hdr))))))
+        (condition (c) (progn
+                         (warn-user "Condtion <~a> signaled while looking for first sync" c)
+                         (log-mpeg-frame "got a condition while looking for first sync: ~a" c)
+                         (error c)))) ; XXX should I propogate this, or just return nil
       nil)))
       nil)))
 
 
 (defmethod next-frame ((me frame) &key instream read-payload)
 (defmethod next-frame ((me frame) &key instream read-payload)
   (log5:with-context "next-frame"
   (log5:with-context "next-frame"
     (let ((nxt-frame (make-instance 'frame)))
     (let ((nxt-frame (make-instance 'frame)))
       (when (not (payload me))
       (when (not (payload me))
-        (log-mpeg-frame "no payload in current frame, skipping from ~:d forward ~:d bytes"
+        (log-mpeg-frame "no payload loaded in current frame, skipping from ~:d forward ~:d bytes"
                         (stream-seek instream)
                         (stream-seek instream)
                         (- (size me) 4) :current)
                         (- (size me) 4) :current)
         (stream-seek instream (- (size me) 4) :current))
         (stream-seek instream (- (size me) 4) :current))
 
 
+      (log-mpeg-frame "at pos ~:d, read-payload is ~a" (stream-seek instream) read-payload)
       (if (load-frame nxt-frame :instream instream :read-payload read-payload)
       (if (load-frame nxt-frame :instream instream :read-payload read-payload)
           nxt-frame
           nxt-frame
           nil))))
           nil))))
 
 
 (defun map-frames (in func &key (start-pos nil) (read-payload nil) (max nil))
 (defun map-frames (in func &key (start-pos nil) (read-payload nil) (max nil))
   (log5:with-context "next-frame"
   (log5:with-context "next-frame"
-    (log-mpeg-frame "mapping frame, start pos ~:d" start-pos)
+    (log-mpeg-frame "mapping frames, start pos ~:d" start-pos)
 
 
     (when start-pos
     (when start-pos
       (stream-seek in start-pos :start))
       (stream-seek in start-pos :start))
 
 
     (loop
     (loop
-       for max-frames = (if max max most-positive-fixnum)
+       for max-frames = (if max max *max-frames-to-read*)
        for count = 0 then (incf count)
        for count = 0 then (incf count)
        for frame = (find-first-sync in) then (next-frame frame :instream in :read-payload read-payload)
        for frame = (find-first-sync in) then (next-frame frame :instream in :read-payload read-payload)
         while (and frame (< count max-frames)) do
         while (and frame (< count max-frames)) do
-         (log-mpeg-frame "At pos ~:d, dispatching function" (pos frame))
+         (log-mpeg-frame "map-frames: at pos ~:d, dispatching function" (pos frame))
          (funcall func frame))))
          (funcall func frame))))
 
 
 (defun get-mpeg-bit-rate-exhaustive (in)
 (defun get-mpeg-bit-rate-exhaustive (in)
@@ -430,14 +436,16 @@
             (round (/ bit-rate 1000))
             (round (/ bit-rate 1000))
             (floor (/ len 60)) (round (mod len 60)))))
             (floor (/ len 60)) (round (mod len 60)))))
 
 
-(defun get-mpeg-audio-info (in &key (max-frames nil))
+(defparameter *max-frames-to-read* most-positive-fixnum "when trying to determine bit-rate, etc, read at most this many frames")
+
+(defun get-mpeg-audio-info (in &key (max-frames *max-frames-to-read*))
   "Get MPEG Layer 3 audio information."
   "Get MPEG Layer 3 audio information."
   (log5:with-context "get-mpeg-audio-info"
   (log5:with-context "get-mpeg-audio-info"
     (let ((pos (stream-seek in))
     (let ((pos (stream-seek in))
           (first-frame (find-first-sync in))
           (first-frame (find-first-sync in))
           (info (make-instance 'mpeg-audio-info)))
           (info (make-instance 'mpeg-audio-info)))
 
 
-      (log-mpeg-frame "search for first frame yielded ~a" first-frame)
+      (log-mpeg-frame "search for first frame yielded ~a" (vpprint first-frame nil))
       (when (null first-frame)
       (when (null first-frame)
         (return-from get-mpeg-audio-info nil))
         (return-from get-mpeg-audio-info nil))
 
 

+ 1 - 1
packages.lisp

@@ -11,7 +11,7 @@
   (:use #:common-lisp))
   (:use #:common-lisp))
 
 
 (defpackage #:audio-streams
 (defpackage #:audio-streams
-  (:export #:octets #:make-octets *get-audio-info*
+  (:export #:octets #:make-octets *get-audio-info* #:audio-stream-condition
            #:mp3-file-stream #:mp4-file-stream #:base-mem-stream
            #:mp3-file-stream #:mp4-file-stream #:base-mem-stream
            #:id3-header #:audio-info #:mp4-atoms
            #:id3-header #:audio-info #:mp4-atoms
            #:parse-mp3-file #:parse-mp4-file
            #:parse-mp3-file #:parse-mp4-file

+ 2 - 2
taglib-tests.asd

@@ -2,8 +2,8 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 ;;;
 ;;;
 
 
-;;; should only be set when on markv machines...
-(pushnew :I-AM-MARKV *features*)
+;(pushnew :I-AM-MARKV *features*)
+(pushnew :USE-MMAP *features*)
 
 
 (asdf:defsystem #:taglib-tests
 (asdf:defsystem #:taglib-tests
   :description "Simple demo/test code for taglib"
   :description "Simple demo/test code for taglib"

+ 4 - 6
taglib-tests.lisp

@@ -43,13 +43,12 @@ to see if it matches. PATHNAME version."
 ;;;;;;;;;;;;;;;;;;;; MP4 Tests ;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;; MP4 Tests ;;;;;;;;;;;;;;;;;;;;
 (defun mp4-test0 (file)
 (defun mp4-test0 (file)
   "Parse one MP3 file (with condition handling)."
   "Parse one MP3 file (with condition handling)."
-  (let ((dir (ccl:current-directory))
-        (foo))
+  (let ((foo))
     (unwind-protect
     (unwind-protect
          (handler-case
          (handler-case
              (setf foo (parse-mp4-file file))
              (setf foo (parse-mp4-file file))
            (condition (c)
            (condition (c)
-             (utils:warn-user "Dir: ~a~%File: ~a~%Got condition: <~a>~%" dir file c)))
+             (utils:warn-user "File: ~a~%Got condition: <~a>~%" file c)))
       (when foo (stream-close foo)))
       (when foo (stream-close foo)))
     foo))
     foo))
 
 
@@ -68,13 +67,12 @@ to see if it matches. PATHNAME version."
 ;;;;;;;;;;;;;;;;;;;; MP3 Tests ;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;; MP3 Tests ;;;;;;;;;;;;;;;;;;;;
 (defun mp3-test0 (file)
 (defun mp3-test0 (file)
   "Parse one MP3 file (with condition handling)."
   "Parse one MP3 file (with condition handling)."
-  (let ((dir (ccl:current-directory))
-        (foo))
+  (let ((foo))
     (unwind-protect
     (unwind-protect
          (handler-case
          (handler-case
              (setf foo (parse-mp3-file file))
              (setf foo (parse-mp3-file file))
            (condition (c)
            (condition (c)
-             (utils:warn-user "Dir: ~a~%File: ~a~%Got condition: <~a>~%" dir file c)))
+             (utils:warn-user "File: ~a~%Got condition: <~a>~%" file c)))
       (when foo (stream-close foo)))
       (when foo (stream-close foo)))
     foo))
     foo))