normalize album, get track-count, total-duration and cover

chad-music.asd

@@ -8,4 +8,5 @@
                #:ironclad
                #:split-sequence)
   :serial t
-  :components ((:file "db")))
+  :components ((:file "utils")
+               (:file "db")))

db.lisp

@@ -1,182 +1,62 @@
 (in-package :cl-user)
 (defpackage chad-music.db
-  (:use :cl #:audio-streams #:alexandria))
+  (:use :cl #:audio-streams #:alexandria #:chad-music.utils))
 (in-package :chad-music.db)
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  #+dbg
-  (defvar *standard-optimize-settings* '(optimize (debug 3)))
-  #-dbg
-  (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0)))
-  )
-
 (defstruct album
-  album-artist year album original-date part-of-set
+  id album-artist year album original-date
   genre album-type album-status mb-id track-count total-duration cover)
 
-(defstruct track2
-  album artist track-no title
-  bit-rate is-vbr duration)
-
 (defstruct track
-  album-artist artist year album original-date genre album-type album-status mb-id
-  track-no part-of-set title
-  bit-rate is-vbr duration
-  ;; (album-artist nil :type (or string null))
-  ;; (artist nil :type (or null string))
-  ;; (year nil :type (or null fixnum))
-  ;; (album nil :type (or null string))
-  ;; (original-date nil :type (or null string))
-  ;; (genre nil :type (or null string))
-  ;; (album-type nil :type (or null string))
-  ;; (album-status nil :type (or null string))
-  ;; (mb-id nil :type (or null string))
-  ;; (track-no nil :type (or null fixnum list))
-  ;; part-of-set
-  ;; (title nil :type (or null string))
-  ;; (bit-rate nil :type (or null fixnum))
-  ;; (is-vbr nil :type (or null boolean))
-  ;; (duration nil :type (or null fixnum))
-  )
-
-(defgeneric text-tag (stream desc) (:method ((object t) desc) nil))
-(defmethod text-tag ((mp3 id3:mp3-file) desc)
-  (declare #.*standard-optimize-settings*)
-
-  (loop for frame in (id3:get-frames mp3 '("TXXX"))
-     when (string-equal (id3:desc frame) desc)
-     do (return-from text-tag (id3:val frame))))
-
-(defgeneric bit-rate (stream) (:method ((object t)) nil))
-(defgeneric is-vbr (stream) (:method ((object t)) nil))
-(defgeneric duration (stream) (:method ((object t)) nil))
-(defmethod bit-rate ((mp3 id3:mp3-file))
-  (let ((info (id3:audio-info mp3)))
-    (when info
-      (round (mpeg::bit-rate info) 1000))))
-
-(defmethod is-vbr ((mp3 id3:mp3-file))
-  (let ((info (id3:audio-info mp3)))
-    (when info
-      (mpeg::is-vbr info))))
-
-(defmethod duration ((mp3 id3:mp3-file))
-  (let ((info (id3:audio-info mp3)))
-    (when info
-      (mpeg::len info))))
-
-(defmethod bit-rate ((m4a m4a:mp4-file))
-  (let ((info (m4a:audio-info m4a)))
-    (when info
-      (round (m4a::avg-bit-rate info) 1000))))
-
-(defmethod duration ((m4a m4a:mp4-file))
-  (let ((info (m4a:audio-info m4a)))
-    (when info
-      (m4a::seconds info))))
-
-(defun parse-file (file)
-  (declare #.*standard-optimize-settings*)
+  album artist track-no title part-of-set
+  bit-rate is-vbr duration)
 
-  (let ((it (open-audio-file file)))
-    (when it
-      (make-track
-       :album-artist (abstract-tag:album-artist it)
-       :artist (abstract-tag:artist it)
-       :year (utils:awhen (abstract-tag::year it) (parse-integer utils:it :junk-allowed t))
-       :album (abstract-tag:album it)
-       :original-date (abstract-tag:original-date it)
-       :genre (abstract-tag::genre it)
-       :album-type (string-downcase (text-tag it "MusicBrainz Album Type"))
-       :album-status (string-downcase (text-tag it "MusicBrainz Album Status"))
-       :mb-id (text-tag it "MusicBrainz Album Id")
-       :track-no (abstract-tag::track it)
-       :part-of-set (abstract-tag::disk it)
-       :title (abstract-tag:title it)
-       :bit-rate (bit-rate it)
-       :is-vbr (is-vbr it)
-       :duration (duration it)))))
+(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))))
 
