Complete refactoring for rktplayer, in order to make it play on DLNA renderers and also use UpNP media server resources.

library/base/booklet-provider.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+
+(require racket/class)
+
+(provide booklet-provider%)
+
+(define booklet-provider%
+  (class object%
+    (abstract
+     has-booklet?
+     booklet-file)
+    (super-new)))

library/base/image-provider.rkt

@@ -0,0 +1,13 @@
+#lang racket/base
+
+(require racket/class)
+
+(provide image-provider%)
+
+(define image-provider%
+  (class object%
+    (abstract
+     has-image?
+     image->file
+     image->mimetype)
+    (super-new)))

library/base/media-container.rkt

@@ -0,0 +1,52 @@
+#lang racket/base
+
+(require racket/class
+         "media-item.rkt")
+
+(provide media-container%)
+
+;; A media container contains media-item% instances. An item can itself be
+;; another media-container%, or it can be a track<%>.
+(define media-container%
+  (class media-item%
+    (init [id #f])
+
+    (super-new
+     [id id]
+     [kind 'container])
+
+    (abstract
+     get-title
+     get-items
+     get-track-reliver)))
+
+(module+ test
+  (require rackunit)
+
+  (define track-reliver
+    (lambda (track-factory-id track-relive-info)
+      (list track-factory-id track-relive-info)))
+
+  (define test-container%
+    (class media-container%
+      (super-new [id 'container-id])
+
+      (define/override (get-title)
+        "Container")
+
+      (define/override (get-items)
+        '())
+
+      (define/override (get-track-reliver)
+        track-reliver)))
+
+  (define container
+    (new test-container%))
+
+  (check-equal? (send container get-id) 'container-id)
+  (check-equal? (send container get-kind) 'container)
+  (check-eq? (send container get-container) container)
+  (check-false (send container get-track))
+  (check-equal? (send container get-title) "Container")
+  (check-equal? (send container get-items) '())
+  (check-eq? (send container get-track-reliver) track-reliver))

library/base/media-item.rkt

@@ -0,0 +1,59 @@
+#lang racket/base
+
+(require racket/class)
+
+(provide media-item%)
+
+;; Common base class for entries returned by a media container.
+(define media-item%
+  (class object%
+    (init-field
+     kind
+     [id #f])
+
+    (unless (memq kind '(container track))
+    (raise-arguments-error
+     'media-item%
+     "invalid media item kind"
+     "expected" '(container track)
+     "kind" kind))
+
+    (define/public (get-id)
+      id)
+
+    (define/public (get-kind)
+      kind)
+
+    (define/public (get-container)
+      (and (eq? kind 'container)
+           this))
+
+    (define/public (get-track)
+      (and (eq? kind 'track)
+           this))
+
+    (super-new)))
+
+(module+ test
+  (require rackunit)
+
+  (define container
+    (new media-item%
+         [id 'container-id]
+         [kind 'container]))
+
+  (define track
+    (new media-item%
+         [id 'track-id]
+         [kind 'track]))
+
+  (check-eq? (send container get-container) container)
+  (check-false (send container get-track))
+  (check-eq? (send track get-track) track)
+  (check-false (send track get-container))
+  (check-equal? (send container get-id) 'container-id)
+  (check-equal? (send track get-kind) 'track)
+  (check-exn
+   exn:fail:contract?
+   (lambda ()
+     (new media-item% [kind 'unknown]))))

library/base/media-library.rkt

@@ -0,0 +1,51 @@
+#lang racket/base
+
+(require racket/class
+         "../library-cfg.rkt"
+         "../../misc/utils.rkt")
+
+(provide media-library%)
+
+(define media-library%
+  (class object%
+    (init-field
+     cfg)
+
+    (check/c media-library%
+             cfg
+             (is-a?/c library-cfg%))
+
+    (define cfg-revision
+      -1)
+
+    (define root-container
+      #f)
+
+    (define/private (reset-if-needed!)
+      (let ((current-revision (send cfg get-revision)))
+        (unless (= cfg-revision current-revision)
+          (set! cfg-revision current-revision)
+          (set! root-container #f))))
+
+    (define/public (get-cfg)
+      cfg)
+
+    (define/public (get-id)
+      (send cfg get-id))
+
+    (define/public (get-kind)
+      (send cfg get-kind))
+
+    (define/public (get-kind-version)
+      (send cfg get-kind-version))
+
+    (define/public (get-root-container)
+      (reset-if-needed!)
+      (when (eq? root-container #f)
+        (set! root-container
+              (send this make-root-container)))
+      root-container)
+
+    (abstract make-root-container)
+
+    (super-new)))

library/base/media-resource.rkt

@@ -0,0 +1,97 @@
+#lang racket/base
+
+(require net/url
+         racket/class
+         racket/string
+         "../../misc/utils.rkt")
+
+(provide media-resource%
+         media-resource-file%)
+
+(define media-resource%
+  (class object%
+    (init-field
+     uri
+     mime-type
+     protocol-info
+     seekable?)
+
+    (check/c* media-resource%
+              (uri string?)
+              (mime-type (or/c #f string?))
+              (protocol-info (or/c #f string?))
+              (seekable? boolean?))
+
+    (define/public (get-uri)
+      uri)
+
+    (define/public (get-mime-type)
+      mime-type)
+
+    (define/public (get-protocol-info)
+      protocol-info)
+
+    (define/public (is-seekable?)
+      seekable?)
+
+    (define/public (get-file)
+      #f)
+
+    (super-new)))
+
+(define media-resource-file%
+  (class media-resource%
+    (init
+     file
+     mime-type
+     [seekable? #t])
+
+    (check/c media-resource-file%
+             file
+             (or/c path? string?))
+
+    (define resource-file
+      (normal-case-path
+       (path->complete-path file)))
+
+    (define/override (get-file)
+      resource-file)
+
+    (super-new
+     [uri
+      (url->string
+       (path->url resource-file))]
+     [mime-type mime-type]
+     [protocol-info
+      (and mime-type
+           (format "file:*:~a:*" mime-type))]
+     [seekable? seekable?])))
+
+(module+ test
+  (require rackunit)
+
+  (define resource
+    (new media-resource-file%
+         [file
+          (build-path
+           (find-system-path 'temp-dir)
+           "track.flac")]
+         [mime-type "audio/flac"]))
+
+  (check-true
+   (is-a? resource media-resource%))
+  (check-true
+   (is-a? resource media-resource-file%))
+  (check-true
+   (path? (send resource get-file)))
+  (check-true
+   (string-prefix? (send resource get-uri)
+                   "file:"))
+  (check-equal?
+   (send resource get-mime-type)
+   "audio/flac")
+  (check-equal?
+   (send resource get-protocol-info)
+   "file:*:audio/flac:*")
+  (check-true
+   (send resource is-seekable?)))

library/base/tag-data-provider.rkt

@@ -0,0 +1,10 @@
+#lang racket/base
+
+(require racket/class)
+
+(provide tag-data-provider%)
+
+(define tag-data-provider%
+  (class object%
+    (abstract get-tag-data)
+    (super-new)))

library/base/track.rkt

@@ -0,0 +1,205 @@
+#lang racket/base
+
+(require racket/class
+         "booklet-provider.rkt"
+         "image-provider.rkt"
+         "media-item.rkt"
+         "media-resource.rkt"
+         "tag-data-provider.rkt"
+         "../track-tag-data.rkt"
+         "../../misc/utils.rkt")
+
+(provide track<%>
+         track%)
+
+(define track<%>
+  (interface ((class->interface media-item%))
+    get-title
+    get-artist
+    get-album
+    get-number
+    get-length
+    get-resource
+    get-music-library-factory-id
+    get-track-factory-id
+    get-track-relive-info
+    has-image?
+    image->file
+    image->mimetype
+    has-booklet?
+    booklet-file
+    track<
+    ->log))
+
+(define next-track-id
+  0)
+
+(define (new-track-id)
+  (set! next-track-id (+ next-track-id 1))
+  (when (> next-track-id 10000000)
+    (set! next-track-id 1))
+  next-track-id)
+
+(define track%
+  (class* media-item% (track<%>)
+    (init
+     tag-data-provider
+     image-provider
+     booklet-provider
+     resource
+     [id #f]
+     [music-library-factory-id #f]
+     [track-factory-id #f]
+     [track-relive-info #f])
+
+    (check/c* track%
+              (tag-data-provider
+               (is-a?/c tag-data-provider%))
+              (image-provider
+               (is-a?/c image-provider%))
+              (booklet-provider
+               (is-a?/c booklet-provider%))
+              (resource
+               (is-a?/c media-resource%)))
+
+    (define the-tag-data-provider
+      tag-data-provider)
+
+    (define the-image-provider
+      image-provider)
+
+    (define the-booklet-provider
+      booklet-provider)
+
+    (define the-resource
+      resource)
+
+    (define the-music-library-factory-id
+      music-library-factory-id)
+
+    (define the-track-factory-id
+      track-factory-id)
+
+    (define the-track-relive-info
+      track-relive-info)
+
+    (define/private (get-tag-data)
+      (send the-tag-data-provider get-tag-data))
+
+    (define/public (get-title)
+      (track-tag-data-title (get-tag-data)))
+
+    (define/public (get-artist)
+      (track-tag-data-artist (get-tag-data)))
+
+    (define/public (get-album)
+      (track-tag-data-album (get-tag-data)))
+
+    (define/public (get-number)
+      (track-tag-data-number (get-tag-data)))
+
+    (define/public (get-length)
+      (track-tag-data-length (get-tag-data)))
+
+    (define/public (get-resource)
+      the-resource)
+
+    (define/public (get-music-library-factory-id)
+      the-music-library-factory-id)
+
+    (define/public (get-track-factory-id)
+      the-track-factory-id)
+
+    (define/public (get-track-relive-info)
+      the-track-relive-info)
+
+    (define/public (has-image?)
+      (send the-image-provider has-image?))
+
+    (define/public (image->file target-file)
+      (send the-image-provider image->file target-file))
+
+    (define/public (image->mimetype)
+      (send the-image-provider image->mimetype))
+
+    (define/public (has-booklet?)
+      (send the-booklet-provider has-booklet?))
+
+    (define/public (booklet-file)
+      (send the-booklet-provider booklet-file))
+
+    (define/public (track< other-track)
+      (if (string-ci<? (send this get-album)
+                       (send other-track get-album))
+          #t
+          (and (string-ci=? (send this get-album)
+                            (send other-track get-album))
+               (< (send this get-number)
+                  (send other-track get-number)))))
+
+    (define/public (->log)
+      (info-rktplayer "~a - ~a - ~a - ~a"
+                      (send this get-number)
+                      (send this get-title)
+                      (send this get-album)
+                      (send this get-length)))
+
+    (super-new
+     [id (if id id (new-track-id))]
+     [kind 'track])))
+
+(module+ test
+  (require rackunit)
+
+  (define test-tag-data-provider%
+    (class tag-data-provider%
+      (define/override (get-tag-data)
+        (track-tag-data
+         "Title"
+         "Artist"
+         "Album"
+         2
+         120))
+      (super-new)))
+
+  (define test-image-provider%
+    (class image-provider%
+      (define/override (has-image?) #f)
+      (define/override (image->file target-file) #f)
+      (define/override (image->mimetype) 'no-mimetype)
+      (super-new)))
+
+  (define test-booklet-provider%
+    (class booklet-provider%
+      (define/override (has-booklet?) #f)
+      (define/override (booklet-file) #f)
+      (super-new)))
+
+  (define resource
+    (new media-resource%
+         [uri "https://example.com/track.flac"]
+         [mime-type "audio/flac"]
+         [protocol-info "http-get:*:audio/flac:*"]
+         [seekable? #t]))
+
+  (define track
+    (new track%
+         [resource resource]
+         [tag-data-provider
+          (new test-tag-data-provider%)]
+         [image-provider
+          (new test-image-provider%)]
+         [booklet-provider
+          (new test-booklet-provider%)]))
+
+  (check-true (is-a? track track%))
+  (check-true (is-a? track track<%>))
+  (check-equal? (send track get-kind) 'track)
+  (check-equal? (send track get-title) "Title")
+  (check-equal? (send track get-artist) "Artist")
+  (check-equal? (send track get-album) "Album")
+  (check-equal? (send track get-number) 2)
+  (check-equal? (send track get-length) 120)
+  (check-eq? (send track get-resource) resource)
+  (check-false (send track has-image?))
+  (check-false (send track has-booklet?)))

library/libraries-config.rkt

@@ -0,0 +1,149 @@
+#lang racket/base
+
+(require racket/class
+         "library-cfg.rkt"
+         "library-item.rkt"
+         "../misc/utils.rkt")
+
+(provide libraries-config%
+         (all-from-out "library-cfg.rkt")
+         (all-from-out "library-item.rkt"))
+
+(define libraries-config%
+  (class object%
+    (init-field settings)
+
+    (define items
+      #f)
+
+    (define revisions
+      (make-hash))
+
+    (define cfg
+      (send settings clone 'settings))
+
+    (define/private (sorted-items value)
+      (sort value
+            (lambda (a b)
+              (string<? (library-item-name a)
+                        (library-item-name b)))))
+
+    (define/private (get-items)
+      (when (eq? items #f)
+        (let ((stored (send cfg get 'libraries '())))
+          (dbg-rktplayer "libraries from ini: ~a" stored)
+          (set! items
+                (sorted-items
+                 (map store->library-item stored)))))
+      items)
+
+    (define/private (store-items! value)
+      (let ((new-items (sorted-items value)))
+        (send cfg
+              set!
+              'libraries
+              (map library-item->store new-items))
+        (set! items new-items)))
+
+    (define/private (increment-revision! id)
+      (hash-update! revisions id add1 0))
+
+    (define/public (libraries)
+      (map (lambda (item)
+             (new library-cfg%
+                  [library-cfg-id (library-item-id item)]
+                  [libraries-config this]))
+           (get-items)))
+
+    (define/public (count)
+      (length (get-items)))
+
+    (define/public (library-id idx)
+      (let ((all-items (get-items)))
+        (if (and (>= idx 0)
+                 (< idx (length all-items)))
+            (library-item-id (list-ref all-items idx))
+            #f)))
+
+    (define/public (get-item id)
+      (check/c libraries-config% get-item id symbol?)
+      (findf (lambda (item)
+               (eq? (library-item-id item) id))
+             (get-items)))
+
+    (define/public (get-item-revision id)
+      (check/c libraries-config% get-item-revision id symbol?)
+      (hash-ref revisions id 0))
+
+    (define/public (get-library id)
+      (check/c libraries-config% get-library id symbol?)
+      (and (send this get-item id)
+           (new library-cfg%
+                [library-cfg-id id]
+                [libraries-config this])))
+
+    (define/public (remove-library id)
+      (check/c libraries-config% remove-library id symbol?)
+      (store-items!
+       (filter (lambda (item)
+                 (not (eq? (library-item-id item) id)))
+               (get-items)))
+      (increment-revision! id))
+
+    (define/public (add-library item)
+      (check/c libraries-config% add-library item library-item?)
+
+      (let ((id (library-item-id item)))
+        (when (send this get-item id)
+          (raise-arguments-error
+           'libraries-config%:add-library
+           "a library with this id already exists"
+           "id" id))
+
+        (store-items! (cons item (get-items)))
+        (increment-revision! id)
+        id))
+
+    (define/public (update-item! item)
+      (check/c libraries-config% update-item! item library-item?)
+
+      (let* ((id (library-item-id item))
+             (current-item (send this get-item id)))
+        (unless current-item
+          (raise-arguments-error
+           'libraries-config%:update-item!
+           "library does not exist"
+           "id" id))
+
+        (unless (and (eq? (library-item-kind current-item)
+                          (library-item-kind item))
+                     (= (library-item-kind-version current-item)
+                        (library-item-kind-version item)))
+          (raise-arguments-error
+           'libraries-config%:update-item!
+           "library kind and kind-version cannot be changed"
+           "id" id))
+
+        (store-items!
+         (map (lambda (existing)
+                (if (eq? (library-item-id existing) id)
+                    item
+                    existing))
+              (get-items)))
+        (increment-revision! id)
+        (void)))
+
+    (define/public (current-library)
+      (let ((item
+             (findf library-item-current
+                    (get-items))))
+        (if item
+            (send this get-library
+                  (library-item-id item))
+            (if (null? (get-items))
+                #f
+                (send this get-library
+                      (library-item-id
+                       (car (get-items))))))))
+
+    (super-new)))

library/library-browser.rkt

@@ -0,0 +1,82 @@
+#lang racket/base
+
+(require racket/class
+         "base/media-container.rkt"
+         "base/media-library.rkt"
+         "../misc/utils.rkt")
+
+(provide library-browser%)
+
+(define library-browser%
+  (class object%
+    (init-field media-library)
+
+    (check/c library-browser%
+             media-library
+             (is-a?/c media-library%))
+
+    (define current-container
+      #f)
+
+    (define parent-containers
+      '())
+
+    (define cfg-revision
+      -1)
+
+    (define/private (reset-if-needed!)
+      (let ((current-revision
+             (send (send media-library get-cfg)
+                   get-revision)))
+        (unless (= cfg-revision current-revision)
+          (set! cfg-revision current-revision)
+          (send this reset!))))
+
+    (define/public (get-media-library)
+      media-library)
+
+    (define/public (get-current-container)
+      (reset-if-needed!)
+      current-container)
+
+    (define/public (get-items)
+      (send (send this get-current-container)
+            get-items))
+
+    (define/public (can-go-up?)
+      (reset-if-needed!)
+      (not (null? parent-containers)))
+
+    (define/public (open-container! container)
+      (check/c library-browser% open-container!
+               container
+               (is-a?/c media-container%))
+
+      (reset-if-needed!)
+      (set! parent-containers
+            (cons current-container
+                  parent-containers))
+      (set! current-container container)
+      (void))
+
+    (define/public (go-up!)
+      (reset-if-needed!)
+      (unless (null? parent-containers)
+        (set! current-container
+              (car parent-containers))
+        (set! parent-containers
+              (cdr parent-containers)))
+      (void))
+
+    (define/public (reset!)
+      (set! cfg-revision
+            (send (send media-library get-cfg)
+                  get-revision))
+      (set! current-container
+            (send media-library get-root-container))
+      (set! parent-containers '())
+      (void))
+
+    (super-new)
+
+    (send this reset!)))

library/library-cfg.rkt

@@ -0,0 +1,71 @@
+#lang racket/base
+
+(require racket/class
+         "library-item.rkt"
+         "../misc/utils.rkt")
+
+(provide library-cfg%)
+
+(define library-cfg%
+  (class object%
+    (init-field
+     library-cfg-id
+     libraries-config)
+
+    (check/c* library-cfg%
+              (library-cfg-id symbol?)
+              (libraries-config object?))
+
+    (define/private (get-item)
+      (let ((item (send libraries-config
+                        get-item
+                        library-cfg-id)))
+        (unless item
+          (raise-arguments-error
+           'library-cfg%
+           "library configuration no longer exists"
+           "library-cfg-id" library-cfg-id))
+        item))
+
+    (define/public (get-id)
+      library-cfg-id)
+
+    (define/public (get-name)
+      (library-item-name (get-item)))
+
+    (define/public (get-kind)
+      (library-item-kind (get-item)))
+
+    (define/public (get-kind-version)
+      (library-item-kind-version (get-item)))
+
+    (define/public (get-root)
+      (library-item-root (get-item)))
+
+    (define/public (get-host)
+      (library-item-host (get-item)))
+
+    (define/public (get-item-limit)
+      (library-item-item-limit (get-item)))
+
+    (define/public (is-current?)
+      (library-item-current (get-item)))
+
+    (define/public (get-current)
+      (library-item-current (get-item)))
+
+    (define/public (get-revision)
+      (send libraries-config
+            get-item-revision
+            library-cfg-id))
+
+    (define/public (set-current! value)
+      (check/c library-cfg% set-current! value boolean?)
+
+      (send libraries-config
+            update-item!
+            (struct-copy library-item
+                         (get-item)
+                         [current value])))
+
+    (super-new)))

library/library-factory.rkt

@@ -0,0 +1,108 @@
+#lang racket/base
+
+(require racket/class
+         "libraries-config.rkt"
+         "base/media-library.rkt"
+         "../misc/utils.rkt")
+
+(provide library-factory%
+         get-library-factory
+         set-library-factory!)
+
+(define current-library-factory
+  #f)
+
+(define (get-library-factory)
+  (unless current-library-factory
+    (raise-arguments-error
+     'get-library-factory
+     "no library factory has been configured"))
+  current-library-factory)
+
+(define (set-library-factory! factory)
+  (check/c set-library-factory!
+           factory
+           (is-a?/c library-factory%))
+  (set! current-library-factory factory)
+  (void))
+
+(define library-factory%
+  (class object%
+    (init-field libraries-config)
+
+    (check/c library-factory%
+             libraries-config
+             (is-a?/c libraries-config%))
+
+    (define makers
+      (make-hash))
+
+    (define libraries
+      (make-hash))
+
+    (define/public (get-libraries-config)
+      libraries-config)
+
+    (define/public (register-library-maker! kind version maker)
+      (check/c* (library-factory% register-library-maker!)
+                (kind symbol?)
+                (version exact-positive-integer?)
+                (maker (-> (is-a?/c library-cfg%) any/c)))
+
+      (let ((maker-key (cons kind version)))
+        (when (hash-has-key? makers maker-key)
+          (raise-arguments-error
+           'library-factory%:register-library-maker!
+           "a library maker is already registered"
+           "kind" kind
+           "version" version))
+
+        (hash-set! makers maker-key maker)
+        (void)))
+
+    (define/public (get-library library-id kind version)
+      (check/c* (library-factory% get-library)
+                (library-id symbol?)
+                (kind symbol?)
+                (version exact-positive-integer?))
+
+      (hash-ref!
+       libraries
+       library-id
+       (lambda ()
+         (let ((cfg (send libraries-config
+                          get-library
+                          library-id)))
+           (unless cfg
+             (raise-arguments-error
+              'library-factory%:get-library
+              "library configuration does not exist"
+              "library-id" library-id))
+
+           (unless (and (eq? kind (send cfg get-kind))
+                        (= version (send cfg get-kind-version)))
+             (raise-arguments-error
+              'library-factory%:get-library
+              "library kind or version does not match its configuration"
+              "library-id" library-id
+              "kind" kind
+              "version" version))
+
+           (let* ((maker-key (cons kind version))
+                  (maker
+                   (hash-ref
+                    makers
+                    maker-key
+                    (lambda ()
+                      (raise-arguments-error
+                       'library-factory%:get-library
+                       "no library maker is registered"
+                       "kind" kind
+                       "version" version))))
+                  (library (maker cfg)))
+             (check/c library-factory% get-library
+                      library
+                      (is-a?/c media-library%))
+             library)))))
+
+    (super-new)))

library/library-filesystem.rkt

@@ -0,0 +1,66 @@
+#lang racket/base
+
+(require racket/class
+         "mc-filesystem.rkt"
+         "library-factory.rkt"
+         "base/media-library.rkt"
+         "track-filesystem.rkt"
+         "../misc/utils.rkt")
+
+(provide library-filesystem%
+         register-library-filesystem!)
+
+(define library-filesystem-kind
+  'filesystem)
+
+(define library-filesystem-version
+  1)
+
+(define (register-library-filesystem! factory)
+  (check/c register-library-filesystem!
+           factory
+           (is-a?/c library-factory%))
+
+  (send factory
+        register-library-maker!
+        library-filesystem-kind
+        library-filesystem-version
+        (lambda (cfg)
+          (new library-filesystem%
+               [cfg cfg]))))
+
+(define library-filesystem%
+  (class media-library%
+    (init
+     cfg)
+
+    (define/override (make-root-container)
+      (new mc-filesystem%
+           [library this]
+           [relative-path '()]))
+
+    (define/public (make-container relative-path)
+      (new mc-filesystem%
+           [library this]
+           [relative-path relative-path]))
+
+    (define/public (make-track relative-path)
+      (new track-filesystem%
+           [library this]
+           [relative-path relative-path]))
+
+    (define/public (resolve-path relative-path)
+      (check/c library-filesystem% resolve-path
+               relative-path
+               list?)
+
+      (let ((root
+             (normal-case-path
+              (send (send this get-cfg)
+                    get-root))))
+        (if (null? relative-path)
+            root
+            (apply build-path root relative-path))))
+
+    (super-new
+     [cfg cfg])))

library/library-item.rkt

@@ -0,0 +1,74 @@
+#lang racket/base
+
+(require "../misc/utils.rkt")
+
+(provide
+ (struct-out library-item)
+ library-item->store
+ store->library-item)
+
+(define library-item-store-version
+  1)
+
+(struct library-item
+  (id
+   name
+   kind
+   kind-version
+   root
+   host
+   item-limit
+   current)
+  #:transparent
+  #:guard
+  (lambda (id name kind kind-version root host item-limit current type-name)
+    (check/c* library-item
+              (id symbol?)
+              (name string?)
+              (kind (or/c 'filesystem 'media-server))
+              (kind-version exact-positive-integer?)
+              (root (or/c path? string?))
+              (host (or/c #f string?))
+              (item-limit exact-positive-integer?)
+              (current boolean?))
+    (values id
+            name
+            kind
+            kind-version
+            root
+            host
+            item-limit
+            current)))
+
+(define (library-item->store item)
+  (check/c library-item->store item library-item?)
+
+  (let ((root (library-item-root item)))
+    (hash
+     'version library-item-store-version
+     'id (library-item-id item)
+     'name (library-item-name item)
+     'kind (library-item-kind item)
+     'kind-version (library-item-kind-version item)
+     'root (if (path? root) (path->string root) root)
+     'host (library-item-host item)
+     'item-limit (library-item-item-limit item)
+     'current (library-item-current item))))
+
+(define (store->library-item stored)
+  (check/c store->library-item stored hash?)
+
+  (let ((version (hash-ref stored 'version #f)))
+    (check/c store->library-item
+             version
+             (=/c library-item-store-version))
+
+    (library-item
+     (hash-ref stored 'id)
+     (hash-ref stored 'name)
+     (hash-ref stored 'kind)
+     (hash-ref stored 'kind-version)
+     (hash-ref stored 'root)
+     (hash-ref stored 'host)
+     (hash-ref stored 'item-limit 100)
+     (hash-ref stored 'current))))

library/library-media-server.rkt

@@ -0,0 +1,219 @@
+#lang racket/base
+
+(require racket/class
+         racket/list
+         racket/match
+         racket/string
+         (prefix-in upnp: racket-upnp)
+         "library-factory.rkt"
+         "mc-media-server.rkt"
+         "base/media-library.rkt"
+         "track-media-server.rkt"
+         "../misc/utils.rkt")
+
+(provide library-media-server%
+         register-library-media-server!)
+
+(define library-media-server-kind
+  'media-server)
+
+(define library-media-server-version
+  1)
+
+(define (register-library-media-server! factory)
+  (check/c register-library-media-server!
+           factory
+           (is-a?/c library-factory%))
+
+  (send factory
+        register-library-maker!
+        library-media-server-kind
+        library-media-server-version
+        (lambda (cfg)
+          (new library-media-server%
+               [cfg cfg]))))
+
+(define library-media-server%
+  (class media-library%
+    (init
+     cfg)
+
+    (define server
+      #f)
+
+    (define server-cfg-revision
+      -1)
+
+    (define/private (server-selector)
+      (or (send (send this get-cfg)
+                get-host)
+          (send (send this get-cfg)
+                get-name)))
+
+    (define/private (server-matches? candidate selector)
+      (let ((name
+             (upnp:media-server-name candidate))
+            (address
+             (upnp:media-server-address candidate))
+            (udn
+             (upnp:upnp-device-udn candidate)))
+        (or
+         (and udn
+              (string-ci=? udn selector))
+         (and name
+              (string-ci=? name selector))
+         (and address
+              (string-ci=? address selector))
+         (and name
+              (string-contains?
+               (string-downcase name)
+               (string-downcase selector))))))
+
+    (define/private (get-server)
+      (let ((cfg-revision
+             (send (send this get-cfg)
+                   get-revision)))
+        (unless (= cfg-revision
+                   server-cfg-revision)
+          (set! server #f)
+          (set! server-cfg-revision
+                cfg-revision))
+        (unless server
+          (let* ((selector (server-selector))
+                 (found
+                  (findf
+                   (lambda (candidate)
+                     (server-matches?
+                      candidate
+                      selector))
+                   (upnp:query-media-servers))))
+            (unless found
+              (raise-arguments-error
+               'library-media-server%
+               "configured media server was not found"
+               "selector" selector))
+            (set! server found)))
+        server))
+
+    (define/private (root-container-id)
+      (format "~a"
+              (send (send this get-cfg)
+                    get-root)))
+
+    (define/private (browse-page container-id start count)
+      (with-handlers
+          (((lambda (exception)
+              (and
+               (upnp:exn:fail:upnp? exception)
+               (equal?
+                (format "~a"
+                        (upnp:exn:fail:upnp-code
+                         exception))
+                "701")
+               (equal? container-id
+                       (root-container-id))
+               (not (string=? container-id
+                              "0"))))
+            (lambda (exception)
+              (warn-rktplayer
+               (string-append
+                "Configured UPnP media-server root ~a "
+                "does not exist; browsing root 0")
+               container-id)
+              (upnp:media-server-browse
+               (get-server)
+               "0"
+               #:start start
+               #:count count))))
+        (upnp:media-server-browse
+         (get-server)
+         container-id
+         #:start start
+         #:count count)))
+
+    (define/public (browse-container container-id)
+      (check/c library-media-server% browse-container
+               container-id
+               string?)
+
+      (browse-page
+       container-id
+       0
+       (send (send this get-cfg)
+             get-item-limit)))
+
+    (define/private (find-entry parent-id entry-id)
+      (let ((page-size
+             (send (send this get-cfg)
+                   get-item-limit)))
+        (let loop ((start 0))
+          (let* ((entries
+                  (browse-page parent-id
+                               start
+                               page-size))
+                 (entry
+                  (findf
+                   (lambda (candidate)
+                     (equal?
+                      (upnp:media-entry-id candidate)
+                      entry-id))
+                   entries)))
+            (cond
+              (entry entry)
+              ((< (length entries)
+                  page-size)
+               #f)
+              (else
+               (loop (+ start
+                        page-size))))))))
+
+    (define/override (make-root-container)
+      (new mc-media-server%
+           [library this]
+           [container-id
+            (root-container-id)]
+           [title
+            (send (send this get-cfg)
+                  get-name)]))
+
+    (define/public (make-container entry)
+      (check/c library-media-server% make-container
+               entry
+               upnp:media-container?)
+
+      (new mc-media-server%
+           [library this]
+           [container-id
+            (upnp:media-entry-id entry)]
+           [title
+            (upnp:media-entry-title entry)]))
+
+    (define/public (make-track entry)
+      (check/c library-media-server% make-track
+               entry
+               upnp:media-item?)
+
+      (new track-media-server%
+           [library this]
+           [entry entry]))
+
+    (define/public (relive-track track-factory-id
+                                 track-relive-info)
+      (case track-factory-id
+        ((media-server-item)
+         (match track-relive-info
+           ((list (? string? parent-id)
+                  (? string? entry-id))
+            (let ((entry
+                   (find-entry parent-id
+                               entry-id)))
+              (and entry
+                   (upnp:media-item? entry)
+                   (send this
+                         make-track
+                         entry))))
+           (else #f)))
+        (else #f)))
+
+    (super-new
+     [cfg cfg])))

library/library-ref.rkt

@@ -0,0 +1,7 @@
+#lang racket/base
+
+(provide (struct-out library-ref))
+
+(struct library-ref
+  (library-id kind version)
+  #:prefab)

library/mc-filesystem.rkt

@@ -0,0 +1,82 @@
+#lang racket/base
+
+(require racket/class
+         racket-audio
+         racket/list
+         racket/path
+         racket/string
+         "base/media-container.rkt"
+         "../misc/utils.rkt")
+
+(provide mc-filesystem%)
+
+(define mc-filesystem%
+  (class media-container%
+    (init-field
+     library
+     [relative-path '()])
+
+    (check/c mc-filesystem% relative-path list?)
+
+    (define/private (full-path)
+      (send library resolve-path relative-path))
+
+    (define/private (music-file-name? path)
+      (let ((file-name
+             (string-downcase (path->string path))))
+        (for/or ((extension
+                  (in-list (audio-known-exts?))))
+          (string-suffix?
+           file-name
+           (string-append "." extension)))))
+
+    (define/private (item-kind path)
+      (cond
+        ((directory-exists? path)
+         (let ((name
+                (path->string
+                 (file-name-from-path path))))
+           (and (not (string-prefix? name "."))
+                'container)))
+        ((music-file-name? path) 'track)
+        (else #f)))
+
+    (define/override (get-title)
+      (if (null? relative-path)
+          (send (send library get-cfg) get-name)
+          (path->string (last relative-path))))
+
+    (define/override (get-items)
+      (let ((path (full-path)))
+        (if (directory-exists? path)
+            (for*/list ((entry (in-list
+                               (sort (directory-list path)
+                                     path<?)))
+                       (entry-path
+                        (in-value (build-path path entry)))
+                       (kind
+                        (in-value (item-kind entry-path)))
+                       #:when kind)
+              (let ((entry-relative-path
+                     (append relative-path (list entry))))
+                (if (eq? kind 'container)
+                    (send library
+                          make-container
+                          entry-relative-path)
+                    (send library
+                          make-track
+                          entry-relative-path))))
+            '())))
+
+    (define/override (get-track-reliver)
+      (lambda (track-factory-id track-relive-info)
+        (case track-factory-id
+          ((file)
+           (send library
+                 make-track
+                 track-relive-info))
+          (else #f))))
+
+    (super-new
+     [id (cons (send (send library get-cfg) get-id)
+               relative-path)])))

library/mc-media-server.rkt

@@ -0,0 +1,86 @@
+#lang racket/base
+
+(require racket/class
+         racket/list
+         racket/string
+         (prefix-in upnp: racket-upnp)
+         "base/media-container.rkt"
+         "../misc/utils.rkt")
+
+(provide mc-media-server%)
+
+(define mc-media-server%
+  (class media-container%
+    (init-field
+     library
+     container-id
+     title)
+
+    (check/c* mc-media-server%
+              (library object?)
+              (container-id string?)
+              (title string?))
+
+    (define/private (audio-item? entry)
+      (and
+       (upnp:media-item? entry)
+       (string? (upnp:media-entry-id entry))
+       (string? (upnp:media-entry-parent-id entry))
+       (not
+        (null?
+         (upnp:media-item-resources entry)))
+       (or
+        (let ((class
+               (upnp:media-entry-class entry)))
+          (and class
+               (string-prefix?
+                class
+                "object.item.audioItem")))
+        (for/or
+            ((resource
+              (in-list
+               (upnp:media-item-resources entry))))
+          (let ((content-type
+                 (upnp:media-resource-content-type
+                  resource)))
+            (and content-type
+                 (string-prefix?
+                  content-type
+                  "audio/")))))))
+
+    (define/override (get-title)
+      title)
+
+    (define/override (get-items)
+      (filter-map
+       (lambda (entry)
+         (cond
+           ((and (upnp:media-container? entry)
+                 (string?
+                  (upnp:media-entry-id entry)))
+            (send library
+                  make-container
+                  entry))
+           ((audio-item? entry)
+            (send library
+                  make-track
+                  entry))
+           (else #f)))
+       (send library
+             browse-container
+             container-id)))
+
+    (define/override (get-track-reliver)
+      (lambda (track-factory-id
+               track-relive-info)
+        (send library
+              relive-track
+              track-factory-id
+              track-relive-info)))
+
+    (super-new
+     [id
+      (cons
+       (send (send library get-cfg)
+             get-id)
+       container-id)])))

library/track-filesystem-providers.rkt

@@ -0,0 +1,159 @@
+#lang racket
+
+(require racket-audio
+         "base/booklet-provider.rkt"
+         "base/image-provider.rkt"
+         "base/tag-data-provider.rkt"
+         "track-tag-data.rkt")
+
+(provide tag-source-filesystem%
+         tag-data-provider-filesystem%
+         image-provider-filesystem%
+         booklet-provider-filesystem%)
+
+(define tag-source-filesystem%
+  (class object%
+    (init-field file)
+
+    (define tags
+      #f)
+
+    (define loaded?
+      #f)
+
+    (define/private (read-tags)
+      (if (and file (file-exists? file))
+          (let* ((source-file
+                  (if (path? file)
+                      (path->string file)
+                      file))
+                 (source-tags (id3-tags source-file)))
+            (if (tags-valid? source-tags)
+                source-tags
+                (let ((temporary-file
+                       (make-temporary-file
+                        "rktplayer-~a"
+                        #:copy-from source-file)))
+                  (let ((temporary-tags
+                         (id3-tags temporary-file)))
+                    (delete-file temporary-file)
+                    temporary-tags))))
+          #f))
+
+    (define/public (get-tags)
+      (unless loaded?
+        (set! tags (read-tags))
+        (set! loaded? #t))
+      tags)
+
+    (super-new)))
+
+(define tag-data-provider-filesystem%
+  (class tag-data-provider%
+    (init-field
+     tag-source
+     [fallback-data (track-tag-data "" "" "" 0 0)])
+
+    (define tag-data
+      #f)
+
+    (define/override (get-tag-data)
+      (unless tag-data
+        (let ((tags (send tag-source get-tags)))
+          (set! tag-data
+                (if (and tags (tags-valid? tags))
+                    (track-tag-data
+                     (tags-title tags)
+                     (tags-artist tags)
+                     (tags-album tags)
+                     (tags-track tags)
+                     (tags-length tags))
+                    fallback-data))))
+      tag-data)
+
+    (super-new)))
+
+(define image-provider-filesystem%
+  (class image-provider%
+    (init-field file tag-source)
+
+    (define image-names
+      '("cover.jpg" "cover.png" "folder.jpg" "folder.png"))
+
+    (define/private (image-from-directory)
+      (and file
+           (let ((directory (path-only file)))
+             (for/first ((image-name (in-list image-names))
+                         #:when
+                         (file-exists?
+                          (build-path directory image-name)))
+               (build-path directory image-name)))))
+
+    (define/override (has-image?)
+      (let ((tags (send tag-source get-tags)))
+        (or (and tags
+                 (tags-valid? tags)
+                 (not (eq? (tags-picture->ext tags) #f)))
+            (not (eq? (image-from-directory) #f)))))
+
+    (define/override (image->file target-file)
+      (let* ((target (format "~a" target-file))
+             (tags (send tag-source get-tags))
+             (picture-extension
+              (and tags
+                   (tags-valid? tags)
+                   (tags-picture->ext tags))))
+        (if picture-extension
+            (let ((stored-file
+                   (string-append
+                    target
+                    "."
+                    (symbol->string picture-extension))))
+              (and (tags-picture->file tags stored-file)
+                   stored-file))
+            (let ((source-file (image-from-directory)))
+              (and source-file
+                   (let ((stored-file
+                          (string-append
+                           target
+                           (bytes->string/utf-8
+                            (path-get-extension source-file)))))
+                     (copy-file source-file
+                                stored-file
+                                #:exists-ok? #t)
+                     (format "~a" stored-file)))))))
+
+    (define/override (image->mimetype)
+      (let ((tags (send tag-source get-tags)))
+        (if (and tags
+                 (tags-valid? tags)
+                 (not (eq? (tags-picture->ext tags) #f)))
+            (tags-picture->mimetype tags)
+            (let ((source-file (image-from-directory)))
+              (if source-file
+                  (case (string->symbol
+                         (string-downcase
+                          (bytes->string/utf-8
+                           (path-get-extension source-file))))
+                    ((|.jpg| |.jpeg|) "image/jpeg")
+                    ((|.png|) "image/png")
+                    (else 'no-mimetype))
+                  'no-mimetype)))))
+
+    (super-new)))
+
+(define booklet-provider-filesystem%
+  (class booklet-provider%
+    (init-field file)
+
+    (define/override (booklet-file)
+      (and file
+           (build-path (path-only file)
+                       "booklet.pdf")))
+
+    (define/override (has-booklet?)
+      (let ((booklet (send this booklet-file)))
+        (and booklet
+             (file-exists? booklet))))
+
+    (super-new)))

library/track-filesystem.rkt

@@ -0,0 +1,116 @@
+#lang racket/base
+
+(require racket-mimetypes/mimetypes
+         racket/class
+         racket/file
+         racket/path
+         "library-ref.rkt"
+         "base/media-resource.rkt"
+         "track-filesystem-providers.rkt"
+         "track-tag-data.rkt"
+         "base/track.rkt"
+         "../misc/utils.rkt")
+
+(provide track-filesystem%)
+
+(define track-filesystem%
+  (class track%
+    (init-field library relative-path)
+
+    (check/c track-filesystem%
+             relative-path
+             list?)
+
+    (define file
+      (send library resolve-path relative-path))
+
+    (define mime-type
+      (mimetype-for-ext
+       file
+       #:default "application/octet-stream"))
+
+    (define tag-source
+      (new tag-source-filesystem%
+           [file file]))
+
+    (super-new
+     [resource
+      (new media-resource-file%
+           [file file]
+           [mime-type mime-type])]
+     [music-library-factory-id
+      (let ((cfg (send library get-cfg)))
+        (library-ref
+         (send cfg get-id)
+         (send cfg get-kind)
+         (send cfg get-kind-version)))]
+     [track-factory-id 'file]
+     [track-relive-info relative-path]
+     [tag-data-provider
+      (new tag-data-provider-filesystem%
+           [tag-source tag-source]
+           [fallback-data
+            (track-tag-data
+             (path->string
+              (file-name-from-path file))
+             ""
+             ""
+             0
+             0)])]
+     [image-provider
+      (new image-provider-filesystem%
+           [file file]
+           [tag-source tag-source])]
+     [booklet-provider
+      (new booklet-provider-filesystem%
+           [file file])])))
+
+(module+ test
+  (require rackunit)
+
+  (define file
+    (make-temporary-file "rktplayer-track-~a.mp3"))
+
+  (define cfg%
+    (class object%
+      (define/public (get-id) 'test-library)
+      (define/public (get-kind) 'filesystem)
+      (define/public (get-kind-version) 1)
+      (super-new)))
+
+  (define library%
+    (class object%
+      (define/public (resolve-path relative-path)
+        file)
+      (define/public (get-cfg)
+        (new cfg%))
+      (super-new)))
+
+  (dynamic-wind
+    void
+    (lambda ()
+      (let* ((track
+              (new track-filesystem%
+                   [library (new library%)]
+                   [relative-path
+                    (list (file-name-from-path file))]))
+             (resource (send track get-resource))
+             (library-reference
+              (send track get-music-library-factory-id)))
+        (check-true (is-a? track track%))
+        (check-equal?
+         (send resource get-file)
+         (normal-case-path
+          (path->complete-path file)))
+        (check-equal? (send track get-track-factory-id) 'file)
+        (check-equal? (send track get-track-relive-info)
+                      (list (file-name-from-path file)))
+        (check-true (is-a? resource media-resource-file%))
+        (check-true (send resource is-seekable?))
+        (check-equal? (send resource get-mime-type)
+                      "audio/mpeg")
+        (check-equal? (library-ref-library-id library-reference)
+                      'test-library)))
+    (lambda ()
+      (when (file-exists? file)
+        (delete-file file)))))

library/track-media-server.rkt

@@ -0,0 +1,191 @@
+#lang racket/base
+
+(require net/url
+         racket-mimetypes/mimetypes
+         racket/class
+         racket/list
+         racket/port
+         racket/string
+         (prefix-in upnp: racket-upnp)
+         "base/booklet-provider.rkt"
+         "base/image-provider.rkt"
+         "library-ref.rkt"
+         "base/media-resource.rkt"
+         "base/tag-data-provider.rkt"
+         "track-tag-data.rkt"
+         "base/track.rkt"
+         "../misc/utils.rkt")
+
+(provide track-media-server%)
+
+(define tag-data-provider-media-server%
+  (class tag-data-provider%
+    (init-field
+     entry
+     resource)
+
+    (define/override (get-tag-data)
+      (let ((artists
+             (upnp:media-item-artists entry)))
+        (track-tag-data
+         (upnp:media-entry-title entry)
+         (cond
+           ((not (null? artists))
+            (car artists))
+           ((upnp:media-item-creator entry)
+            (upnp:media-item-creator entry))
+           (else ""))
+         (or (upnp:media-item-album entry)
+             "")
+         (or
+          (upnp:media-item-original-track-number
+           entry)
+          0)
+         (or (upnp:media-resource-duration
+              resource)
+             0))))
+
+    (super-new)))
+
+(define image-provider-media-server%
+  (class image-provider%
+    (init-field uri)
+
+    (define mime-type
+      (and uri
+           (mimetype-for-ext
+            (regexp-replace
+             #px"[?#].*$"
+             uri
+             "")
+            #:default
+            "application/octet-stream")))
+
+    (define/private (stored-file target-file)
+      (let ((extension
+             (cond
+               ((equal? mime-type "image/jpeg") ".jpg")
+               ((equal? mime-type "image/png") ".png")
+               (else ""))))
+        (string-append
+         (format "~a" target-file)
+         extension)))
+
+    (define/override (has-image?)
+      (and (string? uri)
+           (not (string=? uri ""))))
+
+    (define/override (image->file target-file)
+      (and
+       (send this has-image?)
+       (with-handlers
+           ((exn:fail?
+             (lambda (exception)
+               (warn-rktplayer
+                "Could not retrieve media-server image: ~a"
+                (exn-message exception))
+               #f)))
+         (let ((file (stored-file target-file)))
+           (call/input-url
+            (string->url uri)
+            get-pure-port
+            (lambda (input)
+              (call-with-output-file
+               file
+               (lambda (output)
+                 (copy-port input output))
+               #:exists 'replace)))
+           file))))
+
+    (define/override (image->mimetype)
+      (or mime-type
+          'no-mimetype))
+
+    (super-new)))
+
+(define booklet-provider-media-server%
+  (class booklet-provider%
+    (define/override (has-booklet?)
+      #f)
+
+    (define/override (booklet-file)
+      #f)
+
+    (super-new)))
+
+(define (audio-resource? resource)
+  (let ((content-type
+         (upnp:media-resource-content-type
+          resource)))
+    (and content-type
+         (string-prefix?
+          content-type
+          "audio/"))))
+
+(define (resource-seekable? resource)
+  (let ((protocol-info
+         (upnp:media-resource-protocol-info
+          resource)))
+    (and protocol-info
+         (regexp-match?
+          #px"DLNA[.]ORG_OP=(?:01|10|11)"
+          protocol-info))))
+
+(define track-media-server%
+  (class track%
+    (init-field
+     library
+     entry)
+
+    (check/c track-media-server%
+             entry
+             upnp:media-item?)
+
+    (define source-resource
+      (or
+       (findf
+        audio-resource?
+        (upnp:media-item-resources entry))
+       (car
+        (upnp:media-item-resources entry))))
+
+    (define resource
+      (new media-resource%
+           [uri
+            (upnp:media-resource-uri
+             source-resource)]
+           [mime-type
+            (upnp:media-resource-content-type
+             source-resource)]
+           [protocol-info
+            (upnp:media-resource-protocol-info
+             source-resource)]
+           [seekable?
+            (resource-seekable?
+             source-resource)]))
+
+    (super-new
+     [resource resource]
+     [music-library-factory-id
+      (let ((cfg (send library get-cfg)))
+        (library-ref
+         (send cfg get-id)
+         (send cfg get-kind)
+         (send cfg get-kind-version)))]
+     [track-factory-id
+      'media-server-item]
+     [track-relive-info
+      (list
+       (upnp:media-entry-parent-id entry)
+       (upnp:media-entry-id entry))]
+     [tag-data-provider
+      (new tag-data-provider-media-server%
+           [entry entry]
+           [resource source-resource])]
+     [image-provider
+      (new image-provider-media-server%
+           [uri
+            (upnp:media-item-album-art-uri
+             entry)])]
+     [booklet-provider
+      (new booklet-provider-media-server%)])))

library/track-store.rkt

@@ -0,0 +1,175 @@
+#lang racket/base
+
+(require racket/class
+         racket/match
+         "library-factory.rkt"
+         "library-ref.rkt"
+         "base/track.rkt"
+         "../misc/utils.rkt")
+
+(provide track-store?
+         track-store-id
+         track-store-number
+         track-store-title
+         track->store
+         store->track)
+
+(define track-store-version
+  1)
+
+(define (track-store? stored)
+  (match stored
+    ((list 'track
+           (== track-store-version)
+           _
+           number
+           title
+           library-reference
+           track-factory-id
+           _)
+     (and (exact-integer? number)
+          (string? title)
+          (library-ref? library-reference)
+          (symbol? track-factory-id)))
+    (else #f)))
+
+(define (track-store-id stored)
+  (check/c track-store-id stored track-store?)
+  (list-ref stored 2))
+
+(define (track-store-number stored)
+  (check/c track-store-number stored track-store?)
+  (list-ref stored 3))
+
+(define (track-store-title stored)
+  (check/c track-store-title stored track-store?)
+  (list-ref stored 4))
+
+(define (track->store track)
+  (check/c track->store track (is-a?/c track<%>))
+
+  (let ((stored
+         (list 'track
+               track-store-version
+               (send track get-id)
+               (send track get-number)
+               (send track get-title)
+               (send track get-music-library-factory-id)
+               (send track get-track-factory-id)
+               (send track get-track-relive-info))))
+    (check/c track->store stored track-store?)
+    stored))
+
+(define (store->track stored factory)
+  (check/c store->track
+           factory
+           (is-a?/c library-factory%))
+
+  (and
+   (track-store? stored)
+   (with-handlers ((exn:fail?
+                    (lambda (_)
+                      #f)))
+     (let* ((library-reference (list-ref stored 5))
+            (library
+             (send factory
+                   get-library
+                   (library-ref-library-id library-reference)
+                   (library-ref-kind library-reference)
+                   (library-ref-version library-reference)))
+            (root-container
+             (send library get-root-container))
+            (track-reliver
+             (send root-container get-track-reliver))
+            (track
+             (track-reliver
+              (list-ref stored 6)
+              (list-ref stored 7))))
+       (and (object? track)
+            (is-a? track track<%>)
+            track)))))
+
+(module+ test
+  (require rackunit
+           racket/file
+           "libraries-config.rkt"
+           "library-filesystem.rkt"
+           "library-item.rkt")
+
+  (define settings%
+    (class object%
+      (define values
+        (make-hash))
+
+      (define/public (clone _)
+        this)
+
+      (define/public (get key default)
+        (hash-ref values key default))
+
+      (define/public (set! key value)
+        (hash-set! values key value))
+
+      (super-new)))
+
+  (define root
+    (make-temporary-file
+     "rktplayer-track-store-~a"
+     'directory))
+
+  (define file-name
+    "track.mp3")
+
+  (define file
+    (build-path root file-name))
+
+  (dynamic-wind
+    (lambda ()
+      (call-with-output-file file void))
+    (lambda ()
+      (let* ((libraries-config
+              (new libraries-config%
+                   [settings (new settings%)]))
+             (factory
+              (new library-factory%
+                   [libraries-config libraries-config])))
+        (send libraries-config
+              add-library
+              (library-item
+               'test-library
+               "Test library"
+               'filesystem
+               1
+               root
+               #f
+               100
+               #t))
+        (register-library-filesystem! factory)
+
+        (let* ((library
+                (send factory
+                      get-library
+                      'test-library
+                      'filesystem
+                      1))
+               (track
+                (send library
+                      make-track
+                      (list (string->path file-name))))
+               (stored (track->store track))
+               (relived (store->track stored factory)))
+          (check-true (track-store? stored))
+          (check-equal? (track-store-id stored)
+                        (send track get-id))
+          (check-equal? (track-store-number stored)
+                        (send track get-number))
+          (check-equal? (track-store-title stored)
+                        (send track get-title))
+          (check-true (is-a? relived track<%>))
+          (check-equal?
+           (normal-case-path
+            (send (send relived get-resource)
+                  get-file))
+           (normal-case-path file)))))
+    (lambda ()
+      (delete-directory/files root))))

library/track-tag-data.rkt

@@ -0,0 +1,7 @@
+#lang racket/base
+
+(provide (struct-out track-tag-data))
+
+(struct track-tag-data
+  (title artist album number length)
+  #:prefab)