reworked warning logic

audio-streams.lisp

@@ -145,9 +145,7 @@
 				 (setf (ldb (byte 8 0) retval) (aref octets 1))
 				 (setf (ldb (byte 8 8) retval) (aref octets 0))
 				 (when (not (or (= #xfffe retval) (= #xfeff retval)))
-				   (warn "got an invalid byte-order mark of ~x" retval)
-				   ; what do I do here... XXX
-				   )
+				   (error "got an invalid byte-order mark of ~x" retval))
 				 retval)))
 
 	  ;; special case: empty (and mis-coded) string
@@ -286,7 +284,7 @@
 		  (setf stream (make-file-stream 'mp4-file-stream filename))
 		  (mp4-atom:find-mp4-atoms stream))
 	  (mp4-atom:mp4-atom-condition (c)
-		(warn "make-mp4-stream got condition: ~a" c)
+		(warn-user "make-mp4-stream got condition: ~a" c)
 		(when stream (stream-close stream))
 		(setf stream nil)))
 	stream))
@@ -302,7 +300,7 @@
 			(when get-mpeg-info
 			  (setf (mpeg-info stream) (mpeg:get-mpeg-info stream))))
 		(id3-frame:id3-frame-condition (c)
-		  (warn "make-mp3-stream got condition: ~a" c)
+		  (warn-user "make-mp3-stream got condition: ~a" c)
 		  (when stream (stream-close stream))
 		  (setf stream nil)))
 	stream))

id3-frame.lisp

@@ -66,6 +66,7 @@ and/or end (version 2.1)"
   (log5:with-context "v21-frame-initializer"
 	(log-id3-frame "reading v2.1 tag")
 	(with-slots      (title artist album year comment genre track) me
+	  (setf track nil)
 	  (setf title    (upto-null (stream-read-string-with-len instream 30)))
 	  (setf artist   (upto-null (stream-read-string-with-len instream 30)))
 	  (setf album    (upto-null (stream-read-string-with-len instream 30)))
@@ -876,7 +877,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 	  (when (or (= version 3) (= version 4))
 		(setf frame-flags (stream-read-u16 instream))
 		(when (not (valid-frame-flags version frame-flags))
-			(warn "Invalid frame flags found ~a" (print-frame-flags version frame-flags nil))))
+		  (warn-user "Invalid frame flags found ~a, will ignore" (print-frame-flags version frame-flags nil))))
 
 	  (log-id3-frame "making frame: id:~a, version: ~d, len: ~:d, flags: ~a"
 					 frame-name version frame-len
@@ -910,6 +911,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 						 (log-id3-frame "bottom of read-loop: pos = ~:d, size = ~:d" (stream-seek stream 0 :current) (stream-size stream))
 						 (push this-frame frames))
 					 (condition (c)
+					   ;; XXX need to 'handle' warnings here...
 					   (log-id3-frame "got condition ~a when making frame" c)
 					   (return-from read-loop (values nil (nreverse frames))))))
 
@@ -939,7 +941,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 			;; start reading frames from memory stream
 			(multiple-value-bind (_ok _frames) (read-loop version mem-stream)
 			  (if (not _ok)
-				  (warn "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
+				  (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
 			  (log-id3-frame "ok = ~a, returning ~d frames" _ok (length _frames))
 			  (setf frames _frames)
 			  _ok)))))))

mp3-tag.lisp

