56 lines
2.4 KiB
Racket
56 lines
2.4 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/file
|
|
racket/list
|
|
racket/path
|
|
racket/string)
|
|
|
|
(provide sidecar-cover-path
|
|
ensure-flac-sidecar-picture!)
|
|
|
|
(define cover-names '("cover.jpg" "folder.jpg" "cover.png" "folder.png"))
|
|
|
|
(define (path-name-ci=? p s)
|
|
(define-values (_base name _dir?) (split-path p))
|
|
(and (path? name) (string-ci=? (path->string name) s)))
|
|
|
|
(define (sidecar-cover-path audio-path)
|
|
(define-values (dir _name _dir?) (split-path audio-path))
|
|
(and (path? dir)
|
|
(for/or ([wanted (in-list cover-names)])
|
|
(or (let ([candidate (build-path dir wanted)])
|
|
(and (file-exists? candidate) candidate))
|
|
(for/or ([p (in-list (with-handlers ([exn:fail? (lambda (_) '())])
|
|
(directory-list dir #:build? #t)))])
|
|
(and (file-exists? p) (path-name-ci=? p wanted) p))))))
|
|
|
|
(define (cover-mimetype path)
|
|
(define ext (let-values ([(base name dir?) (split-path path)])
|
|
(and (path? name) (path-get-extension name))))
|
|
(cond [(and ext (member (string-downcase (bytes->string/utf-8 ext)) '(".jpg" ".jpeg"))) "image/jpeg"]
|
|
[(and ext (string-ci=? (bytes->string/utf-8 ext) ".png")) "image/png"]
|
|
[else (error 'cover-mimetype "unsupported cover image extension: ~a" path)]))
|
|
|
|
(define (ensure-flac-sidecar-picture! flac-path)
|
|
(define cover (sidecar-cover-path flac-path))
|
|
(and cover
|
|
(let ()
|
|
(define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
|
|
(define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
|
|
(define tags-picture (dynamic-require 'racket-audio/taglib 'tags-picture))
|
|
(define tags-picture! (dynamic-require 'racket-audio/taglib 'tags-picture!))
|
|
(define tags-save! (dynamic-require 'racket-audio/taglib 'tags-save!))
|
|
(define make-tags-picture (dynamic-require 'racket-audio/taglib 'make-tags-picture))
|
|
(call-with-id3-tags
|
|
flac-path
|
|
(lambda (tags)
|
|
(cond [(not (tags-valid? tags)) #f]
|
|
[(tags-picture tags) #f]
|
|
[else
|
|
(define picture (make-tags-picture (cover-mimetype cover) 3 (file->bytes cover)
|
|
#:description "Front cover"))
|
|
(tags-picture! tags picture)
|
|
(tags-save! tags)
|
|
cover]))
|
|
#:mode 'read-write))))
|