Add UI for creating metadata export for Opus Quad.

Deep-Symmetry · Apr 23, 2024 · 60bfc94 · 60bfc94
1 parent d65ded3
commit 60bfc94
Show file tree

Hide file tree

Showing 4 changed files with 78 additions and 10 deletions.
diff --git a/src/beat_link_trigger/show.clj b/src/beat_link_trigger/show.clj
@@ -2536,7 +2536,7 @@
   (let [extension (util/extension-for-file-type :show)]
     (when-let [^File file (chooser/choose-file parent :type :save
                                                :all-files? false
-                                               :filters [["BeatLinkTrigger Show files"
+                                               :filters [["Beat Link Trigger Show files"
                                                           [extension]]])]
       (let [file (.getCanonicalFile file)]
         (if (latest-show file)

diff --git a/src/beat_link_trigger/track_loader.clj b/src/beat_link_trigger/track_loader.clj
@@ -27,7 +27,7 @@
             LifecycleListener VirtualCdj]
            [org.deepsymmetry.beatlink.data MenuLoader MetadataFinder MountListener SlotReference]
            [org.deepsymmetry.beatlink.dbserver Message Message$MenuItemType NumberField StringField]
-           [org.deepsymmetry.cratedigger Database Database$PlaylistFolderEntry]
+           [org.deepsymmetry.cratedigger Archivist Archivist$ArchiveListener Database Database$PlaylistFolderEntry]
            [org.deepsymmetry.cratedigger.pdb RekordboxPdb$TrackRow RekordboxPdb$AlbumRow
             RekordboxPdb$ArtistRow RekordboxPdb$GenreRow]))
 
@@ -2436,8 +2436,10 @@
    (choose-media-export nil))
   ([parent]
    (seesaw/invoke-now
-     (let [root (chooser/choose-file parent :selection-mode :dirs-only :all-files? true :type "Choose Media"
-                                     :filters [rekordbox-export-filter])]
+     (let [root (chooser/choose-file parent :selection-mode :dirs-only :all-files? true :type
+                                     "Choose Rekordbox Media"
+                                     :filters [rekordbox-export-filter]
+                                     :remember-directory? false)]
        (when root
          (let [candidates (find-pdb-recursive root 3)]
            (cond
@@ -2479,3 +2481,62 @@
         (create-chooser-dialog parent pdb extra-labels)
         (seesaw/alert parent "Could not find exported rekordbox database."
                       :title "Nowhere to Load Tracks From" :type :error))))))
+
+(defn create-metadata-archive
+  "Prompt the user to select some mounted rekordbox media, then for a
+  file in which to archive its metadata for use with the Opus Quad.
+  `parent` is the window over which the UI should be centered, if any."
+  [parent]
+  (when-let [^Database database (choose-media-export parent)]
+    (let [extension (util/extension-for-file-type :metadata-archive)]
+      (try
+        (when-let [^File file (chooser/choose-file parent :type "Create Metadata Archive"
+                                                   :all-files? false
+                                                   :filters [["Beat Link Metadata Archives" [extension]]])]
+          (let [continue?    (atom true)
+                progress     (seesaw/progress-bar :indeterminate? true :min 0 :max 1000)
+                panel        (mig/mig-panel
+                              :items [[(seesaw/label :text
+                                                     (str "<html>Creating metadata archive, in file <strong>"
+                                                          (.getName file) "</strong>:</html>"))
+                                       "span, wrap 20"]
+                                      [progress "grow, span, wrap 16"]
+                                      [(seesaw/button :text "Cancel"
+                                                      :listen [:action-performed
+                                                               (fn [e]
+                                                                 (reset! continue? false)
+                                                                 (seesaw/config! e :enabled? false
+                                                                                 :text "Canceling…"))])
+                                       "span, align center"]])
+                ^JFrame root (seesaw/frame :title "Archiving Metadata" :on-close :dispose :content panel)
+                listener (reify Archivist$ArchiveListener
+                           (continueCreating [_this finished-count total-count]
+                             (seesaw/invoke-later
+                               (seesaw/config! progress :max total-count :indeterminate? false)
+                               (seesaw/value! progress finished-count)
+                               (when (or (not @continue?) (>= finished-count total-count))
+                                 (.dispatchEvent root (WindowEvent. root WindowEvent/WINDOW_CLOSING))))
+                             @continue?))]
+            (when-let [^File file (util/confirm-overwrite-file file extension parent)]
+              (seesaw/listen root :window-closed (fn [_] (reset! continue? false)))
+              (seesaw/pack! root)
+              (.setLocationRelativeTo root parent)
+              (seesaw/show! root)
+              (future
+                (try
+                  (.createArchive (Archivist/getInstance) database file listener)
+                  (catch Exception e
+                    (timbre/error e "Problem Creating Metadata Archive")
+                    (seesaw/invoke-later
+                      (seesaw/alert (str "<html>Unable to Create Metadata Cache:<br><br>" (.getMessage e)
+                                         "<br><br>See the log file for more details.")
+                                    :title "Problem Creating Cache" :type :error)
+                      (.dispose root))))))))
+        (catch Exception e
+          (timbre/error e "Problem Setting Up Metadata Archive")
+          (seesaw/invoke-later
+            (seesaw/alert (str "<html>Unable to Create Metadata Cache:<br><br>" (.getMessage e)
+                               "<br><br>See the log file for more details.")
+                          :title "Problem Creating Cache" :type :error)))
+        (finally
+          (.close database))))))
diff --git a/src/beat_link_trigger/triggers.clj b/src/beat_link_trigger/triggers.clj
@@ -1516,6 +1516,12 @@
                                                    :title "Beat Link Trigger is Offline" :type :error)))
                         :name "Write Playlist" :enabled? false)))
 
+(defonce ^{:private true
+           :doc "The menu action which allows creation of a metadata archive from rekordbox media."}
+  archive-metadata-action
+  (delay (seesaw/action :handler (fn [_] (track-loader/create-metadata-archive @trigger-frame))
+                        :name "Archive Metadata" :enabled? true)))
+
 (defonce ^{:private true
            :doc "The action which opens the OBS overlay web server window."}
   overlay-server-action
@@ -1625,7 +1631,8 @@
     (seesaw/menubar :items [(seesaw/menu :text "File"
                                          :items (concat [@save-action @save-as-action @load-action
                                                          (seesaw/separator) new-show-action open-show-action
-                                                         (seesaw/separator) @playlist-writer-action]
+                                                         (seesaw/separator) @playlist-writer-action
+                                                         (seesaw/separator) @archive-metadata-action]
                                                         (menus/non-mac-file-actions quit)))
                             (seesaw/menu :text "Triggers"
                                          :items (concat [@new-trigger-action (seesaw/separator)]

diff --git a/src/beat_link_trigger/util.clj b/src/beat_link_trigger/util.clj
@@ -66,11 +66,11 @@
   "A map from keywords identifying the kinds of files we work with to
   the filename extensions we create them with and require them to
   have."
-  {:configuration  "blt"
-   :trigger-export "bltx"
-   :metadata       "bltm"
-   :playlist       "csv"
-   :show           "bls"})
+  {:configuration    "blt"
+   :trigger-export   "bltx"
+   :metadata-archive "blm"
+   :playlist         "csv"
+   :show             "bls"})
 
 (def ^:private file-extensions
   "A map from filename extensions we use to the corresponding keyword