taglib-tests.lisp 8.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219
  1. ;;; -*- Mode: Lisp; show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: TAGLIB-TESTS; -*-
  2. ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
  3. (in-package #:cl-user)
  4. (defpackage #:taglib-tests
  5. (:use #:common-lisp #:audio-streams #:utils))
  6. (in-package #:taglib-tests)
  7. ;;; some convenient songs to parse
  8. (defparameter *song-m4a*
  9. "/home/markv/Music/Queen/Queen I/01 Keep Yourself Alive.m4a")
  10. (defparameter *song-mp3*
  11. "/home/markv/Music/Queen/Sheer Heart Attack/07 In The Lap Of The Gods.mp3")
  12. (defparameter *song-flac*
  13. "/home/markv/Music/Frank Zappa/Baby Snakes/02. Baby Snakes.flac")
  14. ;;;
  15. ;;; Set the pathname (aka filename) encoding for appropriate platform
  16. ;;;
  17. ;;; A note re filesystem encoding: my music collection is housed on a Mac and shared via SAMBA.
  18. ;;; In order to make sure we get valid pathnames, we need to set CCL's filesystem encoding to
  19. ;;; :UTF-8
  20. (defun set-pathname-encoding (enc)
  21. #+CCL (setf (ccl:pathname-encoding-name) enc)
  22. #-CCL (declare (ignore enc))
  23. t)
  24. (defun set-pathname-encoding-for-osx () (set-pathname-encoding :utf-8))
  25. (defun set-pathname-encoding-for-linux () (set-pathname-encoding nil))
  26. (defun do-audio-file (&optional (file *song-m4a*)
  27. (func #'abstract-tag:show-tags))
  28. "Parse one audio file and display the tags"
  29. (awhen (open-audio-file file)
  30. (funcall func it)))
  31. (defstruct file-counts
  32. (mp3-count 0 :type fixnum)
  33. (flac-count 0 :type fixnum)
  34. (mp4-count 0 :type fixnum)
  35. (other-count 0 :type fixnum))
  36. (defmethod print-object ((me file-counts) stream)
  37. (with-slots (mp3-count flac-count mp4-count other-count) me
  38. (format stream
  39. "~&~:d MP3s, ~:d MP4s, ~:d FLACs, ~:d Others, for a total of ~:d files~%"
  40. mp3-count mp4-count flac-count other-count
  41. (+ mp3-count mp4-count flac-count other-count))))
  42. (defun do-audio-dir (&optional (dir "/home/markv/Music/Queen")
  43. (func #'abstract-tag:show-tags))
  44. "Walk :DIR and FUNCALL specified function for each file audio found."
  45. (let ((file-counts (make-file-counts)))
  46. (with-slots (mp3-count flac-count mp4-count other-count) file-counts
  47. (cl-fad:walk-directory dir
  48. (lambda (f)
  49. (do-audio-file
  50. f
  51. (lambda (s)
  52. (cond ((typep s 'id3:mp3-file)
  53. (incf mp3-count))
  54. ((typep s 'flac:flac-file)
  55. (incf flac-count))
  56. ((typep s 'm4a:mp4-file)
  57. (incf mp4-count))
  58. ((null s)
  59. (incf other-count)))
  60. (when (and (not (null s)) func)
  61. (funcall func s)))))))
  62. file-counts))
  63. (defun time-test (&optional (dir "/home/markv/Music/Queen")
  64. (do-audio-processing t))
  65. "Time parsing of DIR."
  66. (let ((audio-streams:*get-audio-info* do-audio-processing))
  67. (time (format t "~a~%"
  68. (do-audio-dir dir nil)))))
  69. (defun insert-into-ht (id ht)
  70. (multiple-value-bind (value foundp)
  71. (gethash id ht)
  72. (setf (gethash id ht)
  73. (if foundp
  74. (1+ value)
  75. 1))))
  76. (defun get-stats (&optional (dir "/home/markv/Music/Queen"))
  77. "Gen up some interesting statistics on DIR"
  78. (let ((m4-ht (make-hash-table :test #'equalp))
  79. (m3-ht (make-hash-table :test #'equalp)))
  80. (do-audio-dir
  81. dir
  82. (lambda (s)
  83. (cond ((typep s 'id3:mp3-file)
  84. (id3:map-id3-frames s
  85. :func (lambda (f)
  86. (insert-into-ht (id3:id f) m3-ht))))
  87. ((typep s 'm4a:mp4-file)
  88. (m4a:map-mp4-atoms s
  89. :func (lambda (f)
  90. (insert-into-ht (m4a:atom-type f) m4-ht)))))))
  91. (format t "MP3 Stats:~%")
  92. (loop for key being the hash-keys of m3-ht
  93. using (hash-value value)
  94. do (format t "~2t~a:~:d~%" key value))
  95. (format t "~%M4A Stats:~%")
  96. (loop for key being the hash-keys of m4-ht
  97. using (hash-value value)
  98. do (format t "~2t~a:~:d~%" key value))
  99. (values m3-ht m4-ht)))
  100. ;;;; multi-thread code below
  101. #+(or :ccl :sbcl :abcl)
  102. (progn
  103. (defparameter *end-thread* #xdeadbeef)
  104. (defparameter *max-threads* 4)
  105. ;;; Simple structure to hold a thread's results
  106. (defstruct chanl-results
  107. name
  108. mp3-count
  109. flac-count
  110. mp4-count
  111. other-count)
  112. (defun mp-do-audio-dir (&optional (dir "/home/markv/Music/Queen")
  113. (func nil))
  114. "Walk :DIR and FUNCALL specified function for each file audio found."
  115. (let ((channel (make-instance 'chanl:unbounded-channel))
  116. (dead-channel (make-instance 'chanl:unbounded-channel))
  117. (mp3-count 0)
  118. (flac-count 0)
  119. (mp4-count 0)
  120. (other-count 0))
  121. ;; This function is run by each thread
  122. ;; Thread sits in a loop, reading from CHAN. If that read
  123. ;; returns the integer *END-THREAD*, then thread exits; otherwise,
  124. ;; it runs DO-AUDIO-FILE on the file passed in.
  125. (labels ((thread-reader ()
  126. (declare (special *me*))
  127. (let ((f)
  128. (results (make-chanl-results :name *me* :mp3-count 0
  129. :flac-count 0 :mp4-count 0
  130. :other-count 0)))
  131. (loop
  132. (with-slots (name mp3-count mp4-count flac-count other-count) results
  133. (setf f (chanl:recv channel))
  134. (when (and (typep f 'integer)
  135. (= f *end-thread*))
  136. (chanl:send dead-channel results)
  137. (return-from thread-reader nil))
  138. (do-audio-file f
  139. (lambda (s)
  140. (cond ((typep s 'id3:mp3-file)
  141. (incf mp3-count))
  142. ((typep s 'flac:flac-file)
  143. (incf flac-count))
  144. ((typep s 'm4a:mp4-file)
  145. (incf mp4-count))
  146. ((null s)
  147. (incf other-count)))
  148. (when (and (not (null s)) func)
  149. (funcall func s)))))))))
  150. ;; first, add all files in DIR to CHANNEL
  151. (cl-fad:walk-directory dir (lambda (f) (chanl:send channel f)))
  152. ;; At this point, CHANNEL is stuffed with files.
  153. ;; Now, send *MAX-THREADS* "ends" (at end of CHANNEL) and
  154. ;; spawn *MAX-THREADS* threads
  155. (dotimes (i *max-threads*)
  156. (chanl:send channel *end-thread*))
  157. (dotimes (i *max-threads*)
  158. (chanl:pcall
  159. #'thread-reader
  160. :initial-bindings `((*me* ,(format nil "reader-thread-~d" i)))))
  161. ;; sit in loop until we read *MAX-THREADS* results
  162. (block thread-reap
  163. (let ((i 0)
  164. results)
  165. (format t "Waiting on ~d threads~%" *max-threads*)
  166. (loop
  167. (force-output *standard-output*)
  168. (setf results (chanl:recv dead-channel))
  169. (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d FLACs, ~:d Others~%"
  170. (chanl-results-name results)
  171. (chanl-results-mp3-count results)
  172. (chanl-results-mp4-count results)
  173. (chanl-results-flac-count results)
  174. (chanl-results-other-count results))
  175. (force-output *standard-output*)
  176. (incf mp3-count (chanl-results-mp3-count results))
  177. (incf mp4-count (chanl-results-mp4-count results))
  178. (incf flac-count (chanl-results-flac-count results))
  179. (incf other-count (chanl-results-other-count results))
  180. (incf i)
  181. (when (= i *max-threads*)
  182. (return-from thread-reap *max-threads*)))))
  183. (format t "All threads done~%")
  184. (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACS, ~:d Others, for a total of ~:d files~%"
  185. mp3-count mp4-count flac-count other-count
  186. (+ mp3-count mp4-count flac-count other-count)))))
  187. (defun mp-time-test (&optional (dir "/home/markv/Music/Queen")
  188. (do-audio-processing t))
  189. "Time parsing of DIR."
  190. (let ((audio-streams:*get-audio-info* do-audio-processing))
  191. (time (mp-do-audio-dir dir nil))))
  192. )