mp3 ID3 mostly implmented.

mp3-frame.lisp

@@ -53,7 +53,7 @@
 		  (string= tag "TAG")))))
 
 (defclass v21-tag-header ()
-  ((songname :accessor songname :initarg :songname :initform nil)
+  ((title :accessor title :initarg :title :initform nil)
    (artist   :accessor artist   :initarg :artist   :initform nil)
    (album    :accessor album    :initarg :album    :initform nil)
    (year     :accessor year     :initarg :year     :initform nil)
@@ -69,16 +69,16 @@
 (defmethod print-object ((me v21-tag-header) stream)
   (if (null *pprint-mp3-frame*)
 	  (call-next-method)
-	  (with-slots (songname artist album year comment genre) me
-		(format stream "songname = <~a>, artist = <~a>, album = <~a>, year = <~a>, comment = <~a>, genre = ~d"
-				songname artist album year comment genre))))
+	  (with-slots (title artist album year comment genre) me
+		(format stream "title = <~a>, artist = <~a>, album = <~a>, year = <~a>, comment = <~a>, genre = ~d"
+				title artist album year comment genre))))
 
 (defmethod initialize-instance ((me v21-tag-header) &key instream)
   "Read in a V2.1 tag.  Caller will have stream-seek'ed file to correct location and ensured that TAG was present"
   (log5:with-context "v21-frame-initializer"
 	(log-mp3-frame "reading v2.1 tag")
-	(with-slots (songname artist album year comment genre) me
-	  (setf songname (trim-string (stream-read-string-with-len instream 30)))
+	(with-slots (title artist album year comment genre) me
+	  (setf title (trim-string (stream-read-string-with-len instream 30)))
 	  (setf artist   (trim-string (stream-read-string-with-len instream 30)))
 	  (setf album    (trim-string (stream-read-string-with-len instream 30)))
 	  (setf year     (trim-string (stream-read-string-with-len instream 4)))
@@ -280,7 +280,6 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 (defclass frame-rev (raw-frame) ())
 (defclass frame-rva (raw-frame) ())
 (defclass frame-slt (raw-frame) ())
-(defclass frame-ult (raw-frame) ())
 (defclass frame-waf (raw-frame) ())
 (defclass frame-war (raw-frame) ())
 (defclass frame-was (raw-frame) ())
@@ -301,17 +300,17 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
   ((encoding :accessor encoding)
    (lang     :accessor lang)
    (desc	 :accessor desc)
-   (text	 :accessor text)))
+   (val	     :accessor val)))
 
 (defmethod initialize-instance :after ((me frame-com) &key instream)
   (log5:with-context "frame-com"
-	(with-slots (len encoding lang desc text) me
+	(with-slots (len encoding lang desc val) me
 	  (setf encoding (stream-read-u8 instream))
 	  (setf lang (stream-read-iso-string-with-len instream 3))
 	  (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 3) encoding encoding)
 		(setf desc n)
-		(setf text v))
-	  (log-mp3-frame "encoding = ~d, lang = <~a>, desc = <~a>, text = <~a>" encoding lang desc text))))
+		(setf val v))
+	  (log-mp3-frame "encoding = ~d, lang = <~a>, desc = <~a>, text = <~a>" encoding lang desc val))))
 
 
 (defmethod print-object :after ((me frame-com) stream)
@@ -397,22 +396,22 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 (defclass frame-txx (id3-frame)
   ((encoding :accessor encoding)
    (desc     :accessor desc)
-   (value    :accessor value)))
+   (val      :accessor val)))
 
 (defmethod initialize-instance :after ((me frame-txx) &key instream)
   (log5:with-context "frame-txx"
-	(with-slots (len encoding desc value) me
+	(with-slots (len encoding desc val) me
 	  (setf encoding (stream-read-u8 instream))
 	  (multiple-value-bind (n v) (get-name-value-pair instream (1- len) encoding encoding)
 		(setf desc n)
-		(setf value v)
-		(log-mp3-frame "encoding = ~d, desc = <~a>, value = <~a>" encoding desc value)))))
+		(setf val v)
+		(log-mp3-frame "encoding = ~d, desc = <~a>, val = <~a>" encoding desc val)))))
 
 (defmethod print-object :after ((me frame-txx) stream)
   (if (null *pprint-mp3-frame*)
 	  (call-next-method)
-	  (with-slots (len encoding desc value) me
-		(format stream "frame-txx, encoding = ~d, desc = <~a>, value = <~a>" encoding desc value))))
+	  (with-slots (len encoding desc val) me
+		(format stream "frame-txx, encoding = ~d, desc = <~a>, val = <~a>" encoding desc val))))
 (defmethod vpprint ((me frame-txx) stream &key (indent 0))
   (let ((*pprint-mp3-frame* t))
 	(format stream "~vt~a" (* indent 1) me)))
