still working on moving to flexi, but this is close

abstract-tag.lisp

@@ -206,11 +206,9 @@
 (defmethod compilation ((me mp3-file-stream))
   (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TCMP" "TCP"))))
-    (when frames
-      (assert (= 1 (length frames)) () "There can be only one compilation tag")
-      (let ((str (info (first frames))))
-        (return-from compilation (if (string= "1" str) "yes" "no")))))
-  nil)
+    (if frames
+      (info (first frames))
+      "no")))
 
 (defmethod disk ((me mp3-file-stream))
   (declare #.utils:*standard-optimize-settings*)
@@ -360,7 +358,7 @@
         (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
         (when artist (format t "~4tartist: ~a~%" artist))
         (when comment (format t "~4tcomment: ~a~%" comment))
-        (when compilation (format t "~4tcompilation: ~[no~;yes;unknown~]~%" (if compilation compilation 2)))
+        (format t "~4tcompilation: ~[no~;yes~;unknown~]~%" (if compilation compilation 2))
         (when composer (format t "~4tcomposer: ~a~%" composer))
         (when copyright (format t "~4tcopyright: ~a~%" copyright))
 ;;;        (when cover (format t "~4tcover: Number of covers: :~d~%" cover))

audio-streams.lisp

@@ -22,7 +22,6 @@
 (defun make-mem-stream (v) (make-instance 'mem-stream :vect v))
 (defun make-mmap-stream (f) (make-instance 'mem-stream :stream-filename f))
 
-;;; XXX from quickutil/alexandria---should change to qtlc:utilize
 (defmethod initialize-instance :after ((stream mem-stream) &key)
   "Stream initializer. If STREAM-FILENAME is set, MMAP a the file. Else, we assume VECT was set."
   (with-mem-stream-slots (stream)
@@ -36,8 +35,7 @@
   "Close a stream, making the underlying object (file or vector) inaccessible."
   (declare #.utils:*standard-optimize-settings*)
   (with-mem-stream-slots (stream)
-    (when stream-filename
-      #+CCL (ccl:unmap-octet-vector vect))
+    #+CCL (when stream-filename (ccl:unmap-octet-vector vect))
     (setf vect nil)))
 
 ;;; finding out current file position is so common, we also

id3-frame.lisp

@@ -468,7 +468,31 @@ 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-tcp (frame-text-info) ())
+
+(defclass frame-itunes-compilation (frame-raw)
+  ((info :accessor info)))
+
+(defmethod initialize-instance :after ((me frame-itunes-compilation) &key &allow-other-keys)
+  "iTunes compilation weirdness: I have seen this encoded soooo many ways..."
+  (declare #.utils:*standard-optimize-settings*)
+  (with-slots (len octets info) me
+    (setf info
+          (cond
+            ((= 1 len) (if (= 0 (aref octets 0)) "0" "1"))
+            ((= 2 len) (if (= #x30 (aref octets 1)) "0" "1"))
+            ((= 3 len) (if (typep me 'frame-tcp)
+                           (upto-null (stream-decode-string octets :start 1 :encoding (aref octets 0)))
+                           "0"))
+            ((= 4 len) "0")
+            (t (upto-null (stream-decode-string octets :start 1 :encoding (aref octets 0))))))))
+
+(defmethod vpprint ((me frame-itunes-compilation) stream)
+  (with-slots (octets info) me
+      (format stream "frame-itunes-compilation: ~a, octets:<~a>, info:~a"
+              (vpprint-frame-header me) (printable-array octets) info)))
+
+(defclass frame-tcp (frame-itunes-compilation) ())
+
 (defclass frame-tcr (frame-text-info) ())
 (defclass frame-tda (frame-text-info) ())
 (defclass frame-tdy (frame-text-info) ())
@@ -573,7 +597,9 @@ NB: 2.3 and 2.4 extended flags are different..."
 ;;; V23/V24 text-info frames
 (defclass frame-talb (frame-text-info) ())
 (defclass frame-tbpm (frame-text-info) ())
-(defclass frame-tcmp (frame-text-info) ())
+
+(defclass frame-tcmp (frame-itunes-compilation) ())
+
 (defclass frame-tcom (frame-text-info) ())
 (defclass frame-tcon (frame-text-info) ())
 (defclass frame-tcop (frame-text-info) ())

taglib-tests.lisp

@@ -40,7 +40,6 @@
       (when foo
         (stream-close foo)))))
 
-
 (defun do-audio-dir (&optional (dir "Queen") &key (file-system-encoding :utf-8)
                                                   (func #'abstract-tag:show-tags))
   "Walk :DIR and FUNCALL specified function for each file audio found."

taglib.asd

@@ -2,12 +2,11 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 
 (pushnew :DBG *features*)
-
 (asdf:defsystem #:taglib
   :description "Pure Lisp implementation to read (and write, perhaps, one day) tags"
   :author "Mark VandenBrink"
   :license "Public Domain"
-  :depends-on (#:optima #:optima.ppcre #:flexi-streams #:babel #:alexandria)
+  :depends-on (#:optima #:optima.ppcre #:flexi-streams #:alexandria)
   :components ((:file "packages")
                (:file "profile"       :depends-on ("packages"))
                (:file "utils"         :depends-on ("packages"))