added flac support and removed conditions

audio-streams.lisp

@@ -6,17 +6,6 @@
 (log5:defcategory cat-log-stream)
 (defmacro log-stream (&rest log-stuff) `(log5:log-for (cat-log-stream) ,@log-stuff))
 
-(define-condition audio-stream-condition ()
-  ((location :initarg :location :reader location :initform nil)
-   (object   :initarg :object   :reader object   :initform nil)
-   (messsage :initarg :message  :reader message  :initform "Undefined Condition"))
-  (:report (lambda (condition stream)
-             (format stream "audio-stream condition at location: <~a> with object: <~a>: message: <~a>"
-                     (location condition) (object condition) (message condition)))))
-
-(defmethod print-object ((me audio-stream-condition) stream)
-  (format stream "location: <~a>, object: <~a>, message: <~a>" (location me) (object me) (message me)))
-
 (deftype octet () '(unsigned-byte 8))
 (defmacro make-octets (len) `(make-array ,len :element-type 'octet))
 
@@ -187,10 +176,7 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
                (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)))
-                 (error 'audio-stream-condition
-                        :location "stream-decode-ucs-string"
-                        :object nil
-                        :message (format nil "got an invalid byte-order mark of ~x" retval)))
+                 (error "Got invalid byte-order mark of ~x in STREAM-DECODE-UCS-STRING" retval))
                retval)))
 
     ;; special case: empty (and mis-coded) string
@@ -342,7 +328,7 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
         (mp4-atom:find-mp4-atoms stream)
         (when get-audio-info
           (setf (audio-info stream) (mp4-atom:get-mp4-audio-info stream))))
