| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219 |
- ;;; -*- Mode: Lisp; show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: TAGLIB-TESTS; -*-
- ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
- (in-package #:cl-user)
- (defpackage #:taglib-tests
- (:use #:common-lisp #:audio-streams #:utils))
- (in-package #:taglib-tests)
- ;;; some convenient songs to parse
- (defparameter *song-m4a*
- "/home/markv/Music/Queen/Queen I/01 Keep Yourself Alive.m4a")
- (defparameter *song-mp3*
- "/home/markv/Music/Queen/Sheer Heart Attack/07 In The Lap Of The Gods.mp3")
- (defparameter *song-flac*
- "/home/markv/Music/Frank Zappa/Baby Snakes/02. Baby Snakes.flac")
- ;;;
- ;;; Set the pathname (aka filename) encoding for appropriate platform
- ;;;
- ;;; 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)
- #+CCL (setf (ccl:pathname-encoding-name) enc)
- #-CCL (declare (ignore enc))
- t)
- (defun set-pathname-encoding-for-osx () (set-pathname-encoding :utf-8))
- (defun set-pathname-encoding-for-linux () (set-pathname-encoding nil))
- (defun do-audio-file (&optional (file *song-m4a*)
- (func #'abstract-tag:show-tags))
- "Parse one audio file and display the tags"
- (awhen (open-audio-file file)
- (funcall func it)))
- (defstruct file-counts
- (mp3-count 0 :type fixnum)
- (flac-count 0 :type fixnum)
- (mp4-count 0 :type fixnum)
- (other-count 0 :type fixnum))
- (defmethod print-object ((me file-counts) stream)
- (with-slots (mp3-count flac-count mp4-count other-count) me
- (format stream
- "~&~: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 do-audio-dir (&optional (dir "/home/markv/Music/Queen")
- (func #'abstract-tag:show-tags))
- "Walk :DIR and FUNCALL specified function for each file audio found."
- (let ((file-counts (make-file-counts)))
- (with-slots (mp3-count flac-count mp4-count other-count) file-counts
- (cl-fad:walk-directory dir
- (lambda (f)
- (do-audio-file
- f
- (lambda (s)
- (cond ((typep s 'id3:mp3-file)
- (incf mp3-count))
- ((typep s 'flac:flac-file)
- (incf flac-count))
- ((typep s 'm4a:mp4-file)
- (incf mp4-count))
- ((null s)
- (incf other-count)))
- (when (and (not (null s)) func)
- (funcall func s)))))))
- file-counts))
- (defun time-test (&optional (dir "/home/markv/Music/Queen")
- (do-audio-processing t))
- "Time parsing of DIR."
- (let ((audio-streams:*get-audio-info* do-audio-processing))
- (time (format t "~a~%"
- (do-audio-dir dir nil)))))
- (defun insert-into-ht (id ht)
- (multiple-value-bind (value foundp)
- (gethash id ht)
- (setf (gethash id ht)
- (if foundp
- (1+ value)
- 1))))
- (defun get-stats (&optional (dir "/home/markv/Music/Queen"))
- "Gen up some interesting statistics on DIR"
- (let ((m4-ht (make-hash-table :test #'equalp))
- (m3-ht (make-hash-table :test #'equalp)))
- (do-audio-dir
- dir
- (lambda (s)
- (cond ((typep s 'id3:mp3-file)
- (id3:map-id3-frames s
- :func (lambda (f)
- (insert-into-ht (id3:id f) m3-ht))))
- ((typep s 'm4a:mp4-file)
- (m4a:map-mp4-atoms s
- :func (lambda (f)
- (insert-into-ht (m4a:atom-type f) m4-ht)))))))
- (format t "MP3 Stats:~%")
- (loop for key being the hash-keys of m3-ht
- using (hash-value value)
- do (format t "~2t~a:~:d~%" key value))
- (format t "~%M4A Stats:~%")
- (loop for key being the hash-keys of m4-ht
- using (hash-value value)
- do (format t "~2t~a:~:d~%" key value))
- (values m3-ht m4-ht)))
- ;;;; multi-thread code below
- #+(or :ccl :sbcl :abcl)
- (progn
- (defparameter *end-thread* #xdeadbeef)
- (defparameter *max-threads* 4)
- ;;; Simple structure to hold a thread's results
- (defstruct chanl-results
- name
- mp3-count
- flac-count
- mp4-count
- other-count)
- (defun mp-do-audio-dir (&optional (dir "/home/markv/Music/Queen")
- (func nil))
- "Walk :DIR and FUNCALL specified function for each file audio found."
- (let ((channel (make-instance 'chanl:unbounded-channel))
- (dead-channel (make-instance 'chanl:unbounded-channel))
- (mp3-count 0)
- (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)
- (results (make-chanl-results :name *me* :mp3-count 0
- :flac-count 0 :mp4-count 0
- :other-count 0)))
- (loop
- (with-slots (name mp3-count mp4-count flac-count other-count) results
- (setf f (chanl:recv channel))
- (when (and (typep f 'integer)
- (= f *end-thread*))
- (chanl:send dead-channel results)
- (return-from thread-reader nil))
- (do-audio-file f
- (lambda (s)
- (cond ((typep s 'id3:mp3-file)
- (incf mp3-count))
- ((typep s 'flac:flac-file)
- (incf flac-count))
- ((typep s 'm4a:mp4-file)
- (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)
- (format t "Waiting on ~d threads~%" *max-threads*)
- (loop
- (force-output *standard-output*)
- (setf results (chanl:recv dead-channel))
- (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d FLACs, ~:d Others~%"
- (chanl-results-name results)
- (chanl-results-mp3-count results)
- (chanl-results-mp4-count results)
- (chanl-results-flac-count results)
- (chanl-results-other-count results))
- (force-output *standard-output*)
- (incf mp3-count (chanl-results-mp3-count results))
- (incf mp4-count (chanl-results-mp4-count results))
- (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 files~%"
- mp3-count mp4-count flac-count other-count
- (+ mp3-count mp4-count flac-count other-count)))))
- (defun mp-time-test (&optional (dir "/home/markv/Music/Queen")
- (do-audio-processing t))
- "Time parsing of DIR."
- (let ((audio-streams:*get-audio-info* do-audio-processing))
- (time (mp-do-audio-dir dir nil))))
- )
|