Compare commits

..

6 commits

Author SHA1 Message Date
a1989a66eb Fix warnings, mainly about missing docstrings 2023-12-07 23:34:18 -08:00
4350856f99 Fix setting up comments 2023-12-07 23:27:21 -08:00
087165a993 Show error if STATUS isn't one of the accepted values 2023-12-07 22:31:54 -08:00
cf761c40a5 Extract data parsing into separate function 2023-12-07 22:21:50 -08:00
8bd0ba25e4 Make sure that ‘tekuti-host’ doesn't end in a ‘/’
Tekuti gets real confused when a request is sent to
https://tekuti.example.com//admin/new-post claiming that the host field is
missing. From my logs:

    Throw to key `uri-error' with args `("Expected path not starting with
    \"//\" (no host): ~a" ("//admin/new-post"))'.
2023-12-07 22:06:26 -08:00
0f663fabc6 Display a different message for an update rather than create 2023-12-07 21:59:45 -08:00

View file

@ -32,7 +32,7 @@
;; #+TITLE: SOME TITLE
;; #+DATE: <2021-06-03 Thu 22:45>
;; #+TAGS: comma,separated
;; #+COMMENT_STATUS: open
;; #+COMMENTS: on
;; #+COMMENTS_DATE:
;; #+STATUS: publish
@ -43,7 +43,11 @@
(require 'org)
(defvar tekuti-host "http://127.0.0.1:8080")
(defvar tekuti-host "http://127.0.0.1:8080"
"The host where tekuti is running.
This should be the base URL of your blog. Where adding /admin
will get you into the admin area of your blog. This shouldn't end
with a /.")
(defun tekuti--format-date (&optional date)
"Format DATE into a date that tekuti understands."
@ -52,48 +56,73 @@
(date-to-time date))
t))
(defun tekuti--parse-data-keyword (pair)
"Ensure that both the key and value in PAIR match what tekuti needs."
(pcase pair
(`("DATE" ,date)
(list "DATE" (tekuti--format-date date)))
(`("COMMENTS_DATE" ,date)
(list "COMMENTS-CLOSED-DATE"
(and (not (string-empty-p date))
(tekuti--format-date date))))
(`("STATUS" ,status)
(let ((accepted-values '("publish" "draft" "private")))
(if (member status accepted-values)
pair
(error "Unknown post status: %s; Accepted values are: %s"
status accepted-values))))
(`("COMMENTS" ,status)
(if (string= status "on")
pair
(error "Unknown value for comments: %s; Can only be on or absent"
status)))
(_ pair)))
(defun tekuti-build-data-from-org ()
"Parse the current org buffer to collect the necessary metadata."
(let ((defaults `(("TITLE")
("DATE" ,(tekuti--format-date))
("TAGS")
("STATUS")
("COMMENT_STATUS")
("COMMENTS")
("COMMENTS-CLOSED-DATE")
("BODY")))
(data (append
(mapcar
(lambda (pair)
(pcase pair
(`("DATE" ,date)
(list "DATE" (tekuti--format-date date)))
(`("COMMENTS_DATE" ,date)
(list "COMMENTS-CLOSED-DATE"
(and (not (string-empty-p date))
(tekuti--format-date date))))
(_ pair)))
(org-collect-keywords '("TITLE" "TAGS" "STATUS" "COMMENT_STATUS" "DATE" "COMMENTS_DATE")))
#'tekuti--parse-data-keyword
(org-collect-keywords '("TITLE" "TAGS" "STATUS" "COMMENTS" "DATE" "COMMENTS_DATE")))
(list
(list "BODY"
(with-current-buffer (org-html-export-as-html nil nil nil t)
(buffer-substring-no-properties (point-min) (point-max))))))))
(mapcar (lambda (item)
(let ((key (car item)))
`(,key ,@(or (alist-get key data nil nil #'string=)
(cdr item)))))
defaults)))
(seq-remove
(lambda (pair) (and (string= "COMMENTS" (car pair))
(null (cdr pair))))
(mapcar (lambda (item)
(let ((key (car item)))
`(,key ,@(or (alist-get key data nil nil #'string=)
(cdr item)))))
defaults))))
(defun tekuti-form-encode-pair (key value)
"Make sure KEY and VALUE are properly form-encoded."
(concat (url-hexify-string key) "=" (url-hexify-string value)))
(defun tekuti-form-encode-data (data)
"Convert DATA from an alist to a form-encoded string."
(mapconcat
(lambda (pair)
(tekuti-form-encode-pair (downcase (car pair)) (cadr pair)))
data
"&"))
(defun tekuti--send-finished (status buffer args)
(defun tekuti--send-finished (status buffer args updatep)
"Callback for when the request to tekuti finishes.
STATUS is the full data structure sent on by url-retrieve.
BUFFER is the buffer that was published. ARGS is a list
containing the data that was collected from the buffer to make
the request. UPDATEP is a boolean indicating whether a post was
updated or created."
(pcase-exhaustive status
(`(:redirect ,url . ,_)
(save-excursion
@ -101,7 +130,7 @@
(goto-char (point-min))
(search-forward "\n\n")
(backward-char)
(let ((data (org-collect-keywords '("TITLE" "TAGS" "STATUS" "COMMENT_STATUS" "DATE" "COMMENTS_DATE"))))
(let ((data (org-collect-keywords '("TITLE" "TAGS" "STATUS" "COMMENTS" "DATE" "COMMENTS_DATE"))))
(mapc (lambda (item)
(let ((key (car item))
(value (cadr item)))
@ -117,28 +146,34 @@
(car (url-path-and-query
(url-generic-parse-url url))))
"\n"))))
(message "Created new post: %s" url))
(message "%s post: %s" (if updatep "Updated" "Created new") url))
(`(:error (error http ,code) . ,_)
(message "Failed to create post: %d" code))))
(message "Failed to %s post: %d" (if updatep "update" "create") code))))
(defun tekuti--get-update-url ()
"Try and get the value of the UPDATE_URL property in the current buffer."
(save-excursion
(goto-char (point-min))
(car (map-elt (org-collect-keywords '("UPDATE_URL")) "UPDATE_URL"))))
;;;###autoload
(defun tekuti-send ()
"Export and send the current buffer to tekuti.
The current buffer should be an org-mode buffer that you wish
to post to your tekuti blog."
(interactive)
(let* ((data (tekuti-build-data-from-org))
(url-request-method "POST")
(url-request-extra-headers
`(("Content-Type" . "application/x-www-form-urlencoded")))
(url-request-data (tekuti-form-encode-data data)))
(url-retrieve (format "%s%s" tekuti-host
(or (tekuti--get-update-url)
(url-request-data (tekuti-form-encode-data data))
(previous-update-url (tekuti--get-update-url))
(updatep (not (null previous-update-url))))
(url-retrieve (format "%s%s" (string-trim-right tekuti-host "/")
(or previous-update-url
"/admin/new-post"))
#'tekuti--send-finished
(list (current-buffer) data))))
(list (current-buffer) data updatep))))
(provide 'tekuti)
;;; tekuti.el ends here