-(defun album-id (album-artist year album-title)
+(defun get-album-id (album-artist year album-title)
   (crypto:byte-array-to-hex-string
    (crypto:digest-sequence :md5 (flex:string-to-octets
                                  (format nil "~A-~A-~A" album-artist year album-title)
                                  :external-format :utf-8))))
 
-(defun parse-file2 (file albums-db)
+(defun parse-file (file albums-db)
   (declare #.*standard-optimize-settings*)
 
   (let ((it (open-audio-file file)))
     (when it
-      (let* ((album-artist (abstract-tag:album-artist it))
+      (let* ((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-title (abstract-tag:album it))
-             (album-id (album-id album-artist year album-title)))
+             (album-id (get-album-id album-artist year album-title)))
         (multiple-value-bind (album foundp) (gethash album-id albums-db)
           (unless foundp
             (setf album (make-album
+                         :id album-id
                          :album-artist album-artist
                          :year year
                          :album album-title
                          :original-date (abstract-tag:original-date it)
                          :genre (abstract-tag::genre it)
-                         :part-of-set (abstract-tag::disk it)
-                         :album-type (string-downcase (text-tag it "MusicBrainz Album Type"))
-                         :album-status (string-downcase (text-tag it "MusicBrainz Album Status"))
+                         :album-type (utils:awhen (text-tag it "MusicBrainz Album Type") (string-downcase utils:it))
+                         :album-status (utils:awhen (text-tag it "MusicBrainz Album Status") (string-downcase utils:it))
                          :mb-id (text-tag it "MusicBrainz Album Id"))
                   (gethash album-id albums-db) album))
-          (make-track2
+          (make-track
            :album album
            :artist (abstract-tag:artist it)
            :track-no (abstract-tag::track it)
            :title (abstract-tag:title it)
+           :part-of-set (abstract-tag::disk it)
            :bit-rate (bit-rate it)
            :is-vbr (is-vbr it)
-           :duration (duration it)))))))
+           :duration (round (duration it))))))))
 
 (defstruct entry path data added modified present)
 
