servlet.clj

(ns socialmetrics.servlet
  (:refer-clojure :exclude (get send))
  (:gen-class :extends javax.servlet.http.HttpServlet)
  (:use (compojure html http)
        [hiredman.datastore :only (create update query exec)]
        [org.danlarkin.json :only (encode-to-str decode-from-str)]
        [hiredman.utilities2 :only (load-properties cron)]
        [clojure.contrib.duck-streams :only (reader writer)])
  (:import (java.util Properties Date)
           (java.util.logging Logger)
           (java.net URL URLEncoder)
           (java.text SimpleDateFormat ParsePosition FieldPosition)
           (org.apache.commons.codec.digest DigestUtils)
           (java.io OutputStreamWriter)
           (com.google.appengine.api.labs.taskqueue QueueFactory TaskOptions
						    TaskOptions$Builder)
           (com.google.appengine.api.xmpp XMPPServiceFactory JID MessageBuilder
					  MessageType)))

(def facebook (load-properties "facebook.properties"))

(cron "war/WEB-INF/cron.xml"
  [{:schedule "every 49 minutes" :url "/cron/get/feeds"
    :tz "America/Los_Angeles" :desc "get feeds"}])

(defn call-id
  "many facebook api calls require a call-id and call-ids must be in ascending
  order per session"
  []
  (.getTime (Date.)))

(def log (Logger/getLogger "social-metrics"))

(defn name|str
  "name on Named things and .toString otherwise"
  [x]
  (if (instance? clojure.lang.Named x)
    (name x)
    (.toString x)))

(defn get
  "get stuff from url, clojure.xml/parse output"
  [url]
  (let [con (.openConnection (URL. url))]
    (with-open [a (-> con .getInputStream)]
      (clojure.xml/parse a))))

(defn post
  "post stuff to url, clojure.xml/parse output"
  [url stuff]
  (let [con (doto (.openConnection (URL. url))
              (.setDoInput true)
              (.setDoOutput true))]
    (with-open [wrt (-> con .getOutputStream OutputStreamWriter.)]
      (.write wrt stuff))
    (with-open [a (-> con .getInputStream)]
      (clojure.xml/parse a))))

(defn md5 [string]
  (DigestUtils/md5Hex string))

(defn sig
  "facebook api calls require a signature (md5 hash) of the call
  and the api secret"
  [params secret]
  (md5 (.concat
	(reduce #(format "%s%s=%s" %1 (name|str (first %2)) (second %2))
		""
		(sort-by key params))
	secret)))

(defn fb-error? [response]
  (= :error_response (:tag response)))

