checkpoint: cleanup continues

audio-streams.lisp

@@ -85,6 +85,11 @@
   (with-slots (stream) in-stream
 	(stream-read-octets stream 4 :bits-per-byte bits-per-byte)))
 
+(defmethod stream-read-u64 ((in-stream base-stream) &key (bits-per-byte 8))
+  "read 8 bytes from file"
+  (with-slots (stream) in-stream
+	(stream-read-octets stream 8 :bits-per-byte bits-per-byte)))
+
 ;; (defmethod stream-read-string ((stream base-stream) &key size (terminators nil))
 ;;   "Read normal string from stream. If size is provided, read exactly that many octets.
 ;; If terminators is supplied, it is a list of characters that can terminate a string (and hence stop read)"
@@ -107,12 +112,12 @@
   (log5:with-context "stream-read-sequence"
 	(ecase bits-per-byte
 	  (8
-	   (log-stream "reading ~:d bytes as 8-bit sequence" size)
+	   ;(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)
+	   ;(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)
@@ -123,8 +128,8 @@
 								  (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" (id3-frame:printable-array octets))
+		 ;(log-stream "file pos is now: ~:d" (stream-seek stream 0 :current))
+		 ;(log-stream "~a" (utils:printable-array octets))
 		 octets)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; STRINGS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

id3-frame.lisp

@@ -282,18 +282,6 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 	  (setf octets (stream-read-sequence instream len))
 	  (log-id3-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))
-		 (print-len (min len *max-raw-bytes-print-len*))
-		 (printable-array (make-array print-len :displaced-to array)))
-	(format nil "[~:d of ~:d bytes] <~x>" print-len len printable-array)))
-
-(defun upto-null (string)
-  "Trim STRING to end at first NULL found"
-  (subseq string 0 (position #\Null string)))
 
 (defmethod vpprint ((me frame-raw) stream)
   (with-slots (octets) me

logging.lisp

@@ -20,12 +20,12 @@
 									 id3-frame::cat-log-id3-frame))
 
 
-(defmacro with-logging ((&key (file nil) (categories *logging-categories*)) &body body)
+(defmacro with-logging ((&optional file &key (categories *logging-categories*)) &body body)
   (alexandria:with-gensyms (output-stream)
 	`(let (,output-stream)
 	   (unwind-protect
 			(setf ,output-stream (if ,file
-									 (open ,file :direction :output :if-exists :overwrite :if-does-not-exist :create)
+									 (open ,file :direction :output :if-exists :supersede :if-does-not-exist :create)
 									 *standard-output*))
 			(log5:start-sender 'trace-log (log5:stream-sender :location ,output-stream)
 							   :category-spec ',categories

mp3-tag.lisp

@@ -163,10 +163,11 @@
 
 (defun get-id3v1-genre (n)
   "Given N, a supposed ID3 genre, range check it to make sure it is > 0 and < (sizeof *ID3V1-GENRES*)"
-  (if (or (> n (length *id3v1-genres*))
-		  (< n 0))
-	  "BAD GENRE"
-	  (aref *id3v1-genres* n)))
+  (let ((idx (- n 1)))	; genres are 1-based, arrays 0-based
+	(if (or (> idx (length *id3v1-genres*))
+			(< idx 0))
+		"BAD GENRE"
+	  (aref *id3v1-genres* idx))))
 
 (defun get-frames (stream names)
   "Given a MP3-STREAM, search its frames for NAMES.  Return file-order list of matching frames"

mp4-tag.lisp

@@ -25,9 +25,9 @@
 		(genre-x (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre-x+)))
 	(assert (not (and genre genre-x)))
 	(cond
-	  (genre (mp3-tag:get-id3v1-genre genre))
-	  (genre-x (mp3-tag:get-id3v1-genre genre-x))
-	  (t nil))))
+	  (genre   (format nil "~d (~a)" genre (mp3-tag:get-id3v1-genre genre)))
+	  (genre-x (format nil "~d (~a)" genre-x (mp3-tag:get-id3v1-genre genre-x)))
+	  (t       "None"))))
 (defmethod track ((me mp4-file-stream))
   (let ((track   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track+))
 		(track-n (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track-n+)))
@@ -64,7 +64,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))
-		(format t "~4tcompilation: ~a~%" compilation)
+		(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 disk (format t "~4tdisk: ~a~%" disk))

packages.lisp

@@ -3,7 +3,7 @@
 (in-package #:cl-user)
 
 (defpackage #:utils
-  (:export #:warn-user)
+  (:export #:warn-user #:printable-array #:upto-null)
   (:use #:common-lisp))
 
 (defpackage #:iso-639-2
@@ -16,7 +16,7 @@
 		   #:id3-header #:mpeg-info #:mp4-atoms
 		   #:parse-mp3-file #:parse-mp4-file
 		   #:make-mem-stream #:stream-filename
-		   #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32 #:stream-read-octets
+		   #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32 #:stream-read-u64 #: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
@@ -60,7 +60,6 @@
 (defpackage #:id3-frame
   (:export #:id3-frame #:find-id3-frames #:id3-frame-condition #:vpprint #:header #:get-frame-info
 		   #:encoding #:lang #:desc #:val #:comment #:artist #:album #:year #:comment #:year
-		   #:printable-array
 		   #:map-id3-frames #:frames #:year #:title #:genre #:id #:v21-tag-header #:info #:version)
   (:use #:common-lisp #:audio-streams #:utils #:iso-639-2))
 

taglib-tests.lisp

@@ -38,7 +38,7 @@
 ;;;;;;;;;;;;;;;;;;;; MP4 Tests ;;;;;;;;;;;;;;;;;;;;
 (defun mp4-test0 (file)
   (let (foo)
-	(unwind-protect 
+	(unwind-protect
 		 (setf foo (parse-mp4-file file))
 	  (when foo (stream-close foo)))
 	foo))

utils.lisp

@@ -6,5 +6,22 @@
   "print a warning error to *ERROR-OUTPUT* and continue"
   ;; COMPLETELY UNPORTABLE!!!
   (format *error-output* "~&~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
-  (format *error-output* format-string args)
+  (apply #'format *error-output* format-string args)
   (format *error-output* "~%~%"))
+
+(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)))
+	(format nil "[~:d of ~:d bytes] <~x>" print-len len printable-array)))
+
+(defun upto-null (string)
+  "Trim STRING to end at first NULL found"
+  (subseq string 0 (position #\Null string)))
+
+(defun dump-data (file-name data)
+  (with-open-file (f file-name :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+	(write-sequence data f)))