@@ -475,6 +474,8 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 (defclass frame-txt (frame-text-info) ())
 (defclass frame-tye (frame-text-info) ())
 
+(defclass frame-ult (frame-com) ())
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; V2.3/4 frames
@@ -512,7 +513,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 (defclass frame-sylt (raw-frame) ())
 (defclass frame-sytc (raw-frame) ())
 (defclass frame-user (raw-frame) ())
-(defclass frame-uslt (raw-frame) ())
+
 
 ;; APIC
 ;; <Header for 'Attached picture', ID: "APIC">
@@ -640,29 +641,30 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 (defclass frame-txxx (id3-frame)
   ((encoding :accessor encoding)
    (desc     :accessor desc)
-   (value    :accessor value)))
+   (val      :accessor val)))
 
 (defmethod initialize-instance :after ((me frame-txxx) &key instream)
   (log5:with-context "frame-txxx"
-	(with-slots (encoding len desc value) me
+	(with-slots (encoding len desc val) me
 	  (setf encoding (stream-read-u8 instream))
 	  (multiple-value-bind (n v) (get-name-value-pair instream
 													  (- len 1)
 													  encoding
 													  encoding)
 		(setf desc n)
-		(setf value v))
-	  (log-mp3-frame "encoding = ~d, desc = <~a>, value = <~a>" encoding desc value))))
+		(setf val v))
+	  (log-mp3-frame "encoding = ~d, desc = <~a>, value = <~a>" encoding desc val))))
 
 (defmethod print-object :after ((me frame-txxx) stream)
   (if (null *pprint-mp3-frame*)
 	  (call-next-method)
-	  (format stream "frame-txxx: <~s/~s>" (desc me) (value me))))
+	  (format stream "frame-txxx: <~s/~s>" (desc me) (val me))))
 (defmethod vpprint ((me frame-txxx) stream &key (indent 0))
   "Set *pprint-mp3-frame* to get pretty printing and call print-object via format"
   (let ((*pprint-mp3-frame* t))
 	(format stream "~vt~a" (* indent 1) me)))
 
+(defclass frame-uslt (frame-comm) ())
 
 ;; UFID frames
 ;; <Header for 'Unique file identifier', ID: "UFID">