@@ -231,7 +231,7 @@
   (let ((frames (get-frames me '("TCO" "TCON"))))
 	(when frames
 	  (when (> (length frames) 1)
-		(warn "file ~a has more than one genre frame, will only use the first" (stream-filename me)))
+		(warn-user "file ~a has more than one genre frame, will only use the first" (stream-filename me)))
 	  (let ((count)
 			(end)
 			(str (info (first frames))))
@@ -244,9 +244,9 @@
 		;; only allow one (no refinements) or we can handle the simple string case
 		(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))
+		  (when (> count 1) (warn-user "Don't support genre refinement yet, found ~d genres" count))
 		  (setf end (position #\) str))
-		  (when (null end) (warn "Bad format for genre, ending paren is missing"))
+		  (when (null end) (warn-user "Bad format for genre, ending paren is missing"))
 		  (setf str (get-id3v1-genre (parse-integer (subseq str 1 end)))))
 		(return-from genre str))))
 

mp4-atom.lisp

@@ -269,7 +269,7 @@ seek forward past end of this atom."
 		   (atom))
 	  (declare (type integer pos siz typ))
 	  (when (= 0 siz)
-		(warn "trying to make an atom ~a with size of 0 at offset ~:d in ~a, ammending size to be 8" (as-string typ) pos (stream-filename mp4-file))
+		(warn-user "trying to make an atom ~a with size of 0 at offset ~:d in ~a, ammending size to be 8" (as-string typ) pos (stream-filename mp4-file))
 		(setf siz 8))
 	  (log-mp4-atom "pos = ~:d, size = ~:d, type = ~a" pos siz (as-string typ))
 	  (cond ((member typ *atoms-of-interest*)

mpeg.lisp

@@ -302,10 +302,10 @@
 			(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")))
+			  (if (= 0 (frames vbr)) (warn-user "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")))
+			  (if (= 0 (bytes vbr)) (warn-user "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+)

packages.lisp

@@ -21,7 +21,7 @@
 		   #:stream-read-utf-8-string #:stream-read-string
 		   #:stream-read-string #:stream-read-sequence #:stream-size
 		   #:stream-seek #:stream-close)
-  (:use #:common-lisp))
+  (:use #:common-lisp #:utils))
 
 (defpackage #:mp4-atom
   (:export #:mp4-atom #:map-mp4-atom #:find-mp4-atoms #:traverse #:mp4-atom-condition
@@ -50,28 +50,32 @@
 		   #:+itunes-tempo+
 		   #:+itunes-track+
 		   #:+itunes-track-n+)
-  (:use #:common-lisp #:audio-streams))
+  (:use #:common-lisp #:audio-streams #:utils))
+
+(defpackage #:utils
+  (:export #:warn-user)
+  (:use #:common-lisp))
 
-(defpackage :id3-frame
+(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 #:iso-639-2))
+  (:use #:common-lisp #:audio-streams #:utils #:iso-639-2))
 
 (defpackage #:mp3-tag
   (:export #:show-tags #:get-id3v1-genre)
-  (:use #:common-lisp #:audio-streams #:id3-frame))
+  (:use #:common-lisp #:audio-streams #:id3-frame #:utils))
 
 (defpackage #:mp4-tag
   (:export #:show-tags #:album #:album-artist #:artist #:comment #:composer #:copyright #:created
 		   #:encoder #:groups #:lyrics #:purd #:title #:tool #:writer)
-  (:use #:common-lisp #:audio-streams))
+  (:use #:common-lisp #:audio-streams #:utils))
 
 (defpackage #:logging
   (:export #:with-logging)
-  (:use #:common-lisp))
+  (:use #:common-lisp #:utils))
 
 (defpackage #:mpeg
   (:export #:get-mpeg-info #:vpprint)
-  (:use #:common-lisp #:audio-streams))
+  (:use #:common-lisp #:audio-streams #:utils))

taglib.asd

@@ -7,6 +7,7 @@
   :license "Public Domain"
   :depends-on (#:log5 #:alexandria)
   :components ((:file "packages")
+			   (:file "utils"         :depends-on ("packages"))
 			   (:file "audio-streams" :depends-on ("packages"))
 			   (:file "mpeg"          :depends-on ("packages" "audio-streams"))
 			   (:file "iso-639-2"     :depends-on ("packages"))

utils.lisp

@@ -0,0 +1,10 @@
+;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: UTILS; -*-
+;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
+(in-package #:utils)
+
+(defun warn-user (format-string &rest args)
+  "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)
+  (format *error-output* "~%~%"))