Finish trashing files

trashinfo.lisp

@@ -174,6 +174,66 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
             (url-encode path :safe-chars '(#\/))
             (format-trashinfo-timestamp deletion-date))))
 
+(declaim (ftype (function (pathname (or string pathname)) stream)
+                open-trashinfo-for))
+(defun open-trashinfo-for (trash-directory path)
+  (loop with trash-directory = (ensure-nonwild-pathname trash-directory
+                                                        :ensure-directory t)
+        with name = (file-or-dir-namestring path)
+        with info-dir = (ensure-directories-exist
+                         (merge-pathnames #P"info/"
+                                          (uiop:ensure-directory-pathname
+                                           trash-directory))
+                         :verbose nil)
+        for info-file = (merge-pathnames
+                         (make-pathname
+                          :name (format nil "~A-~D"
+                                        name (random most-positive-fixnum))
+                          :type "trashinfo")
+                         info-dir)
+        for stream = (open info-file :direction :output
+                                     :if-exists nil
+                                     :if-does-not-exist :create)
+        until stream
+        finally (return stream)))
+
+(declaim (ftype (function (string string) string) remove-suffix))
+(defun remove-suffix (string suffix)
+  "Return STRING without SIFFIX."
+  (if (uiop:string-suffix-p string suffix)
+      (subseq string 0 (- (length string) (length suffix)))
+      string))
+
+(declaim (ftype (function (pathname (or pathname string)
+                                    &optional local-time:timestamp)
+                          trashinfo)
+                make-trashinfo-for))
+(defun make-trashinfo-for (trash-directory path &optional (deletion-date
+                                                           (local-time:now)))
+  "Generate a new name based off PATH and create a new trashinfo file under
+TRASH-DIRECTORY. Return a trashinfo object pointing to this file."
+  (let* ((path (ensure-nonwild-pathname path))
+         (stream (open-trashinfo-for trash-directory path)))
+    (prog1
+        (handler-bind
+            ((t #'(lambda (e)
+                    (close stream :abort t)
+                    (signal e))))
+          (let ((trashinfo
+                  (make-instance 'trashinfo
+                                 :path (uiop:native-namestring
+                                        (merge-pathnames path (uiop:getcwd)))
+                                 :name (remove-suffix
+                                        (file-or-dir-namestring
+                                         (pathname stream))
+                                        ".trashinfo")
+                                 :trash-directory trash-directory
+                                 :deletion-date deletion-date)))
+            (format-trashinfo trashinfo stream)
+            trashinfo))
+      ;; if we exited successfully
+      (close stream))))
+
 
 ;; Local Variables:
 ;; jinx-local-words: "trashinfo"