Loading specs/clpi-0.4.org +37 −28 Original line number Diff line number Diff line #+TITLE: CLPI Specification v0.4 #+AUTHOR: clpm-devel@common-lisp.net #+AUTHOR: Eric Timmons #+EMAIL: clpm-devel@common-lisp.net This document provides the specification of version 0.4 of the Common Lisp Project Index. Loading Loading @@ -40,43 +41,51 @@ the secondary. + =clpi-version= :: Required. A string naming the version of the CLPI specification used by this index. Must be ="0.4"= for this version of the spec. + =project-index-object-version= :: An integer or NIL/missing whose purpose is further described in [[*Project index]]. + =system-index-object-version= :: An integer or NIL/missing whose purpose is further described in [[*System index]]. * Index * Project index The object =index= must exist. This object is a lightweight summary of all projects, systems, and releases contained within the index. It contains a single plist with the keys: The object =project-index= or =project-index-PROJECT-INDEX-OBJECT-VERSION= must exist, where =PROJECT-INDEX-OBJECT-VERSION= is defined in the [[*Index metadata]]. If the project index object version is NIL/not provided, only the former must exist, otherwise the latter must exist. + =:projects= :: A list of project information, described in [[*Project index]]. + =:systems= :: A list of system information, described in [[*System index]]. Each form in this object is a list where the first element is a project name (string). The rest is a list of strings naming versions of releases of this project. It is allowed for a project to be named with no releases. It is allowed for a project to appear multiple times in this object. If it does, all the releases should be combined after reading. As this object is typically fetched from the primary by the secondaries on a regular basis, other keys (including in sub plists) are allowed, but discouraged in order to keep the size to a minimum. If =PROJECT-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended to. ** Project index * System index This list contains all projects defined within the index as well as each project's releases. Each element in the project index must be of the form =(project-name . project-plist)= where =project-name= is a string naming the project and =project-plist= is a plist containing the following keys: The object =system-index= or =system-index-SYSTEM-INDEX-OBJECT-VERSION= must exist, where =SYSTEM-INDEX-OBJECT-VERSION= is defined in the [[*Index metadata]]. If the system index object version is NIL/not provided, only the former must exist, otherwise the latter must exist. + =:releases= :: A list of strings providing the versions of each release of the project. Each form in this object is a list where the first element is a system name (string). The rest is a list of lists describing releases of this system. Each element is a list with one or two member. The first member is a [[*Project release description]]. The second element is the ASD version of the system (if one is defined). If the second element is missing, it is assumed the ASD version of the system is =NIL=. ** System index It is allowed for a system to be named with no releases. This list contains the names of all systems defined within the index as well as which project releases provide them. Every element in the system index must be of the form =(system-name . system-plist)=, where =system-name= is a string containing the name of the system and =system-plist= is a list containing the following keys: It is allowed for a system to appear multiple times in this object. If it does, all the releases should be combined after reading. = =:releases= :: A list of releases of the system. Each element is a list with one or two members. The first member is a [[*Project release description]]. The second element is the ASD version of the system (if one is defined). If the second element is missing, it is assumed the ASD version of the system is =NIL=. If =SYSTEM-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended to. * Project metadata Loading src/index-defs.lisp +21 −1 Original line number Diff line number Diff line Loading @@ -15,6 +15,8 @@ #:index-plist #:index-project #:index-project-class #:index-project-index-object-path #:index-project-index-object-version #:index-project-missing #:index-project-missing-index #:index-project-missing-project-name Loading @@ -25,6 +27,8 @@ #:index-system #:index-system-class #:index-system-file-class #:index-system-index-object-path #:index-system-index-object-version #:index-system-missing #:index-system-missing-index #:index-system-missing-system-name Loading Loading @@ -73,7 +77,7 @@ slots. This is not called as part of INITIALIZE-INSTANCE in order to allow work to be defered until first access instead of instantiation.")) (defgeneric index-initialize-internal (index &key projects systems &allow-other-keys) (defgeneric index-initialize-internal (index projects systems) (:documentation "Performs initialization of the index using the data read from the index object.")) Loading @@ -98,6 +102,14 @@ signaled.")) (:documentation "Return the class used to instantiate projects for INDEX.")) (defgeneric index-project-index-object-path (index) (:documentation "Return the path of the INDEX's project-index object.")) (defgeneric index-project-index-object-version (index) (:documentation "Return the version of the INDEX's project-index object.")) (defgeneric index-project-names (index) (:documentation "Return a list of the names of projects in INDEX.")) Loading Loading @@ -130,6 +142,14 @@ signaled.")) (:documentation "Return the class used to instantiate system files for INDEX.")) (defgeneric index-system-index-object-path (index) (:documentation "Return the path of the INDEX's system-index object.")) (defgeneric index-system-index-object-version (index) (:documentation "Return the version of the INDEX's system-index object.")) (defgeneric index-system-names (index) (:documentation "Return a list of the names of systems in INDEX.")) Loading src/index.lisp +179 −39 Original line number Diff line number Diff line Loading @@ -6,6 +6,7 @@ (uiop:define-package #:clpi/index (:use #:cl #:alexandria #:anaphora #:clpi/defs #:clpi/object-store-dual #:clpi/project Loading @@ -27,10 +28,28 @@ :accessor index-version :documentation "The version of the CLPI spec to which this index adhears.") (project-index-object-version :accessor index-project-index-object-version :documentation "The version of the project-index object.") (system-index-object-version :accessor index-system-index-object-version :documentation "The version of the system-index object.") (system-ht :accessor index-system-ht :documentation "Maps system names to system instances.")) "Maps system names to system instances.") (new-projects :initform nil :accessor index-new-projects :documentation "A list of new projects added to the index.") (new-systems :initform nil :accessor index-new-systems :documentation "A list of new systems added to the index.")) (: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 @@ -44,7 +63,9 @@ project-index and system-index files are read to instantiate the objects.")) (gethash (project-name project) (index-project-ht index)) (when (and exists-p (not (eql project existing-project))) (error "Project already exists!")) (setf (gethash (project-name project) (index-project-ht index)) project)) (unless exists-p (push project (index-new-projects index)) (setf (gethash (project-name project) (index-project-ht index)) project))) index) (defmethod index-add-system ((index index) system) Loading @@ -52,41 +73,70 @@ project-index and system-index files are read to instantiate the objects.")) (gethash (system-name system) (index-system-ht index)) (when (and exists-p (not (eql system existing-system))) (error "System already exists!")) (setf (gethash (system-name system) (index-system-ht index)) system)) (unless exists-p (push system (index-new-systems index)) (setf (gethash (system-name system) (index-system-ht index)) system))) index) (defmethod index-project-index-object-path ((index index)) (let ((version (index-project-index-object-version index))) (if version (uiop:strcat "project-index-" (write-to-string version)) "project-index"))) (defmethod index-system-index-object-path ((index index)) (let ((version (index-system-index-object-version index))) (if version (uiop:strcat "system-index-" (write-to-string version)) "system-index"))) (defmethod index-initialize ((index index)) (let (contents) (let ((projects (make-hash-table :test 'equal)) (systems (make-hash-table :test 'equal))) (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-object-stream (s (index-object-store index) "index" :if-does-not-exist nil) (with-open-object-stream (s (index-object-store index) "project-index-object-version" :if-does-not-exist nil) (setf (index-project-index-object-version index) (when s (with-clpi-io-syntax () (read s))))) (with-open-object-stream (s (index-object-store index) "system-index-object-version" :if-does-not-exist nil) (setf (index-system-index-object-version index) (when s (with-clpi-io-syntax () (read s))))) (with-open-object-stream (s (index-object-store index) (index-project-index-object-path index) :if-does-not-exist nil) (when s (with-clpi-io-syntax () (setf contents (read s))))) (apply #'index-initialize-internal index contents))) (with-stream-forms (f s) (destructuring-bind (project-name &rest versions) f (setf (gethash project-name projects) (append versions (gethash project-name projects))))))) (with-open-object-stream (s (index-object-store index) (index-system-index-object-path index) :if-does-not-exist nil) (when s (with-stream-forms (f s) (destructuring-bind (system-name &rest versions) f (setf (gethash system-name systems) (append versions (gethash system-name systems))))))) (index-initialize-internal index projects systems))) (defmethod index-initialize-internal ((index index) &key projects systems &allow-other-keys) (defmethod index-initialize-internal ((index index) projects systems) (let ((project-ht (make-hash-table :test 'equal)) (system-ht (make-hash-table :test 'equal))) (dolist (project-description projects) (destructuring-bind (name &rest plist) project-description (setf (gethash name project-ht) (apply #'make-instance (index-project-class index) (maphash (lambda (project-name project-versions) (setf (gethash project-name project-ht) (make-instance (index-project-class index) :index index :name name plist)))) (dolist (system-description systems) (destructuring-bind (name &rest plist) system-description (setf (gethash name system-ht) (apply #'make-instance (index-system-class index) :name project-name :releases project-versions))) projects) (maphash (lambda (system-name system-versions) (setf (gethash system-name system-ht) (make-instance (index-system-class index) :index index :name name plist)))) :name system-name :releases system-versions))) systems) (setf (slot-value index 'project-ht) project-ht (slot-value index 'system-ht) system-ht))) Loading Loading @@ -116,9 +166,28 @@ project-index and system-index files are read to instantiate the objects.")) (hash-table-values (index-project-ht index))) (defmethod index-save ((index index)) (let ((project-added-release-versions-ht (make-hash-table)) (project-removed-release-versions-ht (make-hash-table)) project-index-object-version-bumped (system-added-release-versions-ht (make-hash-table)) (system-removed-release-versions-ht (make-hash-table)) system-index-object-version-bumped) (dolist (p (index-projects index)) ;; First, figure out the added and removed project releases. (awhen (project-added-release-versions p) (setf (gethash p project-added-release-versions-ht) it)) (awhen (project-removed-release-versions p) (setf (gethash p project-removed-release-versions-ht) it)) ;; Then write to disk. (project-save p)) (dolist (s (index-systems index)) ;; First, figure out the added and removed system releases. (awhen (system-added-system-release-descriptions s) (setf (gethash s system-added-release-versions-ht) it)) (awhen (system-removed-system-release-descriptions s) (setf (gethash s system-removed-release-versions-ht) it)) ;; Then write to disk. (system-save s)) (with-open-object-stream (s (index-object-store index) "clpi-version" :direction :output Loading @@ -126,18 +195,89 @@ project-index and system-index files are read to instantiate the objects.")) (with-clpi-io-syntax () (write "0.4" :stream s) (terpri s))) (let ((plist (index-plist index))) (with-open-object-stream (s (index-object-store index) "index" ;; Determine if the project-index version needs to be updated. (when (and (index-project-index-object-version index) (not (zerop (hash-table-count project-removed-release-versions-ht)))) (incf (index-project-index-object-version index)) (setf project-index-object-version-bumped t)) ;; Determine if the project-index version needs to be updated. (when (and (index-system-index-object-version index) (not (zerop (hash-table-count system-removed-release-versions-ht)))) (incf (index-system-index-object-version index)) (setf system-index-object-version-bumped t)) ;; Write the project-index. If we bumped the version or the version is NIL, ;; we need to write the whole file. (if (or (null (index-project-index-object-version index)) project-index-object-version-bumped) (with-open-object-stream (s (index-object-store index) (index-project-index-object-path index) :direction :output :if-exists :supersede) (dolist (p (index-projects index)) (with-clpi-io-syntax () (write (list* (project-name p) (project-versions p)) :stream s) (terpri s)))) (with-open-object-stream (s (index-object-store index) (index-project-index-object-path index) :direction :output :if-exists :append) (dolist (p (index-new-projects index)) (with-clpi-io-syntax () (write (list* (project-name p) (project-versions p)) :stream s) (terpri s)) (remhash p project-added-release-versions-ht)) (maphash (lambda (project added-versions) (with-clpi-io-syntax () (write (list* (project-name project) added-versions) :stream s) (terpri s))) project-added-release-versions-ht))) (setf (index-new-projects index) nil) (awhen (index-project-index-object-version index) (with-open-object-stream (s (index-object-store index) "project-index-object-version" :direction :output :if-exists :supersede) (write it :stream s))) ;; Write the system-index. If we bumped the version or the version is NIL, ;; we need to write the whole file. (if (or (null (index-system-index-object-version index)) system-index-object-version-bumped) (with-open-object-stream (s (index-object-store index) (index-system-index-object-path index) :direction :output :if-exists :supersede) (dolist (system (index-systems index)) (with-clpi-io-syntax () (write (list* (system-name system) (system-system-release-descriptions system)) :stream s) (terpri s)))) (with-open-object-stream (s (index-object-store index) (index-system-index-object-path index) :direction :output :if-exists :append) (dolist (system (index-new-systems index)) (with-clpi-io-syntax () (write (list* (system-name system) (system-system-release-descriptions system)) :stream s) (terpri s)) (remhash system system-added-release-versions-ht)) (maphash (lambda (system added-versions) (with-clpi-io-syntax () (pprint plist s))))) (write (list* (system-name system) added-versions) :stream s) (terpri s))) system-added-release-versions-ht))) (setf (index-new-systems index) nil) (awhen (index-system-index-object-version index) (with-open-object-stream (s (index-object-store index) "system-index-object-version" :direction :output :if-exists :supersede) (write it :stream s)))) (values)) (defmethod index-sync ((index index)) (let ((object-store (index-object-store index))) (when (typep object-store 'dual-object-store) (dual-object-store-update-object object-store "clpi-version") (dual-object-store-update-object object-store "index") (dual-object-store-update-object object-store "project-index-object-version") (dual-object-store-update-object object-store "system-index-object-version") (dual-object-store-update-object object-store (index-project-index-object-path index)) (dual-object-store-update-object object-store (index-system-index-object-path index)) (dolist (p (index-projects index)) (dual-object-store-update-object object-store (project-object-path p "repo")) (dual-object-store-update-object object-store (project-object-path p "authors")) Loading src/object-store-dual.lisp +3 −1 Original line number Diff line number Diff line Loading @@ -37,7 +37,9 @@ store, the secondary is updated from the primary and then the secondary is read. (defun path-appendable-p (path) (let ((file-namestring (file-namestring path))) (starts-with-subseq "releases-" file-namestring))) (or (starts-with-subseq "releases-" file-namestring) (starts-with-subseq "project-index-" file-namestring) (starts-with-subseq "system-index-" file-namestring)))) (defun dual-object-store-update-object (object-store path) (let* ((primary (dual-object-store-primary object-store)) Loading src/project-defs.lisp +12 −0 Original line number Diff line number Diff line Loading @@ -7,6 +7,7 @@ (:use #:cl) (:export #:project #:project-add-release #:project-added-release-versions #:project-changes-appendable-p #:project-commit-new-releases-to-stream! #:project-dirty-p Loading @@ -25,6 +26,7 @@ #:project-release-class #:project-releases #:project-releases-path #:project-removed-release-versions #:project-repo #:project-save #:project-version-scheme Loading Loading @@ -58,6 +60,11 @@ (:documentation "Add a new release to PROJECT.")) (defgeneric project-added-release-versions (project) (:documentation "Returns a list of strings naming new versions of the PROJECT added since it was last saved.")) (defgeneric project-changes-appendable-p (project) (:documentation "Returns a boolean indicating if the changes made to the project can be Loading Loading @@ -112,6 +119,11 @@ NIL.")) (:documentation "Returns the path to the PROJECT's releases object in its index.")) (defgeneric project-removed-release-versions (project) (:documentation "Returns a list of strings naming versions of the PROJECT removed since it was last saved.")) (defgeneric project-repo (project) (:documentation "Returns the source repository for PROJECT.")) Loading Loading
specs/clpi-0.4.org +37 −28 Original line number Diff line number Diff line #+TITLE: CLPI Specification v0.4 #+AUTHOR: clpm-devel@common-lisp.net #+AUTHOR: Eric Timmons #+EMAIL: clpm-devel@common-lisp.net This document provides the specification of version 0.4 of the Common Lisp Project Index. Loading Loading @@ -40,43 +41,51 @@ the secondary. + =clpi-version= :: Required. A string naming the version of the CLPI specification used by this index. Must be ="0.4"= for this version of the spec. + =project-index-object-version= :: An integer or NIL/missing whose purpose is further described in [[*Project index]]. + =system-index-object-version= :: An integer or NIL/missing whose purpose is further described in [[*System index]]. * Index * Project index The object =index= must exist. This object is a lightweight summary of all projects, systems, and releases contained within the index. It contains a single plist with the keys: The object =project-index= or =project-index-PROJECT-INDEX-OBJECT-VERSION= must exist, where =PROJECT-INDEX-OBJECT-VERSION= is defined in the [[*Index metadata]]. If the project index object version is NIL/not provided, only the former must exist, otherwise the latter must exist. + =:projects= :: A list of project information, described in [[*Project index]]. + =:systems= :: A list of system information, described in [[*System index]]. Each form in this object is a list where the first element is a project name (string). The rest is a list of strings naming versions of releases of this project. It is allowed for a project to be named with no releases. It is allowed for a project to appear multiple times in this object. If it does, all the releases should be combined after reading. As this object is typically fetched from the primary by the secondaries on a regular basis, other keys (including in sub plists) are allowed, but discouraged in order to keep the size to a minimum. If =PROJECT-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended to. ** Project index * System index This list contains all projects defined within the index as well as each project's releases. Each element in the project index must be of the form =(project-name . project-plist)= where =project-name= is a string naming the project and =project-plist= is a plist containing the following keys: The object =system-index= or =system-index-SYSTEM-INDEX-OBJECT-VERSION= must exist, where =SYSTEM-INDEX-OBJECT-VERSION= is defined in the [[*Index metadata]]. If the system index object version is NIL/not provided, only the former must exist, otherwise the latter must exist. + =:releases= :: A list of strings providing the versions of each release of the project. Each form in this object is a list where the first element is a system name (string). The rest is a list of lists describing releases of this system. Each element is a list with one or two member. The first member is a [[*Project release description]]. The second element is the ASD version of the system (if one is defined). If the second element is missing, it is assumed the ASD version of the system is =NIL=. ** System index It is allowed for a system to be named with no releases. This list contains the names of all systems defined within the index as well as which project releases provide them. Every element in the system index must be of the form =(system-name . system-plist)=, where =system-name= is a string containing the name of the system and =system-plist= is a list containing the following keys: It is allowed for a system to appear multiple times in this object. If it does, all the releases should be combined after reading. = =:releases= :: A list of releases of the system. Each element is a list with one or two members. The first member is a [[*Project release description]]. The second element is the ASD version of the system (if one is defined). If the second element is missing, it is assumed the ASD version of the system is =NIL=. If =SYSTEM-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended to. * Project metadata Loading
src/index-defs.lisp +21 −1 Original line number Diff line number Diff line Loading @@ -15,6 +15,8 @@ #:index-plist #:index-project #:index-project-class #:index-project-index-object-path #:index-project-index-object-version #:index-project-missing #:index-project-missing-index #:index-project-missing-project-name Loading @@ -25,6 +27,8 @@ #:index-system #:index-system-class #:index-system-file-class #:index-system-index-object-path #:index-system-index-object-version #:index-system-missing #:index-system-missing-index #:index-system-missing-system-name Loading Loading @@ -73,7 +77,7 @@ slots. This is not called as part of INITIALIZE-INSTANCE in order to allow work to be defered until first access instead of instantiation.")) (defgeneric index-initialize-internal (index &key projects systems &allow-other-keys) (defgeneric index-initialize-internal (index projects systems) (:documentation "Performs initialization of the index using the data read from the index object.")) Loading @@ -98,6 +102,14 @@ signaled.")) (:documentation "Return the class used to instantiate projects for INDEX.")) (defgeneric index-project-index-object-path (index) (:documentation "Return the path of the INDEX's project-index object.")) (defgeneric index-project-index-object-version (index) (:documentation "Return the version of the INDEX's project-index object.")) (defgeneric index-project-names (index) (:documentation "Return a list of the names of projects in INDEX.")) Loading Loading @@ -130,6 +142,14 @@ signaled.")) (:documentation "Return the class used to instantiate system files for INDEX.")) (defgeneric index-system-index-object-path (index) (:documentation "Return the path of the INDEX's system-index object.")) (defgeneric index-system-index-object-version (index) (:documentation "Return the version of the INDEX's system-index object.")) (defgeneric index-system-names (index) (:documentation "Return a list of the names of systems in INDEX.")) Loading
src/index.lisp +179 −39 Original line number Diff line number Diff line Loading @@ -6,6 +6,7 @@ (uiop:define-package #:clpi/index (:use #:cl #:alexandria #:anaphora #:clpi/defs #:clpi/object-store-dual #:clpi/project Loading @@ -27,10 +28,28 @@ :accessor index-version :documentation "The version of the CLPI spec to which this index adhears.") (project-index-object-version :accessor index-project-index-object-version :documentation "The version of the project-index object.") (system-index-object-version :accessor index-system-index-object-version :documentation "The version of the system-index object.") (system-ht :accessor index-system-ht :documentation "Maps system names to system instances.")) "Maps system names to system instances.") (new-projects :initform nil :accessor index-new-projects :documentation "A list of new projects added to the index.") (new-systems :initform nil :accessor index-new-systems :documentation "A list of new systems added to the index.")) (: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 @@ -44,7 +63,9 @@ project-index and system-index files are read to instantiate the objects.")) (gethash (project-name project) (index-project-ht index)) (when (and exists-p (not (eql project existing-project))) (error "Project already exists!")) (setf (gethash (project-name project) (index-project-ht index)) project)) (unless exists-p (push project (index-new-projects index)) (setf (gethash (project-name project) (index-project-ht index)) project))) index) (defmethod index-add-system ((index index) system) Loading @@ -52,41 +73,70 @@ project-index and system-index files are read to instantiate the objects.")) (gethash (system-name system) (index-system-ht index)) (when (and exists-p (not (eql system existing-system))) (error "System already exists!")) (setf (gethash (system-name system) (index-system-ht index)) system)) (unless exists-p (push system (index-new-systems index)) (setf (gethash (system-name system) (index-system-ht index)) system))) index) (defmethod index-project-index-object-path ((index index)) (let ((version (index-project-index-object-version index))) (if version (uiop:strcat "project-index-" (write-to-string version)) "project-index"))) (defmethod index-system-index-object-path ((index index)) (let ((version (index-system-index-object-version index))) (if version (uiop:strcat "system-index-" (write-to-string version)) "system-index"))) (defmethod index-initialize ((index index)) (let (contents) (let ((projects (make-hash-table :test 'equal)) (systems (make-hash-table :test 'equal))) (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-object-stream (s (index-object-store index) "index" :if-does-not-exist nil) (with-open-object-stream (s (index-object-store index) "project-index-object-version" :if-does-not-exist nil) (setf (index-project-index-object-version index) (when s (with-clpi-io-syntax () (read s))))) (with-open-object-stream (s (index-object-store index) "system-index-object-version" :if-does-not-exist nil) (setf (index-system-index-object-version index) (when s (with-clpi-io-syntax () (read s))))) (with-open-object-stream (s (index-object-store index) (index-project-index-object-path index) :if-does-not-exist nil) (when s (with-clpi-io-syntax () (setf contents (read s))))) (apply #'index-initialize-internal index contents))) (with-stream-forms (f s) (destructuring-bind (project-name &rest versions) f (setf (gethash project-name projects) (append versions (gethash project-name projects))))))) (with-open-object-stream (s (index-object-store index) (index-system-index-object-path index) :if-does-not-exist nil) (when s (with-stream-forms (f s) (destructuring-bind (system-name &rest versions) f (setf (gethash system-name systems) (append versions (gethash system-name systems))))))) (index-initialize-internal index projects systems))) (defmethod index-initialize-internal ((index index) &key projects systems &allow-other-keys) (defmethod index-initialize-internal ((index index) projects systems) (let ((project-ht (make-hash-table :test 'equal)) (system-ht (make-hash-table :test 'equal))) (dolist (project-description projects) (destructuring-bind (name &rest plist) project-description (setf (gethash name project-ht) (apply #'make-instance (index-project-class index) (maphash (lambda (project-name project-versions) (setf (gethash project-name project-ht) (make-instance (index-project-class index) :index index :name name plist)))) (dolist (system-description systems) (destructuring-bind (name &rest plist) system-description (setf (gethash name system-ht) (apply #'make-instance (index-system-class index) :name project-name :releases project-versions))) projects) (maphash (lambda (system-name system-versions) (setf (gethash system-name system-ht) (make-instance (index-system-class index) :index index :name name plist)))) :name system-name :releases system-versions))) systems) (setf (slot-value index 'project-ht) project-ht (slot-value index 'system-ht) system-ht))) Loading Loading @@ -116,9 +166,28 @@ project-index and system-index files are read to instantiate the objects.")) (hash-table-values (index-project-ht index))) (defmethod index-save ((index index)) (let ((project-added-release-versions-ht (make-hash-table)) (project-removed-release-versions-ht (make-hash-table)) project-index-object-version-bumped (system-added-release-versions-ht (make-hash-table)) (system-removed-release-versions-ht (make-hash-table)) system-index-object-version-bumped) (dolist (p (index-projects index)) ;; First, figure out the added and removed project releases. (awhen (project-added-release-versions p) (setf (gethash p project-added-release-versions-ht) it)) (awhen (project-removed-release-versions p) (setf (gethash p project-removed-release-versions-ht) it)) ;; Then write to disk. (project-save p)) (dolist (s (index-systems index)) ;; First, figure out the added and removed system releases. (awhen (system-added-system-release-descriptions s) (setf (gethash s system-added-release-versions-ht) it)) (awhen (system-removed-system-release-descriptions s) (setf (gethash s system-removed-release-versions-ht) it)) ;; Then write to disk. (system-save s)) (with-open-object-stream (s (index-object-store index) "clpi-version" :direction :output Loading @@ -126,18 +195,89 @@ project-index and system-index files are read to instantiate the objects.")) (with-clpi-io-syntax () (write "0.4" :stream s) (terpri s))) (let ((plist (index-plist index))) (with-open-object-stream (s (index-object-store index) "index" ;; Determine if the project-index version needs to be updated. (when (and (index-project-index-object-version index) (not (zerop (hash-table-count project-removed-release-versions-ht)))) (incf (index-project-index-object-version index)) (setf project-index-object-version-bumped t)) ;; Determine if the project-index version needs to be updated. (when (and (index-system-index-object-version index) (not (zerop (hash-table-count system-removed-release-versions-ht)))) (incf (index-system-index-object-version index)) (setf system-index-object-version-bumped t)) ;; Write the project-index. If we bumped the version or the version is NIL, ;; we need to write the whole file. (if (or (null (index-project-index-object-version index)) project-index-object-version-bumped) (with-open-object-stream (s (index-object-store index) (index-project-index-object-path index) :direction :output :if-exists :supersede) (dolist (p (index-projects index)) (with-clpi-io-syntax () (write (list* (project-name p) (project-versions p)) :stream s) (terpri s)))) (with-open-object-stream (s (index-object-store index) (index-project-index-object-path index) :direction :output :if-exists :append) (dolist (p (index-new-projects index)) (with-clpi-io-syntax () (write (list* (project-name p) (project-versions p)) :stream s) (terpri s)) (remhash p project-added-release-versions-ht)) (maphash (lambda (project added-versions) (with-clpi-io-syntax () (write (list* (project-name project) added-versions) :stream s) (terpri s))) project-added-release-versions-ht))) (setf (index-new-projects index) nil) (awhen (index-project-index-object-version index) (with-open-object-stream (s (index-object-store index) "project-index-object-version" :direction :output :if-exists :supersede) (write it :stream s))) ;; Write the system-index. If we bumped the version or the version is NIL, ;; we need to write the whole file. (if (or (null (index-system-index-object-version index)) system-index-object-version-bumped) (with-open-object-stream (s (index-object-store index) (index-system-index-object-path index) :direction :output :if-exists :supersede) (dolist (system (index-systems index)) (with-clpi-io-syntax () (write (list* (system-name system) (system-system-release-descriptions system)) :stream s) (terpri s)))) (with-open-object-stream (s (index-object-store index) (index-system-index-object-path index) :direction :output :if-exists :append) (dolist (system (index-new-systems index)) (with-clpi-io-syntax () (write (list* (system-name system) (system-system-release-descriptions system)) :stream s) (terpri s)) (remhash system system-added-release-versions-ht)) (maphash (lambda (system added-versions) (with-clpi-io-syntax () (pprint plist s))))) (write (list* (system-name system) added-versions) :stream s) (terpri s))) system-added-release-versions-ht))) (setf (index-new-systems index) nil) (awhen (index-system-index-object-version index) (with-open-object-stream (s (index-object-store index) "system-index-object-version" :direction :output :if-exists :supersede) (write it :stream s)))) (values)) (defmethod index-sync ((index index)) (let ((object-store (index-object-store index))) (when (typep object-store 'dual-object-store) (dual-object-store-update-object object-store "clpi-version") (dual-object-store-update-object object-store "index") (dual-object-store-update-object object-store "project-index-object-version") (dual-object-store-update-object object-store "system-index-object-version") (dual-object-store-update-object object-store (index-project-index-object-path index)) (dual-object-store-update-object object-store (index-system-index-object-path index)) (dolist (p (index-projects index)) (dual-object-store-update-object object-store (project-object-path p "repo")) (dual-object-store-update-object object-store (project-object-path p "authors")) Loading
src/object-store-dual.lisp +3 −1 Original line number Diff line number Diff line Loading @@ -37,7 +37,9 @@ store, the secondary is updated from the primary and then the secondary is read. (defun path-appendable-p (path) (let ((file-namestring (file-namestring path))) (starts-with-subseq "releases-" file-namestring))) (or (starts-with-subseq "releases-" file-namestring) (starts-with-subseq "project-index-" file-namestring) (starts-with-subseq "system-index-" file-namestring)))) (defun dual-object-store-update-object (object-store path) (let* ((primary (dual-object-store-primary object-store)) Loading
src/project-defs.lisp +12 −0 Original line number Diff line number Diff line Loading @@ -7,6 +7,7 @@ (:use #:cl) (:export #:project #:project-add-release #:project-added-release-versions #:project-changes-appendable-p #:project-commit-new-releases-to-stream! #:project-dirty-p Loading @@ -25,6 +26,7 @@ #:project-release-class #:project-releases #:project-releases-path #:project-removed-release-versions #:project-repo #:project-save #:project-version-scheme Loading Loading @@ -58,6 +60,11 @@ (:documentation "Add a new release to PROJECT.")) (defgeneric project-added-release-versions (project) (:documentation "Returns a list of strings naming new versions of the PROJECT added since it was last saved.")) (defgeneric project-changes-appendable-p (project) (:documentation "Returns a boolean indicating if the changes made to the project can be Loading Loading @@ -112,6 +119,11 @@ NIL.")) (:documentation "Returns the path to the PROJECT's releases object in its index.")) (defgeneric project-removed-release-versions (project) (:documentation "Returns a list of strings naming versions of the PROJECT removed since it was last saved.")) (defgeneric project-repo (project) (:documentation "Returns the source repository for PROJECT.")) Loading