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.
73 lines
2.4 KiB
73 lines
2.4 KiB
;;; (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))))) |
|
|
|
|
|
|