Files
rktplayer/library/mc-media-server.rkt
T

87 lines
2.1 KiB
Racket

#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)])))