taglib-tests.lisp 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147
  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 #:logging #:audio-streams))
  6. (in-package #:taglib-tests)
  7. ;;; some convenient songs to parse
  8. (defparameter *song-m4a* "Queen/Queen I/01 Keep Yourself Alive.m4a")
  9. (defparameter *song-mp3* "Queen/Sheer Heart Attack/07 In The Lap Of The Gods.mp3")
  10. ;;;
  11. ;;; Set the pathname (aka filename) encoding in CCL for appropriate platorm
  12. (defun set-pathname-encoding (enc) (setf (ccl:pathname-encoding-name) enc))
  13. (defun set-pathname-encoding-for-osx () (set-pathname-encoding :utf-8))
  14. (defun set-pathname-encoding-for-linux () (set-pathname-encoding nil))
  15. ;;; A note re filesystem encoding: my music collection is housed on a Mac and shared via SAMBA.
  16. ;;; In order to make sure we get valid pathnames, we need to set CCL's filesystem encoding to
  17. ;;; :UTF-8
  18. (defun do-audio-file (&optional (file *song-m4a*) &key (func (constantly t)))
  19. "Parse one audio file (with condition handling)."
  20. (let ((foo))
  21. (unwind-protect
  22. (handler-case
  23. (progn
  24. (setf foo (make-file-stream file))
  25. (when foo
  26. (parse-audio-file foo)) ; only call parse-audio if we got back a MP3/M4A
  27. (funcall func foo)) ; call func even is foo is null so it can account for non MP3/M4A files
  28. (condition (c)
  29. (utils:warn-user "File: ~a~%Got condition: <~a>" file c)))
  30. (when foo
  31. (stream-close foo)))))
  32. (defun do-audio-dir (&optional (dir "Queen") &key (file-system-encoding :utf-8)
  33. (func #'abstract-tag:show-tags))
  34. "Walk :DIR and FUNCALL specified function for each file (MP4/MP3) found."
  35. (set-pathname-encoding file-system-encoding)
  36. (let ((mp3-count 0)
  37. (mp4-count 0)
  38. (other-count 0))
  39. (cl-fad:walk-directory dir (lambda (f)
  40. (do-audio-file f :func (lambda (s)
  41. (cond ((typep s 'mp3-file-stream)
  42. (incf mp3-count)
  43. (when func
  44. (funcall func s)))
  45. ((typep s 'mp4-file-stream)
  46. (incf mp4-count)
  47. (when func
  48. (funcall func s)))
  49. ((null s) (incf other-count)))))))
  50. (format t "~&~:d MP3s, ~:d MP4s, ~:d Others, for a total of ~:d~%"
  51. mp3-count mp4-count other-count (+ mp3-count mp4-count other-count))))
  52. (defun time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))
  53. "Time parsing of DIR."
  54. (let ((audio-streams:*get-audio-info* do-audio-processing))
  55. (time (do-audio-dir dir :file-system-encoding file-system-encoding :func nil))))
  56. ;;;;;;;;;;;;;;;;;;;; Experimental multi-thread code below ;;;;;;;;;;;;;;;;;;;;
  57. (defparameter *END-THREAD* #xdeadbeef)
  58. (defparameter *MAX-THREADS* 4)
  59. (defstruct chanl-results
  60. name
  61. mp3-count
  62. mp4-count
  63. other-count)
  64. (defun mp-do-audio-dir (&optional (dir "Queen") &key (file-system-encoding :utf-8)
  65. (func #'abstract-tag:show-tags))
  66. "Walk :DIR and FUNCALL specified function for each file (MP4/MP3) found."
  67. (set-pathname-encoding file-system-encoding)
  68. (let ((channel (make-instance 'chanl:unbounded-channel))
  69. (dead-channel (make-instance 'chanl:unbounded-channel))
  70. (mp3-count 0)
  71. (mp4-count 0)
  72. (other-count 0))
  73. (labels ((thread-reader ()
  74. (declare (special *me*))
  75. (let ((f)
  76. (results (make-chanl-results :name *me* :mp3-count 0 :mp4-count 0 :other-count 0)))
  77. (loop
  78. (with-slots (name mp3-count mp4-count other-count) results
  79. (setf f (chanl:recv channel))
  80. (when (and (typep f 'integer)
  81. (= f *END-THREAD*))
  82. (chanl:send dead-channel results)
  83. (return-from thread-reader nil))
  84. (do-audio-file f :func (lambda (s)
  85. (cond ((typep s 'mp3-file-stream)
  86. (incf mp3-count)
  87. (when func (funcall func s)))
  88. ((typep s 'mp4-file-stream)
  89. (incf mp4-count)
  90. (when func (funcall func s)))
  91. ((null s) (incf other-count))))))))))
  92. (cl-fad:walk-directory dir (lambda (f)
  93. (chanl:send channel f)))
  94. (dotimes (i *MAX-THREADS*)
  95. (chanl:send channel *END-THREAD*))
  96. (dotimes (i *MAX-THREADS*)
  97. (chanl:pcall #'thread-reader :initial-bindings `((*me* ,(format nil "reader-thread-~d" i)))))
  98. (block thread-reap
  99. (let ((i 0)
  100. results)
  101. (format t "Waiting on ~d threads~%" *MAX-THREADS*)
  102. (loop
  103. (force-output *standard-output*)
  104. (setf results (chanl:recv dead-channel))
  105. (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d Others~%"
  106. (chanl-results-name results)
  107. (chanl-results-mp3-count results)
  108. (chanl-results-mp4-count results)
  109. (chanl-results-other-count results))
  110. (force-output *standard-output*)
  111. (incf mp3-count (chanl-results-mp3-count results))
  112. (incf mp4-count (chanl-results-mp4-count results))
  113. (incf other-count (chanl-results-other-count results))
  114. (incf i)
  115. (when (= i *MAX-THREADS*)
  116. (return-from thread-reap *MAX-THREADS*)))))
  117. (format t "All threads done~%")
  118. (format t "~&~:d MP3s, ~:d MP4s, ~:d Others, for a total of ~:d~%"
  119. mp3-count mp4-count other-count (+ mp3-count mp4-count other-count)))))
  120. (defun mp-time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))
  121. "Time parsing of DIR."
  122. (let ((audio-streams:*get-audio-info* do-audio-processing))
  123. (time (mp-do-audio-dir dir :file-system-encoding file-system-encoding :func nil))))