(defn call
  "takes a map representing a facebook api call and makes the call"
  [bag secret]
  (try
   (doto
       (post "http://api.facebook.com/restserver.php"
	     (doto (format "%s&sig=%s"
			   (reduce
			    #(format "%s%s=%s&"
				     %1 (name|str (first %2))
				     (URLEncoder/encode (str (second %2))))
			    ""
			    bag)
			   (sig bag secret))
	       (#(.info log %))))
     (#(when (fb-error? %)
	 (.info log (str (:method bag)
			 " :: " (with-out-str (clojure.xml/emit %)))))))
   (catch Exception e
     nil)))

(defn FBstring->date
  [string]
  (.parse (SimpleDateFormat. "MM/dd/yyyy")
          string
          (ParsePosition. 0)))

(defn string->date
  [string]
  (.parse (SimpleDateFormat. "EEE, d MMM yyyy HH:mm:ss Z")
          string
          (ParsePosition. 0)))

(defn date->age [date]
  (let [cy (.getYear (Date.))
        oy (.getYear date)]
    (- cy oy)))

(defn select-birthday_date [foo]
  (-> foo :content
      ((partial filter #(= :birthday_date (:tag %))))
      first
      :content
      first
      ((fn [x]
	 (when x (when-let [t (FBstring->date x)] (date->age t)))))))

(defn chart [map’]
  (format "http://chart.apis.google.com/chart?chtt=%s&cht=bvg&chd=t:%s&chs=900x250&chl=%s"
          "Your friends' ages:"
          (reduce #(format "%s,%s" %1 %2) (vals map’))
          (reduce
	   #(format "%s|%s" (or %1 "unknown") (or %2 "unknown")) (keys map’))))

(defn agegraph [request]
  (let [session (-> request :params :fb_sig_session_key) ;facebook passes me a session key
        friends (-> request :params :fb_sig_friends) ; and a list of friends
        foo (call {:api_key (facebook "api.key") ;get the birthday_date profile field from all the friends
                   :method "Users.getInfo"
                   :call_id (call-id)
                   :v "1.0"
                   :uids friends
                   :fields "birthday_date"
                   :session_key session}
                  (facebook "api.secret"))
        foo (-> foo :content
		((partial map select-birthday_date))
		((partial map #(array-map %1 1)))
		((partial apply (partial merge-with +)))
		((partial into (sorted-map)))
		chart)]
    (format
     "
    <fb:if-is-app-user>
    <img style=\"width:750px;\" src=\"%s\" />
    <fb:else>
    <fb:redirect url=\"http://www.facebook.com/login.php?v=1.0&api_key=%s&next=%s&canvas=\"/></fb:else>
    </fb:if-is-app-user>
    "
     foo
     (facebook "api.key")
     "http://apps.facebook.com/agegraph/")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def bb (load-properties "book-binding.properties"))

(defn item->book [x]
  {:title (-> x 
	      ((partial (comp first filter) #(= :title (:tag %))))
	      :content first)
   :link (-> x
	     ((partial (comp first filter) #(= :link (:tag %))))
	     :content first)
   :image (-> x
	      ((partial (comp first filter) #(= :description (:tag %))))
	      :content first ((partial apply str))
	      (.replaceAll "<img src=\"(.*)\" .*" "$1"))
   :description (-> x
		    ((partial (comp first filter) #(= :description (:tag %))))
		    :content first ((partial apply str))
		    (.replaceAll "<img src=\"(.*)\"[^>]+>" ""))
   :pub-date (-> x
		 ((partial (comp first filter) #(= :pubDate (:tag %))))
		 :content first string->date)})

(defn books [xml]
  (-> xml :content
      ((partial filter #(= :channel (:tag %))))
      first :content
      ((partial filter #(= :item (:tag %))))
      ((partial map :content))
      ((partial map item->book))))

(defn send [jid message xmpp]
  (-> (MessageBuilder.)
      (.withRecipientJids (into-array [(JID. jid)]))
      (.withBody message)
      .build
      (#(.sendMessage xmpp %))))

(declare book->facebook)

(defn xmpp-service []
  (XMPPServiceFactory/getXMPPService))

(defn queue []
  (QueueFactory/getDefaultQueue))

(defn get-feeds [request]
  (.info log "get-feeds")
  (let [sb (StringBuilder.)]
    (doseq [f (exec (query :feed))]
      (let [xmpp (XMPPServiceFactory/getXMPPService)
            queue (QueueFactory/getDefaultQueue)
            p (-> f :url get books
		  ((partial filter
			    #(.before (or (:atime f) (Date.)) (:pub-date %))))
		  ((partial map (fn [x] (.append sb (pr-str x)) x)))
		  ((partial sort-by :atime))
		  reverse)]
	(.info log "get-feeds 1")
	(.info log (str (count p)))
	#_(.info log (pr-str (-> p last (:pub-date (:atime f)))))
        (doseq [bk p]
          (.add queue
		(-> (TaskOptions$Builder/url "/queue/feeds/post/story")
		    (.param "body"
			    (encode-to-str
			     (assoc (dissoc bk :pub-date) :uid (:uid f)))))))
        (update
	 (assoc f :atime
		(-> p last (:pub-date (or (:atime f) (Date.))))))))
    (.replaceAll (.toString sb)
                 "<"
                 "&lt;")))

(defn feeds-post-story [request]
  (book->facebook
   (-> request :params :body decode-from-str)
   (bb "api.secret"))
  (html
   [:html
    [:head
     [:title "FOO"]]
    [:body
     [:h1 "FOO"]]])) 

(defmulti feeds-canvas-index (comp type :lib_user :params))

(defmethod feeds-canvas-index nil [request]
  (let [session (-> request :params :fb_sig_session_key)]
    (format
     "
      <fb:if-is-app-user>
        <form promptpermission=\"publish_stream, offline_access\">
          What is your library thing username? (You will be prompted for stream_publish permissions)
          <br/>
          <input type=\"text\" name=\"lib_user\" />
          <input type=\"submit\" value=\"submit\" />
        </form>
      <fb:else>
        <fb:redirect url=\"http://www.facebook.com/login.php?v=1.0&api_key=%s&next=%s&canvas=\"/></fb:else>
      </fb:if-is-app-user>
      "
     (bb "api.key")
     (format "http://apps.facebook.com/%s/" (bb "application.name")))))

(defn fb-name [uid key secret]
  (-> (call {:method "Users.getInfo"
             :api_key key
             :call_id (call-id)
             :v "1.0"
             :uids (str uid)
             :fields "name"}
            secret)
      :content first :content
      ((partial (comp first filter) #(= :name (:tag %))))
      :content first))

(defn fb-gender [uid key secret]
  (-> (call {:method "Users.getInfo"
             :api_key key
             :call_id (call-id)
             :v "1.0"
             :uids (str uid)
             :fields "sex"}
            secret)
      pr-str
      (.replaceAll "<" "&lt;")))

(defn book->facebook [{:keys [uid title link description image]} secret]
  (try
   (call {:method "Stream.publish"
	  :call_id (call-id)
	  :message (format "has added a book to LibraryThing")
	  :api_key (bb "api.key")
	  :action_links (encode-to-str
			 [{:text "LibraryThing"
			   :href "http://www.librarything.com/"}])
	  :attachment (encode-to-str
		       {:name title
			:href link
			:description description
			:media [{:type "image"
				 :src image
				 :href link}]})
	  :uid uid}
	 secret)
   (catch Exception e nil))
  " ")

(defmethod feeds-canvas-index String [request]
  (create :feed
	  {:url (-> request :params :lib_user
		    ((partial
		      format "http://www.librarything.com/rss/recent/%s")))
           :uid (-> request :params :fb_sig_user Long/parseLong)})
  "Done!")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn sms [request]
  (send (format "1%s@sms.talk.google.com" (-> request :params :number))
        (-> request :params :message)
        (xmpp-service)))

(defn sms-test [request]
  (.add (queue)
        (-> (TaskOptions$Builder/url "/queue/sms")
	    (.param "number" "2064198032")
	    (.param "message" "this is a test")))
  "Foo")

(defn blarg [request]
  (.info log (pr-str request))
  "")

#_(load-file "/home/kpd/odds-and-ends/newegg.clj")

(defroutes socialmetrics
  (ANY "/feeds/canvas/index" #(feeds-canvas-index %))
  #_(GET "/sms/test" sms-test)
  ;; Cron
  (GET "/cron/get/feeds" get-feeds)
  ;; Taskqueues
  (POST "/queue/feeds/post/story" feeds-post-story)
  (POST "/queue/sms" sms)
  ;;
  (ANY "/agegraph" agegraph)
  (POST "/foo" blarg)
  (ANY "/*" agegraph))

(defservice socialmetrics)