coleslaw/plugins/twitter.lisp

plugins/twitter.lisp (3275 bytes)
1 (:eval-when (:compile-toplevel :load-toplevel)
2   (ql:quickload :chirp))
3 
4 (defpackage :coleslaw-twitter
5   (:use :cl)
6   (:import-from :coleslaw #:*config*
7                           #:deploy
8                           #:get-updated-files
9                           #:find-content-by-path
10                           #:title-of
11                           #:author-of
12                           #:page-url
13                           #:plugin-conf-error)
14   (:export #:enable))
15 
16 (in-package :coleslaw-twitter)
17 
18 (defvar *tweet-format* '(:title "by" :author)
19   "Controls what the tweet annoucing the post looks like.")
20 
21 (defvar *tweet-format-fn* nil "Function that expects an instance of
22 coleslaw:post and returns the tweet content.")
23 
24 (defvar *tweet-format-dsl-mapping*
25   '((:title  title-of)
26     (:author author-of)))
27 
28 (define-condition malformed-tweet-format (error)
29   ((item :initarg :item :reader item))
30   (:report
31    (lambda (condition stream)
32      (format stream "Malformed tweet format. Can't proccess: ~A"
33              (item condition)))))
34 
35 (defun compile-tweet-format (tweet-format)
36   (flet ((accessor-for (x)
37            (rest (assoc x *tweet-format-dsl-mapping*))))
38     (lambda (post)
39       (apply #'format nil "~{~A~^ ~}"
40              (loop for item in *tweet-format*
41                 unless (or (keywordp item) (stringp item))
42                   (error 'malformed-tweet-format :item item)
43                 when (keywordp item)
44                   collect (funcall (accessor-for item) post)
45                 when (stringp item)
46                   collect item)))))
47 
48 (defun enable (&key api-key api-secret access-token access-secret tweet-format)
49   (if (and api-key api-secret access-token access-secret)
50       (setf chirp:*oauth-api-key* api-key
51             chirp:*oauth-api-secret* api-secret
52             chirp:*oauth-access-token* access-token
53             chirp:*oauth-access-secret* access-secret)
54       (error 'plugin-conf-error :plugin "twitter"
55              :message "Credentials missing."))
56 
57   ;; fallback to chirp for credential erros
58   (chirp:account/verify-credentials)
59   (when tweet-format
60     (setf *tweet-format* tweet-format))
61   (setf *tweet-format-fn* (compile-tweet-format *tweet-format*)))
62 
63 (defmethod deploy :after (staging)
64   (declare (ignore staging))
65   (loop :for (state file) :in (get-updated-files)
66      :when (and (string= "A" state) (string= "post" (pathname-type file)))
67      :do (tweet-new-post file)))
68 
69 (defun tweet-new-post (file)
70   "Retrieve content matching FILE from in memory DB and publish it."
71   (let ((post (find-content-by-path file)))
72     (chirp:statuses/update (%format-post 0 post))))
73 
74 (defun %format-post (offset post)
75   "Guarantee that the tweet content is 140 chars at most. The 117 comes from
76 the spaxe needed for a space and the url."
77   (let* ((content-prefix (subseq (render-tweet post) 0 (- 117 offset)))
78          (content (format nil "~A ~A/~A" content-prefix
79                           (coleslaw::domain *config*)
80                           (page-url post)))
81          (content-length (chirp:compute-status-length content)))
82     (cond
83       ((>= 140 content-length) content)
84       ((< 140 content-length) (%format-post (1- offset) post)))))
85 
86 (defun render-tweet (post)
87   "Sans the url, which is a must."
88   (funcall *tweet-format-fn* post))