Browse Source

minor rework, cleaned up rough edges + added code to extract mpeg audio info

Mark VandenBrink 13 năm trước cách đây
mục cha
commit
ae0c752161
11 tập tin đã thay đổi với 642 bổ sung và 165 xóa
  1. 1 0
      logging.lisp
  2. 55 41
      mp3-frame.lisp
  3. 12 4
      mp3-tag.lisp
  4. 2 2
      mp4-atom.lisp
  5. 2 2
      mp4-tag.lisp
  6. 496 0
      mpeg.lisp
  7. 15 14
      packages.lisp
  8. 29 23
      streams.lisp
  9. 0 57
      tag.lisp
  10. 29 21
      taglib-tests.lisp
  11. 1 1
      taglib.asd

+ 1 - 0
logging.lisp

@@ -16,6 +16,7 @@
 
 (defparameter *logging-categories* '(mp4-atom::cat-log-mp4-atom
 									 audio-streams::cat-log-stream
+									 mpeg::cat-log-mpeg-frame
 									 mp3-frame::cat-log-mp3-frame))
 
 

+ 55 - 41
mp3-frame.lisp

@@ -110,18 +110,20 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 
 (defmethod vpprint ((me mp3-id3-header) stream)
   (with-slots (version revision flags v21-tag-header size ext-header frames) me
-	(format stream "Header: version/revision: ~d/~d, flags: ~a, size = ~:d bytes; ~a; ~a"
-			version revision (print-header-flags nil flags) size
-			(if (header-extended-p flags)
-				(concatenate 'string "Extended header: " (vpprint ext-header nil))
-				"No extended header")
-			(if v21-tag-header
-				(concatenate 'string "V21 tag: " (vpprint v21-tag-header nil))
-				"No v21 tag"))
-		(when frames
-		  (format stream "~&~4tFrames[~d]:~%" (length frames))
-		  (dolist (f frames)
-			(format stream "~8t~a~%" (vpprint f nil))))))
+	(format stream "~a"
+			(with-output-to-string (s)
+			  (format s "Header: version/revision: ~d/~d, flags: ~a, size = ~:d bytes; ~a; ~a"
+					  version revision (print-header-flags nil flags) size
+					  (if (header-extended-p flags)
+						  (concatenate 'string "Extended header: " (vpprint ext-header nil))
+						  "No extended header")
+					  (if v21-tag-header
+						  (concatenate 'string "V21 tag: " (vpprint v21-tag-header nil))
+						  "No v21 tag"))
+			  (when frames
+				(format s "~&~4tFrames[~d]:~%" (length frames))
+				(dolist (f frames)
+				  (format s "~8t~a~%" (vpprint f nil))))))))
 
 (defmethod initialize-instance :after ((me mp3-id3-header) &key instream &allow-other-keys)
   "Fill in an mp3-header from INSTREAM."
@@ -142,10 +144,9 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 		(setf flags (stream-read-u8 instream))
 		(setf size (stream-read-u32 instream :bits-per-byte 7))
 		(when (header-unsynchronized-p flags)
-		  (log-mp3-frame "unsync"))
-		(assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet"))
-
-	  (log-mp3-frame "~a" (vpprint me nil)))))
+		  (log-mp3-frame "header flags indicate unsync"))
+		(assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet")
+		(log-mp3-frame "id3 header = ~a" (vpprint me nil))))))
 
 (defclass id3-frame ()
   ((pos     :accessor pos     :initarg :pos)
@@ -176,30 +177,32 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 	(3 (zerop (logand #b0001111100011111 frame-flags)))
 	(4 (zerop (logand #b1000111110110000 frame-flags)))))
 
+(defun print-frame-flags (version flags stream)
+  (ecase version
+	(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
+			   (frame-23-altertag-p flags)
+			   (frame-23-alterfile-p flags)
+			   (frame-23-readonly-p flags)
+			   (frame-23-compress-p flags)
+			   (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
+			   (frame-24-altertag-p flags)
+			   (frame-24-alterfile-p flags)
+			   (frame-24-readonly-p flags)
+			   (frame-24-groupid-p flags)
+			   (frame-24-compress-p flags)
+			   (frame-24-encrypt-p flags)
+			   (frame-24-unsynch-p flags)
+			   (frame-24-datalen-p flags)))))
+
 (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 " pos version id len)
-	  (if flags
-		  (ecase version
-			(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
-					   (frame-23-altertag-p flags)
-					   (frame-23-alterfile-p flags)
-					   (frame-23-readonly-p flags)
-					   (frame-23-compress-p flags)
-					   (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
-					   (frame-24-altertag-p flags)
-					   (frame-24-alterfile-p flags)
-					   (frame-24-readonly-p flags)
-					   (frame-24-groupid-p flags)
-					   (frame-24-compress-p flags)
-					   (frame-24-encrypt-p flags)
-					   (frame-24-unsynch-p flags)
-					   (frame-24-datalen-p flags))))))))
+	  (if flags (print-frame-flags version flags stream)))))
 
 (defclass frame-raw (id3-frame)
   ((octets :accessor octets :initform nil))
@@ -213,6 +216,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 	  (log-mp3-frame "frame: ~a" (vpprint me nil)))))
 
 (defparameter *max-raw-bytes-print-len* 10)
+
 (defun printable-array (array)
   "given an array, return a string of the first *MAX-RAW-BYTES-PRINT-LEN* bytes"
   (let* ((len (length array))
@@ -328,11 +332,17 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 
 (defmethod initialize-instance :after ((me frame-text-info) &key instream)
   (log5:with-context "frame-text-info"
-	(with-slots (len encoding info) me
-	  (setf encoding (stream-read-u8 instream))
-	  (setf info (stream-read-string-with-len instream (1- len) :encoding encoding))
+	(with-slots (version flags len encoding info) me
+	  (let ((read-len len))
+		(when (and (= version 4) (frame-24-unsynch-p flags))
+		  (if (frame-24-datalen-p flags)
+			  (setf read-len (stream-read-u32 instream :bits-per-byte 7))))
+
+		(setf encoding (stream-read-u8 instream))
+		(setf info (stream-read-string-with-len instream (1- read-len) :encoding encoding)))
 
 	  ;; a null is ok, but according to the "spec", you're supposed to ignore anything after a 'Null'
+	  (log-mp3-frame "made text-info-frame: ~a" (vpprint me nil))
 	  (setf info (upto-null info))
 
 	  (log-mp3-frame "encoding = ~d, info = <~a>" encoding info))))
@@ -767,9 +777,13 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 						(4 (stream-read-u32 instream :bits-per-byte 7))))
 
 	  (when (or (= version 3) (= version 4))
-		(setf frame-flags (stream-read-u16 instream)))
+		(setf frame-flags (stream-read-u16 instream))
+		(if (not (valid-frame-flags version frame-flags))
+			(warn "Invalid frame flags found ~a" (print-frame-flags version frame-flags nil))))
 
-	  (log-mp3-frame "making frame: id:~a, version: ~d, len: ~:d, flags: ~x" frame-name version frame-len frame-flags)
+	  (log-mp3-frame "making frame: id:~a, version: ~d, len: ~:d, flags: ~a"
+					 frame-name version frame-len
+					 (print-frame-flags version frame-flags nil))
 	  (setf frame-class (find-frame-class frame-name))
 	  (when (or (> (+ (stream-seek instream 0 :current) frame-len) (stream-size instream))
 				(null frame-class))

+ 12 - 4
mp3-tag.lisp

@@ -165,7 +165,7 @@
 					:func (lambda (f)
 							(when (member (id f) names :test #'string=)
 							  (push f found-frames))))
-	found-frames))
+	(nreverse found-frames)))
 
 (defmethod album ((me mp3-file-stream))
   (let ((frames (get-frames me '("TAL" "TALB"))))
@@ -217,7 +217,8 @@
 (defmethod genre ((me mp3-file-stream))
   (let ((frames (get-frames me '("TCO" "TCON"))))
 	(when frames
-	  (assert (= 1 (length frames)) () "There can be only one genre tag")
+	  (when (> (length frames) 1)
+		(warn "file ~a has more than one genre frame, will only use the first" (stream-filename me)))
 	  (let ((count)
 			(end)
 			(str (info (first frames))))
@@ -325,7 +326,12 @@
 (defmethod show-tags ((me mp3-file-stream) &key (raw nil))
   "Show the tags for an mp3-file.  If RAW is non-nil, dump all the frames; else, print out a subset."
   (if raw
-	  (format t "~a:~a~%" (stream-filename me) (with-output-to-string (s) (mp3-frame:vpprint (audio-streams:mp3-header me) s)))
+	  (format t "~a: ~a~%" (stream-filename me)
+			  (with-output-to-string (s)
+				(when (audio-streams:mpeg-info me)
+				  (mpeg:vpprint (audio-streams:mpeg-info me) s)
+				  (format s "~%"))
+				(mp3-frame:vpprint (audio-streams:mp3-header me) s)))
 	  (let ((album (album me))
 			(album-artist (album-artist me))
 			(artist (artist me))
@@ -345,7 +351,9 @@
 			(track (track me))
 			(writer (writer me))
 			(year (year me)))
-		(format t "~a~%" (stream-filename me))
+		(format t "~a: ~a~%" (stream-filename me) 
+				(if (audio-streams:mpeg-info me)
+					(mpeg:vpprint (audio-streams:mpeg-info me) nil) ""))
 		(when album (format t "~4talbum: ~a~%" album))
 		(when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
 		(when artist (format t "~4tartist: ~a~%" artist))

+ 2 - 2
mp4-atom.lisp

@@ -428,8 +428,8 @@ call traverse atom (unless length of path == 1, in which case, we've found out m
   (map-mp4-atom (mp4-atom::traverse (mp4-atoms mp4-file-stream)
 									(list +mp4-atom-moov+ +mp4-atom-udta+ +mp4-atom-meta+ +mp4-atom-ilst+))
 				:depth 0
-				:func (lambda (atom)
+				:func (lambda (atom depth)
 						(when (= (atom-type atom) +itunes-ilst-data+)
-						  (format t "~4t~a~%" (vpprint atom nil))))))
+						  (format t "~vt~a~%" depth (vpprint atom nil))))))
 
 

+ 2 - 2
mp4-tag.lisp

@@ -25,8 +25,8 @@
 		(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))
+	  (genre (mp3-tag:get-id3v1-genre genre))
+	  (genre-x (mp3-tag:get-id3v1-genre genre-x))
 	  (t nil))))
 
 (defmethod track ((me mp4-file-stream))

+ 496 - 0
mpeg.lisp

@@ -0,0 +1,496 @@
+;;; -*- 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.
+(in-package #:mpeg)
+
+(log5:defcategory cat-log-mpeg-frame)
+(defmacro log-mpeg-frame (&rest log-stuff) `(log5:log-for (cat-log-mpeg-frame) ,@log-stuff))
+
+(define-condition mpeg-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 "MP3 condition at location <~a> with object <~a>: message<~a>"
+					 (location condition) (object condition) (message condition)))))
+
+(define-condition mpeg-bad-header (mpeg-condition) ())
+
+(defconstant +sync-word+  #xffe0)
+
+(defconstant +mpeg-2.5+   0)
+(defconstant +v-reserved+ 1)
+(defconstant +mpeg-2+     2)
+(defconstant +mpeg-1+     3)
+
+(defun valid-version (version)
+  (or ;; can't deal with 2.5's yet (= (the fixnum +mpeg-2.5+) (the fixnum version))
+	  (= (the fixnum +mpeg-2+) (the fixnum version))
+	  (= (the fixnum +mpeg-1+) (the fixnum version))))
+
+(defun get-mpeg-version-string (version) (nth version '("MPEG 2.5" "Reserved" "MPEG 2" "MPEG 1")))
+
+(defconstant +layer-reserved+  0)
+(defconstant +layer-3+         1)
+(defconstant +layer-2+		   2)
+(defconstant +layer-1+		   3)
+
+(defun valid-layer (layer)
+  (or (= (the fixnum +layer-3+) (the fixnum layer))
+	  (= (the fixnum +layer-2+) (the fixnum layer))
+	  (= (the fixnum +layer-1+) (the fixnum layer))))
+
+(defun get-layer-string (layer) (nth layer '("Reserved" "Layer III" "Layer II" "Layer I")))
+
+(defconstant +channel-mode-stereo+ 0)
+(defconstant +channel-mode-joint+  1)
+(defconstant +channel-mode-dual+   2)
+(defconstant +channel-mode-mono+   3)
+(defun get-channel-mode-string (mode)  (nth mode '("Stereo" "Joint" "Dual" "Mono")))
+
+(defconstant +emphasis-none+     0)
+(defconstant +emphasis-50-15+    1)
+(defconstant +emphasis-reserved+ 2)
+(defconstant +emphasis-ccit+     3)
+(defun get-emphasis-string (e)   (nth e '("None" "50/15 ms" "Reserved" "CCIT J.17")))
+(defun valid-emphasis (e) (or (= (the fixnum e) (the fixnum +emphasis-none+))
+							  (= (the fixnum e) (the fixnum +emphasis-50-15+))
+							  (= (the fixnum e) (the fixnum +emphasis-ccit+))))
+
+(defconstant +mode-extension-0+ 0)
+(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)
+  (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)))))
+  
+(defun get-samples-per-frame (version layer)
+  (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 384)
+		((= (the fixnum layer) (the fixnum +layer-2+)) 1152)
+		((= (the fixnum layer) (the fixnum +layer-3+))
+		 (cond ((= (the fixnum version) +mpeg-1+) 1152)
+			   ((or (= (the fixnum version) (the fixnum +mpeg-2+))
+					(= (the fixnum version) (the fixnum +mpeg-2.5+))) 576)))))
+
+(defclass frame ()
+  ((pos		       :accessor pos :initarg :pos)
+   (b-array        :accessor b-array :initarg :b-array)
+   (samples        :accessor samples :initarg :samples)
+   (sync           :accessor sync :initarg :sync)
+   (version        :accessor version :initarg :version)
+   (layer          :accessor layer :initarg :layer)
+   (protection     :accessor protection :initarg :protection)
+   (bit-rate       :accessor bit-rate :initarg :bit-rate)
+   (sample-rate    :accessor sample-rate :initarg :sample-rate)
+   (padded         :accessor padded :initarg :padded)
+   (private        :accessor private :initarg :private)
+   (channel-mode   :accessor channel-mode :initarg :channel-mode)
+   (mode-extension :accessor mode-extension :initarg :mode-extension)
+   (copyright      :accessor copyright :initarg :copyright)
+   (original       :accessor original :initarg :original)
+   (emphasis       :accessor emphasis :initarg :emphasis)
+   (size           :accessor size :initarg :size)
+   (vbr	           :accessor vbr :initarg :vbr)
+   (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
+					 :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 b-array samples sync version layer protection bit-rate sample-rate 
+					padded private channel-mode mode-extension copyright  
+					original emphasis size vbr payload) ,instance
+	 ,@body))
+
+(let ((bit-array-table
+	   (make-array '(14 5) :initial-contents
+				   '((32   32  32  32   8)
+					 (64   48  40  48  16)
+					 (96   56  48  56  24)
+					 (128  64  56  64  32)
+					 (160  80  64  80  40)
+					 (192  96  80  96  48)
+					 (224 112  96 112  56)
+					 (256 128 112 128  64)
+					 (288 160 128 144  80)
+					 (320 192 160 160  96)
+					 (352 224 192 176 112)
+					 (384 256 224 192 128)
+					 (416 320 256 224 144)
+					 (448 384 320 256 160)))))
+
+  (defun valid-bit-rate-index (br-index)
+	(and (> (the fixnum br-index) 0) (< (the fixnum br-index) 15)))
+
+  (defun get-bit-rate (version layer bit-rate-index)
+	(log5:with-context "get-bit-rate"
+	  (log-mpeg-frame "version = ~d, layer = ~d, bit-rate-index = ~d" version layer bit-rate-index)
+	  (let ((row (1- bit-rate-index))
+			(col (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
+						(cond ((= (the fixnum layer) (the fixnum +layer-1+)) 0)
+							  ((= (the fixnum layer) (the fixnum +layer-2+)) 1)
+							  ((= (the fixnum layer) (the fixnum +layer-3+)) 2)
+							  (t nil)))
+					   ((= (the fixnum version) (the fixnum +mpeg-2+))
+						(cond ((= (the fixnum layer) (the fixnum +layer-1+)) 3)
+							  ((= (the fixnum layer) (the fixnum +layer-2+)) 4)
+							  ((= (the fixnum layer) (the fixnum +layer-3+)) 4)
+							  (t nil)))
+					   (t (error "don't support MPEG 2.5 yet")))))
+
+		(log-mpeg-frame "version = ~d, row = ~d, col = ~d" version row col)
+		(if (or (null col) (< row 0) (> row 14))
+			nil
+			(let ((ret (* 1000 (aref bit-array-table row col))))
+			  (log-mpeg-frame "returning ~:d" ret)
+			  ret))))))
+
+(defun valid-sample-rate-index (sr-index)
+  (and (>= (the fixnum sr-index) 0)
+	   (<  (the fixnum sr-index) 3)))
+
+(defun get-sample-rate (version sr-index)
+  (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+))
+		 (case (the fixnum sr-index) (0 22050) (1 24000) (2 16000)))
+		(t nil)))
+
+(defun get-frame-size (version layer bit-rate sample-rate padded)
+  (truncate (float (cond ((= (the fixnum layer) (the fixnum +layer-1+))
+						  (* 4 (+ (/ (* 12 bit-rate) sample-rate) padded)))
+						 ((= (the fixnum layer) (the fixnum +layer-2+))
+						  (+ (* 144 (/ bit-rate sample-rate)) padded))
+						 ((= (the fixnum layer) (the fixnum +layer-3+))
+						  (if (= (the fixnum version) (the fixnum +mpeg-1+))
+							  (+ (* 144 (/ bit-rate sample-rate)) padded)
+							  (+ (* 72  (/ bit-rate sample-rate)) padded)))))))
+
+(defmethod load-frame ((me frame) &key instream (read-payload nil))
+  (log5:with-context "load-frame"
+	(with-frame-slots (me)
+	  (when (null b-array)				; has header already been read in?
+		(setf pos (stream-seek instream 0 :current))
+		(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)))))
+
+(defmethod parse-header ((me frame))
+  (log5:with-context "parse-header"
+	(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)))
+	  (when (not (= sync +sync-word+))
+		(return-from parse-header nil))
+
+	  (setf version (ldb (byte 2 3) (aref b-array 1)))
+	  (when (not (valid-version version))
+		(log-mpeg-frame "bad version ~d" version)
+		(return-from parse-header nil))
+
+	  (setf layer (ldb (byte 2 1) (aref b-array 1)))
+	  (when (not (valid-layer layer))
+		(log-mpeg-frame "bad layer ~d" layer)
+		(return-from parse-header nil))
+
+	  (setf protection (ldb (byte 1 0) (aref b-array 1)))
+	  (setf samples (get-samples-per-frame version layer))
+
+	  (let ((br-index (the fixnum (ldb (byte 4 4) (aref b-array 2)))))
+		(when (not (valid-bit-rate-index br-index))
+		  (log-mpeg-frame "bad bit-rate index ~d" br-index)
+		  (return-from parse-header nil))
+		(setf bit-rate (get-bit-rate version layer br-index)))
+
+	  (let ((sr-index (the fixnum (ldb (byte 2 2) (aref b-array 2)))))
+		(when (not (valid-sample-rate-index sr-index))
+		  (log-mpeg-frame "bad sample-rate index ~d" sr-index)
+		  (return-from parse-header nil))
+		(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 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)))
+	  (when (not (valid-emphasis emphasis))
+		(log-mpeg-frame "bad emphasis ~d" emphasis)
+		(return-from parse-header nil))
+
+	  (log-mpeg-frame "good parse: ~a" me)
+	  t)))
+
+(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))))
+
+(defclass vbr-info ()
+  ((tag    :accessor tag :initarg :tag)
+   (flags  :accessor flags :initarg :flags)
+   (frames :accessor frames :initarg :frames)
+   (bytes  :accessor bytes :initarg :bytes)
+   (tocs   :accessor tocs :initarg :tocs)
+   (scale  :accessor scale :initarg :scale))
+  (:default-initargs :tag nil :flags 0 :frames nil :bytes nil :tocs nil :scale nil))
+
+(defmacro with-vbr-info-slots ((instance) &body body)
+  `(with-slots (tag flags frames bytes tocs scale) ,instance
+	 ,@body))
+
+(defconstant +vbr-frames+  1)
+(defconstant +vbr-bytes+   2)
+(defconstant +vbr-tocs+    4)
+(defconstant +vbr-scale+   8)
+
+(defun get-side-info-size (version channel-mode)
+  (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))
+  (log5::with-context "check-vbr"
+	(with-frame-slots (me)
+	  (let ((i (get-side-info-size version channel-mode)))
+		(log-mpeg-frame "array index = ~d, payload size = ~d" i (length payload))
+		(when (or (and (= (aref payload (+ i 0)) (char-code #\X))
+					   (= (aref payload (+ i 1)) (char-code #\i))
+					   (= (aref payload (+ i 2)) (char-code #\n))
+					   (= (aref payload (+ i 3)) (char-code #\g)))
+				  (and (= (aref payload (+ i 0)) (char-code #\I))
+					   (= (aref payload (+ i 1)) (char-code #\n))
+					   (= (aref payload (+ i 2)) (char-code #\f))
+					   (= (aref payload (+ i 3)) (char-code #\o))))
+
+		  (log-mpeg-frame "found xing/info: ~c ~c ~c ~c"
+					  (code-char (aref payload (+ i 0)))
+					  (code-char (aref payload (+ i 1)))
+					  (code-char (aref payload (+ i 2)))
+					  (code-char (aref payload (+ i 3))))
+
+		  (setf vbr (make-instance 'vbr-info))
+		  (let ((v (make-mem-stream (payload me))))
+			(stream-seek v i :start)			; seek to xing/info info
+			(setf (tag vbr)   (stream-read-iso-string-with-len v 4))
+			(setf (flags vbr) (stream-read-u32 v))
+			(when (logand (flags vbr) +vbr-frames+)
+			  (setf (frames vbr) (stream-read-u32 v))
+			  (if (= 0 (frames vbr)) (warn "warning Xing/Info header flags has FRAMES set, but field is zero")))
+			(when (logand (flags vbr) +vbr-bytes+)
+			  (setf (bytes vbr) (stream-read-u32 v))
+			  (if (= 0 (bytes vbr)) (warn "warning Xing/Info header flags has BYTES set, but field is zero")))
+			(when (logand (flags vbr) +vbr-tocs+)
+			  (setf (tocs vbr) (stream-read-sequence v 100)))
+			(when (logand (flags vbr) +vbr-scale+)
+			  (setf (scale vbr) (stream-read-u32 v)))
+			(log-mpeg-frame "vbr-info = ~a" (vpprint vbr nil))))))))
+
+(defmethod vpprint ((me vbr-info) stream)
+  (with-vbr-info-slots (me)
+	(format stream "tag = ~a, flags = 0x~x, frames = ~:d, bytes = ~:d, tocs = ~d, scale = ~d, "
+			tag flags frames bytes tocs scale)))
+
+(defun find-first-sync (in)
+  (log5:with-context "find-first-sync"
+
+	(log-mpeg-frame "Looking for first sync, begining at file position ~:d" (stream-seek in 0 :current))
+	(let ((b-array (make-octets 4))
+		  (pos))
+
+	  (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 
+			 (setf pos (stream-seek in 0 :current))
+			 (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))))
+	  nil)))
+
+(defmethod next-frame ((me frame) &key instream read-payload)
+  (log5:with-context "next-frame"
+	(let ((nxt-frame (make-instance 'frame)))
+	  (when (not (payload me))
+		(log-mpeg-frame "no payload in current frame, skipping from ~:d forward ~:d bytes"
+						(stream-seek instream 0 :current)
+						(- (size me) 4) :current)
+		(stream-seek instream (- (size me) 4) :current))
+
+	  (if (load-frame nxt-frame :instream instream :read-payload read-payload)
+		  nxt-frame
+		  nil))))
+
+(defun map-frames (in func &key (start-pos nil) (read-payload nil) (max nil))
+  (log5:with-context "next-frame"
+	(log-mpeg-frame "mapping frame, start pos ~:d" start-pos)
+
+	(when start-pos
+	  (stream-seek in start-pos :start))
+
+	(loop 
+	   for max-frames = (if max max most-positive-fixnum)
+	   for count = 0 then (incf count)
+	   for frame = (find-first-sync in) then (next-frame frame :instream in :read-payload read-payload)
+	    while (and frame (< count max-frames)) do
+		 (log-mpeg-frame "At pos ~:d, dispatching function" (pos frame))
+		 (funcall func frame))))
+
+(defun get-mpeg-bit-rate-exhaustive (in)
+  (let ((n-frames 0)
+		(total-len 0)
+		(last-bit-rate nil)
+		(bit-rate-total 0)
+		(vbr nil))
+	(map-frames in (lambda (f)
+					 (incf n-frames)
+					 (incf total-len (float (/ (samples f) (sample-rate f))))
+					 (incf bit-rate-total (bit-rate f))
+					 (if (null last-bit-rate)
+						 (setf last-bit-rate (bit-rate f))
+						 (progn
+						   (when (not (= last-bit-rate (bit-rate f)))
+							 (setf vbr t))
+						   (setf last-bit-rate (bit-rate f)))))
+				:read-payload nil)
+	(if (or (zerop n-frames) (zerop bit-rate-total))
+		(values nil nil nil) 
+		(values vbr (float (/ bit-rate-total n-frames)) total-len))))
+
+(defun get-mpeg-bit-rate-ff (in)
+  (let ((ff (find-first-sync in)))
+	(if (not ff)
+		(return-from get-mpeg-bit-rate-ff (values nil nil)))
+	(if (vbr ff)
+		(let* ((len (float (* (frames (vbr ff)) (/ (samples ff) (sample-rate ff)))))
+			   (br (float (/ (* 8 (bytes (vbr ff)) ) len))))
+		  (values t br len))
+		(values nil nil nil))))
+
+(defclass mpeg-info ()
+  ((is-vbr      :accessor is-vbr :initarg :is-vbr)
+   (bit-rate    :accessor bit-rate :initarg :bit-rate)
+   (sample-rate :accessor sample-rate :initarg :sample-rate)
+   (len         :accessor len :initarg :len)
+   (version     :accessor version :initarg :version)
+   (layer       :accessor layer :initarg :layer))
+  (:default-initargs :is-vbr nil :bit-rate nil :sample-rate nil :len nil :version nil :layer nil))
+
+(defmethod vpprint ((me mpeg-info) stream)
+  (with-slots (is-vbr sample-rate  bit-rate len version layer) me
+	(format stream "~a, ~a, ~:[CBR,~;VBR,~] sample rate: ~:d Hz, bit rate: ~:d Kbps, duration: ~:d:~2,'0d"
+			(get-mpeg-version-string version)
+			(get-layer-string layer)
+			is-vbr
+			sample-rate
+			(round (/ bit-rate 1000))
+			(floor (/ len 60)) (round (mod len 60)))))
+  
+(defun get-mpeg-info (in &key (max-frames nil))
+  "Get MPEG Layer 3 audio information."
+  (log5:with-context "get-mpeg-info"
+	(let ((pos (stream-seek in 0 :current))
+		  (first-frame (find-first-sync in))
+		  (info (make-instance 'mpeg-info)))
+
+	  (log-mpeg-frame "search for first frame yielded ~a" first-frame)
+	  (when (null first-frame)
+		(return-from get-mpeg-info nil))
+
+	  (with-slots (is-vbr sample-rate bit-rate len version layer) info
+		(setf version (version first-frame))
+		(setf layer (layer first-frame))
+		(setf sample-rate (sample-rate first-frame))
+		(if (vbr first-frame)
+			(progn
+			  (log-mpeg-frame "found Xing/Info header")
+			  (setf is-vbr t)
+			  (setf len (float (* (frames (vbr first-frame)) (/ (samples first-frame) (sample-rate first-frame)))))
+			  (setf bit-rate  (float (/ (* 8 (bytes (vbr first-frame)) ) len))))
+			(let ((n-frames 0)
+				  (total-len 0)
+				  (last-bit-rate nil)
+				  (bit-rate-total 0)
+				  (vbr nil))
+			  (stream-seek in pos :start)
+			  (log-mpeg-frame "no Xing/Info, so mapping frames")
+			  (map-frames in (lambda (f)
+							   (incf n-frames)
+							   (incf total-len (float (/ (samples f) (sample-rate f))))
+							   (incf bit-rate-total (bit-rate f))
+							   (if (null last-bit-rate)
+								   (setf last-bit-rate (bit-rate f))
+								   (progn
+									 (when (not (= last-bit-rate (bit-rate f)))
+									   (setf vbr t))
+									 (setf last-bit-rate (bit-rate f)))))
+						  :read-payload nil :max max-frames)
+			  (if (or (< n-frames 10) (zerop bit-rate-total))
+				  (progn
+					(log-mpeg-frame "couldn't get mpeg-info: only got ~d frames" n-frames)
+					(return-from get-mpeg-info nil))
+				  (progn
+					(setf is-vbr vbr)
+					(setf len total-len)
+					(setf bit-rate (float (/ bit-rate-total n-frames))))))))
+	  info)))
+
+
+#|
+
+if we have a xing header, we use
+  num-frames, num-bytes from xing header and
+  sample-rate and layer info (to get num samples/sec---for layer 3 its 1152)
+
+then:
+
+  length in seconds is  =  num-frames * (1152 / sample-rate)
+  bit-rate is = (8 * num-bytes) / length in seconds, then divide by 1000 to get kbits/sec
+---------
+
+|#

+ 15 - 14
packages.lisp

@@ -3,12 +3,12 @@
 (in-package #:cl-user)
 
 (defpackage #:audio-streams
-  (:export #:octets #:make-octets
+  (:export #:octets #:make-octets *get-mpeg-info*
 		   #:mp3-file-stream #:mp4-file-stream #:base-mem-stream
 		   #:parse-mp3-file #:parse-mp4-file #:mp3-frame-condition
 		   #:make-mem-stream #:stream-filename
-		   #:mp4-atoms #:mp3-header
-		   #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32
+		   #:mp4-atoms #:mp3-header #:mpeg-info
+		   #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32 #:stream-read-octets
 		   #:stream-decode-iso-string #:stream-deocode-ucs-string #:stream-decode-ucs-be-string
 		   #:stream-decode-utf-8-string #:stream-decode-string #:stream-read-iso-string-with-len
 		   #:stream-read-ucs-string-with-len #:stream-read-ucs-be-string-with-len
@@ -49,18 +49,14 @@
   (:use #:common-lisp #:audio-streams))
 
 (defpackage :mp3-frame
-  (:export :mp3-frame #:find-mp3-frames :mp3-frame-condition #:vpprint #:header :get-frame-info
-		   :encoding :lang :desc :val :comment :artist :album :year :comment :year
-		   :mp3-map-frames :frames :year :title :genre :id :v21-tag-header :info :version)
-  (:use :common-lisp :audio-streams))
-
-(defpackage :mp3-tag
-  (:export :show-tags)
-  (:use :common-lisp :audio-streams :mp3-frame))
+  (:export #:mp3-frame #:find-mp3-frames #:mp3-frame-condition #:vpprint #:header #:get-frame-info
+		   #:encoding #:lang #:desc #:val #:comment #:artist #:album #:year #:comment #:year
+		   #:mp3-map-frames #:frames #:year #:title #:genre #:id #:v21-tag-header #:info #:version)
+  (:use #:common-lisp #:audio-streams))
 
-(defpackage #:tag
-  (:export #:get-genre-text)
-  (:use #:common-lisp))
+(defpackage #:mp3-tag
+  (:export #:show-tags #:get-id3v1-genre)
+  (:use #:common-lisp #:audio-streams #:mp3-frame))
 
 (defpackage #:mp4-tag
   (:export #:show-tags #:album #:album-artist #:artist #:comment #:composer #:copyright #:created
@@ -70,3 +66,8 @@
 (defpackage #:logging
   (:export #:with-logging)
   (:use #:common-lisp))
+
+(defpackage #:mpeg
+  (:export #:get-mpeg-info #:vpprint)
+  (:use #:common-lisp #:audio-streams))
+

+ 29 - 23
streams.lisp

@@ -16,7 +16,8 @@
   ((stream-filename :accessor stream-filename)))
 
 (defclass mp3-file-stream (base-file-stream)
-  ((mp3-header  :accessor mp3-header)))
+  ((mp3-header  :accessor mp3-header)
+   (mpeg-info   :accessor mpeg-info :initform nil)))
 
 (defclass mp4-file-stream (base-file-stream)
   ((mp4-atoms :accessor mp4-atoms :initform nil)))
@@ -36,7 +37,6 @@
 	(setf (stream new-stream) (ccl:make-vector-input-stream vector))
 	new-stream))
 
-
 (defmethod stream-close ((in-stream base-file-stream))
   (with-slots (stream) in-stream
 	(when stream
@@ -104,25 +104,28 @@
 
 (defmethod stream-read-sequence ((stream base-stream) size &key (bits-per-byte 8))
   "Read SIZE octets from input-file in BIT-PER-BYTE sizes"
-  (ecase bits-per-byte
-	(8
-	 (let ((octets (make-octets size)))
-	   (read-sequence octets (slot-value stream 'stream))
-	   octets))
-	(7
-	 (let* ((last-byte-was-FF nil)
-			(byte nil)
-			(octets (ccl:with-output-to-vector (out)
-					  (dotimes (i size)
-						(setf byte (stream-read-u8 stream))
-						(if last-byte-was-FF
-							(if (not (zerop byte))
-								(write-byte byte out))
-							(write-byte byte out))
-						(setf last-byte-was-FF (= byte #xFF))))))
-	   (format t "file pos is now: ~:d~%" (stream-seek stream 0 :current))
-	   (format t "length of data is ~:d~%" (length octets))
-	   octets))))
+  (log5:with-context "stream-read-sequence"
+	(ecase bits-per-byte
+	  (8
+	   (log-stream "reading ~:d bytes as 8-bit sequence" size)
+	   (let ((octets (make-octets size)))
+		 (read-sequence octets (slot-value stream 'stream))
+		 octets))
+	  (7
+	   (log-stream "reading ~:d bytes as 7-bit sequence" size)
+	   (let* ((last-byte-was-FF nil)
+			  (byte nil)
+			  (octets (ccl:with-output-to-vector (out)
+						(dotimes (i size)
+						  (setf byte (stream-read-u8 stream))
+						  (if last-byte-was-FF
+							  (if (not (zerop byte))
+								  (write-byte byte out))
+							  (write-byte byte out))
+						  (setf last-byte-was-FF (= byte #xFF))))))
+		 (log-stream "file pos is now: ~:d" (stream-seek stream 0 :current))
+		 (log-stream "~a" (mp3-frame::printable-array octets))
+		 octets)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; STRINGS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -292,12 +295,15 @@
 		(setf stream nil)))
 	stream))
 
-(defun parse-mp3-file (filename)
+(defvar *get-mpeg-info* nil)
+
+(defun parse-mp3-file (filename &key (get-mpeg-info *get-mpeg-info*))
   (let (stream)
 	  (handler-case
 		  (progn
 			(setf stream (make-file-stream 'mp3-file-stream filename))
-			(mp3-frame:find-mp3-frames stream))
+			(mp3-frame:find-mp3-frames stream)
+			(when get-mpeg-info (setf (mpeg-info stream) (mpeg:get-mpeg-info stream))))
 		(mp3-frame:mp3-frame-condition (c)
 		  (warn "make-mp3-stream got condition: ~a" c)
 		  (when stream (stream-close stream))

+ 0 - 57
tag.lisp

@@ -1,57 +0,0 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: TAG; -*-
-;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
-(in-package #:tag)
-
-;;;
-;;; From Practical Common Lisp be Peter Seibel
-;;;
-(defparameter *id3-v1-genres*
-  #(
-    ;; These are the official ID3v1 genres.
-    "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk" "Grunge"
-    "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other" "Pop" "R&B" "Rap"
-    "Reggae" "Rock" "Techno" "Industrial" "Alternative" "Ska"
-    "Death Metal" "Pranks" "Soundtrack" "Euro-Techno" "Ambient"
-    "Trip-Hop" "Vocal" "Jazz+Funk" "Fusion" "Trance" "Classical"
-    "Instrumental" "Acid" "House" "Game" "Sound Clip" "Gospel" "Noise"
-    "AlternRock" "Bass" "Soul" "Punk" "Space" "Meditative"
-    "Instrumental Pop" "Instrumental Rock" "Ethnic" "Gothic" "Darkwave"
-    "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance" "Dream"
-    "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40" "Christian Rap"
-    "Pop/Funk" "Jungle" "Native American" "Cabaret" "New Wave"
-    "Psychadelic" "Rave" "Showtunes" "Trailer" "Lo-Fi" "Tribal"
-    "Acid Punk" "Acid Jazz" "Polka" "Retro" "Musical" "Rock & Roll"
-    "Hard Rock"
-
-    ;; These were made up by the authors of Winamp but backported into
-    ;; the ID3 spec.
-    "Folk" "Folk-Rock" "National Folk" "Swing" "Fast Fusion"
-    "Bebob" "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde"
-    "Gothic Rock" "Progressive Rock" "Psychedelic Rock" "Symphonic Rock"
-    "Slow Rock" "Big Band" "Chorus" "Easy Listening" "Acoustic" "Humour"
-    "Speech" "Chanson" "Opera" "Chamber Music" "Sonata" "Symphony"
-    "Booty Bass" "Primus" "Porn Groove" "Satire" "Slow Jam" "Club"
-    "Tango" "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
-    "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella" "Euro-House"
-    "Dance Hall"
-
-    ;; These were also invented by the Winamp folks but ignored by the
-    ;; ID3 authors.
-    "Goa" "Drum & Bass" "Club-House" "Hardcore" "Terror" "Indie"
-    "BritPop" "Negerpunk" "Polsk Punk" "Beat" "Christian Gangsta Rap"
-    "Heavy Metal" "Black Metal" "Crossover" "Contemporary Christian"
-    "Christian Rock" "Merengue" "Salsa" "Thrash Metal" "Anime" "Jpop"
-    "Synthpop"))
-
-
-(defmacro safe-aref (arry index)
-  `(handler-case (aref ,arry ,index)
-	 (condition (c)
-	   (declare (ignore c))
-	   "N/A")))
-
-(defmethod get-genre-text ((genre string))
-  (safe-aref *id3-v1-genres* (parse-integer genre :start 1 :junk-allowed t)))
-
-(defmethod get-genre-text ((genre integer))
-  (safe-aref *id3-v1-genres* (- genre 1)))

+ 29 - 21
taglib-tests.lisp

@@ -10,6 +10,13 @@
 (defparameter *song-m4a* "01 Keep Yourself Alive.m4a")
 (defparameter *song-mp3* "02 You Take My Breath Away.mp3")
 
+(defun set-pathname-encoding (enc)
+  (setf (ccl:pathname-encoding-name) enc))
+(defun set-pathname-encoding-for-osx ()
+  (set-pathname-encoding :utf-8))
+(defun set-pathname-encoding-for-linux ()
+  (set-pathname-encoding nil))
+
 (defmethod has-extension ((n string) ext)
   (has-extension (parse-namestring n) ext))
 
@@ -19,9 +26,10 @@
 	  (string= (string-downcase e) (string-downcase ext))
 	  nil)))
 
-(defmacro redirect (filename &rest body)
-  `(let ((*standard-output* (open ,filename :direction :output :if-does-not-exist :create :if-exists :overwrite)))
-	 ,@body))
+(defmacro redirect ((filename) &rest body)
+  `(let ((*standard-output* (open ,filename :direction :output :if-does-not-exist :create :if-exists :supersede)))
+	 ,@body
+	 (finish-output *standard-output*)))
 
 ;;; A note re filesystem encoding: my music collection is housed on a Mac and shared via SAMBA.
 ;;; In order to make sure we get valid pathnames, we need to set CCL's filesystem encoding to 
@@ -39,11 +47,11 @@
   (mp4-test0 *song-m4a*))
 
 (defun mp4-test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
-  (let ((ccl:pathname-encoding-name file-system-encoding))
-	(osicat:walk-directory dir (lambda (f)
-								 (when (has-extension f "m4a")
-								   (let ((file (mp4-test0 f)))
-									 (when file (mp4-tag:show-tags file :raw raw))))))))
+  (set-pathname-encoding file-system-encoding)
+  (osicat:walk-directory dir (lambda (f)
+							   (when (has-extension f "m4a")
+								 (let ((file (mp4-test0 f)))
+								   (when file (mp4-tag:show-tags file :raw raw)))))))
 
 ;;;;;;;;;;;;;;;;;;;; MP3 Tests ;;;;;;;;;;;;;;;;;;;;
 (defun mp3-test0 (file)
@@ -57,19 +65,19 @@
   (mp3-test0 *song-mp3*))
 
 (defun mp3-test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
-  (let ((ccl:pathname-encoding-name file-system-encoding))
-	(osicat:walk-directory dir (lambda (f)
-								 (when (has-extension f "mp3")
-								   (let ((file (mp3-test0 f)))
-									 (when file (mp3-tag:show-tags file :raw raw))))))))
+  (set-pathname-encoding file-system-encoding)
+  (osicat:walk-directory dir (lambda (f)
+							   (when (has-extension f "mp3")
+								 (let ((file (mp3-test0 f)))
+								   (when file (mp3-tag:show-tags file :raw raw)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
-  (let ((ccl:pathname-encoding-name file-system-encoding))
-	(osicat:walk-directory dir (lambda (f)
-								 (if (has-extension f "mp3")
-									 (let ((file (mp3-test0 f)))
-									   (when file (mp3-tag:show-tags file :raw raw)))
-									 (if (has-extension f "m4a")
-										 (let ((file (mp4-test0 f)))
-										   (when file (mp4-tag:show-tags file :raw raw)))))))))
+  (set-pathname-encoding file-system-encoding)
+  (osicat:walk-directory dir (lambda (f)
+							   (if (has-extension f "mp3")
+								   (let ((file (mp3-test0 f)))
+									 (when file (mp3-tag:show-tags file :raw raw)))
+								   (if (has-extension f "m4a")
+									   (let ((file (mp4-test0 f)))
+										 (when file (mp4-tag:show-tags file :raw raw))))))))

+ 1 - 1
taglib.asd

@@ -7,8 +7,8 @@
   :license "Public Domain"
   :depends-on (#:log5 #:alexandria)
   :components ((:file "packages")
-			   (:file "tag"       :depends-on ("packages"))
 			   (:file "streams"   :depends-on ("packages"))
+			   (:file "mpeg"      :depends-on ("packages" "streams"))
 			   (:file "mp3-frame" :depends-on ("packages"))
 			   (:file "mp3-tag"   :depends-on ("packages" "mp3-frame" "streams"))
 			   (:file "logging"   :depends-on ("packages" "mp4-atom" "streams"))