-(defun file-id (file)
-  (crypto:byte-array-to-hex-string
-   (crypto:digest-sequence :md5 (flex:string-to-octets (namestring file) :external-format :utf-8))))
-
-(defun rescan (paths &optional (db (make-hash-table :test 'equal)))
-  (declare #.*standard-optimize-settings*)
-
-  (let ((added 0) (updated 0) (removed 0))
-    (declare (fixnum added updated removed))
-
-    (loop for value being the hash-values in db
-       do (setf (entry-present value) nil))
-
-    (unless (listp paths)
-      (setf paths (list paths)))
-
-    (labels ((scan-file (file)
-               (let ((file-id (file-id file)))
-                 (multiple-value-bind (entry foundp)
-                     (gethash file-id db)
-                   (let ((modified (file-write-date file)))
-                     (unless foundp
-                       (incf added)
-                       (setf entry (make-entry :path file :added (get-universal-time))
-                             (gethash file-id db) entry))
-                     (unless (and foundp (= (the fixnum (entry-modified entry)) modified))
-                       (when foundp (incf updated))
-                       (setf (entry-data entry) (parse-file file)
-                             (entry-modified entry) modified))
-                     (setf (entry-present entry) t))))))
-      (dolist (dir paths)
-        (cl-fad:walk-directory dir #'scan-file :follow-symlinks nil))
-
-      (loop for file being the hash-keys in db using (hash-value entry)
-         unless (entry-present entry)
-         do (incf removed) and
-         do (remhash file db))
-
-      (values db added updated removed))))
-
-(defun rescan2 (paths &optional (dbs (cons (make-hash-table :test 'equal) (make-hash-table :test 'equal))))
+(defun rescan (paths &optional (dbs (cons (make-hash-table :test 'equal) (make-hash-table :test 'equal))))
   (declare #.*standard-optimize-settings*)
 
   (let ((added 0) (updated 0) (removed 0)
@@ -191,7 +71,7 @@
       (setf paths (list paths)))
 
     (labels ((scan-file (file)
-               (let ((file-id (file-id file)))
+               (let ((file-id (get-file-id file)))
                  (multiple-value-bind (entry foundp)
                      (gethash file-id tracks-db)
                    (let ((modified (file-write-date file)))
@@ -201,7 +81,7 @@
                              (gethash file-id tracks-db) entry))
                      (unless (and foundp (= (the fixnum (entry-modified entry)) modified))
                        (when foundp (incf updated))
-                       (setf (entry-data entry) (parse-file2 file albums-db)
+                       (setf (entry-data entry) (parse-file file albums-db)
                              (entry-modified entry) modified))
                      (setf (entry-present entry) t))))))
       (dolist (dir paths)
@@ -210,32 +90,46 @@
       (let ((album-stats (make-hash-table)))
         (loop for file being the hash-keys in tracks-db using (hash-value entry)
            do (if (entry-present entry)
-                  (alexandria:when-let (track (entry-data entry))
-                    (incf (car (gethash (track))))
-                    )
+                  (when-let (track (entry-data entry))
+                    (let ((album (track-album track)))
+                      (multiple-value-bind (stats foundp) (gethash album album-stats)
+                        (unless foundp
+                          (setf stats (cons 0 0)
+                                (gethash album album-stats) stats)
+                          (unless (album-cover album)
+                            (setf (album-cover album)
+                                  (probe-file (cl-fad:merge-pathnames-as-file
+                                               (cl-fad:pathname-directory-pathname (entry-path entry))
+                                               "cover.jpg")))))
+                        (incf (the fixnum (car stats))) ;; track-count
+                        (incf (the fixnum (cdr stats))  ;; total-duration
+                              (the fixnum (or (track-duration track) 0))))))
                   (progn
                     (incf removed)
-                    (remhash file tracks-db)))))
+                    (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))))
 
       (values (cons tracks-db albums-db) added updated removed))))
 
 (defparameter +album-type-order+ '("album" "lp" "ep" "single" "compilation" "live" "soundtrack"
                                    "spokenword" "remix" "mixed" "dj-mix" "mixtape" "broadcast")
   "Half-arbitrary album type order")
-(defun track-comparator (slots)
+(defun gen-comparator (slots)
   (labels ((clear-track-no (track-no)
              (when track-no
                (parse-integer (if (consp track-no)
                                   (car track-no)
                                   track-no)
                               :junk-allowed t))))
-    (alexandria:named-lambda info< (a b)
+    (named-lambda info<> (a b)
       (declare #.*standard-optimize-settings*)
-      (dolist (slot slots)
+      (dolist (slot slots 0)
         (let ((slot-a (slot-value a slot))
               (slot-b (slot-value b slot)))
           (when (xor (null slot-a) (null slot-b))
-            (return-from info< (null slot-b)))
+            (return-from info<> (if (null slot-b) 1 -1)))
           (case slot
             (album-type
              (setf slot-a (or (position slot-a +album-type-order+ :test 'string-equal) 0)
@@ -247,9 +141,19 @@
                       (case slot
                         ((album-type year track-no) (= slot-a slot-b))
                         (t (string-equal slot-a slot-b))))
-            (return-from info< (case slot
-                                 ((album-type year track-no) (< slot-a slot-b))
-                                 (t (string< slot-a slot-b))))))))))
+            (return-from info<> (case slot
+                                 ((album-type year track-no) (- slot-a slot-b))
+                                 (t (if (string< slot-a slot-b) -1 1))))))))))
+(defparameter +album<>+ (gen-comparator '(album-artist album-type original-date year album)))
+(defun album< (a b)
+  (< (funcall +album<>+ a b) 0))
+
+(defparameter +track<>+ (gen-comparator '(track-no title)))
+(defun track< (a b)
+  (let ((albs (funcall +album<>+ (track-album a) (track-album b))))
+    (if (zerop albs)
+        (< (funcall +track<>+ a b) 0)
+        albs)))
 
 (defun match-filter (data category filter)
   (declare #.*standard-optimize-settings*)
@@ -258,9 +162,10 @@
       (let ((words (split-sequence:split-sequence #\Space filter)))
         (every #'(lambda (word)
                    (case category
-                     (album (or (search word (track-album data) :test 'char-equal)
-                                (search word (track-album-artist data) :test 'char-equal)))
-                     (year (search word (princ-to-string (track-year data)) :test 'char-equal))
+                     (album (or (search word (album-album data) :test 'char-equal)
+                                (search word (album-album-artist data) :test 'char-equal)))
+                     (year (or (search word (princ-to-string (album-year data)) :test 'char-equal)
+                               (search word (album-original-date data) :test 'char-equal)))
                      (t (search word (slot-value data category) :test 'char-equal))))
                words))))
 
@@ -271,53 +176,45 @@
              (equal (slot-value data (car r)) (cdr r)))
          restrictions))
 
-(defun query-category (db category &key filter restrictions limit (offset 0))
+(defun query-category (albums-db category &key filter restrictions limit (offset 0))
   (declare #.*standard-optimize-settings*
            (type (or null fixnum) limit offset))
+o  (let ((results (make-hash-table :test (case category
+                                          (album 'eq)
+                                          (t 'equalp)))))
+    (loop for data being the hash-value of albums-db
+       for result = (case category
+                      (album data)
+                      (t (slot-value data category)))
+       when (and
+             result
+             (match-restrictions data restrictions)
+             (match-filter data category filter))
+       do (setf (gethash result results) t))
+    (let* ((total (hash-table-count results))
+           (start (min total offset))
+           (end (min total (+ offset limit))))
+      (subseq (sort (hash-table-keys results)
+                    (case category
+                      (album #'album<)
+                      (year #'<)
+                      (t #'string<)))
+              start end))))
 
-  (labels ((category-data (data category)
-             (case category
-               (album (with-slots (album-artist year album original-date genre album-type album-status mb-id) data
-                        (make-album :album-artist album-artist
-                                    :year year
-                                    :album album
-                                    :original-date original-date
-                                    :genre genre
-                                    :album-type album-type
-                                    :album-status album-status
-                                    :mb-id mb-id)))
-               (t (slot-value data category)))))
-    (let ((results (make-hash-table :test 'equalp)))
-      (loop for entry being the hash-value of db
-         for data = (entry-data entry)
-         when (and data
-                   (match-restrictions data restrictions)
-                   (match-filter data category filter))
-         do (setf (gethash (category-data data category) results) t))
-      (let* ((total (hash-table-count results))
-             (start (min total offset))
-             (end (min total (+ offset limit))))
-        (subseq (sort (hash-table-keys results)
-                      (case category
-                        (album (track-comparator '(album-artist album-type original-date year album)))
-                        (year #'<)
-                        (t #'string<)))
-                start end)))))
-
-(defun query-tracks (db &key filter restrictions limit (offset 0))
+(defun query-tracks (tracks-db &key filter restrictions limit (offset 0))
   (declare #.*standard-optimize-settings*
            (type (or null fixnum) limit offset))
   (let (results)
-    (loop for entry being the hash-value of db
+    (loop for entry being the hash-value of tracks-db
        for data = (entry-data entry)
        when (and data
-                 (match-restrictions data restrictions)
+                 (match-restrictions (track-album data) restrictions)
                  (match-filter data 'title filter))
        do (push (cons (entry-path entry) data) results))
     (let* ((total (length results))
            (start (min total offset))
            (end (min total (+ offset limit))))
       (subseq (sort results
-                    (track-comparator '(album-artist album-type original-date year album track-no title))
+                    #'track<
                     :key 'cdr)
               start end))))

utils.lisp

@@ -0,0 +1,51 @@
+(in-package :cl-user)
+(defpackage chad-music.utils
+  (:use :cl #:audio-streams #:alexandria)
+  (:export #:*standard-optimize-settings*
+           #:text-tag
+           #:bit-rate
+           #:is-vbr
+           #:duration))
+(in-package :chad-music.utils)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  #+dbg
+  (defvar *standard-optimize-settings* '(optimize (debug 3)))
+  #-dbg
+  (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0))))
+
+(defgeneric text-tag (stream desc) (:method ((object t) desc) nil))
+(defmethod text-tag ((mp3 id3:mp3-file) desc)
+  (declare #.*standard-optimize-settings*)
+
+  (loop for frame in (id3:get-frames mp3 '("TXXX"))
+     when (string-equal (id3:desc frame) desc)
+     do (return-from text-tag (id3:val frame))))
+
+(defgeneric bit-rate (stream) (:method ((object t)) nil))
+(defgeneric is-vbr (stream) (:method ((object t)) nil))
+(defgeneric duration (stream) (:method ((object t)) nil))
+(defmethod bit-rate ((mp3 id3:mp3-file))
+  (let ((info (id3:audio-info mp3)))
+    (when info
+      (round (mpeg::bit-rate info) 1000))))
+
+(defmethod is-vbr ((mp3 id3:mp3-file))
+  (let ((info (id3:audio-info mp3)))
+    (when info
+      (mpeg::is-vbr info))))
+
+(defmethod duration ((mp3 id3:mp3-file))
+  (let ((info (id3:audio-info mp3)))
+    (when info
+      (mpeg::len info))))
+
+(defmethod bit-rate ((m4a m4a:mp4-file))
+  (let ((info (m4a:audio-info m4a)))
+    (when info
+      (round (m4a::avg-bit-rate info) 1000))))
+
+(defmethod duration ((m4a m4a:mp4-file))
+  (let ((info (m4a:audio-info m4a)))
+    (when info
+      (m4a::seconds info))))