Loading src/file-index.lisp +41 −25 Original line number Diff line number Diff line Loading @@ -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) Loading @@ -61,18 +72,20 @@ (when (metadata-dirty-p (metadata index)) (let ((pn (merge-pathnames "metadata" (file-index-root index)))) (ensure-directories-exist pn) (with-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (metadata-write-to-stream index s)))) (metadata-write-to-stream index s))))) (let ((pn (merge-pathnames "index" (file-index-root index)))) (ensure-directories-exist pn) (let ((plist (index-plist index))) (with-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (let ((plist (index-plist index))) (with-clpi-io-syntax () (pprint plist s))))) (pprint plist s)))))) (dolist (p (index-projects index)) (let ((dirty-p (project-dirty-p p)) (appendable-p (project-changes-appendable-p p)) Loading @@ -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-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))))) (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-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (metadata-write-to-stream p s)))))) (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-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (metadata-write-to-stream system s)))))) (metadata-write-to-stream system s))))))) (defmethod open-index-object-stream ((index file-index) path &key signal-if-older-than Loading Loading
src/file-index.lisp +41 −25 Original line number Diff line number Diff line Loading @@ -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) Loading @@ -61,18 +72,20 @@ (when (metadata-dirty-p (metadata index)) (let ((pn (merge-pathnames "metadata" (file-index-root index)))) (ensure-directories-exist pn) (with-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (metadata-write-to-stream index s)))) (metadata-write-to-stream index s))))) (let ((pn (merge-pathnames "index" (file-index-root index)))) (ensure-directories-exist pn) (let ((plist (index-plist index))) (with-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (let ((plist (index-plist index))) (with-clpi-io-syntax () (pprint plist s))))) (pprint plist s)))))) (dolist (p (index-projects index)) (let ((dirty-p (project-dirty-p p)) (appendable-p (project-changes-appendable-p p)) Loading @@ -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-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))))) (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-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (metadata-write-to-stream p s)))))) (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-staging-pathname (pn) (with-open-file (s pn :direction :output :if-exists :supersede) (metadata-write-to-stream system s)))))) (metadata-write-to-stream system s))))))) (defmethod open-index-object-stream ((index file-index) path &key signal-if-older-than Loading