diff options
| -rw-r--r-- | src/config.clj | 1 | ||||
| -rw-r--r-- | src/datalayer.clj | 68 | ||||
| -rw-r--r-- | src/site.clj | 90 | ||||
| -rw-r--r-- | src/tags.clj | 3 |
4 files changed, 121 insertions, 41 deletions
diff --git a/src/config.clj b/src/config.clj index ce3a88c..5253379 100644 --- a/src/config.clj +++ b/src/config.clj @@ -31,3 +31,4 @@ (def *dumps-per-page* 20) (def *vip-dumps-per-page* 200) (def message-count-limit 200) +(def num-hall-dumps 50)
\ No newline at end of file diff --git a/src/datalayer.clj b/src/datalayer.clj index 38a597e..0d328b6 100644 --- a/src/datalayer.clj +++ b/src/datalayer.clj @@ -2,6 +2,7 @@ (:require redis tags) (:use config + jedis utils)) @@ -28,14 +29,42 @@ WHERE u.user_id = ANY(?)" user-id) ", false AS favorited"))) +(defn recent-posts-nick-query [user-id] + (format " +SELECT u.user_id, u.nick, u.avatar, + m.content, m.message_id%s +FROM users u +LEFT JOIN messages m on m.message_id = + (SELECT message_id FROM messages + WHERE user_id = u.user_id + AND is_image + AND room_id IN (SELECT room_id from rooms where admin_only = false) + ORDER BY created_on desc LIMIT 1) +WHERE u.nick = ANY(?)" + (if user-id + (format + ", + EXISTS (SELECT 1 FROM tags + WHERE tag = 'favorite' AND user_id = %s AND message_id = m.message_id) AS favorited" + user-id) + ", false AS favorited"))) + (defn lookup-recent-posts [user-tag-id user-ids] (do-select [(recent-posts-query user-tag-id) (sql-array "int" user-ids)])) -(defn lookup-recent-posts-tagless [user-tag-id user-ids] +(defn lookup-recent-posts-tagless [user-ids] (do-select [(recent-posts-query nil) (sql-array "int" user-ids)])) +(defn lookup-recent-posts-by-nicks [user-tag-id nicks] + (do-select [(recent-posts-nick-query user-tag-id) + (sql-array "varchar" nicks)])) + +(defn lookup-recent-posts-tagless-by-nicks [nicks] + (do-select [(recent-posts-nick-query nil) + (sql-array "text" nicks)])) + (defn fetch-message-by-id [m-id] (let [query "SELECT m.message_id, m.content, m.created_on, m.user_id, u.nick, u.avatar, r.key, r.admin_only @@ -63,7 +92,7 @@ order by count desc limit ? offset ?") (defn fetch-popular-dumps [nick viewer-nick] (for [d (do-select [popular-dumps-qry nick 40 0])] - (let [favers (vec (.getArray (:user_nicks d)))] + (let [favers (.getArray (:user_nicks d))] (assoc d :favers favers :favorited (some #(= % viewer-nick) favers))))) @@ -75,3 +104,38 @@ order by count desc limit ? offset ?") msg-ids (map maybe-parse-int msg-ids)] (if-not (empty? msg-ids) (tags/fetch-dumps-by-ids msg-ids viewer-nick)))) + + +;;;; Redis Favscores + +(defn fetch-redis-directory [offset num] + (vec + (for [t (with-jedis + #(.zrevrangeWithScores % "favscores" offset (dec num)))] + {:nick (.getElement t) + :score (int (.getScore t))}))) + +(defn fetch-redis-favscore [nick] + (maybe-parse-int + (redis/with-server redis-server + (redis/zscore "favscores" (lower-case nick))) + 0)) + +(defn incrby-redis-favscore! [nick msg-id inc] + (let [msg-id (str msg-id) + inc (double inc)] + (with-jedis + #(doto % + (.zincrby "favscores" inc (lower-case nick)) + (.zincrby (str "popular:" nick) inc msg-id) + (.zincrby "hall" inc msg-id))))) + + +;;;; Redis Hall of Fame + +(defn fetch-redis-hall [viewer-nick] + (let [ids (map maybe-parse-int + (redis/with-server redis-server + (redis/zrevrange "hall" 0 (dec num-hall-dumps))))] + (if-not (empty? ids) + (tags/fetch-dumps-by-ids ids viewer-nick)))) diff --git a/src/site.clj b/src/site.clj index e79b937..3548149 100644 --- a/src/site.clj +++ b/src/site.clj @@ -376,6 +376,8 @@ ORDER BY cnt DESC (comp take-images :content) dumps)))))) +(def use-redis-favscore true) + (defn profile ([session profile-nick] (profile session profile-nick "profile")) ([session profile-nick template] @@ -385,7 +387,9 @@ ORDER BY cnt DESC nick (session :nick) logger (make-time-logger) is-home (and nick (= nick profile-nick)) - score (lookup-score profile-nick) + score (if use-redis-favscore + (fetch-redis-favscore profile-nick) + (lookup-score profile-nick)) dumps (logger tags/fetch-dumps :user-tag-id (:user_id session) :nick profile-nick @@ -448,7 +452,9 @@ ORDER BY cnt DESC (defn build-mini-profile [user-info] (let [st (fetch-template-fragment "mini_profile") nick (user-info :nick) - score (lookup-score nick)] + score (if use-redis-favscore + (fetch-redis-favscore nick) + (lookup-score nick))] (doseq [a [:nick :avatar :contact :bio]] (let [v (user-info a)] (.setAttribute st (name a) @@ -516,6 +522,7 @@ ORDER BY cnt DESC raw-dumps (if use-popular-redis (fetch-popular-dumps-redis profile-nick (:nick session)) (fetch-popular-dumps profile-nick (:nick session))) + raw-dumps (filter #(> (:count %) 0) raw-dumps) dumps (map process-message-for-output raw-dumps)] (.setAttribute st "nick" profile-nick) (.setAttribute st "mini_profile" (build-mini-profile user-info)) @@ -528,10 +535,8 @@ ORDER BY cnt DESC (def *per-directory-page* 25) (defn process-directory-entry [entry] - (let [score (lookup-score (:nick entry))] - (assoc (stringify-and-escape entry) - "score_ent" (score-to-entity score) - "score" score))) + (assoc (stringify-and-escape entry) + "score_ent" (score-to-entity (:score entry)))) (def directory-cache-ttl (minutes 10)) @@ -541,15 +546,25 @@ ORDER BY cnt DESC (defn add-recent-posts [user-id users] (if-not (empty? users) - (let [f (if user-id lookup-recent-posts lookup-recent-posts-tagless) - res (f user-id (map :user_id users))] + (let [res (if user-id + (lookup-recent-posts user-id (map :user_id users)) + (lookup-recent-posts-tagless (map :user_id users)))] (for [u users] (merge u (find-first #(= (:user_id u) (:user_id %)) res)))))) +(defn add-recent-posts-nick [user-id users] + (if-not (empty? users) + (let [nicks (map :nick users) + res (if user-id + (lookup-recent-posts-by-nicks user-id nicks) + (lookup-recent-posts-tagless-by-nicks nicks))] + (for [u users] + (merge u (find-first #(= (:nick u) (:nick %)) res)))))) + (defn get-directory-info [user-id offset] - (map process-directory-entry - (add-recent-posts user-id - (get-user-ranking offset *per-directory-page*)))) + (let [res (fetch-redis-directory offset *per-directory-page*)] + (map process-directory-entry + (add-recent-posts-nick user-id res)))) (defn directory [session offset] (let [st (fetch-template "directory" session) @@ -805,28 +820,31 @@ ORDER BY cnt DESC (try (do-insert "tags" ["user_id" "message_id" "tag"] - [(:user_id user) (msg :message_id) tag]) - (if (and (= tag "favorite") - (not (= (msg :nick) (user :nick)))) + [(:user_id user) (:message_id msg) tag]) + (when (and (= tag "favorite") + (not (= (msg :nick) (:nick user)))) + (if-not (:admin_only msg) + (incrby-redis-favscore! (:nick msg) (:message_id msg) 1)) (insert-fav-notification! (msg :nick) (user :nick) (user :avatar) (msg :content))) true ; catch error when inserting duplicate tags - (catch Exception e false))) + (catch Exception e + (do (println e) + false)))) (defn validated-add-tag [session params] (if (session :nick) (let [nick (session :nick) user-id (session :user_id) - user-admin? (session :admin-only) - msg-id (params :message_id) + msg-id (params :message_id) tag (validate-tag (params :tag)) msg (fetch-message-by-id msg-id) access (or (is-vip? session) - (not (:admin-only msg)))] + (not (:admin_only msg)))] (cond (not msg) (resp-error "NO_MSG") (not access) (resp-error "NO_MSG") (not tag) (resp-error "NO_TAG") @@ -835,10 +853,18 @@ ORDER BY cnt DESC (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 remove-tag [user-id msg-id tag] + (let [query "user_id = ? AND message_id = ? AND lower(tag) = ?" + msg-id (maybe-parse-int msg-id) + tag (normalize-tag-for-db tag) + msg (fetch-message-by-id msg-id)] + (let [rows-deleted (first (do-delete "tags" [query user-id msg-id tag]))] + (if-not (zero? rows-deleted) + (do + (if-not (:admin_only msg) + (incrby-redis-favscore! (:nick msg) msg-id -1)) + (resp-success "OK")) + (resp-error "NO_TAG"))))) (defn validated-remove-tag [session params] (if (session :nick) @@ -1149,9 +1175,8 @@ ORDER BY cnt DESC (unknown-page))) (defn hall-of-fame [session] - (let [st (fetch-template "fame" session) - msgs (add-user-favs-to-msgs (poll hall-results) - (session :user_id))] + (let [st (fetch-template "fame" session) + msgs (fetch-redis-hall (:nick session))] (.setAttribute st "dumps" (map process-message-for-output msgs)) (.toString st))) @@ -1394,23 +1419,12 @@ ORDER BY cnt DESC (load-rooms!) (start! reserved-nicks) -(def server (start-server (options :port))) -(start! *active-mutes*) -; Delay the following to reduce start-load -(Thread/sleep 15000) -(start! *user-scores*) +(def server (start-server (options :port))) +(start! *active-mutes*) (start-user-flusher!) (start-session-pruner!) -(start! hall-results) - -;; Scott 2010/8/30: disable feeds to test impact on server load -;; (and see if anyone notices) -;; (if (= *server-url* "http://dump.fm") -;; (do (start! feed-downloader) -;; (start! feed-inserter))) - ;(if (not= *server-url* "http://dump.fm") ; (start! random-poster)) diff --git a/src/tags.clj b/src/tags.clj index 37c93b0..bc022f9 100644 --- a/src/tags.clj +++ b/src/tags.clj @@ -15,7 +15,8 @@ (.toLowerCase tag))) ; save all spaces in tags as dashes? -(defn normalize-tag-for-db [tag] (str tag)) +(defn normalize-tag-for-db [tag] + (lower-case tag)) ; (.replace tag " " "-")) ; todo: remove unicode escape sequences and line breaks and stuff? |