administration

.gitignore

@@ -20,3 +20,4 @@ compiled/
 scribblings/*.html
 scribblings/*.css
 scribblings/*.js
+scribblings/*.bak

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)
+         (file-db-store (begin
-                           (deserialize (file->value file-db-path))
+                          (store-config! #:kind (ini-get ini
-                           (make-hash)
+                                                         '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))))
       )

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
+    (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)
-                         (hash-remove! db-hash key)
+                              (store-remove! db-store key)
-                         (hash-set! value 'file-db 'unknown)))))
+                              (begin
+                                (hash-set! value 'file-db 'unknown)
+                                (store-set! db-store key value))
+                              )
+                          )
+                        )
+        )
+      )
+    )
 
   (define (get-deleted)
-    (let ((keys (hash-keys db-hash)))
+    (let ((count (store-count db-store))
+          (k 0))
+      (let ((keys (store-keys db-store)))
         (map (λ (key)
-             (let ((info (hash-ref db-hash key)))
+               (let ((info (store-ref db-store key)))
                  (hash-set! info 'file-db 'deleted)
                  info))
              (filter (λ (key)
-                     (let ((v (hash-ref db-hash 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 (λ ()

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

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)
+
+
+         
+
+
+
+
+
+