taglib-tests.lisp 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  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. (defparameter *song-m4a* "01 Keep Yourself Alive.m4a" "handy filename to test MP4s")
  8. (defparameter *song-mp3* "02 You Take My Breath Away.mp3" "handy filename to test MP3s")
  9. ;;;
  10. ;;; Set the pathname (aka filename) encoding in CCL for appropriate platorm
  11. (defun set-pathname-encoding (enc) (setf (ccl:pathname-encoding-name) enc))
  12. (defun set-pathname-encoding-for-osx () (set-pathname-encoding :utf-8))
  13. (defun set-pathname-encoding-for-linux () (set-pathname-encoding nil))
  14. (defmethod has-extension ((n string) ext)
  15. "Probably should use CL's PATHNAME methods, but simply looking at the .XXX portion of a filename
  16. to see if it matches. This is the string version that makes a PATHNAME and calls the PATHNAME version."
  17. (has-extension (parse-namestring n) ext))
  18. (defmethod has-extension ((p pathname) ext)
  19. "Probably should use CL's PATHNAME methods , but simply looking at the .XXX portion of a filename
  20. to see if it matches. PATHNAME version."
  21. (let ((e (pathname-type p)))
  22. (if e
  23. (string= (string-downcase e) (string-downcase ext))
  24. nil)))
  25. (defmacro redirect (filename &rest body)
  26. "Temporarily set *STANDARD-OUTPUT* to FILENAME and execute BODY."
  27. `(let ((*standard-output* (open ,filename :direction :output :if-does-not-exist :create :if-exists :supersede)))
  28. ,@body
  29. (finish-output *standard-output*)))
  30. ;;; A note re filesystem encoding: my music collection is housed on a Mac and shared via SAMBA.
  31. ;;; In order to make sure we get valid pathnames, we need to set CCL's filesystem encoding to
  32. ;;; :UTF-8
  33. ;;;;;;;;;;;;;;;;;;;; MP4 Tests ;;;;;;;;;;;;;;;;;;;;
  34. (defun mp4-test0 (file)
  35. "Parse one MP3 file (with condition handling)."
  36. (let ((dir (ccl:current-directory))
  37. (foo))
  38. (unwind-protect
  39. (handler-case
  40. (setf foo (parse-mp4-file file))
  41. (condition (c)
  42. (utils:warn-user "Dir: ~a~%File: ~a~%Got condition: <~a>~%" dir file c)))
  43. (when foo (stream-close foo)))
  44. foo))
  45. (defun mp4-test1 ()
  46. (mp4-test0 *song-m4a*))
  47. (defun mp4-test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
  48. "Walk :DIR and call SHOW-TAGS for each file (MP4/MP3) found."
  49. (set-pathname-encoding file-system-encoding)
  50. (osicat:walk-directory dir (lambda (f)
  51. (when (has-extension f "m4a")
  52. (let ((file (mp4-test0 (merge-pathnames (ccl:current-directory) (pathname f)))))
  53. (when file
  54. (mp4-tag:show-tags file :raw raw)))))))
  55. ;;;;;;;;;;;;;;;;;;;; MP3 Tests ;;;;;;;;;;;;;;;;;;;;
  56. (defun mp3-test0 (file)
  57. "Parse one MP3 file (with condition handling)."
  58. (let ((dir (ccl:current-directory))
  59. (foo))
  60. (unwind-protect
  61. (handler-case
  62. (setf foo (parse-mp3-file file))
  63. (condition (c)
  64. (utils:warn-user "Dir: ~a~%File: ~a~%Got condition: <~a>~%" dir file c)))
  65. (when foo (stream-close foo)))
  66. foo))
  67. (defun mp3-test1 ()
  68. (mp3-test0 *song-mp3*))
  69. (defun mp3-test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
  70. "Walk :DIR and parse every MP3 we find."
  71. (set-pathname-encoding file-system-encoding)
  72. (osicat:walk-directory dir (lambda (f)
  73. (when (has-extension f "mp3")
  74. (let ((file (mp3-test0 (merge-pathnames (ccl:current-directory) (pathname f)))))
  75. (when file
  76. (mp3-tag:show-tags file :raw raw)))))))
  77. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78. (defun test2 (&key (dir "Queen") (raw nil) (file-system-encoding :utf-8))
  79. "Walk :DIR and call SHOW-TAGS for each file (MP4/MP3) found."
  80. (set-pathname-encoding file-system-encoding)
  81. (osicat:walk-directory dir (lambda (f)
  82. (let ((full-name (merge-pathnames (ccl:current-directory) (pathname f))))
  83. (cond ((has-extension f "mp3")
  84. (let ((file (mp3-test0 full-name)))
  85. (when file
  86. (mp3-tag:show-tags file :raw raw))))
  87. ((has-extension f "m4a")
  88. (let ((file (mp4-test0 full-name)))
  89. (when file
  90. (mp4-tag:show-tags file :raw raw)))))))))