[bknr-cvs] hans changed trunk/projects/planetwit/

[BKNR Commits]

Revision: 4432
Author: hans
URL: http://bknr.net/trac/changeset/4432

add clojure sources
A   trunk/projects/planetwit/http-client.clj
A   trunk/projects/planetwit/load.clj
A   trunk/projects/planetwit/planetwit.clj

Added: trunk/projects/planetwit/http-client.clj
===================================================================
--- trunk/projects/planetwit/http-client.clj	                        (rev 0)
+++ trunk/projects/planetwit/http-client.clj	2009-07-06 11:18:51 UTC (rev 4432)
@@ -0,0 +1,35 @@
+;; Clojure interface to the xlightweb HTTP client/server library
+;;
+;; Copyright 2008 Hans Huebner
+;; All rights reserved
+
+(ns http
+  (:import (org.apache.commons.codec.binary Base64)
+           (org.xlightweb.client HttpClient)
+           (org.xlightweb HttpRequest)))
+
+(def method-string-map {:get "GET"
+                        :post "POST"})
+
+(defn method-string [keyword]
+  (or (method-string-map keyword)
+      (throw (Error. (format "Invalid request method %s" keyword)))))
+
+(defn make-request [url method content-type content]
+  (if (and content-type content)
+    (HttpRequest. (method-string method) url content-type content)
+    (HttpRequest. (method-string method) url)))
+
+(defn simple-http-request
+  [url attributes]
+  (let [{:keys [method content-type content client basic-authorization], :or {method :get}} attributes
+        client (or client (HttpClient.))
+        request (make-request url method content-type content)]
+    (when basic-authorization
+      (. request (addHeader "Authorization"
+                            (format "Basic %s"
+                                    (String. (. (Base64.) (encode (. basic-authorization getBytes))))))))
+    (let [response (. client call request)]
+      {:status (. response getStatus)
+       :content-type (. response getContentType)
+       :body (. (. response getBlockingBody) readString)})))
\ No newline at end of file

Added: trunk/projects/planetwit/load.clj
===================================================================
--- trunk/projects/planetwit/load.clj	                        (rev 0)
+++ trunk/projects/planetwit/load.clj	2009-07-06 11:18:51 UTC (rev 4432)
@@ -0,0 +1,8 @@
+(load-file "http-client.clj")
+(load-file "planetwit.clj")
+(loop []
+  (println "polling")
+  (planetwit/poll)
+  (println "sleeping")
+  (. java.lang.Thread (sleep 300000))
+  (recur))

Added: trunk/projects/planetwit/planetwit.clj
===================================================================
--- trunk/projects/planetwit/planetwit.clj	                        (rev 0)
+++ trunk/projects/planetwit/planetwit.clj	2009-07-06 11:18:51 UTC (rev 4432)
@@ -0,0 +1,67 @@
+(ns planetwit
+  (:require [clojure.zip :as zip]
+            [clojure.xml :as xml])
+  (:use clojure.contrib.duck-streams
+        clojure.contrib.zip-filter.xml))
+
+(def +state-file+ "/home/hans/clojure/planetwit/planetwit.dat")
+(def +twitter-url+ "http://twitter.com/statuses/update.xml")
+(def +twitter-auth-file+ "/home/hans/clojure/planetwit/planetwit-auth.dat")
+
+(defn read-file [file-name & defaults]
+  (try
+   (with-in-str (slurp file-name)
+     (read))
+   (catch java.io.FileNotFoundException e
+     (if (pos? (count defaults))
+       (first defaults)
+       (throw (java.io.FileNotFoundException. (format "File %s not found" file-name)))))))
+
+(defn write-file [data file-name]
+  (spit file-name (with-out-str (pr data))))
+
+(defn load-data []
+  (read-file +state-file+ #{}))
+
+(defn save-data [data]
+  (write-file data +state-file+))
+
+(defn feed-to-zip [url]
+  (zip/xml-zip (xml/parse url)))
+
+(defn update-twitter-status [auth-file status]
+  (http/simple-http-request +twitter-url+
+                            {:method :post
+                             :basic-authorization (read-file auth-file)
+                             :content-type "application/x-www-form-urlencoded"
+                             :content (format "status=%s&source=planetlisp" (java.net.URLEncoder/encode status))}))
+
+(defn maybe-post-twit [items]
+  (let [twitter-status (cond
+                        (< 1 (count items))
+                        (format "%d new items posted" (count items))
+                        (= 1 (count items))
+                        (format "new: %s" (first items)))]
+    (when twitter-status
+      (update-twitter-status +twitter-auth-file+ twitter-status))))
+
+(defn poll
+  "Poll planet lisp, check for new postings, update Twitter status when new postings have appeared"
+  []
+  (save-data
+   (let [old-data (load-data)
+         process
+         (fn [items new-data new-items]
+           (if items
+             (let [item (first items)
+                   guid (first (xml-> item :guid text)) ]
+               (recur (rest items)
+                      (conj new-data guid)
+                      (if (old-data guid)
+                        new-items
+                        (conj new-items (first (xml-> item :title text))))))
+             (do
+               (maybe-post-twit new-items)
+               new-data)))]
+     (process (xml-> (feed-to-zip "http://planet.lisp.org/rss20.xml") :channel :item)
+              #{} []))))