#| 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 #: #: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 () ()) (defvar *web* (make-instance ')) (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: labels.pdf") (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")))