taglib-tests.lisp 4.7 KB

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