You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
74 lines
2.4 KiB
74 lines
2.4 KiB
2 years ago
|
;;; (in-package :cl-user)
|
||
|
(defpackage #:rails-to-caveman.storage
|
||
|
(:use #:cl)
|
||
|
(:shadow #:write
|
||
|
#:read
|
||
|
#:remove
|
||
|
#:probe-file))
|
||
|
(in-package #:rails-to-caveman.storage)
|
||
|
|
||
|
(defstruct (file (:type vector))
|
||
|
name
|
||
|
size
|
||
|
content-type)
|
||
|
|
||
|
(defun prin1-to-base64-string (object)
|
||
|
;;; SOMETHING IS CALLING THIS AND NOT PROPERLY. YOU ARE UP TO HERE.
|
||
|
(cl-base64:string-to-base64-string (prin1-to-string object)))
|
||
|
|
||
|
(defun read-from-base64-string(string)
|
||
|
(values (read-from-string
|
||
|
(cl-base64:base64-string-to-string string))))
|
||
|
|
||
|
(defun make-storage-pathname (id subdirectory &optional file)
|
||
|
(merge-pathnames (format nil "storage/~A/~A/~@[~A~]"
|
||
|
id
|
||
|
subdirectory
|
||
|
(when file (prin1-to-base64-string file)))
|
||
|
rails-to-caveman.config::*application-root*))
|
||
|
|
||
|
(defun write (stream id subdirectory file)
|
||
|
;; (let ((path (ensure-directories-exist
|
||
|
;; (make-storage-pathname id subdirectory file))))
|
||
|
(let ((path "/home/craig/Desktop/test.png"))
|
||
|
(with-open-file (s path
|
||
|
:direction :output
|
||
|
:if-does-not-exist :create
|
||
|
:element-type '(unsigned-byte 8)
|
||
|
:if-exists nil)
|
||
|
(write-sequence (slot-value stream 'vector) s :start 0))))
|
||
|
;; (if s
|
||
|
;; (write-sequence (slot-value stream 'vector) s)
|
||
|
;; (warn "File already exists ~S~&Ignored." path))))
|
||
|
|
||
|
(defun read (id subdirectory file)
|
||
|
(with-open-file (s (make-storage-pathname id subdirectory file)
|
||
|
:element-type '(unsigned-byte 8))
|
||
|
(let* ((length (file-length s))
|
||
|
(buffer (make-array length
|
||
|
:element-type '(unsigned-byte 8))))
|
||
|
(read-sequence buffer s)
|
||
|
(values buffer length))))
|
||
|
|
||
|
(defun remove (id subdirectory file)
|
||
|
(delete-file (make-storage-pathname id subdirectory file)))
|
||
|
|
||
|
(defun probe-file (id subdirectory file)
|
||
|
(cl:probe-file (make-storage-pathname id subdirectory file)))
|
||
|
|
||
|
;;; This function requires ImageMagick so you will need to install it
|
||
|
;;; with 'sudo apt install imagemagick' (assuming you are on a
|
||
|
;;; Debian-based system).
|
||
|
(defun convert (id subdirectory original-file converted-file)
|
||
|
(let ((command (format nil "convert -geometry ~A ~A ~A"
|
||
|
(file-size converted-file)
|
||
|
(make-storage-pathname id subdirectory original-file)
|
||
|
(make-storage-pathname id subdirectory converted-file))))
|
||
|
(let ((message (nth-value 1
|
||
|
(uiop:run-program command
|
||
|
:ignore-error-status t
|
||
|
:error-output :string))))
|
||
|
(when message (error message)))))
|
||
|
|
||
|
|