Commit 0958403d authored by Eric Timmons's avatar Eric Timmons
Browse files

Add DUAL-INDEX-SYNC

parent 02eccc08
Loading
Loading
Loading
Loading
+31 −6
Original line number Diff line number Diff line
@@ -8,8 +8,10 @@
          #:alexandria
          #:clpi/index-defs
          #:clpi/index
          #:clpi/metadata
          #:clpi/project-defs)
  (:export #:dual-index))
  (:export #:dual-index
           #:dual-index-sync))

(in-package #:clpi/dual-index)

@@ -54,15 +56,28 @@ minutes old."))
           (ends-with-subseq "metadata" path))
       (not (gethash path (dual-index-updated-paths index)))))

(defun path-appendable-p (path)
  (let ((file-namestring (file-namestring path)))
    (starts-with-subseq "releases-" file-namestring)))

(defun update-object-from-primary (index path)
  (let* ((primary (dual-index-primary index))
         (secondary (dual-index-secondary index)))
    (if (path-appendable-p path)
        (with-open-index-object-stream (primary-stream primary path
                                                       :binary-p t
                                                       :offset (index-object-size secondary path))
          (index-object-append secondary path primary-stream))
        (with-open-index-object-stream (s primary path)
          (index-object-write secondary path s)
          (setf (gethash path (dual-index-updated-paths index)) t)))))

(defmethod open-index-object-stream ((index dual-index) path
                                     &key signal-if-older-than
                                       binary-p offset)
  (let ((primary (dual-index-primary index))
        (secondary (dual-index-secondary index)))
  (let ((secondary (dual-index-secondary index)))
    (flet ((read-from-primary ()
             (with-open-index-object-stream (s primary path)
               (index-object-write secondary path s)
               (setf (gethash path (dual-index-updated-paths index)) t))))
             (update-object-from-primary index path)))
      (handler-bind ((index-object-missing
                       (lambda (c)
                         (read-from-primary)
@@ -78,3 +93,13 @@ minutes old."))
                                                               (* 10 60)))
                                  :binary-p binary-p
                                  :offset offset)))))

(defun dual-index-sync (index)
  "Ensure that every object is present in INDEX's secondary."
  (update-object-from-primary index (metadata-path index))
  (update-object-from-primary index "index")
  (dolist (p (index-projects index))
    (update-object-from-primary index (metadata-path p))
    (update-object-from-primary index (project-releases-path p)))
  (dolist (s (index-systems index))
    (update-object-from-primary index (metadata-path s))))