Commit abc1e9c1 authored by Eric Timmons's avatar Eric Timmons

Fix bug causing multiple syncs to nuke existing data

parent 2a27bc28
......@@ -48,6 +48,17 @@
(when s
(file-length s)))))
(defun call-with-staging-pathname (thunk pn append-p)
(uiop:with-staging-pathname (staging-pn pn)
(when (and append-p (probe-file pn))
(uiop:copy-file pn staging-pn))
(funcall thunk staging-pn)))
(defmacro with-staging-pathname ((pn-var &key (pathname-value pn-var)
append-p)
&body body)
`(call-with-staging-pathname (lambda (,pn-var) ,@body) ,pathname-value ,append-p))
(defmethod index-object-write ((index file-index) path in-stream)
(let ((pn (merge-pathnames path (file-index-root index))))
(ensure-directories-exist pn)
......@@ -61,18 +72,20 @@
(when (metadata-dirty-p (metadata index))
(let ((pn (merge-pathnames "metadata" (file-index-root index))))
(ensure-directories-exist pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream index s))))
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream index s)))))
(let ((pn (merge-pathnames "index" (file-index-root index))))
(ensure-directories-exist pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(let ((plist (index-plist index)))
(with-clpi-io-syntax ()
(pprint plist s)))))
(let ((plist (index-plist index)))
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(with-clpi-io-syntax ()
(pprint plist s))))))
(dolist (p (index-projects index))
(let ((dirty-p (project-dirty-p p))
(appendable-p (project-changes-appendable-p p))
......@@ -82,28 +95,31 @@
(incf (project-releases-object-version p)))
(let ((pn (merge-pathnames (project-releases-path p) (file-index-root index))))
(ensure-directories-exist pn)
(with-open-file (s pn
:direction :output
:if-exists (if appendable-p :append :supersede)
:if-does-not-exist :create)
(if (and appendable-p releases-object-version)
(project-write-changes-to-stream p s)
(project-write-to-stream p s)))))
(with-staging-pathname (pn :append-p appendable-p)
(with-open-file (s pn
:direction :output
:if-exists (if appendable-p :append :supersede)
:if-does-not-exist :create)
(if (and appendable-p releases-object-version)
(project-write-changes-to-stream p s)
(project-write-to-stream p s))))))
(when (metadata-dirty-p (metadata p))
(let ((pn (merge-pathnames (metadata-path p) (file-index-root index))))
(ensure-directories-exist pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream p s))))))
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream p s)))))))
(dolist (system (index-systems index))
(when (metadata-dirty-p (metadata system))
(let ((pn (merge-pathnames (metadata-path system) (file-index-root index))))
(ensure-directories-exist pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream system s))))))
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream system s)))))))
(defmethod open-index-object-stream ((index file-index) path
&key signal-if-older-than
......
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