-    (mp4-atom:mp4-atom-condition (c)
+    (condition (c)
       (utils:warn-user "make-mp4-stream got condition: ~a" c))))
 
 (defmethod parse-audio-file ((stream flac-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
@@ -351,7 +337,7 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
   (declare (ignore get-audio-info)) ; audio info comes for "free" by parsing headers
   (handler-case
       (flac-frame:find-flac-frames stream)
-    (flac-frame:flac-frame-condition (c)
+    (condition (c)
       (utils:warn-user "make-flac-stream got condition: ~a" c))))
 
 (defmethod parse-audio-file ((stream mp3-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
@@ -362,5 +348,5 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
         (id3-frame:find-id3-frames stream)
         (when get-audio-info
           (setf (audio-info stream) (mpeg:get-mpeg-audio-info stream))))
-    (id3-frame:id3-frame-condition (c)
+    (condition (c)
       (utils:warn-user "make-mp3-stream got condition: ~a" c))))

flac-frame.lisp

@@ -0,0 +1,169 @@
+;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: FLAC-FRAME; -*-
+;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
+(in-package #:flac-frame)
+
+(log5:defcategory cat-log-flac-frame)
+(defmacro log-flac-frame (&rest log-stuff) `(log5:log-for (cat-log-flac-frame) ,@log-stuff))
+
+;;; FLAC header types
+(defconstant +metadata-streaminfo+  0)
+(defconstant +metadata-padding+     1)
+(defconstant +metadata-application+ 2)
+(defconstant +metadata-seektable+   3)
+(defconstant +metadata-comment+     4)
+(defconstant +metadata-cuesheet+    5)
+(defconstant +metadata-picture+     6)
+
+(defclass flac-header ()
+  ((pos         :accessor pos         :initarg :pos         :documentation "file location of this flac header")
+   (last-bit    :accessor last-bit    :initarg :last-bit    :documentation "if set, this is the last flac header in file")
+   (header-type :accessor header-type :initarg :header-type :documentation "one of the flac header types above")
+   (header-len  :accessor header-len  :initarg :header-len  :documentation "how long the info associated w/header is"))
+  (:documentation "Representation of FLAC stream header"))
+
+(defmacro with-frame-slots ((instance) &body body)
+  `(with-slots (pos last-bit header-type header-len) ,instance
+     ,@body))
+
+(defmethod vpprint ((me flac-header) stream)
+  (with-slots (pos last-bit header-type header-len) me
+    (format stream "pos = ~:d, last-bit = ~b, header-type = ~d, length = ~:d"
+            pos
+            last-bit
+            header-type
+            header-len)))
+
+(defun is-valid-flac-file (flac-file)
+  "Make sure this is a FLAC file. Look for FLAC header at begining"
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "is-valid-flac-file"
+    (stream-seek flac-file 0 :start)
+    (let ((valid nil))
+      (when (> (stream-size flac-file) 4)
+        (unwind-protect
+             (handler-case
+                 (let ((hdr (stream-read-string-with-len flac-file 4)))
+                   (log-flac-frame "got <~a> for flac header" hdr)
+                   (setf valid (string= "fLaC" hdr))
+                   (log-flac-frame "valid = ~a" valid))
+               (condition (c)
+                 (utils:warn-user "is-valid-flac-file: got condition ~a" c)))
+          (stream-seek flac-file 0 :start)))
+        valid)))
+
+(defun make-flac-header (stream)
+  "Make a flac header from current position in stream"
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "make-flac-header"
+    (let* ((header (stream-read-u32 stream))
+           (flac-header (make-instance 'flac-header
+                                       :pos (- (stream-seek stream) 4)
+                                       :last-bit (utils:get-bitfield header 31 1)
+                                       :header-type (utils:get-bitfield header 30 7)
+                                       :header-len (utils:get-bitfield header 23 24))))
+      (log-flac-frame "header = ~a" (vpprint flac-header nil))
+      flac-header)))
+
+
+(defparameter *flac-tag-pattern* "(^[a-zA-Z]+)=(.*$)" "used to parse FLAC/ORBIS comments")
+
+(defclass flac-tags ()
+  ((vendor-str :accessor vendor-str :initarg :vendor-str :initform nil)
+   (comments   :accessor comments   :initarg :comments   :initform nil)
+   (tags       :accessor tags                            :initform (make-hash-table :test 'equal))))
+
+(defmethod flac-add-tag ((me flac-tags) new-tag new-val)
+  (declare #.utils:*standard-optimize-settings*)
+  (let ((l-new-tag (string-downcase new-tag)))
+    (setf (gethash l-new-tag (tags me)) new-val)))
+
+(defmethod flac-get-tag ((me flac-tags) key)
+  (declare #.utils:*standard-optimize-settings*)
+  (gethash (string-downcase key) (tags me)))
+
+(defun flac-get-tags (stream)
+  "Loop through file and find all comment tags."
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "flac-get-tags"
+    (let* ((tags (make-instance 'flac-tags))
+           (vendor-len (stream-read-u32 stream :endian :big-endian))
+           (vendor-str (stream-read-utf-8-string-with-len stream vendor-len))
+           (lst-len (stream-read-u32 stream :endian :big-endian)))
+
+      (setf (vendor-str tags) vendor-str)
+
+      (dotimes (i lst-len)
+        (let* ((comment-len (stream-read-u32 stream :endian :big-endian))
+               (comment (stream-read-utf-8-string-with-len stream comment-len)))
+          (push comment (comments tags))
+          (optima:match comment ((optima.ppcre:ppcre *flac-tag-pattern* tag value)
+                                 (log-flac-frame "got ~a/~a" tag value)
+                                 (flac-add-tag tags tag value)))))
+      (setf (comments tags) (nreverse (comments tags)))
+      tags)))
+
+(defmethod find-flac-frames ((stream flac-file-stream))
+  "Loop through file and find all FLAC headers. If we find comment or audio-info headers, go ahead and parse them too."
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "find-flac-frames"
+    (stream-seek stream 4 :start)
+
+    (handler-case
+        (let (headers)
+          (loop for h = (make-flac-header stream) then (make-flac-header stream) do
+            (push h headers)
+            (log-flac-frame "Found flac frame: ~a" (vpprint h nil))
+            (cond
+              ((= +metadata-comment+ (header-type h))
+               (setf (flac-tags stream) (flac-get-tags stream)))
+              ((= +metadata-streaminfo+ (header-type h))
+               (setf (audio-info stream) (get-flac-audio-info stream)))
+              (t (stream-seek stream (header-len h) :current)))
+            (when (not (zerop (last-bit h))) (return)))
+          (setf (flac-headers stream) (nreverse headers)))
+      (condition (c)
+        (utils:warn-user "find-flac-frames got condition ~a" c)
+        (log-flac-frame "got condition ~a when finding flac frames" c)))))
+
+(defclass flac-audio-properties ()
+  ((min-block-size  :accessor min-block-size  :initarg :min-block-size  :initform 0)
+   (max-block-size  :accessor max-block-size  :initarg :max-block-size  :initform 0)
+   (min-frame-size  :accessor min-frame-size  :initarg :min-frame-size  :initform 0)
+   (max-frame-size  :accessor max-frame-size  :initarg :max-frame-size  :initform 0)
+   (sample-rate     :accessor sample-rate     :initarg :sample-rate     :initform 0)
+   (num-channels    :accessor num-channels    :initarg :num-channels    :initform 0)
+   (bits-per-sample :accessor bits-per-sample :initarg :bits-per-sample :initform 0)
+   (total-samples   :accessor total-samples   :initarg :total-samples   :initform 0)
+   (md5-sig         :accessor md5-sig         :initarg :md5-sig         :initform 0))
+  (:documentation "FLAC audio file properties"))
+
+(defmethod vpprint ((me flac-audio-properties) stream)
+  (format stream
+          "min/max block size: ~:d/~:d; min/max frame size: ~:d/~:d; sample rate: ~d Hz; # channels: ~d; bps: ~:d; total-samples: ~:d; sig: ~x"
+          (min-block-size me) (max-block-size me)
+          (min-frame-size me) (max-frame-size me)
+          (sample-rate me) (num-channels me) (bits-per-sample me)
+          (total-samples me) (md5-sig me)))
+
+(defun get-flac-audio-info (flac-stream)
+  "Read in the the audio properties from current file position."
+  (declare #.utils:*standard-optimize-settings*)
+  (let ((info (make-instance 'flac-audio-properties)))
+    (setf (min-block-size info) (stream-read-u16 flac-stream))
+    (setf (max-block-size info) (stream-read-u16 flac-stream))
+    (setf (min-frame-size info) (stream-read-u24 flac-stream))
+    (setf (max-frame-size info) (stream-read-u24 flac-stream))
+    (let* ((int1 (stream-read-u32 flac-stream))
+           (int2 (stream-read-u32 flac-stream)))
+      (setf (total-samples info) (logior (ash (get-bitfield int1 3  4) -32) int2))
+      (setf (bits-per-sample info)            (1+ (get-bitfield int1 8  5)))
+      (setf (num-channels info)               (1+ (get-bitfield int1 11 3)))
+      (setf (sample-rate info)                (get-bitfield int1 31 20)))
+    (setf (md5-sig info) (stream-read-u128 flac-stream))
+    info))
+
+(defun flac-show-raw-tag (flac-file-stream out-stream)
+  (declare #.utils:*standard-optimize-settings*)
+  (format out-stream "Vendor string: <~a>~%" (vendor-str (flac-tags flac-file-stream)))
+  (dotimes (i (length (comments (flac-tags flac-file-stream))))
+    (format out-stream "~4t[~d]: <~a>~%" i (nth i (comments (flac-tags flac-file-stream))))))

id3-frame.lisp

@@ -6,17 +6,6 @@
 (log5:defcategory cat-log-id3-frame)
 (defmacro log-id3-frame (&rest log-stuff) `(log5:log-for (cat-log-id3-frame) ,@log-stuff))
 
-(define-condition id3-frame-condition ()
-  ((location :initarg :location :reader location :initform nil)
-   (object   :initarg :object   :reader object   :initform nil)
-   (messsage :initarg :message  :reader message  :initform "Undefined Condition"))
-  (:report (lambda (condition stream)
-             (format stream "id3-frame condition at location: <~a> with object: <~a>: message: <~a>"
-                     (location condition) (object condition) (message condition)))))
-
-(defmethod print-object ((me id3-frame-condition) stream)
-  (format stream "location: <~a>, object: <~a>, message: <~a>" (location me) (object me) (message me)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ID3 header/extended header/v2.1 header ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defclass id3-header ()
   ((version        :accessor version        :initarg :version        :initform 0   :documentation "ID3 version: 2, 3, or 4")
@@ -230,7 +219,7 @@ NB: 2.3 and 2.4 extended flags are different..."
         (log-id3-frame "looking at last 128 bytes at ~:d to try to read id3v21 header" (stream-seek instream))
         (handler-case
             (setf v21-tag-header (make-instance 'v21-tag-header :instream instream))
-          (id3-frame-condition (c)
+          (condition (c)
             (utils:warn-user "initialize id3-header got condition ~a" c)
             (log-id3-frame "reading v21 got condition: ~a" c))))
 
@@ -974,7 +963,7 @@ NB: 2.3 and 2.4 extended flags are different..."
       ;; would blow past the end of the file/buffer
       (when (or (> (+ (stream-seek instream) frame-len) (stream-size instream))
                 (null frame-class))
-        (error 'id3-frame-condition :message "bad frame found" :object frame-name :location pos))
+        (error "bad frame at position ~d found: ~a" pos frame-name))
 
       (make-instance frame-class :pos pos :version version :id frame-name :len frame-len :flags frame-flags :instream instream))))
 

mp4-atom.lisp

@@ -5,17 +5,6 @@
 (log5:defcategory cat-log-mp4-atom)
 (defmacro log-mp4-atom (&rest log-stuff) `(log5:log-for (cat-log-mp4-atom) ,@log-stuff))
 
-(define-condition mp4-atom-condition ()
-  ((location :initarg :location :reader location :initform nil)
-   (object   :initarg :object   :reader object   :initform nil)
-   (messsage :initarg :message  :reader message  :initform "Undefined Condition"))
-  (: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)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ATOMS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; A word about atoms (aka "boxes").  There are three kinds of atoms: ones that are containers, ones
@@ -57,7 +46,7 @@
     (declare #.utils:*standard-optimize-settings*)
     (cond ((typep c 'standard-char) (coerce (char-code c) '(unsigned-byte 8)))
           ((typep c 'integer) (coerce c '(unsigned-byte 8)))
-          (t (error "can any handle characters and integers"))))
+          (t (error "can only handle characters and integers"))))
 
   (defmacro mk-mp4-atom-type (l1 l2 l3 l4)
     "Given 4 chars/ints, create a 32-bit word representing an atom 'type' (aka name)"

mpeg.lisp

@@ -7,16 +7,6 @@
 (log5:defcategory cat-log-mpeg-frame)
 (defmacro log-mpeg-frame (&rest log-stuff) `(log5:log-for (cat-log-mpeg-frame) ,@log-stuff))
 
-(define-condition mpeg-condition ()
-  ((location :initarg :location :reader location :initform nil)
-   (object   :initarg :object   :reader object   :initform nil)
-   (messsage :initarg :message  :reader message  :initform "Undefined Condition"))
-  (:report (lambda (condition stream)
-             (format stream "MP3 condition at location <~a> with object <~a>: message<~a>"
-                     (location condition) (object condition) (message condition)))))
-
-(define-condition mpeg-bad-header (mpeg-condition) ())
-
 (defconstant +sync-word+  #x7ff "NB: this is 11 bits so as to be able to recognize V2.5")
 
 ;;; the versions

taglib-tests.lisp

@@ -14,13 +14,14 @@
 
 ;;;
 ;;; Set the pathname (aka filename) encoding in CCL for appropriate platorm
+;;;
+;;; 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
 (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))
 
-;;; 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
 
 (defun do-audio-file (&optional (file *song-m4a*) &key (func (constantly t)))
   "Parse one audio file (with condition handling)."
@@ -49,16 +50,11 @@
 
     (cl-fad:walk-directory dir (lambda (f)
                                  (do-audio-file f :func (lambda (s)
-                                                          (cond ((typep s 'mp3-file-stream)
-                                                                 (incf mp3-count)
-                                                                 (when func (funcall func s)))
-                                                                ((typep s 'flac-file-stream)
-                                                                 (incf flac-count)
-                                                                 (when func (funcall func s)))
-                                                                ((typep s 'mp4-file-stream)
-                                                                 (incf mp4-count)
-                                                                 (when func (funcall func s)))
-                                                                ((null s) (incf other-count)))))))
+                                                          (cond ((typep s 'mp3-file-stream)  (incf mp3-count))
+                                                                ((typep s 'flac-file-stream) (incf flac-count))
+                                                                ((typep s 'mp4-file-stream)  (incf mp4-count))
+                                                                ((null s)                    (incf other-count)))
+                                                          (when (and (not (null s)) func) (funcall func s))))))
 
     (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACs, ~:d Others, for a total of ~:d~%"
             mp3-count mp4-count flac-count other-count (+ mp3-count mp4-count flac-count other-count))))
@@ -68,11 +64,11 @@
   (let ((audio-streams:*get-audio-info* do-audio-processing))
     (time (do-audio-dir dir :file-system-encoding file-system-encoding :func nil))))
 
-;;;;;;;;;;;;;;;;;;;; Experimental multi-thread code below ;;;;;;;;;;;;;;;;;;;;
-
-(defparameter *END-THREAD* #xdeadbeef)
+;;;;;;;;;;;;;;;;;;;; multi-thread code below ;;;;;;;;;;;;;;;;;;;;
+(defparameter *END-THREAD*  #xdeadbeef)
 (defparameter *MAX-THREADS* 4)
 
+;;; Simple structure to hold a thread's results
 (defstruct chanl-results
   name
   mp3-count
@@ -90,6 +86,11 @@
         (flac-count 0)
         (mp4-count 0)
         (other-count 0))
+
+    ;; This function is run by each thread
+    ;; Thread sits in a loop, reading from CHAN.  If that read
+    ;; returns the integer *END-THREAD*, then thread exits; otherwise,
+    ;; it runs DO-AUDIO-FILE on the file passed in.
     (labels ((thread-reader ()
                (declare (special *me*))
                (let ((f)
@@ -99,29 +100,28 @@
                      (setf f (chanl:recv channel))
                      (when (and (typep f 'integer)
                                 (= f *END-THREAD*))
-                       (chanl:send dead-channel results)
+                       (chanl:send dead-channel results) ; send structure of stats back to parent
                        (return-from thread-reader nil))
 
                      (do-audio-file f :func (lambda (s)
-                                              (cond ((typep s 'mp3-file-stream)
-                                                     (incf mp3-count)
-                                                     (when func (funcall func s)))
-                                                    ((typep s 'flac-file-stream)
-                                                     (incf flac-count)
-                                                     (when func (funcall func s)))
-                                                    ((typep s 'mp4-file-stream)
-                                                     (incf mp4-count)
-                                                     (when func (funcall func s)))
-                                                    ((null s) (incf other-count))))))))))
-
-      (cl-fad:walk-directory dir (lambda (f)
-                                   (chanl:send channel f)))
-
+                                              (cond ((typep s 'mp3-file-stream)  (incf mp3-count))
+                                                    ((typep s 'flac-file-stream) (incf flac-count))
+                                                    ((typep s 'mp4-file-stream)  (incf mp4-count))
+                                                    ((null s)                    (incf other-count)))
+                                              (when (and (not (null s)) func) (funcall func s)))))))))
+
+      ;; first, add all files in DIR to CHANNEL
+      (cl-fad:walk-directory dir (lambda (f) (chanl:send channel f)))
+
+      ;; At this point, CHANNEL is stuffed with files.
+      ;; Now, send *MAX-THREADS* "ends" (at end of CHANNEL) and
+      ;; spawn *MAX-THREADS* threads
       (dotimes (i *MAX-THREADS*)
         (chanl:send channel *END-THREAD*))
       (dotimes (i *MAX-THREADS*)
         (chanl:pcall #'thread-reader :initial-bindings `((*me* ,(format nil "reader-thread-~d" i)))))
 
+      ;; sit in loop until we read *MAX-THREADS* results
       (block thread-reap
         (let ((i 0)
               results)
@@ -143,11 +143,12 @@
             (incf flac-count (chanl-results-flac-count results))
             (incf other-count (chanl-results-other-count results))
             (incf i)
+
             (when (= i *MAX-THREADS*)
               (return-from thread-reap *MAX-THREADS*)))))
 
       (format t "All threads done~%")
-      (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACS, ~:d Others, for a total of ~:d~%"
+      (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACS, ~:d Others, for a total of ~:d files~%"
               mp3-count mp4-count flac-count other-count (+ mp3-count mp4-count flac-count other-count)))))
 
 (defun mp-time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))