From a855d9db90c337ebcba6829fedaf4f5bd50801fe Mon Sep 17 00:00:00 2001
From: Craig Oates <craig@craigoates.net>
Date: Mon, 19 Sep 2022 22:54:53 +0100
Subject: [PATCH] refactor store-file functions to include more file types.

The original code was very ham-fisted in how it dealt with storing
files -- based on their file-types. The changes made here improves on
it and the store-file (for both raw and /storage paths) functions now
accepts more file types because of it.
---
 src/storage.lisp | 40 +++++++++++++++++++++++++++++-----------
 1 file changed, 29 insertions(+), 11 deletions(-)

diff --git a/src/storage.lisp b/src/storage.lisp
index 114c47d..3d2f120 100644
--- a/src/storage.lisp
+++ b/src/storage.lisp
@@ -20,7 +20,8 @@
 	   #:store-text
 	   #:store-with-raw-path
 	   #:store-text-with-raw-path
-	   #:open-text-file-with-raw-path))
+	   #:open-text-file-with-raw-path
+	   #:store-test))
 (in-package #:storage)
 
 (defun init-storage ()
@@ -145,15 +146,29 @@ Before calling this function, make sure the file exists. You should have
   (rename-file (make-path username subdirectory old-slug)
 	       (make-path username subdirectory new-slug)))
 
+(defun store-file-old (username subdirectory filename data)
+  "OBSOLETE. USE `STORE-FILE'."
+  (let ((path (ensure-directories-exist
+	       (make-path username subdirectory filename))))
+    (cond ((or (string= (caddr data) "application/gzip")
+	       (string= (caddr data) "application/zip")
+	       (string= (caddr data) "application/epub+zip"))
+	   (uiop:copy-file (slot-value (car data) 'pathname) path))
+	  (t (with-open-file (stream
+			      path
+			      :direction :output
+			      :if-does-not-exist :create
+			      :element-type '(unsigned-byte 8)
+			      :if-exists :supersede)
+	       (write-sequence (slot-value (car data) 'vector) stream))))))
+
 (defun store-file (username subdirectory filename data)
   "Stores the uploaded file to the /storage directory.
 Storage path: `*APPLICATION-ROOT*'/storage/`USERNAME'/`SUBDIRECTORY'/`FILENAME'
 `DATA' is the actual contents which will be written to the said path."
   (let ((path (ensure-directories-exist
 	       (make-path username subdirectory filename))))
-    (cond ((or (string= (caddr data) "application/gzip")
-	       (string= (caddr data) "application/zip")
-	       (string= (caddr data) "application/epub+zip"))
+    (cond ((equal (type-of (car data)) 'SB-SYS:FD-STREAM)
 	   (uiop:copy-file (slot-value (car data) 'pathname) path))
 	  (t
 	   (with-open-file (stream
@@ -182,13 +197,16 @@ Storage path: `*APPLICATION-ROOT*'/storage/`USERNAME'/`SUBDIRECTORY'/`FILENAME'
   (let ((path (ensure-directories-exist
 	       (merge-pathnames path
 				ritherdon-archive.config::*application-root*))))
-    (with-open-file (stream
-		     path
-		     :direction :output
-		     :element-type '(unsigned-byte 8)
-		     :if-does-not-exist :create
-		     :if-exists :supersede)
-      (write-sequence (slot-value (car data) 'vector) stream))))
+    (cond ((equal (type-of (car data)) 'SB-SYS:FD-STREAM)
+	   (uiop:copy-file (slot-value (car data) 'pathname) path))
+	  (t
+	   (with-open-file (stream
+			    path
+			    :direction :output
+			    :element-type '(unsigned-byte 8)
+			    :if-does-not-exist :create
+			    :if-exists :supersede)
+	     (write-sequence (slot-value (car data) 'vector) stream))))))
 
 (defun store-text-with-raw-path (path data)
   "Stores the plain text `DATA' at `PATH'.