diff options
Diffstat (limited to 'src/site.clj')
| -rw-r--r-- | src/site.clj | 163 |
1 files changed, 153 insertions, 10 deletions
diff --git a/src/site.clj b/src/site.clj index 713dc9d..bf745c9 100644 --- a/src/site.clj +++ b/src/site.clj @@ -15,6 +15,7 @@ clojure.contrib.json.write clojure.contrib.sql clojure.contrib.str-utils + clojure.contrib.def compojure email utils @@ -202,6 +203,7 @@ (assoc m "topic" topic) m))) + (defn count-messages-by-room [room-id image-only] (let [query (str "SELECT COUNT(*) FROM messages m, users u @@ -261,6 +263,46 @@ :topic (ref nil) }) +;; User-id/nick cache +;; I keep needing to grab user-id from a nick or nick from a user-id so I thought I'd cache them + +(def user-id-nick-cache (ref {})) +(def *user-id-nick-cache-size* 500) + +;; this is really ugly, need to make this nicer or get rid of it +(defnk user-id-from-nick-or-nick-from-user-id [:nick false :user-id false] + (let [cache-key (or nick (str "~" user-id)) + found (@user-id-nick-cache cache-key)] + (if found + found + (let [query (if nick + (str "SELECT user_id FROM users WHERE lower(nick) = ?") + (str "SELECT nick FROM users WHERE user_id = ?")) + res (first (do-select [query (or nick user-id)]))] + (if (nil? res) + nil + (let [found (if nick + (res :user_id) + (res :nick)) + cache-key2 (if nick + (str "~" found) + (lower-case found))] + (dosync + (if (> (count @user-id-nick-cache) *user-id-nick-cache-size*) (ref-set user-id-nick-cache {})) + (alter user-id-nick-cache assoc cache-key found cache-key2 (or nick user-id)) + ) + found)))))) + +(defn user-id-from-nick [nick] (user-id-from-nick-or-nick-from-user-id :nick (lower-case nick))) +(defn nick-from-user-id [user-id] (user-id-from-nick-or-nick-from-user-id :user-id user-id)) + +;; Favorites cache + +(def favorites-cache (ref [])) +(def *favorites-cache-size* 50) + + + ;; Login code (defn is-vip? [session] @@ -385,7 +427,7 @@ has-avatar (non-empty-string? (user-info :avatar)) offset (maybe-parse-int offset 0) dump-offset (* offset *dumps-per-page*) - raw-dumps (logger tags/fetch-dumps-by-nick profile-nick true (+ 1 *dumps-per-page*) dump-offset) + raw-dumps (logger tags/fetch-dumps-by-nick :nick profile-nick :amount (+ 1 *dumps-per-page*) :offset dump-offset) dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session)) dumps (map tags/remove-tags-for-output dumps) dumps (logger doall (map process-message-for-output dumps))] @@ -580,7 +622,7 @@ nick (session :nick) st (fetch-template template session) ; TODO: remove db query - message-list (reverse (tags/fetch-dumps-by-room (room :room_id) false)) + message-list (reverse (tags/fetch-dumps-by-room :room-id (room :room_id) :image-only false)) message-list (map tags/add-favorited-flag message-list (repeat session)) message-list (to-array (map process-message-for-output message-list))] (if nick @@ -698,7 +740,10 @@ dump-offset (* offset *dumps-per-page*) image-only (and (not (room :admin_only)) (not= (params :show) "all")) - raw-dumps (logger tags/fetch-dumps-by-room (room :room_id) image-only (+ 1 *dumps-per-page*) dump-offset) + raw-dumps (logger tags/fetch-dumps-by-room :room-id (room :room_id) + :image-only image-only + :amount (+ 1 *dumps-per-page*) + :offset dump-offset) dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session)) ;; json-tags (for [dump dumps :when (not (empty? (dump :tags)))] ;; (json-str {"id" (dump :message_id) "tags" (dump :tags) })) @@ -720,6 +765,103 @@ (log session (@rooms room-key) offset params) (resp-error "UNKNOWN_ROOM"))) +;; Tags + +(defn undecoded-url-piece [url position] + "Get nth thing out of a url path. + For example, (undecoded-url-piece 'http://example.com/a/b/c?foo' 2) will return 'c'" + (let [path-without-domain (nth (re-find #"//[^/]+/(.+)" url) 1)] + (nth (re-split #"/|\?" path-without-domain) position))) + +(defn add-tag [user-id message-id tag] + (try + (do-insert "tags" ["user_id" "message_id" "tag"] [user-id (maybe-parse-int message-id) (normalize-tag-for-db tag)]) + true + ; catch error when inserting duplicate tags + (catch Exception e false))) + + +; to do: don't let people set tags on messages they can't access +(defn validated-add-tag [session params] + (if (session :nick) + (if (add-tag (session :user_id) (params :message_id) (params :tag)) + (resp-success "OK") + (resp-error "TAG_EXISTS_ALREADY_OR_SOMETHING_ELSE_IS_FUCKED")) + (resp-error "NO_USER"))) + +(defn remove-tag [user-id message-id tag] + (let [query "user_id = ? AND message_id = ? AND lower(tag) = ?"] + (do-delete "tags" [query user-id (maybe-parse-int message-id) (normalize-tag-for-db (.toLowerCase tag))]) + (resp-success "OK"))) + +(defn validated-remove-tag [session params] + (if (session :nick) + (remove-tag (session :user_id) (params :message_id) (params :tag)) + (resp-error "NO_USER"))) + +(defnk tagged-dumps-template [session params tags url page-title :message-user-id false + :tag-user-id false + :logger (make-time-logger)] + (let [st (fetch-template "tagged_dumps" session) + offset (maybe-parse-int (params :offset) 0) + dump-offset (* offset *dumps-per-page*) + raw-dumps (logger tags/fetch-dumps-by-tag :tags tags + :image-only false + :amount (+ 1 *dumps-per-page*) + :offset dump-offset + :message-user-id message-user-id + :tag-user-id tag-user-id) + dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session)) + dumps (map tags/remove-tags-for-output dumps) + dumps (logger doall (map process-message-for-output dumps))] + (if (> (count raw-dumps) *dumps-per-page*) + (.setAttribute st "next" (inc offset))) + (if (not= offset 0) + (.setAttribute st "prev" (max (dec offset) 0))) + (.setAttribute st "dumps" dumps) + (.setAttribute st "page_title" page-title) + (.setAttribute st "page_url" url) + (.setAttribute st "debug_log_items" (logger)) + (.toString st))) + +;; gotta parse tag intersections myself because +'s get decoded into spaces +;; there's probably a less hacky way to do this +(defn tagged-dumps-by-nick [session params url] + (let [nick (params :nick) + tags (map url-decode (re-split #"\+" (undecoded-url-piece url 3))) + user-id (user-id-from-nick nick) + url (str "u/" nick "/tag/" (str-join "+" (map url-encode tags))) + page-title (str "dumps " nick " tagged as '" (escape-html (str-join "' and '" tags)) "'")] + (tagged-dumps-template session params tags url page-title :tag-user-id user-id))) + +(defn tagged-dumps [session params url] + (let [tags (map url-decode (re-split #"\+" (undecoded-url-piece url 1))) + url (str "tag/" (str-join "+" (map url-encode tags))) + page-title (str "dumps tagged as '" (escape-html (str-join "' and '" tags)) "'")] + (tagged-dumps-template session params tags url page-title))) + +(defn favorites [session params] + (let [nick (params :nick) + user-id (user-id-from-nick nick) + url (str "u/" nick "/favorites") + page-title (str nick "'s favorites")] + (tagged-dumps-template session params "favorite" url page-title :tag-user-id user-id))) + +(defn json-favorites [session params] + (let [nick (params :nick) + user-id (user-id-from-nick nick) + raw-favs (tags/fetch-dumps-by-tag :tags "favorite" + :image-only false + :amount 50 + :offset 0 + :tag-user-id user-id + :with-tags false) + favs (reduce (fn [m fav] (assoc m (str (fav :message_id)) (fav :content))) {} raw-favs)] + (str "RawFavs=" (json-str favs)))) + + + + ;; Account resets (defn reset-page [session] @@ -884,13 +1026,14 @@ (GET "/favicon.ico" (serve-static "static" "favicon.ico")) (GET "/u/:nick" (profile session (params :nick) "0")) (GET "/u/:nick/" (profile session (params :nick) "0")) - (GET "/u/:nick/tag/:tag" ("nuthin yet")) - (GET "/u/:nick/tag/:tag/:offset" ("nuthin yet")) - (GET "/u/:nick/favorites" ("nuthin yet")) - (GET "/u/:nick/favorites/:offset" ("nuthing yet")) + (GET "/u/:nick/tag/:tag" (tagged-dumps-by-nick session params (request-url request))) + (GET "/u/:nick/tag/:tag/:offset" (tagged-dumps-by-nick session params (request-url request))) + (GET "/u/:nick/favorites" (favorites session params)) + (GET "/u/:nick/favorites/:offset" (favorites session params)) + (GET "/json/:nick/favorites" (json-favorites session params)) (GET "/u/:nick/:offset" (profile session (params :nick) - (params :offset))) + (params :offset))) ; have to put this route after favs (GET "/p/:nick/:postid" (single-message session (params :nick) (params :postid))) (GET "/login" (login session params cookies)) (GET "/logout" (logout session)) @@ -900,8 +1043,8 @@ (GET "/chat/:t" (no-cache (validated-chat session "dumpfm" (-> request :route-params :t)))) (GET "/browser" (browser session)) (GET "/refresh" (validated-refresh session params)) - (GET "/tag/:tag" ("nuthin yet")) - (GET "/tag/:tag/:offset" ("nuthin yet")) + (GET "/tag/:tag" (tagged-dumps session params (request-url request))) + (GET "/tag/:tag/:offset" (tagged-dumps session params (request-url request))) (POST "/cmd/tag/add" (validated-add-tag session params)) (POST "/cmd/tag/rm" (validated-remove-tag session params)) (GET "/log" (validated-log session "dumpfm" "0" params)) |