Commit f3fee945 authored by Eric Timmons's avatar Eric Timmons

Make saving projects more robust

parent 322a3a25
......@@ -18,6 +18,7 @@
#:object-out-of-date-path
#:object-out-of-date-universal-time
#:open-object-stream
#:probe-object
#:with-open-object-stream))
(in-package #:clpi/object-store-defs)
......@@ -58,6 +59,10 @@
"Write the contents of IN-STREAM to the object located at PATH in the
OBJECT-STORE. Overwrites the object if it exists."))
(defgeneric probe-object (object-store path)
(:documentation
"Returns non-NIL if the PATH exists in OBJECT-STORE."))
(defgeneric open-object-stream (object-store path direction
&key binary-p offset
if-does-not-exist if-exists)
......
......@@ -63,6 +63,10 @@
:if-exists :supersede)
(uiop:copy-stream-to-stream in-stream s :element-type (stream-element-type in-stream)))))
(defmethod probe-object ((object-store file-object-store) path)
(let ((pn (merge-pathnames path (file-object-store-root object-store))))
(probe-file pn)))
(defmethod call-with-open-object-stream ((object-store file-object-store) path thunk
&rest args
&key (direction :input)
......
......@@ -180,23 +180,29 @@ instantiated."))
:if-exists :supersede)
(with-clpi-io-syntax ()
(write it :stream s)
(terpri s))))
(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 (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))))
(setf (project-slots-changed project) nil)))
(terpri s)))))
(when (or (member 'repo (project-slots-changed project))
(and (slot-boundp project 'repo)
(not (probe-object (index-object-store (index project))
(project-object-path project "repo")))))
(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 (or (member 'version-scheme (project-slots-changed project))
(and (slot-boundp project 'version-scheme)
(not (probe-object (index-object-store (index project))
(project-object-path project "version-scheme")))))
(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))))
(setf (project-slots-changed project) nil))
(defmethod project-versions ((project project))
(hash-table-keys (project-release-ht project)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment