ritherdon-archive/src/utils.lisp

(in-package #:cl-user)
(defpackage #:utils
  (:use #:cl
	#:caveman2
	#:log4cl
        #:xml-emitter
	#:app-constants
	#:storage)
  (:export #:request-params
	   #:separate-files-in-web-request
	   #:set-alert
	   #:get-alert
	   #:get-and-reset-alert
	   #:checkbox-to-bool
	   #:asciify
	   #:slugify
	   #:get-image-dimensions
	   #:run-bash-command
	   #:create-thumbnail
	   #:create-timestamp-id
	   #:format-filename
	   #:format-keywords
	   #:build-alert-string
           #:month-number-to-name
           #:build-url-root
           #:build-url
           #:create-timestamp-text)
  (:documentation "Utilities that do not depend on models."))

(in-package #:utils)

(defun asciify (string)
  (str:downcase (slug:asciify string)))

(defun slugify (string)
  "Turns a string of text into a slug."
  (str:downcase (slug:slugify string)))

(defun format-filename (string)
  "Changes the filename into the system's standard.
Replaces whitespace with '-' and changes everything to lowecase."
  (str:replace-all " " "-" (asciify string)))

(defun format-keywords (string)
  "Formats the keywords used in the `ARCHIVE-ENTRY' class.
This is mostly just over-prep'ing the keywords assuming the user
enters them in the incorrect format. Meilisearch exects something like
'art,welding,green paint,ritherdon'. The comma is the seperator which
allows each 'keyword' to have (white-)spaces."
  (str:replace-all ", " "," (asciify string)))

(defun request-params (request)
  (loop :for (key . value) :in request
	:collect (let ((*package* (find-package :keyword)))
		   (read-from-string key))
	:collect value))

(defun separate-files-in-web-request (request &optional request-value)
  "Creates a new list of 'upload' files from a web `REQUEST'.
You will mostly use this for processing a multi-file upload (HTML)
form. The standard value for the 'name' attribute in (file) input tag
in the HTML form is `CONTENT-FILES' but you can use a different
name. Just specify it in this function's `REQUEST-VALUE' argument."
  (loop :for item :in request
	if (or (string= "CONTENT-FILES" (car item))
	       (string= request-value (car item)))
	  collect item))

(defun set-alert (message &optional alert-type)
  "Sets the alert `MESSAGE' stored in session, provide info. to users.
The intention is store a `MESSAGE' across a redirect during a HTTP
POST request."
  (cond ((string= "error" alert-type)
	 (setf (gethash :alert ningle:*session*)
	       (build-alert-string alert-type "vomit-cat.png" message)))
	((string= "success" alert-type)
	 (setf (gethash :alert ningle:*session*)
	       (build-alert-string alert-type "success-cat.png" message)))
	((string= "missing-data" alert-type)
	 (setf (gethash :alert ningle:*session*)
	       (build-alert-string alert-type "sherlock-cat.png" message)))
	((string= "invalid-data" alert-type)
	 (setf (gethash :alert ningle:*session*)
	       (build-alert-string alert-type "confused-cat.png" message)))
	((string= "created" alert-type)
	 (setf (gethash :alert ningle:*session*)
	       (build-alert-string alert-type "disco-cat.png" message)))
	((string= "warning" alert-type)
	 (setf (gethash :alert ningle:*session*)
	       (build-alert-string alert-type "workout-cat.png" message)))
	(t (setf (gethash :alert ningle:*session*) message))))

(defun build-alert-string (alert-text src-image message)
  (format nil
	  "<p class=\"~a\"><img alt=\"~a\" src=\"/images/alerts/~a\">~a</p>"
	  alert-text
	  alert-text
	  src-image
	  message))

(defun get-alert ()
  "Get alert message from session data."
  (gethash :alert ningle:*session*))

(defun get-and-reset-alert ()
  "Returns the `ALERT' message and clears its content from the session hash."
  (let ((message (get-alert)))
    (set-alert nil)
    message))

(defun checkbox-to-bool (value)
  "Converts a HTML Checkbox `VALUE' to a Boolean.
The `VALUE' will either be 'on' or 'off'. 'Boolean' in this instance
is assuming you are using SQLite and need to convert `VALUE' to an
integer/number. If you are needing a traditional Boolean value, DO NOT USE
THIS FUNCTION."
  (cond ((or (string= "checked" value) (string= "on" value)) +true+)
	((or (string= "off" value) (null value)) +false+)
	((null value) +false+)))

(defun get-image-dimensions (filepath)
  "Uses Image Magick (via Bash) to get the resolution of an image as 'WxH'.
The `FILEPATH' must be already merged with
`ritherdon-archive.config::*application-root*' before you call this function."
  (let* ((command
	   (format nil "identify -format \"%wx%h\" ~a" filepath))
	 (out-message (uiop:run-program command :output :string
						:ignore-error-status t
						:error-output :string)))
    out-message))

(defun run-bash-command (command)
  "Runs the Bash command."
  (uiop:run-program command :output :string
			    :ignore-error-status t
			    :error-output :string))

(defun create-thumbnail (storage-sub-directory file-name &optional (overwrite t))
  "Runs a Bash command to convert a file to a thumbnail  in /storage/media dir.
The file is reduced to 512x512 pixels if bigger than that. A new file
is then created with a 'thumbnail-' pre-fix. This process relies on
Image Magick. So, it must be installed on the system for this function
to operate properly."
  (run-bash-command
   (format nil "convert ~a -resize 512x512\\> ~a"
	   (storage:file-exists-p "" storage-sub-directory file-name)
	   (if (eq overwrite t)
	       (storage:file-exists-p "" storage-sub-directory file-name)
	       (storage:make-path "" storage-sub-directory
				  (format nil "thumbnail-~a" file-name))))))

(defun create-timestamp-id ()
  "Creates a integer based on time the function is called, in YYYYMMDD format."
  (multiple-value-bind
	(second minute hour day month year)
      (get-decoded-time)
    (format nil "~d~2,'0d~d~2,'0d~2,'0d~2,'0d" year month day hour minute second)))

(defun create-timestamp-text ()
  "Creates a text-based timestamp (value being the time function was called)."
  (multiple-value-bind
	(second minute hour day month year)
      (get-decoded-time)
    (format nil "~d-~2,'0d-~d_~2,'0d-~2,'0d-~2,'0d" year month day hour minute second)))

(defun month-number-to-name (month-number)
  "Converts `MONTHS-NUMBER' to its name (E.G. 1 to 'January')."
  (cond ((= 1 month-number) "January")
        ((= 2 month-number) "February")
        ((= 3 month-number) "March")
        ((= 4 month-number) "April")
        ((= 5 month-number) "May")
        ((= 6 month-number) "June")
        ((= 7 month-number) "July")
        ((= 8 month-number) "August")
        ((= 9 month-number) "September")
        ((= 10 month-number) "October")
        ((= 11 month-number) "November")
        ((= 12 month-number) "December")
        (t nil)))

(defun build-url (request)
  "Concatenates parts of the web request to form the full URL the user requested."
  (format nil "~a://~a~a~a"
          (lack.request:request-uri-scheme request)
          (lack.request:request-server-name request)
          (if (string= "localhost" (lack.request:request-server-name request))
              (format nil ":~a" (lack.request:request-server-port request))
              "")
          (lack.request:request-uri request)))

(defun build-url-root (request)
  "Concatenates parts of the web request to form site's root URL.
This is mostly used for generating the site map (XML file for crawlers)."
  (format nil "~a://~a~a"
          (lack.request:request-uri-scheme request)
          (lack.request:request-server-name request)
          (if (string= "localhost" (lack.request:request-server-name request))
              (format nil ":~a" (lack.request:request-server-port request))
              "")))