1
0

test.lisp 4.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091
  1. (in-package :cl-user)
  2. (defpackage chad-music.test
  3. (:use :cl #:audio-streams #:alexandria #:chad-music.db))
  4. (in-package :chad-music.test)
  5. (defparameter +album-split-slots+ '(artist album))
  6. (defparameter +album-whole-slots+ '(year genre type status))
  7. (defun gen-name (elements length)
  8. (format nil "~{~A~^ ~}" (loop for i below (1+ (random length)) collect (random-elt elements))))
  9. (defun generate-albums (count albums-db)
  10. (let ((splits (loop for slot in +album-split-slots+ append (list slot (make-hash-table :test 'equal))))
  11. (wholes (loop for slot in +album-whole-slots+ append (list slot (make-hash-table :test 'equal))))
  12. (albums (make-hash-table :test 'equal)))
  13. (loop for album being the hash-values of albums-db
  14. do (dolist (slot +album-split-slots+)
  15. (loop for word in (split-sequence:split-sequence #\Space (slot-value album slot))
  16. when (> (length word) 1)
  17. do (setf (gethash word (getf splits slot)) t)))
  18. do (dolist (slot +album-whole-slots+)
  19. (setf (gethash (slot-value album slot) (getf wholes slot)) t)))
  20. (dolist (slot +album-split-slots+)
  21. (setf (getf splits slot) (hash-table-keys (getf splits slot))))
  22. (dolist (slot +album-whole-slots+)
  23. (setf (getf wholes slot) (hash-table-keys (getf wholes slot))))
  24. (loop while (> count 0)
  25. do (let ((artist (gen-name (getf splits 'artist) 3))
  26. (num-albums (1+ (random 7))))
  27. (loop for i below num-albums
  28. for year = (random-elt (getf wholes 'year))
  29. for title = (gen-name (getf splits 'album) 5) then
  30. (gen-name (getf splits 'album) 5)
  31. for id = (get-album-id artist year title)
  32. while (> count 0)
  33. do (decf count)
  34. do (setf (gethash id albums)
  35. (make-album
  36. :id id
  37. :artist artist
  38. :year year
  39. :album title
  40. :original-date (format nil "~4,'0D-~2,'0D-~2,'0D"
  41. year (1+ (random 12)) (1+ (random 31)))
  42. :genre (random-elt (getf wholes 'genre))
  43. :type (random-elt (getf wholes 'type))
  44. :status (random-elt (getf wholes 'status))
  45. :cover (format nil "~A/~A/~D - ~A/cover.jpg" (elt artist 0) artist year title))))))
  46. albums))
  47. (defparameter +bit-rates+ '(128 160 192 228 320))
  48. (defun generate-tracks (max-album-length test-albums-db tracks-db)
  49. (let ((track-words (make-hash-table :test 'equal))
  50. (tracks (make-hash-table :test 'equal)))
  51. (loop for entry being the hash-values of tracks-db
  52. for track = (entry-data entry)
  53. when track
  54. do (loop for word in (split-sequence:split-sequence #\Space (track-title track))
  55. do (setf (gethash word track-words) t)))
  56. (setf track-words (hash-table-keys track-words))
  57. (loop for album being the hash-values of test-albums-db
  58. for track-count = (+ 2 (random (- max-album-length 1)))
  59. for bit-rate = (random-elt +bit-rates+)
  60. for is-vbr = (zerop (random 2))
  61. do (setf (album-track-count album) track-count
  62. (album-total-duration album) 0)
  63. do (loop for i below track-count
  64. for title = (gen-name track-words 5)
  65. for path = (format nil "~A/~A/~A - ~A/~A.mp3"
  66. (elt (album-artist album) 0) (album-artist album)
  67. (album-year album) (album-album album)
  68. title)
  69. for id = (get-file-id (pathname path))
  70. for track = (make-track
  71. :album album
  72. :artist (album-artist album)
  73. :no (list (write-to-string (1+ i)) (write-to-string track-count))
  74. :title title
  75. :part-of-set '("1" "1")
  76. :bit-rate bit-rate
  77. :is-vbr is-vbr
  78. :duration (+ 30 (random 300)))
  79. do (setf (gethash id tracks)
  80. (make-entry :path path :data track
  81. :added (get-universal-time) :modified (get-universal-time) :present t))
  82. do (incf (album-total-duration album) (track-duration track))))
  83. tracks))
  84. (defun generate-dbs (num-tracks dbs)
  85. (let* ((albums (generate-albums (round num-tracks 12) (cdr dbs)))
  86. (tracks (generate-tracks 24 albums (car dbs))))
  87. (cons tracks albums)))