@@ -894,8 +896,8 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 
 	(log5:with-context "find-mp3-frames"
 	  (when (not (is-valid-mp3-file mp3-file))
-		(log-mp3-frame "~a is not an mp3 file" mp3-file)
-		(error 'mp3-frame-condition :location "find-mp3-frames" :object mp3-file :message "is not an mp3 file"))
+		(log-mp3-frame "~a is not an mp3 file" (stream-filename mp3-file))
+		(error 'mp3-frame-condition :location "find-mp3-frames" :object (stream-filename mp3-file) :message "is not an mp3 file"))
 
 	  (log-mp3-frame "~a is a valid mp3 file" (stream-filename mp3-file))
 
@@ -910,13 +912,16 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 			  (setf ext-header (make-instance 'mp3-extended-header :instream mem-stream)))
 			(multiple-value-bind (_ok _frames) (read-loop version mem-stream)
 			  (if (not _ok)
-				  (warn "had an error finding mp3 frames. potentially missed frames!"))
-			  (log-mp3-frame "ok = ~a, returing ~d frames" _ok (length _frames))
+				  (warn "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
+			  (log-mp3-frame "ok = ~a, returning ~d frames" _ok (length _frames))
 			  (setf frames _frames)
 			  _ok)))))))
 
 (defun get-frame-info (mp3-file frame-id)
-  (with-slots (frames version) (mp3-header mp3-file)
+  (with-slots (frames) (mp3-header mp3-file)
 	(dolist (f frames)
 	  (if (string= frame-id (id f))
 		  (return-from get-frame-info f)))))
+
+(defun mp3-map-frames (mp3-file &key (func (constantly t)))
+  (mapcar func (frames (mp3-header mp3-file))))

mp3-tag.lisp

@@ -2,40 +2,302 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:mp3-tag)
 
+(defparameter *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"
+	"Alternative Rock"
+	"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"
+	"Psychedelic"
+	"Rave"
+	"Showtunes"
+	"Trailer"
+	"Lo-Fi"
+	"Tribal"
+	"Acid Punk"
+	"Acid Jazz"
+	"Polka"
+	"Retro"
+	"Musical"
+	"Rock & Roll"
+	"Hard Rock"
+	"Folk"
+	"Folk/Rock"
+	"National Folk"
+	"Swing"
+	"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 Cappella"
+	"Euro-House"
+	"Dance Hall"
+	"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"))
+
+(defun get-id3v1-genre (n) 
+  (let ((idx (- n 1))) ; arrays are zero-based
+	(if (> idx (length *id3v1-genres*))
+		"BAD GENRE!?!?!?"
+		(aref *id3v1-genres* idx))))
+
+(defun get-frames (stream names)
+  (let (found-frames)
+	(mp3-map-frames stream
+					:func (lambda (f)
+							(when (member (id f) names :test #'string=)
+							  (push f found-frames))))
+	found-frames))
 
 (defmethod album ((me mp3-file-stream))
-  (let ((ret)
-		(f (get-frame-info me (ecase (version (mp3-header me)) (2 "TAL") (3 "TALB") (4 "TALB")))))
-	(if (not f)
-		(if (v21-tag-header (mp3-header me))
-			(setf ret (album (v21-tag-header (mp3-header me)))))
-		(setf ret (info f)))
-	ret))
+  (let ((ret (get-frames me '("TAL" "TALB"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one album tag")
+	  (return-from album (info (first ret)))))
+  (if (v21-tag-header (mp3-header me))
+	  (album (v21-tag-header (mp3-header me)))
+	  nil))
 
 (defmethod artist ((me mp3-file-stream))
-  (let ((f (get-frame-info me (ecase (version (mp3-header me)) (2 "TP1") (3 "TPE1") (4 "TPE1")))))
-	(if f
-		(info f)
-		nil)))
-
-(defmethod album-artist ((me mp3-file-stream)) nil)
-(defmethod comment ((me mp3-file-stream)) nil)
-(defmethod composer ((me mp3-file-stream)) nil)
-(defmethod copyright ((me mp3-file-stream)) nil)
-(defmethod year ((me mp3-file-stream)) nil)
-(defmethod encoder ((me mp3-file-stream)) nil)
-(defmethod groups ((me mp3-file-stream)) nil)
-(defmethod lyrics ((me mp3-file-stream)) nil)
-(defmethod purchased-date ((me mp3-file-stream)) nil)
-(defmethod title ((me mp3-file-stream)) nil)
-(defmethod tool ((me mp3-file-stream)) nil)
-(defmethod writer ((me mp3-file-stream)) nil)
-
-(defmethod compilation ((me mp3-file-stream)) nil)
-(defmethod disk  ((me mp3-file-stream)) nil)
-(defmethod tempo ((me mp3-file-stream)) nil)
-(defmethod genre ((me mp3-file-stream)) nil)
-(defmethod track ((me mp3-file-stream)) nil)
+  (let ((ret (get-frames me '("TP1" "TPE1"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one artist tag")
+	  (return-from artist (info (first ret)))))
+  (if (v21-tag-header (mp3-header me))
+	  (artist (v21-tag-header (mp3-header me)))
+	  nil))
+
+(defmethod comment ((me mp3-file-stream))
+  (let ((ret (get-frames me '("COM" "COMM"))))
+	(when ret
+	  (let ((new-ret))
+		(dolist (f ret)
+		  (push (list (encoding f) (lang f) (desc f) (val f)) new-ret))
+		(return-from comment new-ret))))
+  (if (v21-tag-header (mp3-header me))
+	  (comment (v21-tag-header (mp3-header me)))
+	  nil))
+
+(defmethod year ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TRD" "TDRC"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one year tag")
+	  (return-from year (info (first ret)))))
+  (if (v21-tag-header (mp3-header me))
+	  (year (v21-tag-header (mp3-header me)))
+	  nil))
+
+(defmethod title ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TT2" "TIT2"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one title tag")
+	  (return-from title (info (first ret)))))
+  (if (v21-tag-header (mp3-header me))
+	  (title (v21-tag-header (mp3-header me)))
+	  nil))
+
+(defmethod genre ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TCO" "TCON"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one genre tag")
+	  (return-from genre (info (first ret)))))
+  (if (v21-tag-header (mp3-header me))
+	  (get-id3v1-genre (genre (v21-tag-header (mp3-header me))))
+	  nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; no V2.1 tags for any of these ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod album-artist ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TP2" "TPE2"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one album-artist tag")
+	  (return-from album-artist (info (first ret)))))
+  nil)
+
+(defmethod composer ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TCM" "TCOM"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one composer tag")
+	  (return-from composer (info (first ret)))))
+  nil)
+
+(defmethod copyright ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TCR" "TCOP"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one copyright tag")
+	  (return-from copyright (info (first ret)))))
+  nil)
+
+(defmethod encoder ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TEN" "TENC"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one encoder tag")
+	  (return-from encoder (info (first ret)))))
+  nil)
+
+(defmethod groups ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TT1" "TTE1"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one group tag")
+	  (return-from groups (info (first ret)))))
+  nil)
+
+(defmethod lyrics ((me mp3-file-stream))
+  (let ((ret (get-frames me '("ULT" "USLT"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one lyrics tag")
+	  (return-from lyrics (val (first ret)))))
+  nil)
+
+(defmethod purchased-date ((me mp3-file-stream)) "NIY")
+
+(defmethod tool ((me mp3-file-stream)) "NIY")
+
+(defmethod writer ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TCM" "TCOM"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one composer tag")
+	  (return-from writer (info (first ret)))))
+  nil)
+
+(defmethod compilation ((me mp3-file-stream)) "NIY")
+
+(defmethod disk ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TPA" "TPOS"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one disk number tag")
+	  (return-from disk (info (first ret)))))
+  nil)
+
+(defmethod tempo ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TBP" "TBPM"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one tempo tag")
+	  (return-from tempo (info (first ret)))))
+  nil)
+
+(defmethod track ((me mp3-file-stream))
+  (let ((ret (get-frames me '("TRK" "TRCK"))))
+	(when ret
+	  (assert (= 1 (length ret)) () "There can be only one track number tag")
+	  (return-from track (info (first ret)))))
+  nil)
 
 (defmethod show-tags ((me mp3-file-stream) &key (raw nil))
   "Show the tags for an mp3-file"

mp4-atom.lisp

@@ -435,5 +435,11 @@ call traverse atom (unless length of path == 1, in which case, we've found out m
 		nil)))
 
 (defun mp4-show-raw-tag-atoms (mp4-file-stream)
-  (map-mp4-atom (mp4-atom::traverse  (mp4-atoms mp4-file-stream) (list +mp4-atom-moov+ +mp4-atom-udta+ +mp4-atom-meta+ +mp4-atom-ilst+)))))
+  (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 depth)
+						(when (= (atom-type atom) +itunes-ilst-data+)
+						  (format t "~4t~a~%" (vpprint atom nil :indent (if (null depth) 0 depth)))))))
+
 

