[back] refactor db, save/load

back/db.lisp

@@ -2,6 +2,7 @@
 (defpackage chad-music.db
   (:use :cl #:audio-streams #:alexandria #:chad-music.utils)
   (:export #:*standard-optimize-settings*
+           #:*db*
            #:album #:id #:artist #:year #:album #:original-date #:publisher #:country #:genre #:type #:status #:mb-id #:track-count #:total-duration #:cover
            #:make-album #:album-id #:album-artist #:album-year #:album-album #:album-original-date #:album-publisher #:album-country
            #:album-genre #:album-type #:album-status #:album-mb-id #:album-track-count #:album-total-duration #:album-cover
@@ -12,22 +13,32 @@
            #:make-entry #:entry-track #:entry-added #:entry-modified #:entry-present
            #:get-album-id #:get-file-id #:rescan
            #:clear-track-no
-           #:query-category #:query-tracks))
+           #:save-db #:load-db
+           #:query-category #:query-tracks #:album-tracks))
 (in-package :chad-music.db)
 
+(defstruct db
+  (albums (make-hash-table :test 'equal) :type hash-table)
+  (tracks (make-hash-table :test 'equal) :type hash-table)
+  (album-tracks (make-hash-table :test 'equal) :type hash-table))
+
+(defvar *db* (make-db) "Metadata database")
+
 (defstruct album
   id artist year album original-date publisher country
   genre type status mb-id track-count total-duration cover)
 
 (defstruct track
-  album artist no title part-of-set
+  id album-id artist no title part-of-set
   bit-rate is-vbr duration path)
 
 (defstruct entry track added modified present)
 
 (defun get-file-id (file)
   (crypto:byte-array-to-hex-string
-   (crypto:digest-sequence :md5 (flex:string-to-octets (namestring file) :external-format :utf-8))))
+   (crypto:digest-sequence :md5 (flex:string-to-octets
+                                 (namestring file)
+                                 :external-format :utf-8))))
 
 (defun get-album-id (artist year title)
   (crypto:byte-array-to-hex-string
@@ -35,22 +46,26 @@
                                  (format nil "~A-~A-~A" artist year title)
                                  :external-format :utf-8))))
 
-(defun parse-file (file albums-db)
+(defun parse-file (file track-id)
   (declare #.*standard-optimize-settings*)
 
   (let ((it (open-audio-file file)))
     (when it
-      (let* ((album-artist (or (abstract-tag:album-artist it)
+      (let* ((albums-db (db-albums *db*))
+             (album-artist (or (abstract-tag:album-artist it)
                                (abstract-tag:artist it)))
-             (year (utils:awhen (abstract-tag::year it) (parse-integer utils:it :junk-allowed t)))
+             (album-year (utils:awhen (or (abstract-tag::year it)
+                                          (abstract-tag:original-date it))
+                           (parse-integer utils:it :junk-allowed t)))
              (album-title (abstract-tag:album it))
-             (album-id (get-album-id album-artist year album-title)))
-        (multiple-value-bind (album foundp) (gethash album-id albums-db)
+             (album-id (get-album-id album-artist album-year album-title)))
+        (multiple-value-bind (album foundp)
+            (gethash album-id albums-db)
           (unless foundp
             (setf album (make-album
                          :id album-id
                          :artist album-artist
-                         :year year
+                         :year album-year
                          :album album-title
                          :original-date (abstract-tag:original-date it)
                          :publisher (publisher it)
@@ -61,7 +76,8 @@
                          :mb-id (text-tag it "MusicBrainz Album Id"))
                   (gethash album-id albums-db) album))
           (make-track
-           :album album
+           :id track-id
+           :album-id album-id
            :artist (abstract-tag:artist it)
            :no (abstract-tag::track it)
            :title (abstract-tag:title it)
@@ -71,12 +87,16 @@
            :duration (round (or (duration it) 0))
            :path file))))))
 
-(defun rescan (paths &optional (dbs (cons (make-hash-table :test 'equal) (make-hash-table :test 'equal))))
+(defun track-album (track)
+  (gethash (track-album-id track)
+           (db-albums *db*)))
+
+(defun rescan (paths)
   (declare #.*standard-optimize-settings*)
 
   (let ((added 0) (updated 0) (removed 0)
-        (tracks-db (car dbs))
-        (albums-db (cdr dbs)))
+        (albums-db (db-albums *db*))
+        (tracks-db (db-tracks *db*)))
     (declare (fixnum added updated removed))
 
     (loop for value being the hash-values in tracks-db
@@ -96,7 +116,7 @@
                              (gethash file-id tracks-db) entry))
                      (unless (and foundp (= (the fixnum (entry-modified entry)) modified))
                        (when foundp (incf updated))
-                       (setf (entry-track entry) (parse-file file albums-db)
+                       (setf (entry-track entry) (parse-file file file-id)
                              (entry-modified entry) modified))
                      (setf (entry-present entry) t))))))
       (dolist (dir paths)
@@ -122,11 +142,28 @@
                   (progn
                     (incf removed)
                     (remhash file tracks-db))))
-        (loop for album being the hash-keys in album-stats using (hash-value stats)
-           do (setf (album-track-count album) (car stats)
-                    (album-total-duration album) (cdr stats))))
+        (loop for album-id being the hash-keys in albums-db using (hash-value album)
+           for stats = (gethash album album-stats)
+           do (if stats
+                  (setf (album-track-count album) (car stats)
+                        (album-total-duration album) (cdr stats))
+                  (remhash album-id albums-db))))
+      (reindex-db)
+      (values added updated removed))))
 
-      (values (cons tracks-db albums-db) added updated removed))))
+(defun reindex-db ()
+  (declare #.*standard-optimize-settings*)
+
+  (let ((tracks-db (db-tracks *db*))
+        (album-tracks-db (db-album-tracks *db*)))
+    (clrhash album-tracks-db)
+    (loop for entry being the hash-values in tracks-db
+       for track = (entry-track entry)
+       when track
+       do (push track (gethash (track-album-id track) album-tracks-db)))
+    (loop for album-id being the hash-keys in album-tracks-db using (hash-value tracks)
+       do (setf (gethash album-id album-tracks-db)
+                (sort tracks 'track<)))))
 
 (defun clear-track-no (track-no)
   (when track-no
@@ -200,10 +237,11 @@
              (equal (slot-value data (car r)) (cdr r)))
          restrictions))
 
-(defun query-category (albums-db category &key filter restrictions limit (offset 0) count-only)
+(defun query-category (category &key filter restrictions limit (offset 0) count-only)
   (declare #.*standard-optimize-settings*
            (type (or null fixnum) limit offset))
-  (let ((results (make-hash-table :test (case category
+  (let ((albums-db (db-albums *db*))
+        (results (make-hash-table :test (case category
                                           (album 'eq)
                                           (t 'equal)))))
     (loop for data being the hash-value of albums-db
@@ -231,10 +269,10 @@
                                          (t #'car))))
                   start end)))))
 
-(defun query-tracks (tracks-db &key filter restrictions limit (offset 0))
+(defun query-tracks (&key filter restrictions limit (offset 0))
   (declare #.*standard-optimize-settings*
            (type (or null fixnum) limit offset))
-  (let (results)
+  (let ((tracks-db (db-tracks *db*)) results)
     (loop for entry being the hash-value of tracks-db
        for track = (entry-track entry)
        when (and track
@@ -247,3 +285,30 @@
       (subseq (sort results
                     #'track<)
               start end))))
+
+(defun album-tracks (album-id)
+  (gethash album-id (db-album-tracks *db*)))
+
+(defun save-db (file-name)
+  (declare #.*standard-optimize-settings*)
+  (with-output-to-file (s file-name :if-exists :supersede)
+    (labels ((print-values (table)
+               (loop for value being the hash-value of table
+                  do (print value s))))
+      (print-values (db-albums *db*))
+      (print-values (db-tracks *db*)))))
+
+(defun load-db (file-name)
+  (declare #.*standard-optimize-settings*)
+  (with-input-from-file (s file-name)
+    (let ((albums (make-hash-table :test 'equal))
+          (entries (make-hash-table :test 'equal)))
+      (loop for value = (read s nil)
+         while value
+         do (etypecase value
+              (album (setf (gethash (album-id value) albums) value))
+              (entry (when (entry-track value)
+                       (setf (gethash (track-id (entry-track value)) entries) value)))))
+      (let ((*db* (make-db :albums albums :tracks entries)))
+        (reindex-db)
+        *db*))))

back/server.lisp

@@ -3,8 +3,6 @@
   (:use :cl #:alexandria #:chad-music.db #:jonathan))
 (in-package :chad-music.server)
 
-(defvar *db* nil "Metadata database")
-
 (defvar *path-url-mappings*
   '(("/media/pogo/Music/" . "/music/")) "Map database paths to urls")
 
@@ -118,7 +116,7 @@
   (declare #.*standard-optimize-settings*)
   (with-category (params category filter restrictions offset limit)
     (declare (ignore offset limit))
-    (200-json (query-category (cdr *db*) category
+    (200-json (query-category category
                               :filter filter :restrictions restrictions
                               :count-only t))))
 
@@ -134,17 +132,16 @@
 (defun get-category (params)
   (declare #.*standard-optimize-settings*)
   (with-category (params category filter restrictions offset limit)
-    (200-json (query-category (cdr *db*) category
+    (200-json (query-category category
                               :filter filter :restrictions restrictions
                               :limit limit :offset offset)
               (case category
                 (album #'to-json)
                 (t #'dumps-category-result)))))
 
-(defun album-tracks (params)
+(defun get-album-tracks (params)
   (declare #.*standard-optimize-settings*)
-  (200-json (query-tracks (car *db*)
-                          :restrictions `((id . ,(getf params :id))))))
+  (200-json (album-tracks (getf params :id))))
 
 (defun file-server (root)
   (lambda (params)
@@ -157,7 +154,7 @@
 (myway:connect *mapper* "/cat/:category/size" 'get-category-size)
 (myway:connect *mapper* "/cat/:category" 'get-category)
 (myway:connect *mapper* "/cat" 'get-category-list)
-(myway:connect *mapper* "/album/:id/tracks" 'album-tracks)
+(myway:connect *mapper* "/album/:id/tracks" 'get-album-tracks)
 ;;(myway:connect *mapper* "*" (lambda (p) (declare (ignore p)) +404+))
 
 (defun main (&rest args &key (port 5000) (debug nil) (use-thread t) (serve-files t) &allow-other-keys)