cleaning up rough edges. checkpoint

mp3-frame.lisp

@@ -17,9 +17,6 @@
 (defmethod print-object ((me mp3-frame-condition) stream)
   (format stream "location: <~a>, object: <~a>, message: <~a>" (location me) (object me) (message me)))
 
-(defparameter *pprint-mp3-frame* nil
-  "Controls whether we pretty print frame data")
-
 (defclass mp3-id3-header ()
   ((version        :accessor version        :initarg :version        :initform 0)
    (revision       :accessor revision       :initarg :revision       :initform 0)
@@ -217,6 +214,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 
 (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))
 		 (print-len (min len *max-raw-bytes-print-len*))
 		 (printable-array (make-array print-len :displaced-to array)))
@@ -278,7 +276,10 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 	  (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 val v))
+		(let ((len (1- (length v))))
+		  (if (and (> len 0) (eq #\Null (aref v len))) ; iTunes broken-ness... maybe this should be done on rendering the comment instead of here?
+			  (setf val (make-array len :displaced-to v))
+			  (setf val v))))
 	  (log-mp3-frame "encoding = ~d, lang = <~a>, desc = <~a>, text = <~a>" encoding lang desc val))))
 
 (defmethod vpprint ((me frame-com) stream)
@@ -507,9 +508,10 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 	  (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)
-		(if (eq #\Null (aref v (1- (length v)))) ; iTunes broken-ness... maybe this should be done on rendering the comment instead of here?
-			(setf val (make-array (1- (length v)) :displaced-to v))
-			(setf val v)))
+		(let ((len (1- (length v))))
+		  (if (and (> len 0) (eq #\Null (aref v len))) ; iTunes broken-ness... maybe this should be done on rendering the comment instead of here?
+			  (setf val (make-array len :displaced-to v))
+			  (setf val v))))
 	  (log-mp3-frame "encoding = ~d, lang = <~a>, desc = <~a>, val = <~a>" encoding lang desc val))))
 
 (defmethod vpprint ((me frame-comm) stream)

mp3-tag.lisp

@@ -221,7 +221,7 @@
 	  (let ((count)
 			(end)
 			(str (info (first frames))))
-		(when (eq #\( (aref str 0))
+		(when (and (>= (length str) 1) (eq #\( (aref str 0)))
 		  (setf count (count #\( str))
 		  (when (> count 1) (warn "Don't support genre refinement yet, found ~d genres" count))
 		  (setf end (position #\) str))
@@ -323,7 +323,7 @@
   nil)
 
 (defmethod show-tags ((me mp3-file-stream) &key (raw nil))
-  "Show the tags for an mp3-file"
+  "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)))
 	  (let ((album (album me))

mp4-atom.lisp

@@ -12,6 +12,7 @@
   (:report (lambda (condition stream)
 			 (format stream "mp4-atom condition at location: <~a> with object: <~a>: message: <~a>"
 					 (location condition) (object condition) (message condition)))))
+
 (defmethod print-object ((me mp4-atom-condition) stream)
   (format stream "location: <~a>, object: <~a>, message: <~a>" (location me) (object me) (message me)))
 
@@ -287,26 +288,15 @@ seek forward past end of this atom."
 	  (log-mp4-atom "returning ~a" (vpprint atom nil))
 	  atom)))
 
-(defparameter *pprint-mp4-atom* nil
-  "Controls whether we pretty print an atom")
-
-(defmethod print-object ((me mp4-atom) stream)
-  (if (null *pprint-mp4-atom*)
-	  (call-next-method)
-	  ;; else
-	  (format stream "~a" (with-output-to-string (s)
-							(with-slots (atom-children atom-file-position atom-size atom-type) me
-							  (format s "Atom <~a> @ ~:d of size ~:d and child count of ~d"
-									  (as-string atom-type) atom-file-position atom-size (size atom-children)))
-							(if (typep me 'mp4-ilst-generic-data-atom)
-								(with-slots (atom-version atom-flags atom-value atom-type atom-parent-type) me
-								  (format s " having ilst fields: atom-parent-type = ~a, verison = ~d, flags = ~x, data = ~x"
-										  (as-string atom-parent-type) atom-version atom-flags atom-value)))))))
-
-(defmethod vpprint ((me mp4-atom) stream &key (indent 0))
-  "set *pprint-mp4-atom* to get pretty printing and call print-object via format"
-  (let ((*pprint-mp4-atom* t))
-	(format stream "~vt~a" (* indent 1) me)))
+(defmethod vpprint ((me mp4-atom) stream)
+  (format stream "~a" (with-output-to-string (s)
+						(with-slots (atom-children atom-file-position atom-size atom-type) me
+						  (format s "Atom <~a> @ ~:d of size ~:d and child count of ~d"
+								  (as-string atom-type) atom-file-position atom-size (size atom-children)))
+						(if (typep me 'mp4-ilst-generic-data-atom)
+							(with-slots (atom-version atom-flags atom-value atom-type atom-parent-type) me
+							  (format s " having ilst fields: atom-parent-type = ~a, verison = ~d, flags = ~x, data = ~x"
+									  (as-string atom-parent-type) atom-version atom-flags atom-value))))))
 
 (defclass mp4-unhandled-data ()
   ((blob :accessor blob :initarg :blob :initform nil))
@@ -380,7 +370,7 @@ The 'right' atoms are those in *atoms-of-interest*"
   "traverse all atoms under a given atom"
   (log5:with-context "map-mp4-atom(single)"
 	(labels ((_indented-atom (atom depth)
-			   (format t "~a~%" (vpprint atom nil :indent (if (null depth) 0 depth)))))
+			   (format t "~vt~a~%"  (if (null depth) 0 depth) (vpprint atom nil))))
 	  (with-slots (atom-type atom-children) me
 		(log-mp4-atom "Begining traversal with ~a, I have ~d children" (as-string atom-type) (size atom-children))
 		(when (null func)
@@ -438,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 depth)
+				:func (lambda (atom)
 						(when (= (atom-type atom) +itunes-ilst-data+)
-						  (format t "~4t~a~%" (vpprint atom nil :indent (if (null depth) 0 depth)))))))
+						  (format t "~4t~a~%" (vpprint atom nil))))))
 
 

mp4-tag.lisp

@@ -38,7 +38,7 @@
 		track-n)))
 
 (defmethod show-tags ((me mp4-file-stream) &key (raw nil))
-  "Show the tags for an MP4-FILE"
+  "Show the tags for an MP4-FILE. If RAW is non-nil, dump the DATA atoms; else show subset of DATA atoms"
   (format t "~a~%" (stream-filename me))
   (if raw
 	  (mp4-atom:mp4-show-raw-tag-atoms me)

taglib-tests.lisp

@@ -10,13 +10,6 @@
 (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))
 
@@ -30,6 +23,10 @@
   `(let ((*standard-output* (open ,filename :direction :output :if-does-not-exist :create :if-exists :overwrite)))
 	 ,@body))
 
+;;; 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 
+;;; :UTF-8
+
 ;;;;;;;;;;;;;;;;;;;; MP4 Tests ;;;;;;;;;;;;;;;;;;;;
 (defun mp4-test0 (file)
   (let (foo)
@@ -41,11 +38,12 @@
 (defun mp4-test1 ()
   (mp4-test0 *song-m4a*))
 
-(defun mp4-test2 (&key (dir "Queen"))
-  (osicat:walk-directory dir (lambda (f)
-							   (when (has-extension f "m4a")
-								 (let ((file (mp4-test0 f)))
-								   (when file (mp4-tag:show-tags file)))))))
+(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))))))))
 
 ;;;;;;;;;;;;;;;;;;;; MP3 Tests ;;;;;;;;;;;;;;;;;;;;
 (defun mp3-test0 (file)
@@ -58,19 +56,20 @@
 (defun mp3-test1 ()
   (mp3-test0 *song-mp3*))
 
-(defun mp3-test2 (&key (dir "Queen") (raw nil))
-  (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 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))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(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 :raw raw)))
-								   (if (has-extension f "m4a")
-									   (let ((file (mp4-test0 f)))
-										 (when file (mp4-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)))))))))