(ns cljssss-g (require [clojure.xml :as xml] [clojure.contrib.sql :as sql] compojure) (import (org.antlr.stringtemplate StringTemplateGroup) (com.sun.syndication.io SyndFeedInput XmlReader) (com.sun.syndication.feed.synd SyndFeed SyndEntry) (java.net URL)) (use compojure)) (Class/forName "org.sqlite.JDBC") (def templates (new StringTemplateGroup "")) (def db-connection-data {:classname "org.sqlite.JDBC" :subprotocol "sqlite" :subname "cljssss-g.sqlite3" :create true}) (defmacro with-db [& body] `(sql/with-connection db-connection-data ~@body)) (defmacro with-dbt [& body] `(with-db (sql/transaction ~@body))) (def web-vars '(context cookies headers method params request response route session)) (defmacro define-web-vars [] `(do ~@(into () (map (fn [varname] `(def ~varname)) web-vars)))) (define-web-vars) (defmacro with-web-vars [& body] `(binding ~(into [] (mapcat (fn [varname] `[~varname ~varname]) web-vars)) ~@body)) (defn opml-string [user] (with-dbt (sql/with-query-results results [(str "SELECT feed.uri, feed.link, user_feed_link.title" " FROM feed, user_feed_link" " WHERE user_feed_link.feed=feed.id AND user_feed_link.user=?" " ORDER BY user_feed_link.title") user] (.toString (doto (.getInstanceOf templates "opml") (.setAttributes {"date" "" ;FIXME "feeds" (map (fn [{title :title uri :uri link :link}] {"text" title "xmlurl" uri "htmlurl" link}) results)})))))) (defn select-feeds [user active-feed-id] (sql/with-query-results results [(str "SELECT feed.id, feed.uri, feed.link, user_feed_link.title" " FROM feed, user_feed_link" " WHERE user_feed_link.feed=feed.id AND user_feed_link.user=?" " ORDER BY user_feed_link.title") user] (doall (map (fn [{title :title id :id link :link}] {"title" title "id" id "link" link "active_p" (= active-feed-id id)}) results)))) (defn select-feed-name [user feed-id] (sql/with-query-results [{feed-name :title}] [(str "SELECT user_feed_link.title" " FROM feed, user_feed_link" " WHERE user_feed_link.feed = ?" " AND user_feed_link.user = ?") feed-id user] feed-name)) (defn select-entries [user feed-id active-entry-id] (sql/with-query-results results [(str "SELECT entry.link, entry.title, entry.id" " FROM entry, feed_entry_link, user_feed_link" " WHERE entry.id = feed_entry_link.entry" " AND feed_entry_link.feed = user_feed_link.feed" " AND user_feed_link.user = ?" " AND user_feed_link.feed = ?" " ORDER BY entry.published DESC") user feed-id] (doall (map (fn [{title :title link :link id :id}] {"title" title "link" link "id" id "active_p" (= active-entry-id id)}) results)))) (defn lynxy-feedlist [user] (with-db (.toString (doto (.getInstanceOf templates "simple-feed-list") (.setAttributes {"feeds" (select-feeds user nil)}))))) (defn lynxy-showfeed [user feed] (with-db (.toString (doto (.getInstanceOf templates "simple-entry-list") (.setAttributes {"feed_name" (select-feed-name user feed) "entries" (select-entries user feed nil)}))))) (defn show-subscriptions [user feed active-entry-id] (with-db (.toString (doto (.getInstanceOf templates "index") (.setAttributes {"feeds" (select-feeds user feed) "entries" (when feed (select-entries user feed active-entry-id)) "active_feed_id" feed "active_feed_title" (and feed (select-feed-name user feed)) "title" "Subscriptions"}))))) (defmacro with-session "Rebind Compojure's magic lexical variables as vars." [& body] `(with-web-vars (if (not (session :id)) (if (= (params :valuesofbetawillgiverisetodom) "true") (.toString (doto (.getInstanceOf templates "login") (.setAttributes {"logintext" "Login failed"}))) (.toString (doto (.getInstanceOf templates "login") (.setAttributes {"logintext" "Login"})))) (do ~@body)))) (defservlet cljssss-g (POST "/login" (dosync (with-db (sql/with-query-results [{id :id password :password}] ["SELECT id, password FROM user WHERE name = ?" (params :name)] (when (= password (params :password)) (alter session assoc :id id)) (redirect-to (or (headers :referer) "/")))))) (GET "/feedlist.opml" (with-session (opml-string (session :id)))) (GET "/lynxy-feedlist.html" (with-session (lynxy-feedlist (session :id)))) (GET "/lynxy-showfeed" (with-session (lynxy-showfeed (session :id) (Integer/parseInt (params :feed))))) (GET "/" (with-session (show-subscriptions (session :id) (Integer/parseInt (params :feed)) nil))) (GET "/entries/*" (with-session (show-subscriptions (session :id) (Integer/parseInt (params :feed)) 5))) (GET "/layout.css" (serve-file "layout.css")) (ANY "*" (page-not-found))) (defn trim-nil [thing] (and thing (.trim thing))) (defn maximum-id [table-name] (sql/with-query-results [max-id-map] [(str "SELECT MAX(id) FROM " table-name)] (or (second (first max-id-map)) -1))) (defn fetch-feed [id] (with-db (let [uri (sql/with-query-results [{uri :uri}] ["SELECT uri FROM feed WHERE id = ?" id] uri), #^SyndFeed feed (.build (new SyndFeedInput) (new XmlReader (new URL uri)))] (sql/transaction (sql/update-values :feed ["id = ?" id] {:language (.getLanguage feed) :iri (.getUri feed) :link (.getLink feed) :rights (trim-nil (.getCopyright feed)) :title (trim-nil (.getTitle feed)) :subtitle (trim-nil (.getDescription feed)) :updated (.getPublishedDate feed)}) (doseq [#^SyndEntry entry (.getEntries feed)] (sql/with-query-results [{potential-entry-id :id}] ["SELECT id FROM entry WHERE iri = ?" (.getUri entry)] (let [entry-id (or potential-entry-id (+ 1 (maximum-id "entry")))] (sql/update-or-insert-values :entry ["id = ?" entry-id] {:id entry-id :iri (.getUri entry) :link (.getLink entry) :title (trim-nil (.getTitle entry)) :summary_type (if (.getDescription entry) (.getType (.getDescription entry)) nil) :summary (if (.getDescription entry) (.getValue (.getDescription entry)) nil) :content_type (if (and (.getContents entry) (first (.getContents entry))) (.getType (first (.getContents entry))) nil) :content (if (and (.getContents entry) (first (.getContents entry))) (.getValue (first (.getContents entry))) nil) :updated (.getUpdatedDate entry) :published (.getPublishedDate entry)}) (sql/update-or-insert-values :feed_entry_link ["feed = ? AND entry = ?" id entry-id] {:feed id :entry entry-id})))))))) ;; system-wide subscription (defn subscribe-to-feed [url] (let [maybe-id (with-dbt (when-not (sql/with-query-results [{id :id}] ["SELECT id FROM feed WHERE uri=?" url] id) (let [free-id (+ 1 (maximum-id "feed"))] (sql/insert-values :feed [:id :uri] [free-id url]) free-id)))] (when maybe-id (fetch-feed maybe-id)) maybe-id)) (run-server {:port 8080} "/*" cljssss-g) ;;;; Sample database content (comment (subscribe-to-feed "http://matthias.benkard.de/journal/feed/") (subscribe-to-feed "http://uxul.wordpress.com/feed/") (with-dbt (sql/insert-values :user [:id :name :password] [0 "mulk" "klum"]) (sql/insert-values :user_feed_link [:user :feed :title] [0 0 "Kompottkins Weisheiten"]) (sql/insert-values :user_feed_link [:user :feed :title] [0 1 "Dijkstrabühl"]))) ;;;; Database schema (comment (with-dbt (sql/create-table :user [:id "integer" "PRIMARY KEY"] [:name "text"] [:email "text"] [:password "text"])) (with-dbt (sql/create-table :feed [:id "integer" "PRIMARY KEY"] [:uri "text"] [:language "text"] [:iri "text"] [:icon "blob"] [:link "text"] [:logo "text"] [:rights "text"] [:title "text"] [:subtitle "text"] [:updated "timestamp"])) (with-dbt (sql/create-table :entry [:id "integer" "PRIMARY KEY"] [:uri "text"] ;? [:language "text"] [:content "blob"] [:content_type "text"] [:iri "text"] [:link "text"] [:published "timestamp"] [:rights "text"] [:source "integer"] ;:feed [:title "text"] [:summary "blob"] [:summary_type "text"] [:updated "timestamp"])) (with-dbt (sql/create-table :feed_entry_link [:feed "integer"] [:entry "integer"])) (with-dbt (sql/create-table :user_feed_link ;subscription [:user "integer"] [:feed "integer"] [:title "text"])) (with-dbt (sql/create-table :user_entry_link [:user "integer"] [:entry "integer"] [:read "boolean"] [:marked "boolean"] [:hidden "boolean"])))