mp4-tag.lisp

@@ -39,6 +39,7 @@
 
 (defmethod show-tags ((me mp4-file-stream) &key (raw nil))
   "Show the tags for an MP4-FILE"
+  (format t "~a~%" (stream-filename me))
   (if raw
 	  (mp4-atom:mp4-show-raw-tag-atoms me)
 	  (let ((album (album me))
@@ -60,7 +61,6 @@
 			(track (track me))
 			(writer (writer me))
 			(year (year me)))
-		(format t "~a~%" (stream-filename me))
 		(when album (format t "~4talbum: ~a~%" album))
 		(when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
 		(when artist (format t "~4tartist: ~a~%" artist))

packages.lisp

@@ -49,8 +49,9 @@
   (:use #:common-lisp #:audio-streams))
 
 (defpackage :mp3-frame
-  (:export :mp3-frame #:find-mp3-frames #:mp3-frame-condition #:vpprint #:header :get-frame-info
-		   :v21-tag-header :info :version)
+  (: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

streams.lisp

@@ -145,7 +145,10 @@
 			   (let ((retval 0))
 				 (setf (ldb (byte 8 0) retval) (aref octets 1))
 				 (setf (ldb (byte 8 8) retval) (aref octets 0))
-				 (assert (or (= #xfffe retval) (= #xfeff retval)) () "decode-ucs: invalid byte order mark ~x" retval)
+				 (when (not (or (= #xfffe retval) (= #xfeff retval)))
+				   (warn "got an invalid byte-order mark of ~x" retval)
+				   ; what do I do here... XXX
+				   )
 				 retval)))
 
 	  ;; special case: empty (and mis-coded) string

taglib-tests.lisp

@@ -65,12 +65,12 @@
 								   (when file (mp3-tag:show-tags file)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun test2 (&key (dir "Queen"))
+(defun test2 (&key (dir "Queen") (raw nil))
   (set-pathname-encoding-for-osx)
   (osicat:walk-directory dir (lambda (f)
 							   (if (has-extension f "mp3")
 								   (let ((file (mp3-test0 f)))
-									 (when file (mp3-tag:show-tags file)))
+									 (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))))))))
+										 (when file (mp4-tag:show-tags file :raw raw))))))))