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) + #{} []))))