/
/twitter.lisp
  1 (in-package :twitter)
  2 
  3 ;;
  4 ;; Main API
  5 ;;
  6 
  7 (defmethod twitter-op (command &rest args)
  8   (let ((cmd (get-command command)))
  9     (multiple-value-bind (response code)
 10 	(send-command cmd args)
 11       (if (eq code 200)
 12 	  (parse-command-response response (command-return-type cmd))
 13 	  (parse-error-response response code)))))
 14 
 15 (defun send-command (command args)
 16   (multiple-value-bind (method url auth post-params)
 17       (command-request-arguments command args)
 18     (multiple-value-bind (response code)
 19 	(http-request url
 20 		      :method method
 21 		      :basic-authorization (or auth (user-http-auth *twitter-user*))
 22 		      :parameters (plist->alist post-params)
 23 		      :want-stream t
 24 		      :additional-headers *twitter-client-headers*)
 25       (values (safe-decode-json response) code))))
 26 
 27 (defun safe-decode-json (response)
 28   (handler-case 
 29       (decode-json response)
 30     (t () nil)))
 31 
 32 (defun parse-command-response (response type)
 33   (cond ((consp type)
 34 	 (mapcar (lambda (r) 
 35 		   (parse-record r (first type)))
 36 		 response))
 37 	((null type)
 38 	 nil)
 39 	(t (parse-record response type))))
 40 
 41 
 42 ;;
 43 ;; Public API for common commands
 44 ;;
 45 
 46 (defun authenticate-user (username password)
 47   (let ((user (get-user username)))
 48     (setf (twitter-user-password user) password)
 49     (handler-case (twitter-op :verify-credentials :user user)
 50       (twitter-api-condition () (return-from authenticate-user nil)))
 51     (setf *twitter-user* user)
 52     (twitter-op :user-show :id (twitter-user-screen-name user))))
 53 
 54 (defun authenticated-user ()
 55   *twitter-user*)
 56 
 57 ;;
 58 ;; Updates
 59 ;;
 60 
 61 (defun public-timeline (&rest args)
 62   (apply 'twitter-op :public-timeline args))
 63 
 64 (defun timeline (&rest args)
 65   (apply 'twitter-op :user-timeline args))
 66 
 67 (defun friends-timeline (&rest args)
 68   (print-tweets (apply 'twitter-op :friends-timeline args)))
 69 
 70 (defun send-tweet (text &rest args &key (tiny-url-p t) &allow-other-keys)
 71   (let ((newtext (if tiny-url-p (convert-to-tinyurl text) text)))
 72     (if (< (length newtext) 139)
 73 	(apply 'twitter-op :tweet-update :status newtext
 74 	       (rem-keywords args '(:tiny-url-p)))
 75 	(error "Tweet updates must be less than 140 characters"))))
 76 
 77 (defun update (text &rest args)
 78   (apply 'send-tweet text args))
 79 
 80 (defun reply-to (tweet text &rest args)
 81   (apply 'send-tweet text :in-reply-to-status-id (tweet-id tweet) args))
 82 
 83 (defun @reply-to (tweet text &rest args)
 84   (let ((fmt (format nil "@~A ~A"
 85                      (twitter-user-screen-name (tweet-user tweet))
 86 		     text)))
 87     (apply 'reply-to tweet fmt args)))
 88 
 89 ;;
 90 ;; Messages
 91 ;;
 92 
 93 (defun messages (&rest args)
 94   (apply 'twitter-op :messages-received args))
 95 
 96 (defun sent-messages (&rest args)
 97   (apply 'twitter-op :messages-sent args))
 98 
 99 (defun send-message (user message &rest args)
100   (apply 'twitter-op :message-new 
101 	 :user (aif (get-user user)
102 		    (twitter-user-id it)
103 		    user)
104 	 :text message
105 	 args))
106 
107 ;;
108 ;; Objects
109 ;;
110 
111 (defun print-tweets (tweets)
112   (mapc #'print-tweet tweets))
113 
114 ;;
115 ;; Search API
116 ;;
117 
118 (defun do-search (query &rest args)
119   (let ((result (apply 'twitter-op :search :q query args)))
120     (values (search-results result) result)))
121 
122 (defun trends (&rest args)
123   (apply 'twitter-op :trends args))
124 
125 ;;
126 ;; Tiny URL API
127 ;;
128 
129 ;;; TinyURL-ize
130 ;;; Using the very simple TinyURL API
131 
132 (defparameter *tinyurl-url* "http://tinyurl.com/api-create.php")
133 (defconstant +http-ok+ 200)
134 
135 (defun get-tinyurl (url)
136   "Get a TinyURL for the given URL. Uses the TinyURL API service.
137    (c) by Chaitanaya Gupta via cl-twit"
138   (multiple-value-bind (body status-code)
139       (http-request *tinyurl-url*
140 		    :parameters `(("url" . ,url)))
141     (if (= status-code +http-ok+)
142         body
143         (error 'http-error
144                :status-code status-code
145                :url url
146                :body body))))
147 
148 (defun convert-to-tinyurl (text)
149   (let ((result text)
150 	(regex (ppcre:create-scanner "http:[^\\s\\)\\]\\'\\\"]+")))
151     (ppcre:do-matches (start end regex result result)
152       (when (> (- end start) 24)
153 	(setf result (ppcre:regex-replace 
154 		      regex result 
155 		      (get-tinyurl (subseq result start end))))))))