Mark VandenBrink 12 anni fa
parent
commit
cdc53149d3
10 ha cambiato i file con 257 aggiunte e 167 eliminazioni
  1. BIN
      FRAME-AND-ATOMS-TO-IMPLEMENT.txt
  2. 30 33
      abstract-tag.lisp
  3. 15 4
      audio-streams.lisp
  4. 1 1
      flac.lisp
  5. 93 56
      id3.lisp
  6. 60 48
      m4a.lisp
  7. 52 21
      mpeg.lisp
  8. 4 2
      packages.lisp
  9. 1 1
      profile.lisp
  10. 1 1
      utils.lisp

BIN
FRAME-AND-ATOMS-TO-IMPLEMENT.txt


+ 30 - 33
abstract-tag.lisp

@@ -148,26 +148,28 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
   (let ((frames (id3:get-frames me '("TCO" "TCON"))))
     (when frames
       (when (> (length frames) 1)
-        (warn-user "file ~a has more than one genre frame, will only use the first"
+        (warn-user "file ~a:~%Has more than one genre frame, will only use the first"
                    (id3:filename me)))
       (let ((count)
             (end)
             (str (id3:info (first frames))))
 
-        ;; For V23/V24 TCON frames, a genre can be pretty gnarly.
-        ;; if the first byte of the TCON INFO field is a '(', what is between this '('
-        ;; and the next ')' is interpreted as an ID3v2.1 genre number.
-        ;; These can stack up (called "refinements") too.
-        ;; The INFO field can also just be a string.
-        ;; We're taking a simplistic approach here: we can handle the '(' case, but
-        ;; only allow one (no refinements) OR we can handle the simple string case
+        ;; For V23/V24 TCON frames, a genre can be pretty gnarly.  if the
+        ;; first byte of the TCON INFO field is a '(', what is between this
+        ;; '(' and the next ')' is interpreted as an ID3v2.1 genre number.
+        ;; These can stack up (called "refinements") too.  The INFO field
+        ;; can also just be a string.  We're taking a simplistic approach
+        ;; here: we can handle the '(' case, but only allow one (no
+        ;; refinements) OR we can handle the simple string case
         (when (and (>= (length str) 1) (eq #\( (aref str 0)))
           (setf count (count #\( str))
           (when (> count 1)
-            (warn-user "Don't support genre refinement yet, found ~d genres" count))
+            (warn-user "file ~a:~%Don't support genre refinement yet, found ~d genres"
+                       (id3:filename me) count))
           (setf end (position #\) str))
           (when (null end)
-            (warn-user "Bad format for genre, ending paren is missing"))
+            (warn-user "file ~a:~%Bad format for genre, ending paren is missing"
+                       (id3:filename me)))
           (setf str (get-id3v1-genre (parse-integer (subseq str 1 end)))))
         (return-from genre str))))
 
@@ -288,13 +290,13 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 else, print out a subset."
   (declare #.utils:*standard-optimize-settings*)
 
+  (format t "~a~%" (id3:filename me))
+  (when (id3:audio-info me)
+    (mpeg:vpprint (id3:audio-info me) t)
+    (format t "~%"))
+
   (if raw
-      (format t "~a~%~a~%" (id3:filename me)
-              (with-output-to-string (s)
-                (when (id3:audio-info me)
-                  (mpeg::vpprint (id3:audio-info me) s)
-                  (format s "~%"))
-                (id3:vpprint (id3:id3-header me) s)))
+      (id3:vpprint (id3:id3-header me) t)
       (let ((album (album me))
             (album-artist (album-artist me))
             (artist (artist me))
@@ -314,11 +316,7 @@ else, print out a subset."
             (writer (writer me))
             (year (year me)))
 
-        (format t "~a~%~a~%" (id3:filename me)
-                (if (id3:audio-info me)
-                    (mpeg::vpprint (id3:audio-info me) nil) ""))
-
-        (when album (format t "~4talbum: ~a~%" album))
+        (when album (format t "~&~4talbum: ~a~%" album))
         (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
         (when artist (format t "~4tartist: ~a~%" artist))
         (when comment (format t "~4tcomment: ~a~%" comment))
@@ -337,7 +335,7 @@ else, print out a subset."
         (when writer (format t "~4twriter: ~a~%" writer))
         (when year (format t "~4tyear: ~a~%" year)))))
 
-;;;;;;;;;;;;;;;;;;;; MP4 ;;;;;;;;;;;;;;;;;;;;
+;;;; MP4
 (defmethod album        ((me m4a:mp4-file)) (m4a:tag-get-value (m4a:mp4-atoms me) m4a:+itunes-album+))
 (defmethod album-artist ((me m4a:mp4-file)) (m4a:tag-get-value (m4a:mp4-atoms me) m4a:+itunes-album-artist+))
 (defmethod artist       ((me m4a:mp4-file)) (m4a:tag-get-value (m4a:mp4-atoms me) m4a:+itunes-artist+))
@@ -382,11 +380,12 @@ else show subset of DATA atoms"
   (declare #.utils:*standard-optimize-settings*)
 
   (format t "~a~%" (m4a:filename me))
+  (when (m4a:audio-info me)
+      (m4a:vpprint (m4a:audio-info me) t)
+      (format t "~%"))
+
   (if raw
-      (progn
-        (if (m4a:audio-info me)
-            (m4a:vpprint (m4a:audio-info me) t))
-        (m4a:mp4-show-raw-tag-atoms me t))
+      (m4a:mp4-show-raw-tag-atoms me t)
       (let ((album (album me))
             (album-artist (album-artist me))
             (artist (artist me))
@@ -406,9 +405,6 @@ else show subset of DATA atoms"
             (writer (writer me))
             (year (year me)))
 
-        (if (m4a:audio-info me)
-            (m4a:vpprint (m4a:audio-info me) t))
-
         (when album (format t "~&~4talbum: ~a~%" album))
         (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
         (when artist (format t "~4tartist: ~a~%" artist))
@@ -428,7 +424,7 @@ else show subset of DATA atoms"
         (when writer (format t "~4twriter: ~a~%" writer))
         (when year (format t "~4tyear: ~a~%" year)))))
 
-;;;;;;;;;;;;;;;;;;;; FLAC ;;;;;;;;;;;;;;;;;;;;
+;;;; FLAC
 (defmacro get-flac-tag-info (stream name)
   `(flac:flac-get-tag (flac:flac-tags ,stream) ,name))
 
@@ -456,6 +452,10 @@ else show subset of DATA atoms"
   (declare #.utils:*standard-optimize-settings*)
 
   (format t "~a~%" (flac:filename me))
+  (when (flac:audio-info me)
+      (flac:vpprint (flac:audio-info me) t)
+      (format t "~%"))
+
   (if raw
       (flac:flac-show-raw-tag me t)
       (let ((album (album me))
@@ -470,9 +470,6 @@ else show subset of DATA atoms"
             (track (track me))
             (year (year me)))
 
-        (if (flac:audio-info me)
-            (flac:vpprint (flac:audio-info me) t))
-
         (when album (format t "~&~4talbum: ~a~%" album))
         (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
         (when artist (format t "~4tartist: ~a~%" artist))

+ 15 - 4
audio-streams.lisp

@@ -3,6 +3,9 @@
 
 (in-package #:audio-streams)
 
+(defparameter *current-file*
+  "The file currently being worked on by OPEN-AUDIO-FILE")
+
 (defun make-audio-stream (arg)
   "Creates a stream for ARG"
   (declare #.utils:*standard-optimize-settings*)
@@ -150,7 +153,8 @@ read in null-terminated ISO string w/o null at end"
           (ldb (byte 8 8) retval) (aref octets 0))
     (when (not (or (= #xfffe retval) (= #xfeff retval)))
       (error
-       "Got invalid byte-order mark of ~x in STREAM-DECODE-UCS-STRING"
+       "File ~a: Got invalid byte-order mark of ~x in STREAM-DECODE-UCS-STRING"
+       *current-file*
        retval))
     retval))
 
@@ -178,11 +182,17 @@ byte-order marks, so we have to do that here before calling."
           (setf len (length octets)))
         (setf octets (stream-read-sequence instream len)))
 
+    ;; This seems to happen a lot in MP3 files: instead of ending a
+    ;; null-terminated UCS string with #x0000, it's terminated with #x00.
+    ;; flexi-streams doesn't like this, so fix and warn only if we're deleting a
+    ;; non-null octet.
     (when (oddp len)
-      (warn-user "UCS string has odd length, decrementing by 1")
+      (when (not (zerop (aref octets (1- len))))
+        (warn-user "file ~a:~%UCS string has odd length, decrementing by 1"
+                   *current-file*))
       (decf len 1))
 
-    (when (= 0 len)
+    (when (<= 0 len)
       (return-from stream-read-ucs-string ""))
 
     (when (eql kind :ucs-2)
@@ -227,7 +237,8 @@ file upon return."
   (declare #.utils:*standard-optimize-settings*)
 
   (let ((stream)
-        (info))
+        (info)
+        (*current-file* filename))
 
     (unwind-protect
          (progn

+ 1 - 1
flac.lisp

@@ -177,6 +177,6 @@ headers, go ahead and parse them too."
   "Spit out the raw form of comments we found"
   (declare #.utils:*standard-optimize-settings*)
 
-  (format out-stream "Vendor string: <~a>~%" (vendor-str (flac-tags flac-file-stream)))
+  (format out-stream "~4tVendor string: <~a>~%" (vendor-str (flac-tags flac-file-stream)))
   (dotimes (i (length (comments (flac-tags flac-file-stream))))
     (format out-stream "~4t[~d]: <~a>~%" i (nth i (comments (flac-tags flac-file-stream))))))

+ 93 - 56
id3.lisp

@@ -17,7 +17,9 @@ is from the ID3 'spec'"
         (2 (stream-read-ucs-string instream :len len :kind :ucs-2be))
         (3 (stream-read-utf-8-string instream len)))))
 
-(defun id3-decode-string (octets &key (encoding 0 ) (start 0) (end (length octets)))
+(defun id3-decode-string (octets &key (encoding 0)
+                                      (start 0)
+                                      (end (length octets)))
   "Decode a string of a given encoding of length 'len'. Encoding
 is from the ID3 'spec'"
   (declare #.utils:*standard-optimize-settings*)
@@ -66,9 +68,9 @@ is from the ID3 'spec'"
           year     (upto-null (stream-read-iso-string instream 4)))
 
     ;; In V21, a comment can be split into comment and track #
-    ;; find the first #\Null then check to see if that index < 28.  If so, the check the last two bytes being
-    ;; non-zero---if so, then track can be set to integer value of last two bytes
-
+    ;; find the first #\Null then check to see if that index < 28.  If so,
+    ;; check the last two bytes being non-zero---if so, track can be set to
+    ;; integer value of last two bytes
     (let* ((c (stream-read-sequence instream 30))
            (first-null (find 0 c))
            (trck 0))
@@ -93,9 +95,10 @@ is from the ID3 'spec'"
   (:documentation "Class representing a V2.3/4 extended header"))
 
 (defmethod initialize-instance :after ((me id3-ext-header) &key instream version)
-  "Read in the extended header.  Caller will have stream-seek'ed to correct location in file.
-Note: extended headers are subject to unsynchronization, so make sure that INSTREAM has been made sync-safe.
-NB: 2.3 and 2.4 extended flags are different..."
+  "Read in the extended header.  Caller will have stream-seek'ed to correct
+location in file. Note: extended headers are subject to unsynchronization, so
+make sure that INSTREAM has been made sync-safe. NB: 2.3 and 2.4 extended flags
+are different..."
   (declare #.utils:*standard-optimize-settings*)
 
   (with-slots (size flags padding crc is-update restrictions) me
@@ -106,24 +109,32 @@ NB: 2.3 and 2.4 extended flags are different..."
        (setf padding (stream-read-u32 instream))
        (when (logand flags #x8000)
          (if (not (= size 10))
-             (warn-user "CRC bit set in extended header, but not enough bytes to read")
+             (warn-user "file ~a:~%CRC bit set in extended header, but not enough bytes to read"
+                        audio-streams:*current-file*)
              (setf crc (stream-read-u32 instream)))))
       (4
        (when (not (= (logand #xff00 flags) 1))
-         (warn-user "v2.4 extended flags length is not 1"))
+         (warn-user "file ~a:~%v2.4 extended flags length is not 1"
+                    audio-streams:*current-file*))
        (setf flags (logand flags #xff)) ; lop off type byte (the flags length)
        (let ((len 0))
          (when (logand #x3000 flags)
            (setf len (stream-read-u8 instream))
-           (when (not (zerop len)) (warn-user "v2.4 extended header is-tag length is ~d" len))
+           (when (not (zerop len))
+             (warn-user "file ~a:~%v2.4 extended header is-tag length is ~d"
+                        audio-streams:*current-file* len))
            (setf is-update t))
          (when (logand #x2000 flags)
            (setf len (stream-read-u8 instream))
-           (when (not (= 5 len)) (warn-user "v2.4 extended header crc length is ~d" len))
+           (when (not (= 5 len))
+             (warn-user "file ~a:~%v2.4 extended header crc length is ~d"
+                        audio-streams:*current-file* len))
            (setf crc (stream-read-u32 instream :bits-per-byte 7)))
          (when (logand #x1000 flags)
            (setf len (stream-read-u8 instream))
-           (when (not (= 5 1)) (warn-user "v2.4 extended header restrictions length is ~d" len))
+           (when (not (= 5 1))
+             (warn-user "file ~a:~%v2.4 extended header restrictions length is ~d"
+                        audio-streams:*current-file* len))
            (setf restrictions (stream-read-u8 instream))))))))
 
 (defun ext-header-restrictions-grok (r)
@@ -165,8 +176,9 @@ NB: 2.3 and 2.4 extended flags are different..."
     (format stream "extended header: size: ~d, flags: ~x, padding ~:d, crc = ~x is-update ~a, restrictions = ~x/~a~%"
             size flags padding crc is-update restrictions (ext-header-restrictions-grok restrictions))))
 
-;;; NB: v2.2 only really defines bit-7. It does document bit-6 as being the compression flag, but then states
-;;; that if it is set, the software should "ignore the entire tag if this (bit-6) is set"
+;;; NB: v2.2 only really defines bit-7. It does document bit-6 as being the
+;;; compression flag, but then states that if it is set, the software should
+;;; "ignore the entire tag if this (bit-6) is set"
 (defmacro header-unsynchronized-p (flags) `(logbitp 7 ,flags)) ; all share this flag
 (defmacro header-extended-p (flags)       `(logbitp 6 ,flags)) ; 2.3/2.4
 (defmacro header-experimental-p (flags)   `(logbitp 5 ,flags)) ; 2.3/2.4
@@ -207,7 +219,8 @@ NB: 2.3 and 2.4 extended flags are different..."
       (handler-case
           (setf v21-tag-header (make-instance 'v21-tag-header :instream instream))
         (condition (c)
-          (utils:warn-user "initialize id3-header got condition ~a" c))))
+          (warn-user "file ~a:~%Initialize id3-header got condition ~a"
+                           audio-streams:*current-file* c))))
 
     (stream-seek instream 0 :start)
     (when (string= "ID3" (stream-read-iso-string instream 3))
@@ -217,26 +230,29 @@ NB: 2.3 and 2.4 extended flags are different..."
             size     (stream-read-u32 instream :bits-per-byte 7))
       (assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet"))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; General plan: for each frame type we are interested in, DEFCLASS a class with
-;;; specfic naming convention: frame-xxx/frame-xxxx, where xxx is valid ID3V2.2 frame name
-;;; and xxxx is a valid ID3V2.[34] frame name.  Upon finding a frame name in an MP3 file,
-;;; we can then do a FIND-CLASS on the "frame-xxx", and a MAKE-INSTANCE on the found class
-;;; to read in that class (each defined class is assumed to have an INITIALIZE-INSTANCE method
-;;; that reads in data to build class.
+;;;; Frames
 ;;;
-;;; Each frame class assumes that the STREAM being passed has been made sync-safe.
+;;; General plan: for each frame type we are interested in, DEFCLASS a
+;;; class with specfic naming convention: frame-xxx/frame-xxxx, where xxx
+;;; is valid ID3V2.2 frame name and xxxx is a valid ID3V2.[34] frame name.
+;;; Upon finding a frame name in an MP3 file, we can then do a FIND-CLASS
+;;; on the "frame-xxx", and a MAKE-INSTANCE on the found class to read in
+;;; that class (each defined class is assumed to have an
+;;; INITIALIZE-INSTANCE method that reads in data to build class.
 ;;;
-;;; For any class we don't want to parse (eg, haven't gotten around to it yet, etc), we create
-;;; a RAW-FRAME class that can be subclassed.  RAW-FRAME simply reads in the frame header, and then
-;;; the frame "payload" as raw OCTETS.
-
+;;; Each frame class assumes that the STREAM being passed has been made
+;;; sync-safe.
 ;;;
-;;; many ID3 tags are name/value pairs, with the name/value encoded in various ways
-;;; this routine assumes that the "name" is always a string with a "normal" encoding (i.e. 0, 1, 2, or 3).
-;;; The "value" field accepts "normal" encoding, but also accepts any negative number, which means read
-;;; the bytes an raw octets.
+;;; For any class we don't want to parse (eg, haven't gotten around to it
+;;; yet, etc), we create a RAW-FRAME class that can be subclassed.
+;;; RAW-FRAME simply reads in the frame header, and then the frame
+;;; "payload" as raw OCTETS.
+
+;;; Many ID3 tags are name/value pairs, with the name/value encoded in
+;;; various ways this routine assumes that the "name" is always a string
+;;; with a "normal" encoding (i.e. 0, 1, 2, or 3).  The "value" field
+;;; accepts "normal" encoding, but also accepts any negative number, which
+;;; means read the bytes an raw octets.
 (defun get-name-value-pair (instream len name-encoding value-encoding)
   (declare #.utils:*standard-optimize-settings*)
 
@@ -291,9 +307,9 @@ NB: 2.3 and 2.4 extended flags are different..."
   (declare #.utils:*standard-optimize-settings*)
 
   (ecase version
-    (2 (format stream "None, "))
+    (2 (format stream "None"))
     (3 (format stream
-               "flags: 0x~4,'0x: ~:[0/~;tag-alter-preservation/~]~:[0/~;file-alter-preservation/~]~:[0/~;read-only/~]~:[0/~;compress/~]~:[0/~;encypt/~]~:[0~;group~], "
+               "flags: 0x~4,'0x: ~:[0/~;tag-alter-preservation/~]~:[0/~;file-alter-preservation/~]~:[0/~;read-only/~]~:[0/~;compress/~]~:[0/~;encypt/~]~:[0~;group~]"
                flags
                (frame-23-altertag-p flags)
                (frame-23-alterfile-p flags)
@@ -302,7 +318,7 @@ NB: 2.3 and 2.4 extended flags are different..."
                (frame-23-encrypt-p flags)
                (frame-23-group-p flags)))
     (4 (format stream
-               "flags: 0x~4,'0x: ~:[0/~;tag-alter-preservation/~]~:[0/~;file-alter-preservation/~]~:[0/~;read-only/~]~:[0/~;group-id/~]~:[0/~;compress/~]~:[0/~;encypt/~]~:[0/~;unsynch/~]~:[0~;datalen~], "
+               "flags: 0x~4,'0x: ~:[0/~;tag-alter-preservation/~]~:[0/~;file-alter-preservation/~]~:[0/~;read-only/~]~:[0/~;group-id/~]~:[0/~;compress/~]~:[0/~;encypt/~]~:[0/~;unsynch/~]~:[0~;datalen~]"
                flags
                (frame-24-altertag-p flags)
                (frame-24-alterfile-p flags)
@@ -316,9 +332,10 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defun vpprint-frame-header (id3-frame)
   (with-output-to-string (stream)
     (with-slots (pos version id len flags) id3-frame
-      (format stream "offset: ~:d, version = ~d, id: ~a, len: ~:d, ~a" pos version id len
+      (format stream "offset: ~:d, version = ~d, id: ~a, len: ~:d, ~a"
+              pos version id len
               (if flags
-                  (print-frame-flags version flags stream)
+                  (print-frame-flags version flags nil)
                   "flags: none")))))
 
 (defclass frame-raw (id3-frame)
@@ -335,7 +352,9 @@ NB: 2.3 and 2.4 extended flags are different..."
   (with-slots (octets) me
     (format stream "frame-raw: ~a, ~a" (vpprint-frame-header me) (printable-array octets))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; V2.2 frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; V2.2 frames
+
+;;; Frames we need to implement someday
 (defclass frame-buf (frame-raw) ())
 (defclass frame-cnt (frame-raw) ())
 (defclass frame-cra (frame-raw) ())
@@ -478,6 +497,10 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defclass frame-tbp (frame-text-info) ())
 (defclass frame-tcm (frame-text-info) ())
 (defclass frame-tco (frame-text-info) ())
+(defclass frame-tsa (frame-text-info) ())
+(defclass frame-tsc (frame-text-info) ())
+(defclass frame-tsp (frame-text-info) ())
+(defclass frame-ts2 (frame-text-info) ())
 
 (defclass frame-itunes-compilation (frame-raw)
   ((info :accessor info)))
@@ -583,7 +606,9 @@ NB: 2.3 and 2.4 extended flags are different..."
   (with-slots (id len name value) me
     (format stream "frame-ufi: ~a, name: <~a>, value: ~a" (vpprint-frame-header me) name (printable-array value))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; V23/V24 frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; V23/V24 frames
+
+;;; Frames we need to implement someday
 (defclass frame-aenc (frame-raw) ())
 (defclass frame-aspi (frame-raw) ())
 (defclass frame-comr (frame-raw) ())
@@ -602,6 +627,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defclass frame-popm (frame-raw) ())
 (defclass frame-poss (frame-raw) ())
 (defclass frame-rbuf (frame-raw) ())
+(defclass frame-rgad (frame-raw) ())
 (defclass frame-rva2 (frame-raw) ())
 (defclass frame-rvad (frame-raw) ())
 (defclass frame-rvrb (frame-raw) ())
@@ -610,6 +636,8 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defclass frame-sylt (frame-raw) ())
 (defclass frame-sytc (frame-raw) ())
 (defclass frame-user (frame-raw) ())
+(defclass frame-xdor (frame-raw) ())
+(defclass frame-xsop (frame-raw) ())
 
 ;;; V23/V24 text-info frames
 (defclass frame-talb (frame-text-info) ())
@@ -882,7 +910,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 ;;; Identical to frame-txx
 (defclass frame-wxxx (frame-txx) ())
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; frame finding/creation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Frame finding/creation
 
 (defun possibly-valid-frame-id? (frame-id)
   "test to see if a string is a potentially valid frame id"
@@ -900,12 +928,13 @@ NB: 2.3 and 2.4 extended flags are different..."
                        (and (alpha-char-p c) (upper-case-p c))))
           (return-from possibly-valid-frame-id? nil))))
     t))
+(memoize 'possibly-valid-frame-id?)
 
 (defun mk-frame-class-name (id)
   (declare #.utils:*standard-optimize-settings*)
 
   (string-upcase (concatenate 'string "frame-" id)))
-(utils:memoize 'mk-frame-class-name)
+(memoize 'mk-frame-class-name)
 
 (defparameter *skipped-id3-frames* (make-hash-table :test #'equalp))
 
@@ -938,14 +967,17 @@ NB: 2.3 and 2.4 extended flags are different..."
                         (#\T (find-class (find-symbol "FRAME-TEXT-INFO" :ID3)))
                         (#\W (find-class (find-symbol "FRAME-URL-LINK"  :ID3)))
                         (t
-                         ;; we don't recognize the frame name.  if it could possibly be a real frame name,
-                         ;; then just read it raw
+                         ;; we don't recognize the frame name.  if it could
+                         ;; possibly be a real frame name, then just read
+                         ;; it raw
                          (when (possibly-valid-frame-id? id)
+                           (add-skipped id)
+                           (warn-user "file ~a~%Unknown frame type <~a> encountered~%"
+                                      audio-streams:*current-file* id)
                            (find-class (find-symbol "FRAME-RAW" :ID3))))))
-    (add-skipped id)
     found-class))
 
-(utils:memoize 'find-frame-class)
+(memoize 'find-frame-class)
 
 (defun make-frame (version instream fn)
   "Create an appropriate mp3 frame by reading data from INSTREAM."
@@ -958,12 +990,15 @@ NB: 2.3 and 2.4 extended flags are different..."
     (when (zerop byte) ; XXX should this be correlated to PADDING in the extended header???
       (return-from make-frame nil))     ; hit padding
 
+    ;; I have seen 3-char frame names where 4-chars were supposed to be...
     (setf frame-name
-          (concatenate 'string (string (code-char byte))
-                       (id3-read-string instream :len (ecase version
-                                                        (2 2)
-                                                        (3 3)
-                                                        (4 3)))))
+          (string-right-trim '(#\Space #\Null)
+                             (concatenate 'string (string (code-char byte))
+                                          (id3-read-string instream
+                                                           :len (ecase version
+                                                                  (2 2)
+                                                                  (3 3)
+                                                                  (4 3))))))
     (setf frame-len (ecase version
                       (2 (stream-read-u24 instream))
                       (3 (stream-read-u32 instream))
@@ -972,12 +1007,13 @@ NB: 2.3 and 2.4 extended flags are different..."
     (when (or (= version 3) (= version 4))
       (setf frame-flags (stream-read-u16 instream))
       (when (not (valid-frame-flags version frame-flags))
-        (warn-user "Invalid frame flags found in ~a: ~a, will ignore" fn (print-frame-flags version frame-flags nil))))
-
+        (warn-user "file: ~a~%Invalid frame flags found: ~a; will ignore"
+                   fn
+                   (print-frame-flags version frame-flags nil))))
     (setf frame-class (find-frame-class frame-name))
 
-    ;; edge case where found a frame name, but it is not valid or where making this frame
-    ;; would blow past the end of the file/buffer
+    ;; edge case where found a frame name, but it is not valid or where
+    ;; making this frame would blow past the end of the file/buffer
     (when (or (> (+ (stream-seek instream) frame-len) (stream-size instream))
               (null frame-class))
       (error "bad frame at position ~d found: ~a" pos frame-name))
@@ -1035,7 +1071,8 @@ NB: 2.3 and 2.4 extended flags are different..."
 
                        (push this-frame frames))
                    (condition (c)
-                     (utils:warn-user "id3 parse-audio-file got condition ~a" c)
+                     (warn-user "file ~a:~%Id3 parse-audio-file got condition ~a"
+                                      audio-streams:*current-file* c)
                      (return-from read-loop (values nil (nreverse frames))))))
 
                (values t (nreverse frames))))) ; frames in "file order"
@@ -1065,7 +1102,7 @@ NB: 2.3 and 2.4 extended flags are different..."
             (multiple-value-bind (_ok _frames) (read-loop version mem-stream)
               (if (not _ok)
                   (warn-user
-                   "File ~a had errors finding mp3 frames. potentially missed frames!"
+                   "file ~a:~%Had errors finding mp3 frames. potentially missed frames!"
                    (stream-filename instream)))
               (setf frames _frames))))
         (when get-audio-info

+ 60 - 48
m4a.lisp

@@ -116,26 +116,9 @@
   `(with-slots (atom-file-pos atom-size atom-type) ,instance
      ,@body))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Concrete atoms ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Concrete atoms
 (defclass atom-skip (mp4-atom) ())
 
-#|
-potential atoms to explicitly skip
-moov.udta.meta.ilst.apID # apple account email address
-moov.udta.meta.ilst.atID # artist-track ID
-moov.udta.meta.ilst.cnID # iTunes Catalog ID
-moov.udta.meta.ilst.geID # genre ID
-moov.udta.meta.ilst.plID # playlist ID (identifies album)
-moov.udta.meta.ilst.sfID # iTunes store identifier (location/number)
-moov.udta.meta.ilst.cprt # copyright information
-moov.udta.meta.ilst.flvr # bitrate/video size information?
-moov.udta.meta.ilst.purd # date purchased
-moov.udta.meta.ilst.rtng # Explicit/Clean information
-moov.udta.meta.ilst.soal # Album sort name
-moov.udta.meta.ilst.stik # media type information
-moov.udta.meta.ilst.xid  # space end!
-|#
-
 (defmethod initialize-instance :after ((me atom-skip) &key mp4-file &allow-other-keys)
   "The 'skip' atom.  Used when we want to capture the header of atom, but don't want/need
 to read the payload of an atom."
@@ -144,6 +127,44 @@ to read the payload of an atom."
   (with-mp4-atom-slots (me)
     (stream-seek mp4-file (- atom-size 8) :current)))
 
+;;; Atoms we need to implement someday
+(defclass atom----- (atom-skip) ())
+(defclass atom-akID (atom-skip) ())
+(defclass atom-apID (atom-skip) ())
+(defclass atom-atID (atom-skip) ())
+(defclass atom-cmID (atom-skip) ())
+(defclass atom-cnID (atom-skip) ())
+(defclass atom-dinf (atom-skip) ())
+(defclass atom-drms (atom-skip) ())
+(defclass atom-edts (atom-skip) ())
+(defclass atom-flvr (atom-skip) ())
+(defclass atom-free (atom-skip) ())
+(defclass atom-ftyp (atom-skip) ())
+(defclass atom-geID (atom-skip) ())
+(defclass atom-iods (atom-skip) ())
+(defclass atom-mdat (atom-skip) ())
+(defclass atom-mvhd (atom-skip) ())
+(defclass atom-name (atom-skip) ())
+(defclass atom-pgap (atom-skip) ())
+(defclass atom-pinf (atom-skip) ())
+(defclass atom-plID (atom-skip) ())
+(defclass atom-rtng (atom-skip) ())
+(defclass atom-sbtd (atom-skip) ())
+(defclass atom-sfID (atom-skip) ())
+(defclass atom-smhd (atom-skip) ())
+(defclass atom-soaa (atom-skip) ())
+(defclass atom-soal (atom-skip) ())
+(defclass atom-soar (atom-skip) ())
+(defclass atom-soco (atom-skip) ())
+(defclass atom-sonm (atom-skip) ())
+(defclass atom-stco (atom-skip) ())
+(defclass atom-stik (atom-skip) ())
+(defclass atom-stsc (atom-skip) ())
+(defclass atom-stsz (atom-skip) ())
+(defclass atom-stts (atom-skip) ())
+(defclass atom-tkhd (atom-skip) ())
+(defclass atom-xid  (atom-skip) ()) ; NOTE: it's actually "xid#\Space"
+
 (defclass mp4-container-atom (mp4-atom)
   ((tree :accessor tree)))
 
@@ -156,7 +177,7 @@ to read the payload of an atom."
           while (< current end) do
             (make-mp4-atom mp4-file me))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ILST ATOMS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; ILST ATOMS (ie atoms related to tagging)
 (defclass atom-ilst (mp4-container-atom) ())
 
 (defclass atom-©alb (atom-ilst) ())
@@ -231,7 +252,7 @@ to read the payload of an atom."
                  (error "fell through all cases of ilst data atoms: parent-type = ~a"
                         (atom-type parent)))))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; AUDIO PROPERTY ATOMS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Audio Property Atoms
 (defclass atom-trak (mp4-container-atom) ())
 (defclass atom-minf (mp4-container-atom) ())
 (defclass atom-moov (mp4-container-atom) ())
@@ -340,13 +361,17 @@ to read the payload of an atom."
 
   (with-slots (version flags esid s-priority obj-id s-type buf-size max-bit-rate avg-bit-rate) me
     (setf version (stream-read-u8 mp4-file)
-          flags (stream-read-u24 mp4-file))
+          flags   (stream-read-u24 mp4-file))
+
     (assert (= +MP4-ESDescrTag+ (stream-read-u8 mp4-file)) () "Expected description tag of ESDescrTag")
-    (let* ((len (read-descriptor-len mp4-file))
+
+    (let* ((len         (read-descriptor-len mp4-file))
            (end-of-atom (+ (stream-seek mp4-file) len)))
-      (setf esid (stream-read-u16 mp4-file)
+      (setf esid       (stream-read-u16 mp4-file)
             s-priority (stream-read-u8 mp4-file))
+
       (assert (= +MP4-DecConfigDescrTag+ (stream-read-u8 mp4-file)) () "Expected tag type of DecConfigDescrTag")
+
       (setf len          (read-descriptor-len mp4-file)
             obj-id       (stream-read-u8 mp4-file)
             s-type       (stream-read-u8 mp4-file)
@@ -412,20 +437,6 @@ reading the container atoms"
            flags   (stream-read-u24 mp4-file)))
   (call-next-method))
 
-;;; XXX
-;;; This needs to be enhanced by accounting for all atom-types,
-;;; else we get potential runaways. For now, just brute-force it
-(defun is-valid (str)
-  (declare #.utils:*standard-optimize-settings*)
-
-  (assert (= 4 (length str)))
-  (loop for c across str do
-    (when (not (or (alphanumericp c)
-                   (char= #\- c)
-                   (= (char-code c) #xa9)))
-      (warn-user "Bad atom type name: c = ~a, str = <~a>" c str)))
-  t)
-
 (defparameter *skipped-m4a-atoms* (make-hash-table :test #'equalp))
 
 (defun clear-skipped ()
@@ -443,8 +454,6 @@ reading the container atoms"
   "Search by concatenating 'atom-' with ID and look for that symbol in this package"
   (declare #.utils:*standard-optimize-settings*)
 
-  (is-valid id)
-
   (let ((found-class-symbol (find-symbol (mk-atom-class-name id) :M4A)))
 
     ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
@@ -453,17 +462,20 @@ reading the container atoms"
 
     ;; didn't find a class, so return ATOM-SKIP class
     (add-skipped id)
+    (warn-user "file ~a~%Unknown atom type <~a> encountered~%"
+               audio-streams:*current-file* id)
     'atom-skip))
 
 (utils:memoize 'find-atom-class)
 
 (defun make-mp4-atom (mp4-file parent)
   "Get current file position, read in size/type, then construct the correct atom."
-
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((pos (stream-seek mp4-file))
          (siz (stream-read-u32 mp4-file))
-         (typ (as-string (stream-read-u32 mp4-file)))
+         (typ (string-right-trim '(#\Space)
+                                 (as-string (stream-read-u32 mp4-file))))
          (atom))
     (declare (fixnum pos siz))
 
@@ -530,14 +542,14 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
          (parsed-info (make-instance 'mp4-file
                                      :filename (stream-filename instream))))
     (setf (mp4-atoms parsed-info)
-          (tree
-           (make-instance 'mp4-container-atom
-                          :atom-type +root+
-                          :atom-file-pos 0
-                          :atom-size (stream-size instream)
-                          :mp4-file instream)))
+          (tree      (make-instance 'mp4-container-atom
+                                    :atom-type +root+
+                                    :atom-file-pos 0
+                                    :atom-size (stream-size instream)
+                                    :mp4-file instream)))
     (when get-audio-info
       (setf (audio-info parsed-info) (get-mp4-audio-info parsed-info)))
+
     parsed-info))
 
 (defparameter *ilst-data* (list +root+ +mp4-atom-moov+ +mp4-atom-udta+
@@ -630,7 +642,7 @@ root.moov.trak.mdia.minf.stbl.mp4a, and root.moov.trak.mdia.minf.stbl.mp4a.esds"
         (when mdhd
           (setf seconds (/ (float (duration mdhd)) (float (scale mdhd)))))
         (when mp4a
-          (setf channels (num-chans mp4a)
+          (setf channels        (num-chans mp4a)
                 bits-per-sample (samp-size mp4a))
           (let* ((upper (ash (samp-rate mp4a) -16))
                  (lower (logand (samp-rate mp4a) #xffff)))

+ 52 - 21
mpeg.lisp

@@ -1,7 +1,8 @@
 ;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: MPEG; -*-
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 
-;;; Parsing MPEG audio frames.  See http://www.datavoyage.com/mpgscript/mpeghdr.htm for format of a frame.
+;;; Parsing MPEG audio frames.  See
+;;; http://www.datavoyage.com/mpgscript/mpeghdr.htm for format of a frame.
 (in-package #:mpeg)
 
 (defconstant* +sync-word+  #x7ff "NB: this is 11 bits so as to be able to recognize V2.5")
@@ -30,6 +31,7 @@
 
 (defun valid-layer (layer)
   (declare #.utils:*standard-optimize-settings*)
+
   (or (= (the fixnum +layer-3+) (the fixnum layer))
       (= (the fixnum +layer-2+) (the fixnum layer))
       (= (the fixnum +layer-1+) (the fixnum layer))))
@@ -43,8 +45,10 @@
 (defconstant* +channel-mode-joint+  1)
 (defconstant* +channel-mode-dual+   2)
 (defconstant* +channel-mode-mono+   3)
+
 (defun get-channel-mode-string (mode)
   (declare #.utils:*standard-optimize-settings*)
+
   (nth mode '("Stereo" "Joint" "Dual" "Mono")))
 
 ;;; the emphases
@@ -55,10 +59,12 @@
 
 (defun get-emphasis-string (e)
   (declare #.utils:*standard-optimize-settings*)
+
   (nth e '("None" "50/15 ms" "Reserved" "CCIT J.17")))
 
 (defun valid-emphasis (e)
   (declare #.utils:*standard-optimize-settings*)
+
   (or (= (the fixnum e) (the fixnum +emphasis-none+))
       (= (the fixnum e) (the fixnum +emphasis-50-15+))
       (= (the fixnum e) (the fixnum +emphasis-ccit+))))
@@ -68,17 +74,21 @@
 (defconstant* +mode-extension-1+ 1)
 (defconstant* +mode-extension-2+ 2)
 (defconstant* +mode-extension-3+ 3)
+
 (defun get-mode-extension-string (channel-mode layer mode-extension)
   (declare #.utils:*standard-optimize-settings*)
+
   (if (not (= channel-mode +channel-mode-joint+))
       ""
       (if (or (= layer +layer-1+)
               (= layer +layer-2+))
           (format nil "Bands ~[4~;8~;12~;16~] to 31" mode-extension)
-          (format nil "Intensity Stereo: ~[off~;on~], MS Stereo: ~[off~;on~]" (ash mode-extension -1) (logand mode-extension 1)))))
+          (format nil "Intensity Stereo: ~[off~;on~], MS Stereo: ~[off~;on~]"
+                  (ash mode-extension -1) (logand mode-extension 1)))))
 
 (defun get-samples-per-frame (version layer)
   (declare #.utils:*standard-optimize-settings*)
+
   (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 384)
         ((= (the fixnum layer) (the fixnum +layer-2+)) 1152)
         ((= (the fixnum layer) (the fixnum +layer-3+))
@@ -107,9 +117,12 @@
    (vbr            :accessor vbr            :initarg :vbr)
    (payload        :accessor payload        :initarg :payload))
   (:documentation "Data in and associated with an MPEG audio frame.")
-  (: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
-                     :copyright 0 :original 0 :emphasis 0 :size nil :vbr nil :payload nil))
+  (: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
+                     :copyright 0 :original 0 :emphasis 0 :size nil :vbr nil
+                     :payload nil))
 
 (defmacro with-frame-slots ((instance) &body body)
   `(with-slots (pos hdr-u32 samples sync version layer protection bit-rate sample-rate
@@ -136,10 +149,12 @@
 
   (defun valid-bit-rate-index (br-index)
     (declare #.utils:*standard-optimize-settings*)
+
     (and (> (the fixnum br-index) 0) (< (the fixnum br-index) 15)))
 
   (defun get-bit-rate (version layer bit-rate-index)
     (declare #.utils:*standard-optimize-settings*)
+
     (let ((row (1- bit-rate-index))
           (col (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
                       (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 0)
@@ -159,11 +174,13 @@
 
 (defun valid-sample-rate-index (sr-index)
   (declare #.utils:*standard-optimize-settings*)
+
   (and (>= (the fixnum sr-index) 0)
        (<  (the fixnum sr-index) 3)))
 
 (defun get-sample-rate (version sr-index)
   (declare #.utils:*standard-optimize-settings*)
+
   (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
          (case (the fixnum sr-index) (0 44100) (1 48000) (2 32000)))
         ((= (the fixnum version) (the fixnum +mpeg-2+))
@@ -172,6 +189,7 @@
 
 (defun get-frame-size (version layer bit-rate sample-rate padded)
   (declare #.utils:*standard-optimize-settings*)
+
   (truncate (float (cond ((= (the fixnum layer) (the fixnum +layer-1+))
                           (* 4 (+ (/ (* 12 bit-rate) sample-rate) padded)))
                          ((= (the fixnum layer) (the fixnum +layer-2+))
@@ -182,8 +200,10 @@
                               (+ (* 72  (/ bit-rate sample-rate)) padded)))))))
 
 (defmethod load-frame ((me frame) &key instream (read-payload nil))
-  "Load an MPEG frame from current file position.  If READ-PAYLOAD is set, read in frame's content."
+  "Load an MPEG frame from current file position.  If READ-PAYLOAD is set,
+read in frame's content."
   (declare #.utils:*standard-optimize-settings*)
+
   (handler-case
       (with-frame-slots (me)
         (when (null hdr-u32)            ; has header already been read in?
@@ -194,7 +214,8 @@
 
         (if (parse-header me)
             (progn
-              (setf size (get-frame-size version layer bit-rate sample-rate padded))
+              (setf size (get-frame-size version layer bit-rate sample-rate
+                                         padded))
               (when read-payload
                 (setf payload (stream-read-sequence instream (- size 4))))
               t)
@@ -219,8 +240,8 @@ Bits   5-4 (2  bits): the mode extension
 Bit      3 (1  bit ): the copyright bit
 Bit      2 (1  bit ): the original bit
 Bits   1-0 (2  bits): the emphasis"
-
   (declare #.utils:*standard-optimize-settings*)
+
   (with-frame-slots (me)
     ;; check sync word
     (setf sync (get-bitfield hdr-u32 31 11))
@@ -303,14 +324,16 @@ Bits   1-0 (2  bits): the emphasis"
 
 (defun get-side-info-size (version channel-mode)
   (declare #.utils:*standard-optimize-settings*)
+
   (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
          (cond ((= (the fixnum channel-mode) (the fixnum +channel-mode-mono+)) 17)
                (t 32)))
         (t (cond ((= (the fixnum channel-mode) (the fixnum +channel-mode-mono+)) 9)
                  (t 17)))))
 
-(defmethod check-vbr ((me frame) fn)
+(defmethod check-vbr ((me frame))
   (declare #.utils:*standard-optimize-settings*)
+
   (with-frame-slots (me)
     (let ((i (get-side-info-size version channel-mode)))
       (when (>= i (length payload))
@@ -332,12 +355,7 @@ Bits   1-0 (2  bits): the emphasis"
                 (flags vbr) (stream-read-u32 v))
 
           (when (logand (flags vbr) +vbr-frames+)
-            (setf (frames vbr) (stream-read-u32 v))
-
-            ;; some VBR files have the Xing/Info header, but it is not correctly formulated.
-            ;; just warn the user.
-            (when (zerop (frames vbr))
-              (warn-user "file ~a Xing/Info header flags has FRAMES set, but field is zero." fn)))
+            (setf (frames vbr) (stream-read-u32 v)))
 
           (when (logand (flags vbr) +vbr-bytes+)
             (setf (bytes vbr) (stream-read-u32 v)))
@@ -354,7 +372,9 @@ Bits   1-0 (2  bits): the emphasis"
             tag flags frames frames bytes tocs scale)))
 
 (defun find-first-sync (instream)
+  "Scan the file looking for the first sync word."
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((hdr-u32)
         (count 0)
         (pos))
@@ -371,16 +391,18 @@ Bits   1-0 (2  bits): the emphasis"
             (let ((hdr (make-instance 'frame :hdr-u32 hdr-u32 :pos pos)))
               (if (load-frame hdr :instream instream :read-payload t)
                   (progn
-                    (check-vbr hdr (stream-filename instream))
+                    (check-vbr hdr)
                     (return-from find-first-sync hdr))))))
       (condition (c) (progn
-                       (warn-user "Condtion <~a> signaled while looking for first sync" c)
+                       (warn-user "file:~a~%Condtion <~a> signaled while looking for first sync"
+                                  audio-streams:*current-file* c)
                        (error c))))
     nil))
 
 (defmethod next-frame ((me frame) &key instream read-payload)
   "Get next frame.  If READ-PAYLOAD is true, read in contents for frame, else, seek to next frame header."
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((nxt-frame (make-instance 'frame)))
     (when (not (payload me))
       (stream-seek instream (- (size me) 4) :current))
@@ -392,8 +414,10 @@ Bits   1-0 (2  bits): the emphasis"
 (defparameter *max-frames-to-read* most-positive-fixnum "when trying to determine bit-rate, etc, read at most this many frames")
 
 (defun map-frames (in func &key (start-pos nil) (read-payload nil) (max nil))
-  "Loop through the MPEG audio frames in a file.  If *MAX-FRAMES-TO-READ* is set, return after reading that many frames."
+  "Loop through the MPEG audio frames in a file.  If *MAX-FRAMES-TO-READ*
+is set, return after reading that many frames."
   (declare #.utils:*standard-optimize-settings*)
+
   (when start-pos
     (stream-seek in start-pos :start))
 
@@ -427,6 +451,7 @@ Bits   1-0 (2  bits): the emphasis"
 (defun calc-bit-rate-exhaustive (instream start info)
   "Map every MPEG frame in INSTREAM and calculate the bit-rate"
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((total-len      0)
         (bit-rate-total 0))
 
@@ -449,6 +474,7 @@ Bits   1-0 (2  bits): the emphasis"
  If the first MPEG frame we find is a Xing/Info header, return that as info.
  Else, we assume CBR and calculate the duration, etc."
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((first-frame (find-first-sync instream))
         (info        (make-instance 'mpeg-audio-info)))
 
@@ -463,9 +489,14 @@ Bits   1-0 (2  bits): the emphasis"
       (if (vbr first-frame)
           ;; found a Xing header, now check to see if it is correct
           (if (zerop (frames (vbr first-frame)))
-              ;; Xing header broken, read all frames to calc
-              (calc-bit-rate-exhaustive instream (pos first-frame) info)
-              ;; Good Xing header, use info in VBR to calc
+              (progn
+                ;; Xing header broken, read all frames to calc
+                (warn-user
+                 "file ~a:~%Xing/Info header has FRAMES set, but field is zero."
+                 audio-streams:*current-file*)
+                (calc-bit-rate-exhaustive instream (pos first-frame) info))
+
+              ;; else, good Xing header, use info in VBR to calc
               (setf n-frames 1
                     is-vbr   t
                     len      (float (* (frames (vbr first-frame))

+ 4 - 2
packages.lisp

@@ -65,7 +65,8 @@
            #:stream-read-utf-8-string
            #:stream-seek
            #:stream-size
-           *get-audio-info*)
+           #:*get-audio-info*
+           #:*current-file*)
   (:use #:common-lisp #:utils))
 
 (defpackage #:flac
@@ -80,7 +81,8 @@
            #:get-flac-audio-info
            #:is-valid-flac-file
            #:parse-audio-file
-           #:vpprint)
+           #:vpprint
+           #:*current-file*)
   (:use #:common-lisp #:utils #:audio-streams))
 
 (defpackage #:m4a

+ 1 - 1
profile.lisp

@@ -1,7 +1,7 @@
 ;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: PROFILE; -*-
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 
-;;;;;;;;;;;;;;;;;;;; Handy, dandy profile functions ;;;;;;;;;;;;;;;;;;;;
+;;;;Handy, dandy profile functions
 ;;; "profile:on" enables profiling for taglib modules
 ;;; "profile:report" shows a profile listing
 ;;; "profile:reset" clears counters

+ 1 - 1
utils.lisp

@@ -127,7 +127,7 @@ Example: (get-bitfield #xFFFBB240 31 11) -->> #x7ff.
 The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE time."
   `(ash (logand ,int ,(utils::get-bitmask start width)) ,(- ( - start width -1))))
 
-;;;;;;;;;;;;;;;;;;;; convenience macros ;;;;;;;;;;;;;;;;;;;;
+;;;; Convenience macros
 (defmacro with-gensyms (syms &body body)
   `(let ,(mapcar #'(lambda (s)
                      `(,s (gensym)))