371 lines
14 KiB
Racket
371 lines
14 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/file)
|
|
(require racket/serialize)
|
|
(require racket/string)
|
|
(require "private/file-walker.rkt")
|
|
(require "private/util.rkt")
|
|
(require "private/mail.rkt")
|
|
(require "private/flac-handling.rkt")
|
|
(require "private/opus-handling.rkt")
|
|
(require "private/log.rkt")
|
|
(require racket-audio)
|
|
(require simple-log)
|
|
(require simple-ini)
|
|
|
|
(provide audio-manager)
|
|
|
|
(define (audio-manager music-path opus-path #:log-level [log-level 'debug])
|
|
(let* ((ini-config-file (build-path music-path ".audio-manager.ini"))
|
|
(ini (file->ini ini-config-file))
|
|
(report-flacs-with-id3 "FLAC files with id3 tags\n\n")
|
|
(report-flac "")
|
|
(report-opus "")
|
|
(file-db-path (build-path music-path ".audio-manager.db"))
|
|
(file-db-hash (if (file-exists? file-db-path)
|
|
(deserialize (file->value file-db-path))
|
|
(make-hash)
|
|
))
|
|
(processed-dirs 0)
|
|
(processed-files 0)
|
|
(processed-opus 0)
|
|
(changed-files 0)
|
|
(unchanged-files 0)
|
|
(deleted-files 0)
|
|
(new-files 0)
|
|
(pictures-set 0)
|
|
(converted-files 0)
|
|
(copied-files 0)
|
|
(failed-converts 0)
|
|
(failed-copies 0)
|
|
(processed-kind (make-hash))
|
|
(base-rate (ini-get ini 'flac 'max-khz 48000))
|
|
(dirs-logged -1)
|
|
(known-exts '(mp3 flac opus mp4 m4a mpg jpg jpeg png pdf))
|
|
(unknown-exts '())
|
|
)
|
|
|
|
(define (kinds< a b)
|
|
(string<? (symbol->string a) (symbol->string b)))
|
|
|
|
(define (needs-processing? path info)
|
|
(let ((state (hash-ref info 'file-db #f)))
|
|
(and (eq? (hash-ref info 'type #f) 'file)
|
|
(not-hidden? path)
|
|
(or
|
|
(eq? state 'changed)
|
|
(eq? state 'new)))))
|
|
|
|
(define (needs-copying? info)
|
|
(and (eq? (hash-ref info 'type #f) 'file)
|
|
(not (eq? (hash-ref info 'file-db #f) 'deleted))
|
|
(let ((path-part (get-path-part info)))
|
|
(if (eq? path-part #f)
|
|
#f
|
|
(not (file-exists? (build-path opus-path path-part)))))))
|
|
|
|
(define (deleted? info)
|
|
(eq? (hash-ref info 'file-db #f) 'deleted))
|
|
|
|
(define (get-path-part info)
|
|
(let ((p (hash-ref info 'path #f)))
|
|
(unless (eq? p #f)
|
|
(let ((path (build-path
|
|
(os-path
|
|
(if (string? p) p (path->string p))))))
|
|
path))))
|
|
|
|
(define (flac-id3? info)
|
|
(and
|
|
(eq? (hash-ref info 'type) 'file)
|
|
(eq? (hash-ref info 'ext) 'flac)
|
|
(eq? (hash-ref info 'sniffed #f) 'mp3)))
|
|
|
|
(define (flac? path info)
|
|
(when (eq? (hash-ref info 'type) 'file)
|
|
(let ((s (hash-ref info 'sniffed #f)))
|
|
(when (eq? s #f)
|
|
(hash-set! info 'sniffed (audio-sniff-format path))
|
|
)))
|
|
(and
|
|
(eq? (hash-ref info 'type) 'file)
|
|
(eq? (hash-ref info 'ext) 'flac)
|
|
(eq? (hash-ref info 'sniffed) 'flac)
|
|
)
|
|
)
|
|
|
|
(define (rep-id3 path)
|
|
(set! report-flacs-with-id3
|
|
(string-append report-flacs-with-id3
|
|
(format "- ~a\n" path))))
|
|
|
|
(define (rep-flac msg)
|
|
(set! report-flac
|
|
(string-append report-flac
|
|
"- " msg "\n")))
|
|
|
|
(define (rep-opus msg)
|
|
(set! report-opus
|
|
(string-append report-opus
|
|
"- " msg "\n")))
|
|
|
|
(define (adjust-ext base-path path info)
|
|
(let ((ext (hash-ref info 'ext)))
|
|
(hash-set! info 'orig-ext ext)
|
|
(unless (eq? ext '||)
|
|
(unless (memq ext known-exts)
|
|
(hash-set! info 'ext 'unkown)
|
|
(unless (memq ext unknown-exts)
|
|
(set! unknown-exts (sort (cons ext unknown-exts)
|
|
kinds<))
|
|
)
|
|
))
|
|
(values base-path path info)))
|
|
|
|
(define (flac-with-id3 base-path path info)
|
|
(if (needs-processing? path info)
|
|
(when (eq? (hash-ref info 'ext) 'flac)
|
|
(let ((sniffed (audio-sniff-format path)))
|
|
(hash-set! info 'sniffed sniffed)
|
|
(when (flac-id3? info)
|
|
(rep-id3 path))
|
|
)
|
|
)
|
|
(when (flac-id3? info)
|
|
(rep-id3 path))
|
|
)
|
|
(values base-path path info))
|
|
|
|
(define (flac-khz-bits base-path path info)
|
|
(when (and (needs-processing? path info) (flac? path info))
|
|
(when (or (eq? (hash-ref info 'khz #f) #f)
|
|
(eq? (hash-ref info 'bits #f) #f))
|
|
(let-values (((khz bits) (determine-flac-khz-and-bits path)))
|
|
(hash-set! info 'khz khz)
|
|
(hash-set! info 'bits bits)
|
|
)
|
|
)
|
|
)
|
|
(values base-path path info)
|
|
)
|
|
|
|
(define (flac-convert base-path path info)
|
|
(when (and (needs-processing? path info) (flac? path info))
|
|
(let ((rate (hash-ref info 'khz 0)))
|
|
(when (> rate base-rate)
|
|
(info-am "Need to convert flac file ~a (rate = ~a)" path rate)
|
|
(rep-flac (format "Convert ~a from ~a to ~a\n" path rate base-rate))
|
|
(if (convert-flac-to-rate path base-rate)
|
|
(hash-set! info 'khz base-rate)
|
|
(begin
|
|
(err-am " Cannot convert!")
|
|
(rep-flac " CANNOT CONVERT!")))
|
|
)
|
|
)
|
|
)
|
|
(values base-path path info))
|
|
|
|
(define (flac-picture base-path path info)
|
|
(when (and (needs-processing? path info) (flac? path info))
|
|
(let ((t (id3-tags path)))
|
|
(when (eq? (tags-picture t) #f)
|
|
(let-values (((kind cover-file) (get-cover-file path)))
|
|
(unless (eq? cover-file #f)
|
|
(info-am "Flac file has no picture, cover/folder.jpg|png available, setting picture")
|
|
(let ((cover (if (eq? kind 'jpg)
|
|
(make-tags-picture "image/jpeg"
|
|
'front-cover
|
|
(file->bytes cover-file)
|
|
#:description "Cover")
|
|
(make-tags-picture "image/png"
|
|
'front-cover
|
|
(file->bytes cover-file)
|
|
#:description "Cover"))
|
|
))
|
|
(call-with-id3-tags path
|
|
(λ (tags)
|
|
(tags-picture! tags cover)
|
|
(tags-save! tags))
|
|
#:mode 'read-write))
|
|
(info-am " Picture set")
|
|
(set! pictures-set (+ pictures-set 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(values base-path path info))
|
|
|
|
(define (to-opus base-path path info)
|
|
(when (or (needs-processing? path info)
|
|
(needs-copying? info))
|
|
(if (flac? path info)
|
|
(let ((path-part (get-path-part info)))
|
|
(unless (eq? path-part #f)
|
|
(let ((opus-file (path-replace-extension
|
|
(build-path opus-path path-part)
|
|
#".opus")))
|
|
(set! processed-opus (+ processed-opus 1))
|
|
(unless (file-exists? opus-file)
|
|
(rep-opus
|
|
(format "Converting flac to opus: ~a" (basename opus-file)))
|
|
(with-handlers ([exn? (λ (e)
|
|
(set! failed-converts (+ failed-converts 1))
|
|
(err-am "Conversion of ~a: ~a" path e))])
|
|
(unless (directory-exists? (basedir opus-file))
|
|
(make-directory* (basedir opus-file)))
|
|
(if (convert-to-opus path opus-file ini)
|
|
(begin
|
|
(set! converted-files (+ converted-files 1))
|
|
(info-am " Converted")
|
|
)
|
|
(begin
|
|
(info-am " CONVERSION PROBLEM")
|
|
(rep-opus " Conversion failed!")
|
|
(set! failed-converts (+ failed-converts 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(begin ; copy files rechtstreeks indien nodig
|
|
(with-handlers ([exn? (λ (e)
|
|
(set! failed-copies (+ failed-copies 1))
|
|
(err-am "Copy file ~a: ~a" path e))])
|
|
(let ((path-part (get-path-part info)))
|
|
(unless (eq? path-part #f)
|
|
(let ((dest-path (build-path opus-path path-part)))
|
|
(unless (directory-exists? (basedir dest-path))
|
|
(make-directory* (basedir dest-path)))
|
|
(copy-file path dest-path #:exists-ok? #t)
|
|
(set! copied-files (+ copied-files 1)))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(values base-path path info))
|
|
|
|
(define (deleter base-path path info)
|
|
(when (deleted? info)
|
|
(let ((path-part (get-path-part info)))
|
|
(unless (eq? path-part #f)
|
|
(let ((rm-path (build-path opus-path path-part)))
|
|
(set! deleted-files (+ deleted-files 1))
|
|
(delete-directory/files rm-path #:must-exist? #f)
|
|
(let ((normalized-sub-path (hash-ref info 'path)))
|
|
(hash-remove! file-db-hash normalized-sub-path))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(values base-path path info))
|
|
|
|
(define (log-processed-file base-path path info)
|
|
(dbg-am "processing ~a" path)
|
|
(if (eq? (hash-ref info 'type) 'dir)
|
|
(set! processed-dirs (+ processed-dirs 1))
|
|
(begin
|
|
(set! processed-files (+ processed-files 1))
|
|
(let ((k (hash-ref info 'file-db 'unknown)))
|
|
(cond ((eq? k 'new) (set! new-files (+ new-files 1)))
|
|
((eq? k 'changed) (set! changed-files (+ changed-files 1)))
|
|
((eq? k 'deleted) (set! deleted-files (+ deleted-files 1)))
|
|
((eq? k 'unchanged) (set! unchanged-files (+ unchanged-files 1)))
|
|
))
|
|
(let* ((ext (hash-ref info 'ext))
|
|
(n (hash-ref processed-kind ext 0)))
|
|
(set! n (+ n 1))
|
|
(hash-set! processed-kind ext n)))
|
|
)
|
|
|
|
(when (or (= (remainder processed-dirs 10) 0)
|
|
(= (remainder processed-files 250) 0))
|
|
(unless (= dirs-logged processed-dirs)
|
|
(set! dirs-logged processed-dirs)
|
|
(info-am (format "processed dirs: ~a, files: ~a, kinds: ~a, unknown kinds: ~a"
|
|
processed-dirs
|
|
processed-files
|
|
(string-join
|
|
(map (λ (ext)
|
|
(format "~a: ~a" ext (hash-ref processed-kind ext)))
|
|
(sort (hash-keys processed-kind)
|
|
kinds<))
|
|
", ")
|
|
(string-join
|
|
(map (λ (ext) (symbol->string ext)) unknown-exts)
|
|
", ")
|
|
))
|
|
))
|
|
|
|
(when (flac-id3? info)
|
|
(warn-am (format " FLAC heeft een id3v2 tag: ~a" path)))
|
|
|
|
(values base-path path info))
|
|
|
|
(define (report)
|
|
(rep-flac (format "Processed ~a flac files"
|
|
(hash-ref processed-kind 'flac 0)))
|
|
(rep-opus (format "Processed ~a opus files"
|
|
processed-opus))
|
|
(let* ((message (list "FLACS with id3 tags\n"
|
|
"-------------------\n"
|
|
report-flacs-with-id3
|
|
"\n"
|
|
"FLAC report\n"
|
|
"-----------\n"
|
|
report-flac
|
|
"OPUS report\n"
|
|
"-----------\n"
|
|
report-opus
|
|
"File report\n"
|
|
"-----------\n"
|
|
(format "Processed ~a files" processed-files)
|
|
(format "Processed ~a directories" processed-dirs)
|
|
(format "Deleted files : ~a" deleted-files)
|
|
(format "New files : ~a" new-files)
|
|
(format "Changed files : ~a" changed-files)
|
|
(format "Unchanged files: ~a" unchanged-files)
|
|
(format "Pictures set : ~a" pictures-set)
|
|
(format "Converted files: ~a" converted-files)
|
|
(format "Copied files : ~a" copied-files)
|
|
(format "Failed convert : ~a" failed-converts)
|
|
(format "Failed copies : ~a" failed-copies)
|
|
))
|
|
(subj (format "Audio manager report d.d. ~a" (date->yyyy-mm-dd (now))))
|
|
)
|
|
(mail-report ini
|
|
subj
|
|
message)
|
|
)
|
|
)
|
|
|
|
(sl-log-to-file&display (build-path music-path ".audio-manager.log"))
|
|
(info-am "Setting log level to ~a" log-level)
|
|
(sl-set-log-level log-level)
|
|
|
|
(let ((fw (make-file-admin music-path file-db-hash)))
|
|
(set! fw (fw-add-filter fw adjust-ext))
|
|
(set! fw (fw-add-filter fw flac-with-id3))
|
|
(set! fw (fw-add-filter fw flac-khz-bits))
|
|
(set! fw (fw-add-filter fw flac-convert))
|
|
(set! fw (fw-add-filter fw flac-picture))
|
|
(set! fw (fw-add-filter fw to-opus))
|
|
(set! fw (fw-add-filter fw deleter))
|
|
(set! fw (fw-add-filter fw log-processed-file))
|
|
(let loop ()
|
|
(let-values (((base-path path info) (fw)))
|
|
(if (eq? info #f)
|
|
(begin
|
|
(info-am "Finished walking music library")
|
|
(write-to-file (serialize file-db-hash) file-db-path #:exists 'replace)
|
|
(report)
|
|
'done)
|
|
(loop))))
|
|
)
|
|
)
|
|
)
|
|
|
|
|