Loading src/clpi.lisp +10 −6 Original line number Diff line number Diff line Loading @@ -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 Loading @@ -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 Loading src/defs.lisp +2 −0 Original line number Diff line number Diff line Loading @@ -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 Loading src/dual-index.lispdeleted 100644 → 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")))) src/index-defs.lisp +5 −106 Original line number Diff line number Diff line Loading @@ -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 Loading @@ -32,7 +22,6 @@ #:index-projects #:index-release-data-missing #:index-save #:index-secondary-p #:index-system #:index-system-class #:index-system-file-class Loading @@ -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 Loading Loading @@ -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 Loading Loading @@ -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. Loading Loading @@ -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)) src/index.lisp +20 −16 Original line number Diff line number Diff line Loading @@ -7,6 +7,7 @@ (:use #:cl #:alexandria #:clpi/defs #:clpi/object-store-dual #:clpi/project #:clpi/system #:clpi/utils) Loading @@ -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.") Loading @@ -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 Loading @@ -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))))) Loading Loading @@ -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 Loading
src/clpi.lisp +10 −6 Original line number Diff line number Diff line Loading @@ -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 Loading @@ -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 Loading
src/defs.lisp +2 −0 Original line number Diff line number Diff line Loading @@ -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 Loading
src/dual-index.lispdeleted 100644 → 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"))))
src/index-defs.lisp +5 −106 Original line number Diff line number Diff line Loading @@ -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 Loading @@ -32,7 +22,6 @@ #:index-projects #:index-release-data-missing #:index-save #:index-secondary-p #:index-system #:index-system-class #:index-system-file-class Loading @@ -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 Loading Loading @@ -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 Loading Loading @@ -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. Loading Loading @@ -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))
src/index.lisp +20 −16 Original line number Diff line number Diff line Loading @@ -7,6 +7,7 @@ (:use #:cl #:alexandria #:clpi/defs #:clpi/object-store-dual #:clpi/project #:clpi/system #:clpi/utils) Loading @@ -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.") Loading @@ -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 Loading @@ -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))))) Loading Loading @@ -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