diff --git a/.gitignore b/.gitignore index ba371a8..d3e62f8 100644 --- a/.gitignore +++ b/.gitignore @@ -20,3 +20,4 @@ compiled/ scribblings/*.html scribblings/*.css scribblings/*.js +scribblings/*.bak diff --git a/audio-manager.rkt b/audio-manager.rkt index e4ad873..ef103bf 100644 --- a/audio-manager.rkt +++ b/audio-manager.rkt @@ -9,12 +9,15 @@ (require "private/flac-handling.rkt") (require "private/opus-handling.rkt") (require "private/log.rkt") +(require "private/store.rkt") (require racket-audio) (require simple-log) (require simple-ini) (provide audio-manager) +(store-config! #:kind 'keystore) + (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)) @@ -23,10 +26,12 @@ (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) - )) + (file-db-store (begin + (store-config! #:kind (ini-get ini + 'manager + 'storage-kind + 'keystore)) + (store-open file-db-path))) (processed-dirs 0) (processed-files 0) (processed-opus 0) @@ -39,6 +44,7 @@ (copied-files 0) (failed-converts 0) (failed-copies 0) + (not-in-source 0) (processed-kind (make-hash)) (base-rate (ini-get ini 'flac 'max-khz 48000)) (dirs-logged -1) @@ -161,8 +167,7 @@ (hash-set! info 'bits bits) ) ) - (values base-path path info) - ) + (values base-path path info)) (define (flac-convert base-path path info) (when (and (needs-processing? path info) (flac? path info)) @@ -238,7 +243,7 @@ (if (convert-to-opus path opus-file ini) (begin (set! converted-files (+ converted-files 1)) - (info-am " Converted") + (info-am " Converted ~a" converted-files) ) (begin (info-am " CONVERSION PROBLEM") @@ -281,13 +286,25 @@ path-part)))) (delete-directory/files rm-path #:must-exist? #f) (let ((normalized-sub-path (hash-ref info 'path))) - (hash-remove! file-db-hash normalized-sub-path)) + (store-remove! file-db-store normalized-sub-path)) ) ) ) ) (values base-path path info)) + (define (updater base-path path info) + (when (not (eq? (hash-ref info 'file-db #f) 'deleted)) + (let ((normalized-sub-path (hash-ref info 'path))) + (store-set! file-db-store normalized-sub-path info))) + (values base-path path info)) + + (define (target-tree-cleaner base-path path info) + (let ((normalized-sub-path (hash-ref info 'path))) + (unless (store-exists? file-db-store normalized-sub-path) + (set! not-in-source (+ not-in-source 1)))) + (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) @@ -358,6 +375,7 @@ (format "Copied files : ~a" copied-files) (format "Failed convert : ~a" failed-converts) (format "Failed copies : ~a" failed-copies) + (format "Not in source : ~a" not-in-source) )) (subj (format "Audio manager report d.d. ~a" (date->yyyy-mm-dd (now)))) ) @@ -367,11 +385,12 @@ ) ) + (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))) + (let ((fw (make-file-admin music-path file-db-store))) ;; Enrichment phase (set! fw (fw-add-step fw adjust-ext)) (set! fw (fw-add-step fw flac-with-id3)) @@ -381,16 +400,29 @@ (set! fw (fw-add-step fw flac-picture)) (set! fw (fw-add-step fw to-opus)) (set! fw (fw-add-step fw copy-other)) - ;; Cleanup/Logging phase + ;; Cleanup/Logging phase/updating (set! fw (fw-add-step fw deleter)) (set! fw (fw-add-step fw log-processed-file)) + (set! fw (fw-add-step fw updater)) + (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) + ;; Cleanup files in target, not in source + (info-am "Checking files in target, not in source") + (let ((fwt (make-file-walker opus-path "*" target-tree-cleaner))) + (let loop1 () + (let-values (((base-path path info) (fwt))) + (if (eq? info #f) + (info-am "Target check finished") + (loop1))))) + (info-am "Closing store") + (store-close file-db-store) + (info-am "Reporting") (report) + (info-am "Done") 'done) (loop)))) ) diff --git a/private/file-walker.rkt b/private/file-walker.rkt index b84aa4e..740c185 100644 --- a/private/file-walker.rkt +++ b/private/file-walker.rkt @@ -4,6 +4,8 @@ racket/generator racket/string racket/path + "store.rkt" + "log.rkt" file/glob) (provide make-file-walker @@ -64,7 +66,7 @@ ) ) -(define (make-file-admin base-path db-hash) +(define (make-file-admin base-path db-store) (define (file-info-equal? i1 i2) (if (eq? (hash-ref i1 'type) (hash-ref i2 'type)) @@ -79,12 +81,12 @@ (define (file-admin base-path path info) (let* ((normalized-sub-path (hash-ref info 'path)) - (in-db (hash-ref db-hash normalized-sub-path #f)) + (in-db (store-ref db-store normalized-sub-path #f)) ) (cond ((eq? in-db #f) (hash-set! info 'file-db 'new) - (hash-set! db-hash normalized-sub-path info) + (store-set! db-store normalized-sub-path info) (values base-path path info) ) (else @@ -96,31 +98,69 @@ (when (eq? (hash-ref info 'type #f) 'file) (hash-set! in-db 'size (hash-ref info 'size)) (hash-set! in-db 'mtime (hash-ref info 'mtime))))) - (hash-set! db-hash normalized-sub-path in-db) + (store-set! db-store normalized-sub-path in-db) (values base-path path in-db) ) ) )) (define (init-db-sweep) - (hash-for-each db-hash - (λ (key value) - (if (eq? (hash-ref value 'file-db #f) 'deleted) - (hash-remove! db-hash key) - (hash-set! value 'file-db 'unknown))))) + (store-transaction db-store + (let ((count (store-count db-store)) + (k 0) + (last-perc 0)) + (store-for-each db-store + (λ (key value) + (set! k (+ k 1)) + (let ((perc (quotient (* k 100) count))) + (when (and (= (remainder perc 10) 0) (> perc last-perc)) + (set! last-perc perc) + (info-am "init-db-sweep: ~a%, k=~a" perc k))) + (if (eq? (hash-ref value 'file-db #f) 'deleted) + (store-remove! db-store key) + (begin + (hash-set! value 'file-db 'unknown) + (store-set! db-store key value)) + ) + ) + ) + ) + ) + ) (define (get-deleted) - (let ((keys (hash-keys db-hash))) - (map (λ (key) - (let ((info (hash-ref db-hash key))) - (hash-set! info 'file-db 'deleted) - info)) - (filter (λ (key) - (let ((v (hash-ref db-hash key))) - (eq? (hash-ref v 'file-db) 'unknown))) - keys)))) + (let ((count (store-count db-store)) + (k 0)) + (let ((keys (store-keys db-store))) + (map (λ (key) + (let ((info (store-ref db-store key))) + (hash-set! info 'file-db 'deleted) + info)) + (filter (λ (key) + (set! k (+ k 1)) + (let ((perc (quotient (* k 100) count))) + (when (= (remainder perc 10) 0) + (info-am "get-deleteed: ~a%" perc))) + (let ((v (store-ref db-store key))) + (eq? (hash-ref v 'file-db) 'unknown))) + keys)))) + ) - (let* ((fw (make-file-walker base-path "*" file-admin)) + (let* ((walker-count 0) + (fw (make-file-walker base-path "*" + (λ (base-path path info) + (cond + ((= walker-count 0) + (store-begin db-store)) + ((= (remainder walker-count 250) 0) + (store-commit db-store) + (store-begin db-store)) + ) + (set! walker-count (+ walker-count 1)) + (let-values (((base-path* path* info*) (file-admin base-path path info))) + (when (eq? info* #f) + (store-commit db-store)) + (values base-path* path* info*))))) (deleted #f)) (init-db-sweep) (letrec ((f (λ () diff --git a/private/mail.rkt b/private/mail.rkt index 9c4e186..0625e13 100644 --- a/private/mail.rkt +++ b/private/mail.rkt @@ -32,7 +32,7 @@ (if (list? report) report (list report)) #:port-no port #:auth-user user - #:auth-pwd passwd + #:auth-passwd passwd ) ) ) diff --git a/private/store.rkt b/private/store.rkt new file mode 100644 index 0000000..24ac6c2 --- /dev/null +++ b/private/store.rkt @@ -0,0 +1,131 @@ +#lang racket + +(require keystore + racket/serialize) + +(provide store-ref + store-set! + store-open + store-close + store-new + store-config! + store-exists? + store-remove! + store-keys + store-for-each + store-count + store-transaction + store-begin + store-commit + ) + +(define store-kind 'hash) + +(define (store-config! #:kind [kind 'hash]) + (if (not (or (eq? kind 'hash) (eq? kind 'keystore))) + (error "kind needs to be 'hash or 'keystore") + (set! store-kind kind))) + +(define (store-new file) + (if (eq? store-kind 'hash) + (let ((h (make-hash))) + (hash-set! h 'store-file file) + (list 'hash h)) + (store-open file)) + ) + +(define (store-open file) + (if (eq? store-kind 'hash) + (if (file-exists? file) + (deserialize (file->value file)) + (store-new file)) + (list 'keystore (ks-open file)))) + +(define (store-close st) + (if (eq? (car st) 'hash) + (let ((file (hash-ref (cadr st) 'store-file))) + (write-to-file + (serialize st) file #:exists 'replace)) + (ks-close (cadr st)))) + +(define (store-ref st key . val) + (if (eq? (car st) 'hash) + (if (null? val) + (hash-ref (cadr st) key) + (hash-ref (cadr st) key (car val))) + (let ((v (if (null? val) + (ks-get (cadr st) key) + (ks-get (cadr st) key (car val))))) + (if (eq? v 'ks-nil) + (error "No such key in storage") + v)) + ) + ) + +(define (store-set! st key val) + (if (eq? (car st) 'hash) + (hash-set! (cadr st) key val) + (ks-set! (cadr st) key val))) + +(define (store-remove! st key) + (if (eq? (car st) 'hash) + (hash-remove! (cadr st) key) + (ks-drop! (cadr st) key))) + +(define (store-exists? st key) + (if (eq? (car st) 'hash) + (hash-has-key? (cadr st) key) + (ks-exists? (cadr st) key))) + +(define (store-keys st) + (if (eq? (car st) 'hash) + (filter (λ (k) + (not (eq? k 'store-file))) + (hash-keys (cadr st))) + (ks-keys (cadr st)))) + +(define (store-count st) + (if (eq? (car st) 'hash) + (hash-count (cadr st)) + (ks-key-count (cadr st)))) + +(define (store-for-each st f) + (if (eq? (car st) 'hash) + (hash-for-each (cadr st) + (λ (k v) + (unless (eq? k 'store-file) + (f k v)))) + (let* ((ks (cadr st)) + (keys (ks-keys ks))) + (for-each (λ (k) + (let ((v (ks-get ks k))) + (f k v))) + keys)) + ) + ) + +(define-syntax store-transaction + (syntax-rules () + ((_ st b1 ...) + (if (eq? (car st) 'hash) + (begin b1 ...) + (ks-transaction (cadr st) b1 ...))))) + +(define (store-begin st) + (when (eq? (car st) 'keystore) + (ks-begin-transaction (cadr st))) + #t) + +(define (store-commit st) + (when (eq? (car st) 'keystore) + (ks-end-transaction (cadr st))) + #t) + + + + + + + + +