|
- #|
-
- 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")))
|