playlists and DLNA playback

2026-08-28 12:51:12 +02:00
parent 69433abee1
commit cd16e3ae42
12 changed files with 1028 additions and 415 deletions
@@ -0,0 +1,202 @@
+#lang racket/base
+
+(require keystore
+         racket/file
+         racket/list
+         racket/path
+         uuid
+         "library.rkt")
+
+(provide (struct-out persisted-tab)
+         open-playlist-store
+         close-playlist-store!
+         load-user-playlists
+         save-user-playlists!)
+
+(struct persisted-tab (id name tracks) #:transparent)
+(struct playlist-store (keystore lock) #:transparent)
+
+(define (user-playlists-key username)
+  (format "playlists-for-~a" username))
+
+(define (track->datum item)
+  (hasheq 'file (path->string (track-file item))
+          'title (track-title item)
+          'artist (track-artist item)
+          'album (track-album item)
+          'duration (or (track-duration item) #f)
+          'mime-type (or (track-mime-type item) #f)))
+
+(define (optional-string? value)
+  (or (not value) (string? value)))
+
+(define (datum->track value libraries)
+  (and (hash? value)
+       (let ((file (hash-ref value 'file #f))
+             (title (hash-ref value 'title #f))
+             (artist (hash-ref value 'artist #f))
+             (album (hash-ref value 'album #f))
+             (duration (hash-ref value 'duration #f))
+             (mime-type (hash-ref value 'mime-type #f)))
+         (and (path-string? file)
+              (string? title)
+              (string? artist)
+              (string? album)
+              (or (not duration)
+                  (and (number? duration) (not (negative? duration))))
+              (optional-string? mime-type)
+              (library-contains-audio-file? libraries file)
+              (track (path->complete-path file)
+                     title artist album duration mime-type)))))
+
+(define (datum->tab id value libraries)
+  (and (uuid-string? id)
+       (hash? value)
+       (let ((name (hash-ref value 'name #f))
+             (tracks (hash-ref value 'tracks #f)))
+         (and (string? name)
+              (not (string=? name ""))
+              (list? tracks)
+              (persisted-tab
+               id
+               name
+               (filter-map
+                (lambda (item) (datum->track item libraries))
+                tracks))))))
+
+(define (open-playlist-store file)
+  (and file
+       (let ((target (path->complete-path file)))
+         (make-parent-directory* target)
+         (playlist-store (ks-open target) (make-semaphore 1)))))
+
+(define (close-playlist-store! store)
+  (when store
+    (call-with-semaphore
+     (playlist-store-lock store)
+     (lambda () (ks-close (playlist-store-keystore store)))))
+  (void))
+
+(define (load-user-playlists store username libraries)
+  (if (not store)
+      '()
+      (call-with-semaphore
+       (playlist-store-lock store)
+       (lambda ()
+         (define ks (playlist-store-keystore store))
+         (define ids (ks-get ks (user-playlists-key username) '()))
+         (if (list? ids)
+             (filter-map
+              (lambda (id)
+                (datum->tab id (ks-get ks id #f) libraries))
+              (remove-duplicates (filter uuid-string? ids) string=?))
+             '())))))
+
+(define (save-user-playlists! store username tabs)
+  (when store
+    (call-with-semaphore
+     (playlist-store-lock store)
+     (lambda ()
+       (define ks (playlist-store-keystore store))
+       (define index-key (user-playlists-key username))
+       (define old-ids (ks-get ks index-key '()))
+       (define ids (map persisted-tab-id tabs))
+       (ks-transaction
+        ks
+        (for ((id (in-list (if (list? old-ids) old-ids '())))
+              #:when (and (string? id) (not (member id ids string=?))))
+          (ks-drop! ks id))
+        (for ((tab (in-list tabs)))
+          (ks-set!
+           ks
+           (persisted-tab-id tab)
+           (hasheq 'name (persisted-tab-name tab)
+                   'tracks (map track->datum
+                                (persisted-tab-tracks tab)))))
+        (ks-set! ks index-key ids))
+       (void)))))
+
+(module+ test
+  (require rackunit
+           uuid/random)
+
+  (define root
+    (make-temporary-file "rkt-playlists-~a" 'directory))
+  (define music (build-path root "music"))
+  (define music-two (build-path root "music-two"))
+  (define outside (build-path root "outside.flac"))
+  (define store-file (build-path root "data" "playlists.keystore"))
+  (dynamic-wind
+    (lambda ()
+      (make-directory music)
+      (make-directory music-two)
+      (call-with-output-file (build-path music "one.flac") void)
+      (call-with-output-file (build-path music-two "two.flac") void)
+      (call-with-output-file outside void))
+    (lambda ()
+      (define libraries (make-music-libraries (list music music-two)))
+      (define store (open-playlist-store store-file))
+      (define first-id (uuid-string))
+      (define second-id (uuid-string))
+      (define item
+        (track (build-path music "one.flac")
+               "One" "Artist" "Album" 60 "audio/flac"))
+      (define item-two
+        (track (build-path music-two "two.flac")
+               "Two" "Artist" "Album" 70 "audio/flac"))
+      (save-user-playlists!
+       store
+       "hans"
+       (list (persisted-tab first-id "First" (list item item-two))
+             (persisted-tab second-id "Second" '())))
+      (save-user-playlists!
+       store
+       "local"
+       (list (persisted-tab (uuid-string) "Local" '())))
+
+      (define loaded (load-user-playlists store "hans" libraries))
+      (define ks (playlist-store-keystore store))
+      (check-equal? (ks-get ks "playlists-for-hans")
+                    (list first-id second-id))
+      (check-equal? (hash-ref (ks-get ks first-id) 'name) "First")
+      (check-equal? (map persisted-tab-id loaded) (list first-id second-id))
+      (check-equal? (persisted-tab-name (car loaded)) "First")
+      (check-equal? (map track-title (persisted-tab-tracks (car loaded)))
+                    '("One" "Two"))
+      (check-equal?
+       (map persisted-tab-name (load-user-playlists store "local" libraries))
+       '("Local"))
+
+      ;; Rewriting the user's GUID index durably removes the omitted playlist.
+      (save-user-playlists!
+       store "hans"
+       (list (persisted-tab first-id "First" (list item item-two))))
+      (check-equal?
+       (map persisted-tab-id (load-user-playlists store "hans" libraries))
+       (list first-id))
+      (check-false (ks-exists? ks second-id))
+      ;; An omitted GUID is deleted rather than becoming orphaned.
+      (check-equal?
+       (map persisted-tab-name (load-user-playlists store "local" libraries))
+       '("Local"))
+
+      ;; A playlist entry may not restore tracks outside configured libraries.
+      (define unsafe-id (uuid-string))
+      (ks-set!
+       (playlist-store-keystore store)
+       unsafe-id
+       (hasheq
+        'name "Unsafe"
+        'tracks
+        (list (hasheq 'file (path->string outside)
+                      'title "Outside" 'artist "" 'album ""
+                      'duration #f 'mime-type "audio/flac"))))
+      (ks-set! (playlist-store-keystore store)
+               (user-playlists-key "unsafe")
+               (list unsafe-id))
+      (check-equal?
+       (persisted-tab-tracks
+        (car (load-user-playlists store "unsafe" libraries)))
+       '())
+      (close-playlist-store! store))
+    (lambda () (delete-directory/files root))))