Loading src/project.lisp +49 −33 Original line number Diff line number Diff line Loading @@ -39,9 +39,12 @@ (release-data-read-p :initform nil :accessor project-release-data-read-p) (deltas (release-deltas :initform nil :accessor project-deltas)) :accessor project-release-deltas) (slots-changed :initform nil :accessor project-slots-changed)) (:documentation "The base implementation of projects. Contains a mapping from version string to release objects. When this mapping is accessed for the first time, all Loading @@ -56,6 +59,15 @@ instantiated.")) (setf (gethash r release-ht) nil)) (setf (project-release-ht project) release-ht))) (defmethod (setf project-repo) :after (new-value (project project)) (pushnew 'repo (project-slots-changed project))) (defmethod (setf project-version-scheme) :after (new-value (project project)) (pushnew 'version-scheme (project-slots-changed project))) (defmethod (setf project-releases-object-version) :after (new-value (project project)) (pushnew 'releases-object-version (project-slots-changed project))) (defmethod index-project-class (index) "Register this as the default project class." 'project) Loading @@ -70,16 +82,18 @@ instantiated.")) (unless (eql (project new-release) project) (error "This release does not belong to this project!")) (setf (gethash (release-version new-release) (project-release-ht project)) new-release) (push (cons :add-release new-release) (project-deltas project)) (push (cons :add-release new-release) (project-release-deltas project)) project) (defmethod project-changes-appendable-p ((project project)) (every (lambda (x) (eql (car x) :add-release)) (project-deltas project))) (project-release-deltas project))) (defmethod project-dirty-p ((project project)) (project-deltas project)) (or (project-release-deltas project) (project-slots-changed project))) (defmethod slot-unbound (class (project project) (slot-name (eql 'releases-object-version))) (with-open-object-stream (s (index-object-store (index project)) Loading Loading @@ -152,8 +166,9 @@ instantiated.")) :if-exists (if appendable-p :append :supersede)) (if appendable-p (project-write-changes-to-stream project s) (project-write-to-stream project s))) (awhen (project-releases-object-version project) (project-write-to-stream project s)))) (awhen (and (member 'releases-object-version (project-slots-changed project)) (project-releases-object-version project)) (with-open-object-stream (s (index-object-store (index project)) (project-object-path project "releases-object-version") :direction :output Loading @@ -161,30 +176,31 @@ instantiated.")) (with-clpi-io-syntax () (write it :stream s) (terpri s)))) (when (slot-boundp project 'repo) (when (member 'repo (project-slots-changed project)) (with-open-object-stream (s (index-object-store (index project)) (project-object-path project "repo") :direction :output :if-exists :supersede) (with-clpi-io-syntax () (write (repo-to-description (project-repo project)) :stream s) (terpri s)))) (when (slot-boundp project 'version-scheme) (when (member 'version-scheme (project-slots-changed project)) (with-open-object-stream (s (index-object-store (index project)) (project-object-path project "version-scheme") :direction :output :if-exists :supersede) (with-clpi-io-syntax () (write (project-version-scheme project) :stream s) (terpri s))))))) (terpri s)))) (setf (project-slots-changed project) nil))) (defmethod project-versions ((project project)) (hash-table-keys (project-release-ht project))) (defmethod project-write-changes-to-stream ((project project) s) (assert (every (lambda (x) (eql (car x) :add-release)) (project-deltas project))) (assert (every (lambda (x) (eql (car x) :add-release)) (project-release-deltas project))) (let ((release-descs (mapcar (lambda (release) (list* (release-version release) (release-plist release))) (mapcar #'cdr (project-deltas project)))) (mapcar #'cdr (project-release-deltas project)))) (version-scheme (project-version-scheme project))) (when version-scheme (setf release-descs (sort release-descs (ecase version-scheme Loading @@ -201,7 +217,7 @@ instantiated.")) (write release-desc :stream s) (terpri s)))) (setf (project-deltas project) nil)) (setf (project-release-deltas project) nil)) (defmethod project-write-to-stream ((project project) s) (let ((release-descs (mapcar (lambda (release) Loading @@ -223,7 +239,7 @@ instantiated.")) (write release-desc :stream s) (terpri s)))) (setf (project-deltas project) nil)) (setf (project-release-deltas project) nil)) (defmethod slot-unbound (class (project project) (slot-name (eql 'repo))) "Create the repository object on demand." Loading Loading
src/project.lisp +49 −33 Original line number Diff line number Diff line Loading @@ -39,9 +39,12 @@ (release-data-read-p :initform nil :accessor project-release-data-read-p) (deltas (release-deltas :initform nil :accessor project-deltas)) :accessor project-release-deltas) (slots-changed :initform nil :accessor project-slots-changed)) (:documentation "The base implementation of projects. Contains a mapping from version string to release objects. When this mapping is accessed for the first time, all Loading @@ -56,6 +59,15 @@ instantiated.")) (setf (gethash r release-ht) nil)) (setf (project-release-ht project) release-ht))) (defmethod (setf project-repo) :after (new-value (project project)) (pushnew 'repo (project-slots-changed project))) (defmethod (setf project-version-scheme) :after (new-value (project project)) (pushnew 'version-scheme (project-slots-changed project))) (defmethod (setf project-releases-object-version) :after (new-value (project project)) (pushnew 'releases-object-version (project-slots-changed project))) (defmethod index-project-class (index) "Register this as the default project class." 'project) Loading @@ -70,16 +82,18 @@ instantiated.")) (unless (eql (project new-release) project) (error "This release does not belong to this project!")) (setf (gethash (release-version new-release) (project-release-ht project)) new-release) (push (cons :add-release new-release) (project-deltas project)) (push (cons :add-release new-release) (project-release-deltas project)) project) (defmethod project-changes-appendable-p ((project project)) (every (lambda (x) (eql (car x) :add-release)) (project-deltas project))) (project-release-deltas project))) (defmethod project-dirty-p ((project project)) (project-deltas project)) (or (project-release-deltas project) (project-slots-changed project))) (defmethod slot-unbound (class (project project) (slot-name (eql 'releases-object-version))) (with-open-object-stream (s (index-object-store (index project)) Loading Loading @@ -152,8 +166,9 @@ instantiated.")) :if-exists (if appendable-p :append :supersede)) (if appendable-p (project-write-changes-to-stream project s) (project-write-to-stream project s))) (awhen (project-releases-object-version project) (project-write-to-stream project s)))) (awhen (and (member 'releases-object-version (project-slots-changed project)) (project-releases-object-version project)) (with-open-object-stream (s (index-object-store (index project)) (project-object-path project "releases-object-version") :direction :output Loading @@ -161,30 +176,31 @@ instantiated.")) (with-clpi-io-syntax () (write it :stream s) (terpri s)))) (when (slot-boundp project 'repo) (when (member 'repo (project-slots-changed project)) (with-open-object-stream (s (index-object-store (index project)) (project-object-path project "repo") :direction :output :if-exists :supersede) (with-clpi-io-syntax () (write (repo-to-description (project-repo project)) :stream s) (terpri s)))) (when (slot-boundp project 'version-scheme) (when (member 'version-scheme (project-slots-changed project)) (with-open-object-stream (s (index-object-store (index project)) (project-object-path project "version-scheme") :direction :output :if-exists :supersede) (with-clpi-io-syntax () (write (project-version-scheme project) :stream s) (terpri s))))))) (terpri s)))) (setf (project-slots-changed project) nil))) (defmethod project-versions ((project project)) (hash-table-keys (project-release-ht project))) (defmethod project-write-changes-to-stream ((project project) s) (assert (every (lambda (x) (eql (car x) :add-release)) (project-deltas project))) (assert (every (lambda (x) (eql (car x) :add-release)) (project-release-deltas project))) (let ((release-descs (mapcar (lambda (release) (list* (release-version release) (release-plist release))) (mapcar #'cdr (project-deltas project)))) (mapcar #'cdr (project-release-deltas project)))) (version-scheme (project-version-scheme project))) (when version-scheme (setf release-descs (sort release-descs (ecase version-scheme Loading @@ -201,7 +217,7 @@ instantiated.")) (write release-desc :stream s) (terpri s)))) (setf (project-deltas project) nil)) (setf (project-release-deltas project) nil)) (defmethod project-write-to-stream ((project project) s) (let ((release-descs (mapcar (lambda (release) Loading @@ -223,7 +239,7 @@ instantiated.")) (write release-desc :stream s) (terpri s)))) (setf (project-deltas project) nil)) (setf (project-release-deltas project) nil)) (defmethod slot-unbound (class (project project) (slot-name (eql 'repo))) "Create the repository object on demand." Loading