Commit f638af4d authored by Eric Timmons's avatar Eric Timmons
Browse files

Separate object store implementation from index implementation

parent 293efb50
Loading
Loading
Loading
Loading
+10 −6
Original line number Diff line number Diff line
@@ -7,9 +7,11 @@
    (:nicknames #:clpi)
  (:use #:cl
        #:clpi/defs
        #:clpi/dual-index
        #:clpi/file-index
        #:clpi/http-index
        #:clpi/index
        #:clpi/object-store
        #:clpi/object-store-dual
        #:clpi/object-store-file
        #:clpi/object-store-http
        #:clpi/project
        #:clpi/release
        #:clpi/repos
@@ -18,9 +20,11 @@
        #:clpi/system-release
        #:clpi/utils)
  (:reexport #:clpi/defs
             #:clpi/dual-index
             #:clpi/file-index
             #:clpi/http-index
             #:clpi/index
             #:clpi/object-store
             #:clpi/object-store-dual
             #:clpi/object-store-file
             #:clpi/object-store-http
             #:clpi/project
             #:clpi/release
             #:clpi/repos
+2 −0
Original line number Diff line number Diff line
@@ -6,12 +6,14 @@
(uiop:define-package #:clpi/defs
    (:use #:cl
          #:clpi/index-defs
          #:clpi/object-store-defs
          #:clpi/project-defs
          #:clpi/release-defs
          #:clpi/system-defs
          #:clpi/system-file-defs
          #:clpi/system-release-defs)
  (:reexport #:clpi/index-defs
             #:clpi/object-store-defs
             #:clpi/project-defs
             #:clpi/release-defs
             #:clpi/system-defs

src/dual-index.lisp

deleted100644 → 0
+0 −121
Original line number Diff line number Diff line
;;;; Dual Index Definitions
;;;;
;;;; This software is part of CLPI. See README.org for more information. See
;;;; LICENSE for license information.

(uiop:define-package #:clpi/dual-index
    (:use #:cl
          #:alexandria
          #:clpi/defs
          #:clpi/index)
  (:export #:dual-index
           #:dual-index-sync))

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

(defclass dual-index (index)
  ((primary
    :initarg :primary
    :reader dual-index-primary)
   (secondary
    :initarg :secondary
    :reader dual-index-secondary)
   (updated-paths
    :initform (make-hash-table :test 'equal)
    :reader dual-index-updated-paths))
  (:documentation
   "A logical view of an index that is backed by two separate indices, the
primary and the secondary. All reads prefer the secondary, but if some data is
missing, it will be transparently read from the primary and placed into the
secondary. Additionally, any metadata object and the project/system indices will
be read from the primary on first access if the local copies are older than 60
minutes old."))

(defmethod initialize-instance :after ((index dual-index) &rest initargs)
  (declare (ignore initargs))
  (setf (index-secondary-p (dual-index-secondary index)) t))

(defmethod index-release-data-missing ((index dual-index) project release)
  (let* ((path (project-releases-path project))
         (primary (dual-index-primary index))
         (secondary (dual-index-secondary index))
         (secondary-size (index-object-size secondary path)))
    (with-open-index-object-stream (primary-stream primary path
                                                   :binary-p t
                                                   :offset secondary-size)
      (index-object-append secondary path primary-stream))))

(defun path-should-be-fetched-if-old-p (index path)
  (and (not (path-appendable-p 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)
                                                       :if-does-not-exist nil)
          (when primary-stream
            (index-object-append secondary path primary-stream)
            t))
        (with-open-index-object-stream (s primary path
                                          :if-does-not-exist nil)
          (when s
            (index-object-write secondary path s)
            (setf (gethash path (dual-index-updated-paths index)) t)
            t)))))

(defmethod open-index-object-stream ((index dual-index) path (direction (eql :input))
                                     &key signal-if-older-than
                                       binary-p offset
                                       (if-does-not-exist :error) if-exists)
  (declare (ignore if-exists))
  (let ((secondary (dual-index-secondary index)))
    (flet ((read-from-primary ()
             (update-object-from-primary index path)))
      (tagbody
       top
         (handler-bind ((index-object-missing
                          (lambda (c)
                            (declare (ignore c))
                            (if (read-from-primary)
                                (go top)
                                (ecase if-does-not-exist
                                  (:error
                                   (error 'index-object-missing :index index :path path))
                                  ((nil)
                                   (return-from open-index-object-stream nil))))))
                        (index-object-out-of-date
                          (lambda (c)
                            (declare (ignore c))
                            (when (path-should-be-fetched-if-old-p index path)
                              (read-from-primary)))))
           (return-from
            open-index-object-stream
             (open-index-object-stream secondary path :input
                                       :signal-if-older-than (or signal-if-older-than
                                                                 (- (get-universal-time)
                                                                    (* 60 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 "clpi-version")
  (update-object-from-primary index "index")
  (dolist (p (index-projects index))
    (update-object-from-primary index (project-object-path p "repo"))
    (update-object-from-primary index (project-object-path p "authors"))
    (update-object-from-primary index (project-object-path p "maintainers"))
    (update-object-from-primary index (project-object-path p "homepage"))
    (update-object-from-primary index (project-object-path p "releases-object-version"))
    (update-object-from-primary index (project-object-path p "version-scheme"))
    (update-object-from-primary index (project-releases-path p)))
  (dolist (s (index-systems index))
    (update-object-from-primary index (system-object-path s "primary-project"))))
+5 −106
Original line number Diff line number Diff line
@@ -6,22 +6,12 @@
(uiop:define-package #:clpi/index-defs
    (:use #:cl
          #:alexandria)
  (:export #:call-with-open-index-object-stream
           #:index
  (:export #:index
           #:index-add-project
           #:index-add-system
           #:index-initialize
           #:index-initialize-internal
           #:index-object-append
           #:index-object-size
           #:index-object-write
           #:index-object-missing
           #:index-object-missing-index
           #:index-object-missing-path
           #:index-object-out-of-date
           #:index-object-out-of-date-index
           #:index-object-out-of-date-path
           #:index-object-out-of-date-universal-time
           #:index-object-store
           #:index-plist
           #:index-project
           #:index-project-class
@@ -32,7 +22,6 @@
           #:index-projects
           #:index-release-data-missing
           #:index-save
           #:index-secondary-p
           #:index-system
           #:index-system-class
           #:index-system-file-class
@@ -42,35 +31,10 @@
           #:index-system-names
           #:index-system-release-class
           #:index-systems
           #:index-version
           #:open-index-object-stream
           #:with-open-index-object-stream))
           #:index-version))

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

(define-condition index-object-missing ()
  ((index
    :initarg :index
    :reader index-object-missing-index)
   (path
    :initarg :path
    :reader index-object-missing-path))
  (:documentation
   "Condition stating that an object is missing from an index."))

(define-condition index-object-out-of-date ()
  ((index
    :initarg :index
    :reader index-object-out-of-date-index)
   (path
    :initarg :path
    :reader index-object-out-of-date-path)
   (universal-time
    :initarg :universal-time
    :reader index-object-out-of-date-universal-time))
  (:documentation
   "Condition stating that an object is out of date."))

(define-condition index-project-missing ()
  ((index
    :initarg :index
@@ -114,18 +78,9 @@ to be defered until first access instead of instantiation."))
   "Performs initialization of the index using the data read from the index
object."))

(defgeneric index-object-append (index path in-stream)
(defgeneric index-object-store (index)
  (:documentation
   "Append the contents of IN-STREAM to the object in INDEX located at PATH."))

(defgeneric index-object-size (index path)
  (:documentation
   "Returns the size of the object located at PATH in the INDEX in bytes."))

(defgeneric index-object-write (index path in-stream)
  (:documentation
   "Write the contents of IN-STREAM to the object located at PATH in the
INDEX. Overwrites the object if it exists."))
   "Returns the object store backing the index."))

(defgeneric index-plist (index)
  (:documentation
@@ -159,10 +114,6 @@ signaled."))
  (:documentation
   "Save modifications to INDEX to persistent storage."))

(defgeneric index-secondary-p (index)
  (:documentation
   "T iff INDEX is a secondary index."))

(defgeneric index-system (index system-name &optional error)
  (:documentation
   "Return the system with the name SYSTEM-NAME.
@@ -193,55 +144,3 @@ signaled."))
(defgeneric index-version (index)
  (:documentation
   "Returns the CLPI version of INDEX."))

(defgeneric open-index-object-stream (index path direction
                                      &key signal-if-older-than binary-p offset
                                        if-does-not-exist if-exists)
  (:documentation
   "Open a stream with the contents of the object from INDEX located at PATH.

If SIGNAL-IF-OLDER-THAN is non-NIL, a condition of type INDEX-OBJECT-OUT-OF-DATE
will be signaled if the last modification time of the object was before the
universal time specified by SIGNAL-IF-OLDER-THAN.

If BINARY-P is true, the returned stream is of type (UNSIGNED-BYTE 8).

If OFFSET is specified, the stream will start at the provided offset.

IF-DOES-NOT-EXIST should be NIL (in which case NIL is returned if the object
does not exist) or :ERROR to signal an error."))

(defgeneric call-with-open-index-object-stream (index path thunk
                                                &rest args
                                                &key direction
                                                  binary-p offset
                                                  if-does-not-exist
                                                  if-exists))

(defmethod call-with-open-index-object-stream (index path thunk
                                               &rest args
                                               &key (direction :input)
                                                 binary-p offset
                                                 if-does-not-exist
                                                 if-exists)
  (declare (ignore binary-p offset if-does-not-exist if-exists))
  (let ((stream (apply #'open-index-object-stream
                       index path direction
                       (remove-from-plist args :direction))))
    (if stream
        (with-open-stream (stream stream)
          (funcall thunk stream))
        (funcall thunk stream))))

(defmacro with-open-index-object-stream ((s index path
                                          &rest args
                                          &key
                                            (direction :input)
                                            binary-p
                                            offset
                                            if-does-not-exist
                                            if-exists)
                                         &body body)
  (declare (ignore binary-p offset if-does-not-exist if-exists direction))
  `(call-with-open-index-object-stream ,index ,path (lambda (,s) ,@body)
                                       ,@args))
+20 −16
Original line number Diff line number Diff line
@@ -7,6 +7,7 @@
    (:use #:cl
          #:alexandria
          #:clpi/defs
          #:clpi/object-store-dual
          #:clpi/project
          #:clpi/system
          #:clpi/utils)
@@ -15,7 +16,10 @@
(in-package #:clpi/index)

(defclass index ()
  ((project-ht
  ((object-store
    :initarg :object-store
    :accessor index-object-store)
   (project-ht
    :accessor index-project-ht
    :documentation
    "Maps project names to project instances.")
@@ -26,10 +30,7 @@
   (system-ht
    :accessor index-system-ht
    :documentation
    "Maps system names to system instances.")
   (secondary-p
    :initform nil
    :accessor index-secondary-p))
    "Maps system names to system instances."))
  (:documentation
   "The base class for an index. Contains a mapping from project (system) names
to projects (systems). Each map slot starts as unbound, when first accessed, the
@@ -56,12 +57,12 @@ project-index and system-index files are read to instantiate the objects."))

(defmethod index-initialize ((index index))
  (let (contents)
    (with-open-index-object-stream (s index "clpi-version" :if-does-not-exist nil)
    (with-open-object-stream (s (index-object-store index) "clpi-version" :if-does-not-exist nil)
      (if s
          (with-clpi-io-syntax ()
            (setf (index-version index) (read s)))
          (setf (index-version index) "0.4")))
    (with-open-index-object-stream (s index "index" :if-does-not-exist nil)
    (with-open-object-stream (s (index-object-store index) "index" :if-does-not-exist nil)
      (when s
        (with-clpi-io-syntax ()
          (setf contents (read s)))))
@@ -115,23 +116,26 @@ project-index and system-index files are read to instantiate the objects."))
  (hash-table-values (index-project-ht index)))

(defmethod index-release-data-missing ((index index) project release)
  "The default method. Nothing can be done to correct the situation, so just
error."
  "If the object store is a dual object store, try to update the relevant
object, otherwise error."
  (unless (typep (index-object-store index) 'dual-object-store)
    (error 'project-missing-version :version release :project project))
  (dual-object-store-update-object (index-object-store index)
                                   (project-releases-path project)))

(defmethod index-save ((index index))
  (dolist (p (index-projects index))
    (project-save p))
  (dolist (s (index-systems index))
    (system-save s))
  (with-open-index-object-stream (s index "clpi-version"
  (with-open-object-stream (s (index-object-store index) "clpi-version"
                              :direction :output
                              :if-exists :supersede)
    (with-clpi-io-syntax ()
      (write "0.4" :stream s)
      (terpri s)))
  (let ((plist (index-plist index)))
    (with-open-index-object-stream (s index "index"
    (with-open-object-stream (s (index-object-store index) "index"
                                :direction :output
                                :if-exists :supersede)
      (with-clpi-io-syntax ()
Loading