Complete refactoring for rktplayer, in order to make it play on DLNA renderers and also use UpNP media server resources.
This commit is contained in:
@@ -0,0 +1,280 @@
|
||||
#lang racket/base
|
||||
|
||||
(require net/url
|
||||
racket/async-channel
|
||||
racket/class
|
||||
racket/file
|
||||
racket/path
|
||||
racket/string
|
||||
"../library/base/media-resource.rkt"
|
||||
"../misc/utils.rkt")
|
||||
|
||||
(provide playlist-cache%
|
||||
playlist-cache-root
|
||||
clear-playlist-cache!)
|
||||
|
||||
(define (playlist-cache-root)
|
||||
(build-path (find-system-path 'cache-dir)
|
||||
"rktplayer"))
|
||||
|
||||
(define (safe-name value)
|
||||
(regexp-replace* #px"[<>:\"/\\\\|?*]"
|
||||
(format "~a" value)
|
||||
"_"))
|
||||
|
||||
(define (resource-extension resource)
|
||||
(let* ((uri (send resource get-uri))
|
||||
(without-query
|
||||
(regexp-replace #px"[?#].*$" uri ""))
|
||||
(uri-extension
|
||||
(regexp-match #px"(?i:[.]([a-z0-9]{1,8})$)"
|
||||
without-query))
|
||||
(mime-type (send resource get-mime-type)))
|
||||
(cond
|
||||
(uri-extension
|
||||
(string-append "."
|
||||
(string-downcase
|
||||
(cadr uri-extension))))
|
||||
((member mime-type
|
||||
'("audio/flac"
|
||||
"audio/x-flac"
|
||||
"application/flac")) ".flac")
|
||||
((or (equal? mime-type "audio/mpeg")
|
||||
(equal? mime-type "audio/mp3")) ".mp3")
|
||||
((or (equal? mime-type "audio/opus")
|
||||
(equal? mime-type "audio/ogg")) ".opus")
|
||||
((member mime-type
|
||||
'("audio/wav"
|
||||
"audio/wave"
|
||||
"audio/x-wav")) ".wav")
|
||||
((member mime-type
|
||||
'("audio/mp4"
|
||||
"audio/x-m4a")) ".m4a")
|
||||
((equal? mime-type "audio/aac") ".aac")
|
||||
((equal? mime-type "audio/x-ms-wma") ".wma")
|
||||
(else ".audio"))))
|
||||
|
||||
(define (content-length headers)
|
||||
(for/or ((header (in-list headers)))
|
||||
(let ((matched
|
||||
(regexp-match
|
||||
#px#"(?i:^content-length:[ \t]*([0-9]+)[ \t]*$)"
|
||||
header)))
|
||||
(and matched
|
||||
(string->number
|
||||
(bytes->string/utf-8
|
||||
(cadr matched)))))))
|
||||
|
||||
(define (successful-status? status)
|
||||
(regexp-match? #px#"^HTTP/[0-9.]+ 2[0-9][0-9]" status))
|
||||
|
||||
(define (clear-playlist-cache! [playlist-id #f])
|
||||
(let ((target
|
||||
(if playlist-id
|
||||
(build-path (playlist-cache-root)
|
||||
(safe-name playlist-id))
|
||||
(playlist-cache-root))))
|
||||
(when (directory-exists? target)
|
||||
(with-handlers ([exn:fail? (lambda (e) (void))])
|
||||
(delete-directory/files target)))))
|
||||
|
||||
(define playlist-cache%
|
||||
(class object%
|
||||
(init-field
|
||||
playlist-id
|
||||
[updated (lambda (entry downloaded total) (void))])
|
||||
|
||||
(define directory
|
||||
(build-path (playlist-cache-root)
|
||||
(safe-name playlist-id)))
|
||||
|
||||
(define queue
|
||||
(make-async-channel))
|
||||
|
||||
(define generations
|
||||
(make-hash))
|
||||
|
||||
(define stopped?
|
||||
#f)
|
||||
|
||||
(define worker-custodian
|
||||
(make-custodian))
|
||||
|
||||
(define/private (entry-generation entry)
|
||||
(hash-ref generations
|
||||
(send entry get-id)
|
||||
0))
|
||||
|
||||
(define/private (next-generation! entry)
|
||||
(hash-update! generations
|
||||
(send entry get-id)
|
||||
add1
|
||||
0)
|
||||
(entry-generation entry))
|
||||
|
||||
(define/private (cache-file entry)
|
||||
(let ((resource
|
||||
(send (send entry get-track)
|
||||
get-resource)))
|
||||
(build-path directory
|
||||
(string-append
|
||||
(safe-name (send entry get-id))
|
||||
(resource-extension resource)))))
|
||||
|
||||
(define/private (notify! entry downloaded total)
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(warn-rktplayer
|
||||
"Cache status callback failed: ~a"
|
||||
(exn-message exception)))))
|
||||
(updated entry downloaded total)))
|
||||
|
||||
(define/private (copy-download!
|
||||
input temporary entry total)
|
||||
(let ((downloaded 0)
|
||||
(last-reported 0)
|
||||
(buffer (make-bytes 65536)))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(call-with-output-file
|
||||
temporary
|
||||
(lambda (output)
|
||||
(let loop ()
|
||||
(let ((count
|
||||
(read-bytes-avail!* buffer input)))
|
||||
(unless (eof-object? count)
|
||||
(write-bytes buffer output 0 count)
|
||||
(set! downloaded (+ downloaded count))
|
||||
(when (>= (- downloaded last-reported)
|
||||
1048576)
|
||||
(set! last-reported downloaded)
|
||||
(notify! entry downloaded total))
|
||||
(loop)))))
|
||||
#:exists 'replace
|
||||
#:mode 'binary))
|
||||
(lambda ()
|
||||
(close-input-port input)))
|
||||
downloaded))
|
||||
|
||||
(define/private (finish-download!
|
||||
entry generation target temporary
|
||||
downloaded total)
|
||||
(if (and (not stopped?)
|
||||
(= generation
|
||||
(entry-generation entry)))
|
||||
(begin
|
||||
(when (file-exists? target)
|
||||
(delete-file target))
|
||||
(rename-file-or-directory temporary target)
|
||||
(send entry set-cache-file! target)
|
||||
(notify! entry downloaded total))
|
||||
(when (file-exists? temporary)
|
||||
(delete-file temporary))))
|
||||
|
||||
(define/private (download! entry generation)
|
||||
(let* ((resource
|
||||
(send (send entry get-track)
|
||||
get-resource))
|
||||
(uri (send resource get-uri))
|
||||
(target (cache-file entry))
|
||||
(temporary
|
||||
(string->path
|
||||
(string-append (path->string target)
|
||||
".part"))))
|
||||
(let ((finished? #f))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(make-directory* directory)
|
||||
(let-values
|
||||
(((status headers input)
|
||||
(http-sendrecv/url
|
||||
(string->url uri)
|
||||
#:headers
|
||||
(list "Connection: close"))))
|
||||
(unless (successful-status? status)
|
||||
(close-input-port input)
|
||||
(error 'playlist-cache%
|
||||
"download failed for ~a: ~a"
|
||||
uri
|
||||
status))
|
||||
(let* ((total (content-length headers))
|
||||
(downloaded
|
||||
(copy-download!
|
||||
input temporary entry total)))
|
||||
(finish-download!
|
||||
entry generation target temporary
|
||||
downloaded total)
|
||||
(set! finished? #t))))
|
||||
(lambda ()
|
||||
(when (and (not finished?)
|
||||
(file-exists? temporary))
|
||||
(delete-file temporary)))))))
|
||||
|
||||
(define worker
|
||||
(parameterize
|
||||
((current-custodian worker-custodian))
|
||||
(thread
|
||||
(lambda ()
|
||||
(let loop ()
|
||||
(let ((request (async-channel-get queue)))
|
||||
(unless (eq? request 'stop)
|
||||
(let ((entry (car request))
|
||||
(generation (cadr request)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(when (= generation
|
||||
(entry-generation entry))
|
||||
(send entry
|
||||
set-cache-failed!
|
||||
(exn-message exception))
|
||||
(notify! entry 0 #f)))))
|
||||
(download! entry generation))
|
||||
(loop)))))))))
|
||||
|
||||
(define/public (ensure-entry! entry)
|
||||
(let ((track (send entry get-track)))
|
||||
(when track
|
||||
(let* ((resource (send track get-resource))
|
||||
(file (send resource get-file)))
|
||||
(cond
|
||||
(file
|
||||
(send entry set-cache-file! file))
|
||||
((regexp-match? #px"(?i:^https?://)"
|
||||
(send resource get-uri))
|
||||
(let ((target (cache-file entry)))
|
||||
(if (file-exists? target)
|
||||
(send entry set-cache-file! target)
|
||||
(let ((generation
|
||||
(next-generation! entry)))
|
||||
(send entry set-cache-downloading!)
|
||||
(notify! entry 0 #f)
|
||||
(async-channel-put
|
||||
queue
|
||||
(list entry generation)))))))))))
|
||||
|
||||
(define/public (drop-entry! entry)
|
||||
(next-generation! entry)
|
||||
(let ((file (send entry get-cache-file)))
|
||||
(when (and file
|
||||
(path? file)
|
||||
(file-exists? file)
|
||||
(equal? (simplify-path directory)
|
||||
(simplify-path
|
||||
(path-only file))))
|
||||
(delete-file file))))
|
||||
|
||||
(define/public (clear!)
|
||||
(when (directory-exists? directory)
|
||||
(delete-directory/files directory)))
|
||||
|
||||
(define/public (stop!)
|
||||
(unless stopped?
|
||||
(set! stopped? #t)
|
||||
(custodian-shutdown-all
|
||||
worker-custodian)))
|
||||
|
||||
(super-new)))
|
||||
Reference in New Issue
Block a user