cl-deck-builder2/src/web/label-maker.lisp

#|

src/web/label-maker.lisp

Label Maker Front-End

https://www.uline.com/product/detail/s-20247/store-fixtures/price-tag-insert-cards-1-1-4-x-2

Supports arbitrary number of labels.
Currently tested with LABELS-LENGTH set to 32 (ULINE S-20247) or 30 (Avery 5160).

We generate a LaTeX file then use PDFLaTeX to produce a pdf in
GENERATE-LABELS-FOR-ATTACHMENT-ID.

The barcodes are generated by ZXingWriter.

TODO A lot of functionality that resides in the web interface needs to be moved to the model interface:
- public-relative-pathname
- generate-labels
- generate-labels-for-attachment
- generate-labels-for-attachment-id
- *current-label-class*

|#

(in-package #:cl-user)

(defpackage #:cl-deck-builder2.web.label-maker
  (:use #:cl
        #:cl-deck-builder2.models.label-maker)
  (:import-from #:caveman2
                #:<app>
                #:defroute
                #:redirect
                #:clear-routing-rules)
  (:import-from #:cl-deck-builder2.i18n
                #:_)
  (:import-from #:cl-deck-builder2.toolkit
                #:query-param
                #:random-pathname-name)
  (:import-from #:cl-deck-builder2.web
                #:flash-error
                #:flash-message
                #:render-with-env
                #:render-markdown-file)
  (:import-from #:cl-deck-builder2.web.query
                #:select-attachment-by-id)
  (:import-from #:cl-deck-builder2.models.attachment
                #:attachment-valid-p
                #:create-attachment)
  (:import-from #:cl-deck-builder2.config
                #:*public-directory*
                #:*static-directory*
                #:*template-directory*)
  (:local-nicknames (#:v #:org.shirakumo.verbose))
  (:export #:*web*))

(in-package #:cl-deck-builder2.web.label-maker)

(defclass <web> (<app>) ())
(defvar *web* (make-instance '<web>))
(clear-routing-rules *web*)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *base-pathspec* #P"/tmp/labels/")

(defparameter *current-label-class* 'latex-label-uline-s-20247
  "The most recently used class for making labels.

The idea was you could select the types of labels from a select box on the Label Maker page.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun public-relative-pathname (pathspec)
  "PROBE-FILE on PATHSPEC in *PUBLIC-DIRECTORY*.

TODO I think this is duplicate code from TOOLKIT.PATHS."
  (probe-file
   (merge-pathnames
    pathspec
    cl-deck-builder2.config:*public-directory*)))

;; TODO All of this needs to be rewritten in some kind of pipeline form.
(defun generate-labels (output &key (class 'latex-label-uline-s-20247) csv pdf tex)
  "Create output with RENDER-PAGE."
  (ensure-directories-exist *base-pathspec*)
  (let ((page (make-instance class :csv csv)))
    (with-open-file (s tex
                       :if-exists :supersede
                       :direction :output)
      (format s "~a" (render-page page))))

  (uiop:delete-file-if-exists (probe-file #P"~/public/labels.pdf"))
  (if (inferior-shell:run
       `(and
         (cd "/tmp/labels/")
         (pdflatex ,tex)
         (mv ,pdf ,output)))
      output))

;; TODO ENOUGH-PATHNAME
;; TODO rewrite this using defclass like we did for CARDINFO
(defun generate-labels-for-attachment (path file-key)
  (generate-labels (make-pathname :name file-key
                                  :type "pdf"
                                  :directory (namestring *public-directory*))
                   :class *current-label-class*
                   :csv path
                   :tex #P"/tmp/labels/labels.tex"
                   :pdf #P"/tmp/labels/labels.pdf"))

(defun generate-labels-for-attachment-id (id)
  (let ((found (select-attachment-by-id id)))
    (when found
      (generate-labels-for-attachment
       (public-relative-pathname
        (;; Trim leading "/"
         subseq
         (namestring (mito-attachment:file-url found)) 1))
       (pathname-name
        (mito-attachment:file-key found))))))

(defun label-maker-process-files (files)
  "Process FILES with ATTACHMENT-VALID-P, CREATE-ATTACHMENT, then GENERATE-LABELS-FOR-ATTACHMENT-ID."
  (dolist (file files)
    (if (attachment-valid-p file)
        (destructuring-bind (content filename content-type)
            file

          (setf filename (random-pathname-name :type (pathname-type filename)))

          (let ((success (create-attachment content filename content-type)))
            (if success
                (progn
                  ;; Create ATTACHMENT was successful
                  (generate-labels-for-attachment-id (mito:object-id success))
                  (flash-message (format nil (_ "Success! Download link: <a href=\"/public/~a.pdf\">labels.pdf</a>")
                                           (pathname-name
                                            (mito-attachment:file-key success)))))
                (flash-error (_ "Something went wrong. Try again?")))))
        (flash-error (_ "Invalid upload.")))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroute ("/" :method :GET) ()
  "Label Maker Main Route."
  (render-with-env #P"label-maker.html"
                   `(:active "/label-maker")))

(defroute ("/instructions" :method :GET) ()
  "Display Label Maker Instructions using RENDER-MARKDOWN-FILE."
  (render-markdown-file
   (asdf:system-relative-pathname :cl-deck-builder2 "doc/label-maker.md")))

(defroute ("/" :method :POST) (&key _parsed)
  "Label Maker POST route.

TODO Parameters: FILES A list of CSV files to process. CLASS the class of label you wish to generate. May be one of LATEX-LABEL-ULINE-S-20247 or LATEX-LABEL-AVERY-5160."
  (v:info :label-maker "POST /label-maker => ~a" _parsed)

  (let ((files (query-param "files" _parsed))
        (class (query-param "class" _parsed)))

    ;; Check the CLASS parameter
    (setf *current-label-class*
          (find-class
           (cond ((string= class "latex-label-uline-s-20247") 'latex-label-uline-s-20247)
                 (t 'latex-label-avery-5160))))

    (if files
        (label-maker-process-files files)
        (flash-error (_ "No files.")))
    (redirect "/label-maker")))