taglib-tests.lisp 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114
  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. (defmacro redirect (filename &rest body)
  16. "Temporarily set *STANDARD-OUTPUT* to FILENAME and execute BODY."
  17. `(let ((*standard-output* (open ,filename :direction :output :if-does-not-exist :create :if-exists :supersede)))
  18. ,@body
  19. (finish-output *standard-output*)))
  20. ;;; A note re filesystem encoding: my music collection is housed on a Mac and shared via SAMBA.
  21. ;;; In order to make sure we get valid pathnames, we need to set CCL's filesystem encoding to
  22. ;;; :UTF-8
  23. ;;;;;;;;;;;;;;;;;;;; MP4 Tests ;;;;;;;;;;;;;;;;;;;;
  24. (defun mp4-test0 (file)
  25. "Parse one MP3 file (with condition handling)."
  26. (let ((foo))
  27. (unwind-protect
  28. (handler-case
  29. (setf foo (parse-mp4-file file))
  30. (condition (c)
  31. (utils:warn-user "File: ~a~%Got condition: <~a>" file c)))
  32. (when foo (stream-close foo)))
  33. foo))
  34. (defun mp4-test1 ()
  35. (mp4-test0 *song-m4a*))
  36. (defun mp4-test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
  37. "Walk :DIR and call SHOW-TAGS for each file (MP4/MP3) found."
  38. (set-pathname-encoding file-system-encoding)
  39. (osicat:walk-directory dir (lambda (f)
  40. (when (utils:has-extension f "m4a")
  41. (let ((file (mp4-test0 (merge-pathnames (ccl:current-directory) (pathname f)))))
  42. (when file
  43. (mp4-tag:show-tags file :raw raw)))))))
  44. ;;;;;;;;;;;;;;;;;;;; MP3 Tests ;;;;;;;;;;;;;;;;;;;;
  45. (defun mp3-test0 (file)
  46. "Parse one MP3 file (with condition handling)."
  47. (let ((foo))
  48. (unwind-protect
  49. (handler-case
  50. (setf foo (parse-mp3-file file))
  51. (condition (c)
  52. (utils:warn-user "File: ~a~%Got condition: <~a>" file c)))
  53. (when foo (stream-close foo)))
  54. foo))
  55. (defun mp3-test1 ()
  56. (mp3-test0 *song-mp3*))
  57. (defun mp3-test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
  58. "Walk :DIR and parse every MP3 we find."
  59. (set-pathname-encoding file-system-encoding)
  60. (osicat:walk-directory dir (lambda (f)
  61. (when (utils:has-extension f "mp3")
  62. (let ((file (mp3-test0 (merge-pathnames (ccl:current-directory) (pathname f)))))
  63. (when file
  64. (mp3-tag:show-tags file :raw raw)))))))
  65. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66. (defun test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
  67. "Walk :DIR and call SHOW-TAGS for each file (MP4/MP3) found."
  68. (set-pathname-encoding file-system-encoding)
  69. (osicat:walk-directory dir (lambda (f)
  70. (let ((full-name (merge-pathnames (ccl:current-directory) (pathname f))))
  71. (cond ((utils:has-extension f "mp3")
  72. (let ((file (mp3-test0 full-name)))
  73. (when file
  74. (mp3-tag:show-tags file :raw raw))))
  75. ((utils:has-extension f "m4a")
  76. (let ((file (mp4-test0 full-name)))
  77. (when file
  78. (mp4-tag:show-tags file :raw raw)))))))))
  79. (defun time-test (dir &key (file-system-encoding :utf-8) (do-audio-processing t))
  80. "Time parsing of DIR."
  81. (let ((mp3-count 0)
  82. (mp4-count 0)
  83. (other-count 0))
  84. (labels ((do-dir (dir)
  85. (osicat:walk-directory dir (lambda (f)
  86. (let ((full-name (merge-pathnames (ccl:current-directory) (pathname f))))
  87. (cond ((utils:has-extension f "mp3")
  88. (incf mp3-count)
  89. (mp3-test0 full-name))
  90. ((utils:has-extension f "m4a")
  91. (incf mp4-count)
  92. (mp4-test0 full-name))
  93. (t
  94. (incf other-count))))))))
  95. (set-pathname-encoding file-system-encoding)
  96. (let ((audio-streams:*get-audio-info* do-audio-processing))
  97. (time (do-dir dir)))
  98. (format t "~:d MP3s, ~:d MP4s, ~:d Others~%"
  99. mp3-count mp4-count other-count))))