Flexible Lisp Blogware. Fork for personal use. Mirrored from https://github.com/kingcons/coleslaw originally.

twitter.lisp 2.4KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  1. (:eval-when (:compile-toplevel :load-toplevel)
  2. (ql:quickload :chirp))
  3. (defpackage :coleslaw-twitter
  4. (:use :cl)
  5. (:import-from :coleslaw
  6. :*config*
  7. :deploy
  8. :get-updated-files
  9. :page-url
  10. :plugin-conf-error)
  11. (:export #:enable))
  12. (in-package :coleslaw-twitter)
  13. (defvar *tweet-format* '("~A by ~A" coleslaw::post-title coleslaw::post-author)
  14. "Controls what the tweet annoucing the post looks like. It contains a format
  15. control string followed with the accesors to evaluate for post.")
  16. (defun enable (&key api-key api-secret access-token access-secret tweet-format)
  17. (if (and api-key api-secret access-token access-secret)
  18. (setf chirp:*oauth-api-key* api-key
  19. chirp:*oauth-api-secret* api-secret
  20. chirp:*oauth-access-token* access-token
  21. chirp:*oauth-access-secret* access-secret)
  22. (error 'plugin-conf-error :plugin "twitter"
  23. :message "Credentials missing.")
  24. ;; fallback to chirp for credential erros
  25. (chirp:account/verify-credentials))
  26. (when tweet-format
  27. (setf *tweet-format* tweet-format)))
  28. (defmethod deploy :after (staging)
  29. (declare (ignore staging))
  30. (loop :for (state file) :in (get-updated-files)
  31. :when (and (string= "A" state) (string= "post" (pathname-type file)))
  32. :do (tweet-new-post file)))
  33. (defun tweet-new-post (file)
  34. "Retrieve most recent post from in memory DB and publish it."
  35. (let ((post (coleslaw::find-content-by-path file)))
  36. (chirp:statuses/update (%format-post 0 post))))
  37. (defun %format-post (offset post)
  38. "Guarantee that the tweet content is 140 chars at most. The 117 comes from
  39. the spaxe needed for a space and the url."
  40. (let* ((content-prefix (subseq (render-tweet post) 0 (- 117 offset)))
  41. (content (format nil "~A ~A/~A" content-prefix
  42. (coleslaw::domain *config*)
  43. (page-url post)))
  44. (content-length (chirp:compute-status-length content)))
  45. (cond
  46. ((>= 140 content-length) content)
  47. ((< 140 content-length) (%format-post (1- offset) post)))))
  48. (defun render-tweet (post)
  49. "Sans the url, which is a must."
  50. (apply #'format `(nil ,(car *tweet-format*)
  51. ,@(loop
  52. :for accesor in (cdr *tweet-format*)
  53. :collect (funcall accesor post)))))