twitter-filter.lisp

   1 ;; Twitter Filter: A simple filter for custom twitter searches
   2 ;; Copyright (C) 2012 Panagiotis Koutsourakis
   3
   4 ;; This program is free software: you can redistribute it and/or modify
   5 ;; it under the terms of the GNU General Public License as published by
   6 ;; the Free Software Foundation, either version 3 of the License, or
   7 ;; (at your option) any later version.
   8
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 (ql:quickload "drakma")
  18 (ql:quickload "cl-json")
  19
  20 (defpackage :twitter-filter
  21   (:use :cl :drakma :json)
  22   (:export :parse-query
  23            :get-tweet-element
  24            :get-tweet-element-list
  25            :add-user-to-white-list
  26            :add-user-to-black-list
  27            :set-white-list-mode
  28            :set-black-list-mode
  29            :apply-lists))
  30
  31 (in-package :twitter-filter)
  32
  33
  34
  35 (defvar *search-url* "http://search.twitter.com/search.json?q="
  36   "The twitter search API URL")
  37
  38 (defun convert-response-to-string (resp)
  39   "The server response is an array of integers. This function converts
  40 it to a string."
  41   (coerce (mapcar #'code-char (coerce resp 'list)) 'string))
  42
  43 ;; TODO: Complete for more characters
  44 (defun percent-encode (str)
  45   "Make the string percent encoded in order to be compatible with
  46 URLs."
  47   (labels ((percent-encode-char-list (char-list)
  48              (let ((curr (car char-list))
  49                    (rest (cdr char-list)))
  50                (cond
  51                  ((null rest) (cons curr nil))
  52                  ((eq curr #\#)
  53                       (append '(#\% #\2 #\3) (percent-encode-char-list rest)))
  54                  (t (cons curr (percent-encode-char-list rest)))))))
  55     (coerce (percent-encode-char-list (coerce str 'list)) 'string)))
  56
  57 (defun make-query (search-term)
  58   "Make the actual search query to the twitter API."
  59   (http-request (concatenate 'string *search-url* (percent-encode search-term))))
  60
  61 (defun get-tweet-element (element tweet)
  62   "Get an element of a single tweet."
  63   (cdr (assoc element tweet)))
  64
  65 (defun get-tweet-element-list (element lisp-tweets)
  66   "Make a list with one element from each tweet from lisp-tweets."
  67   (mapcar (lambda (tweet) (get-tweet-element element tweet)) lisp-tweets))
  68
  69 (defvar *cache* nil
  70   "The tweets we already have gotten from the server.")
  71 (defvar *cache-valid* nil
  72   "Shows if the cache is valid or needs update.")
  73 (defvar *cache-update-time* 0
  74   "Last time we got tweets from the server.")
  75 ;;; +cache-update-intervar+ depends on the Twitter rate limit. Once a
  76 ;;; minute is a good place to start. I should check the streaming API
  77 ;;; as well that is not rate limited
  78 (defconstant +cache-update-interval+ 60
  79   "How long should we wait between two cache updates.")
  80
  81 (defun invalidate-cache (last-update)
  82   "Check if the time for a cache update has come."
  83   (let* ((ctime (sb-ext:get-time-of-day))
  84          (diff  (- ctime last-update)))
  85     (if (> diff +cache-update-interval+)
  86         (setf *cache-valid* nil))))
  87
  88 (defun drop-old-tweets (new old)
  89   "The new tweets coming from the server might contain some of the
  90 tweets we have already shown. Find the set of the new tweets."
  91   (let* ((old-ids (get-tweet-element-list :id--str old))
  92          (new-cache
  93            (remove-if (lambda (x)
  94                         (member (get-tweet-element :id--str x) old-ids :test #'equal))
  95                       new)))
  96     (if new-cache
  97         new-cache
  98         *cache*)))
  99
 100 (defun update-cache (search-term)
 101   "Update the cache and its update time"
 102   (let ((server-resp (parse-query search-term)))
 103     (setf *cache* (drop-old-tweets server-resp *cache*))
 104     (setf *cache-valid* t)
 105     (setf *cache-update-time* (sb-ext:get-time-of-day)))
 106   *cache*)
 107
 108 (defun get-tweets (search-term)
 109   "Return the tweets either from the cache if it's valid or update it"
 110   (invalidate-cache *cache-update-time*)
 111   (if *cache-valid*
 112       *cache*
 113       (update-cache search-term)))
 114
 115 (defun parse-query (search-term)
 116   "Convert the response to Lisp objects using cl-json library."
 117   (with-input-from-string
 118       (s (convert-response-to-string (make-query search-term)))
 119     (cdr (assoc :results (decode-json s)))))
 120
 121 (defvar *white-list-mode* nil
 122   "A boolean variable that shows if we are applying the white list.")
 123 (defvar *black-list-mode* nil
 124   "A boolean variable that shows if we are applying the black list.")
 125
 126 (defvar *white-list* nil
 127   "A list of users whose tweets will be shown.")
 128 (defvar *black-list* nil
 129   "A list of users whose tweets will never be shown.")
 130
 131 (defmacro create-filter (name mode-var filt selector)
 132   `(defun ,name (tweet-list)
 133      (if ,mode-var
 134          (,selector (lambda (x)
 135                       (member (get-tweet-element :from--user x)
 136                               ,filt :test #'equal))
 137                     tweet-list)
 138          tweet-list)))
 139
 140 (create-filter filter-black-list *black-list-mode* *black-list* remove-if)
 141 (create-filter filter-white-list *white-list-mode* *white-list* remove-if-not)
 142
 143
 144 (defun apply-lists (lisp-tweets)
 145   "Apply the functions white-list and black-list"
 146   (filter-black-list (filter-white-list lisp-tweets)))
 147
 148 (defmacro make-add-functs (name lst)
 149   "A simple macro to create functions to add users to the white or the
 150 black list."
 151   `(defun ,name (user)
 152      (push user ,lst)))
 153
 154 (defmacro make-set-functs (name mode-var)
 155   "A simple macro to create functions to change the mode of the white
 156 and the black lists."
 157   `(defun ,name (mode)
 158      (setf ,mode-var mode)))
 159
 160 (make-add-functs add-user-to-white-list *white-list*)
 161 (make-add-functs add-user-to-black-list *black-list*)
 162
 163 (make-set-functs set-white-list-mode *white-list-mode*)
 164 (make-set-functs set-black-list-mode *black-list-mode*)
 165
 166 ;;; Experimental stuff. Could be useful for the presentation.
 167 ;Not strictly necessary... Just a reminder.
 168 (defun convert-tweets-to-json (lisp-tweets)
 169   (encode-json lisp-tweets))
 170
 171 (defvar *twitter-base* "http://www.twitter.com/#!/")
 172
 173 (defun tweet-to-html (tweet)
 174   (concatenate 'string *twitter-base*
 175                (get-tweet-element tweet :from--user)
 176                "/status/"
 177                (get-tweet-element tweet :id--str)))