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

Make saving projects more robust

parent 322a3a25
Loading
Loading
Loading
Loading
+5 −0
Original line number Diff line number Diff line
@@ -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)
+4 −0
Original line number Diff line number Diff line
@@ -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)
+23 −17
Original line number Diff line number Diff line
@@ -180,15 +180,21 @@ instantiated."))
                                  :if-exists :supersede)
        (with-clpi-io-syntax ()
          (write it :stream s)
          (terpri s))))
    (when (member 'repo (project-slots-changed project))
          (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 (member 'version-scheme (project-slots-changed project))
  (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
@@ -196,7 +202,7 @@ instantiated."))
      (with-clpi-io-syntax ()
        (write (project-version-scheme project) :stream s)
        (terpri s))))
    (setf (project-slots-changed project) nil)))
  (setf (project-slots-changed project) nil))

(defmethod project-versions ((project project))
  (hash-table-keys (project-release-ht project)))