taglib-tests.lisp 8.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222
  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. (typecase s
  53. (id3:mp3-file
  54. (incf mp3-count))
  55. (flac:flac-file
  56. (incf flac-count))
  57. (m4a:mp4-file
  58. (incf mp4-count))
  59. (otherwise
  60. (incf other-count)))
  61. (when (and (not (null s)) func)
  62. (funcall func s)))))))
  63. file-counts))
  64. (defun time-test (&optional (dir "/home/markv/Music/Queen")
  65. (do-audio-processing t))
  66. "Time parsing of DIR."
  67. (let ((audio-streams:*get-audio-info* do-audio-processing))
  68. (time (format t "~a~%"
  69. (do-audio-dir dir nil)))))
  70. (defun insert-into-ht (id ht)
  71. (multiple-value-bind (value foundp)
  72. (gethash id ht)
  73. (setf (gethash id ht)
  74. (if foundp
  75. (1+ value)
  76. 1))))
  77. (defun get-stats (&optional (dir "/home/markv/Music/Queen"))
  78. "Gen up some interesting statistics on DIR"
  79. (let ((m4-ht (make-hash-table :test #'equalp))
  80. (m3-ht (make-hash-table :test #'equalp)))
  81. (do-audio-dir
  82. dir
  83. (lambda (s)
  84. (typecase s
  85. (id3:mp3-file
  86. (id3:map-id3-frames s
  87. :func (lambda (f)
  88. (insert-into-ht (id3:id f) m3-ht))))
  89. (m4a:mp4-file
  90. (m4a:map-mp4-atoms s
  91. :func (lambda (f)
  92. (insert-into-ht (m4a:atom-type f) m4-ht)))))))
  93. (format t "MP3 Stats:~%")
  94. (loop for key being the hash-keys of m3-ht
  95. using (hash-value value)
  96. do (format t "~2t~a:~:d~%" key value))
  97. (format t "~%M4A Stats:~%")
  98. (loop for key being the hash-keys of m4-ht
  99. using (hash-value value)
  100. do (format t "~2t~a:~:d~%" key value))
  101. (values m3-ht m4-ht)))
  102. ;;;; multi-thread code below
  103. #+(or :ccl :sbcl :abcl)
  104. (progn
  105. (defparameter *end-thread* #xdeadbeef)
  106. (defparameter *max-threads* 4)
  107. ;;; Simple structure to hold a thread's results
  108. (defstruct chanl-results
  109. name
  110. mp3-count
  111. flac-count
  112. mp4-count
  113. other-count)
  114. (defun mp-do-audio-dir (&optional (dir "/home/markv/Music/Queen")
  115. (func nil))
  116. "Walk :DIR and FUNCALL specified function for each file audio found."
  117. (let ((channel (make-instance 'chanl:unbounded-channel))
  118. (dead-channel (make-instance 'chanl:unbounded-channel))
  119. (mp3-count 0)
  120. (flac-count 0)
  121. (mp4-count 0)
  122. (other-count 0))
  123. ;; This function is run by each thread
  124. ;; Thread sits in a loop, reading from CHAN. If that read
  125. ;; returns the integer *END-THREAD*, then thread exits; otherwise,
  126. ;; it runs DO-AUDIO-FILE on the file passed in.
  127. (labels ((thread-reader ()
  128. (declare (special *me*))
  129. (let ((f)
  130. (results (make-chanl-results :name *me* :mp3-count 0
  131. :flac-count 0 :mp4-count 0
  132. :other-count 0)))
  133. (loop
  134. (with-slots (name mp3-count mp4-count flac-count other-count) results
  135. (setf f (chanl:recv channel))
  136. (when (and (typep f 'integer)
  137. (= f *end-thread*))
  138. (chanl:send dead-channel results)
  139. (return-from thread-reader nil))
  140. (do-audio-file f
  141. (lambda (s)
  142. (typecase s
  143. (id3:mp3-file
  144. (incf mp3-count))
  145. (flac:flac-file
  146. (incf flac-count))
  147. (m4a:mp4-file
  148. (incf mp4-count))
  149. (otherwise
  150. (incf other-count)))
  151. (when (and (not (null s)) func)
  152. (funcall func s)))))))))
  153. ;; first, add all files in DIR to CHANNEL
  154. (cl-fad:walk-directory dir (lambda (f) (chanl:send channel f)))
  155. ;; At this point, CHANNEL is stuffed with files.
  156. ;; Now, send *MAX-THREADS* "ends" (at end of CHANNEL) and
  157. ;; spawn *MAX-THREADS* threads
  158. (dotimes (i *max-threads*)
  159. (chanl:send channel *end-thread*))
  160. (dotimes (i *max-threads*)
  161. (chanl:pcall
  162. #'thread-reader
  163. :initial-bindings `((*me* ,(format nil "reader-thread-~d" i)))))
  164. ;; sit in loop until we read *MAX-THREADS* results
  165. (block thread-reap
  166. (let ((i 0)
  167. results)
  168. (format t "Waiting on ~d threads~%" *max-threads*)
  169. (loop
  170. (force-output *standard-output*)
  171. (setf results (chanl:recv dead-channel))
  172. (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d FLACs, ~:d Others~%"
  173. (chanl-results-name results)
  174. (chanl-results-mp3-count results)
  175. (chanl-results-mp4-count results)
  176. (chanl-results-flac-count results)
  177. (chanl-results-other-count results))
  178. (force-output *standard-output*)
  179. (incf mp3-count (chanl-results-mp3-count results))
  180. (incf mp4-count (chanl-results-mp4-count results))
  181. (incf flac-count (chanl-results-flac-count results))
  182. (incf other-count (chanl-results-other-count results))
  183. (incf i)
  184. (when (= i *max-threads*)
  185. (return-from thread-reap *max-threads*)))))
  186. (format t "All threads done~%")
  187. (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACS, ~:d Others, for a total of ~:d files~%"
  188. mp3-count mp4-count flac-count other-count
  189. (+ mp3-count mp4-count flac-count other-count)))))
  190. (defun mp-time-test (&optional (dir "/home/markv/Music/Queen")
  191. (do-audio-processing t))
  192. "Time parsing of DIR."
  193. (let ((audio-streams:*get-audio-info* do-audio-processing))
  194. (time (mp-do-audio-dir dir nil))))
  195. )