Browse Source

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.
stable
Craig Oates 2 years ago
parent
commit
a855d9db90
  1. 40
      src/storage.lisp

40
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'.

Loading…
Cancel
Save