diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/datalayer.clj | 76 | ||||
| -rw-r--r-- | src/site.clj | 184 | ||||
| -rw-r--r-- | src/tags.clj | 58 |
3 files changed, 148 insertions, 170 deletions
diff --git a/src/datalayer.clj b/src/datalayer.clj new file mode 100644 index 0000000..7086b12 --- /dev/null +++ b/src/datalayer.clj @@ -0,0 +1,76 @@ +(ns datalayer + (:require redis + tags) + (:use config + utils)) + + + +;;;; Message lookup + +(defn recent-posts-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.user_id = 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] + (do-select [(recent-posts-query nil) + (sql-array "int" user-ids)])) + +(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 + FROM messages m, users u, rooms r + WHERE m.user_id = u.user_id + AND r.room_id = m.room_id + AND m.message_id = ?"] + (first (do-select [query (maybe-parse-int m-id -1)])))) + + + +;;;; Popular Posts + +(def popular-dumps-qry " +select u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on, count(*) as count, + array_agg(u2.nick) as user_nicks +from users u, messages m, rooms r, tags t, users u2 +where lower(u.nick) = lower(?) +and u.user_id = m.user_id and m.message_id = t.message_id +and m.room_id = r.room_id and m.is_image = true and r.admin_only = false +and t.tag = 'favorite' +and t.user_id = u2.user_id +group by u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on +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)))] + (assoc d + :favers favers + :favorited (some #(= % viewer-nick) favers))))) + +(defn fetch-popular-dumps-redis [nick viewer-nick] + (let [rkey (str "popular:" nick) + msg-ids (redis/with-server redis-server + (redis/zrevrange rkey 0 (dec num-popular-dumps))) + msg-ids (map maybe-parse-int msg-ids)] + (tags/fetch-dumps-by-ids msg-ids viewer-nick)))
\ No newline at end of file diff --git a/src/site.clj b/src/site.clj index 161f0d5..1abb876 100644 --- a/src/site.clj +++ b/src/site.clj @@ -18,6 +18,7 @@ config admin compojure + datalayer email fame utils @@ -110,38 +111,10 @@ (new-messages room ts)) "favs" (new-favs nick ts)}) -(defn count-messages-by-nick [nick image-only] - (let [query (str "SELECT COUNT(*) - FROM messages m, users u, rooms r - WHERE m.user_id = u.user_id AND u.nick = ? - AND r.room_id = m.room_id AND r.admin_only = false " - (if image-only "AND m.is_image = true " ""))] - (do-count [query nick]))) -(defn fetch-messages-by-nick - ([nick image-only] (fetch-messages-by-nick nick image-only 0)) - ([nick image-only offset] - (let [query (str "SELECT m.content, m.created_on, m.message_id, u.nick, u.avatar, r.key - FROM messages m, users u, rooms r - WHERE m.user_id = u.user_id AND u.nick = ? - AND r.room_id = m.room_id AND r.admin_only = false " - (if image-only "AND m.is_image = true " "") - "ORDER BY created_on DESC - LIMIT ? OFFSET ?")] - (do-select [query nick *dumps-per-page* offset])))) - -(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 - FROM messages m, users u, rooms r - WHERE m.user_id = u.user_id - AND r.room_id = m.room_id - AND m.message_id = ?"] - (first (do-select [query (maybe-parse-int m-id -1)])))) - -(defn fetch-public-message-by-id [m-id] - (let [msg (tags/fetch-dump-by-id m-id)] - (if (and msg (not (:admin_only msg))) +(defn fetch-public-message-by-id [m-id viewer-nick] + (if-let [msg (tags/fetch-dump-by-id m-id viewer-nick)] + (if-not (:admin_only msg) msg))) ;; User-id/nick cache @@ -246,9 +219,10 @@ (defn log-login [user_id ip] ;; i'm using do-cmds here because update-values can't deal with stuff like 'last_login = now()' - (let [query (format "UPDATE users SET last_ip = '%s'::cidr, last_login = now() WHERE user_id = %s" (str ip) (str user_id))] - (do-cmds query)) -) + (try + (let [query (format "UPDATE users SET last_ip = '%s'::cidr, last_login = now() WHERE user_id = %s" (str ip) (str user_id))] + (do-cmds query)) + (catch Exception e nil))) (defn login [session params cookies request] (let [nick (or (params :nick) "") @@ -264,9 +238,8 @@ (log-login (db-user :user_id) ip) [(session-assoc-from-db db-user) login-cookie - (resp-success "OK")] - ) - (resp-error "BAD_LOGIN")))) + (resp-success "OK")]) + (resp-error "BAD_LOGIN")))) (defn logout [session] [(session-dissoc :nick :user_id :is_admin :avatar) @@ -401,22 +374,6 @@ ORDER BY cnt DESC (map (comp take-images :content) dumps)))))) - -(defn count-dumps-posted [nick] - (:count - (first - (do-select ["select count(*) from messages m, users u - where m.user_id = u.user_id and lower(u.nick) = ? - and m.is_image = true" (.toLowerCase nick)])))) - -(defn count-dumps-user-faved [nick] - (:count - (first - (do-select ["select count(distinct(m.message_id)) from users u, tags t, messages m - where lower(u.nick) = ? and u.user_id = t.user_id - and t.tag = 'favorite' - and t.message_id = m.message_id and m.is_image = true" - (.toLowerCase nick)])))) (defn profile ([session profile-nick] (profile session profile-nick "profile")) @@ -549,42 +506,15 @@ ORDER BY cnt DESC ;; Who faved me -(def popular-dumps-qry " -select u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on, count(*) as count, - array_agg(u2.nick) as user_nicks, - array_agg(u2.avatar) as user_avs, - array_agg(t.created_on) as favtime, - (select exists (select 1 from tags - where tag = 'favorite' and user_id = ? and message_id = m.message_id)) as favorited -from users u, messages m, rooms r, tags t, users u2 -where lower(u.nick) = lower(?) -and u.user_id = m.user_id and m.message_id = t.message_id -and m.room_id = r.room_id and m.is_image = true and r.admin_only = false -and t.tag = 'favorite' and t.user_id != u.user_id -and t.user_id = u2.user_id -group by u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on -order by count desc limit ? offset ?") - -(def num-popular-dumps 40) - -(defn get-popular-dumps [nick user-id] - (for [d (do-select [popular-dumps-qry user-id nick 40 0])] - (let [fav-nicks (.getArray (:user_nicks d))] - (assoc d - :favers (sort-by :t (comp #(* -1 %) compare) - (map (fn [n a t] (if (non-empty-string? a) - {:nick n :avatar a :t t} - {:nick n :t t})) - fav-nicks - (.getArray (:user_avs d)) - (.getArray (:favtime d)))) - :user_nicks nil :user_avs nil :favtime nil)))) +(def use-popular-redis false) (defn popular [session profile-nick] (if-let [user-info (fetch-nick profile-nick)] (let [st (fetch-template "popular" session) profile-nick (:nick user-info) - raw-dumps (get-popular-dumps profile-nick (or (:user_id session) -1)) + raw-dumps (if use-popular-redis + (fetch-popular-dumps-redis profile-nick (:nick session)) + (fetch-popular-dumps profile-nick (:nick session))) dumps (map process-message-for-output raw-dumps)] (.setAttribute st "nick" profile-nick) (.setAttribute st "mini_profile" (build-mini-profile user-info)) @@ -602,33 +532,6 @@ order by count desc limit ? offset ?") "score_ent" (score-to-entity score) "score" score))) -(defn recent-posts-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.user_id = 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] - (do-select [(recent-posts-query nil) - (sql-array "int" user-ids)])) (def directory-cache-ttl (minutes 10)) (def memoized-lookup-recent-posts-tagless @@ -662,19 +565,15 @@ WHERE u.user_id = ANY(?)" ;; Single posts (defn single-message [session nick-from-url id-from-url] - (if-let [user-info (fetch-nick nick-from-url)] - (if-let [message (fetch-public-message-by-id id-from-url)] - ; error if nick in url doesn't match the nick who posted the message from the id in url - ; this prevents people from scraping all the content by incrementing the id in the url - (if (= (user-info :user_id) (message :user_id)) - (let [st (fetch-template "single_message" session) - message (tags/add-favorited-flag message session) - message (tags/remove-tags-for-output message)] - (.setAttribute st "dump" (process-message-for-output message)) - (.toString st)) - (resp-error "NO_MESSAGE")) + (if-let [message (fetch-public-message-by-id id-from-url (:nick session))] + ; error if nick in url doesn't match the nick who posted the message from the id in url + ; this prevents people from scraping all the content by incrementing the id in the url + (if (= nick-from-url (:nick message)) + (let [st (fetch-template "single_message" session)] + (.setAttribute st "dump" (process-message-for-output message)) + (.toString st)) (resp-error "NO_MESSAGE")) - (resp-error "NO_USER"))) + (resp-error "NO_MESSAGE"))) ;; Chat @@ -844,18 +743,15 @@ WHERE u.user_id = ANY(?)" (.toString st))) (defn validated-log [session room-key offset params] - (if-vip - (let [room-key (if (= (lower-case room-key) "www") "dumpfm" room-key)] - (if (validate-room-access room-key session) - (log session (lookup-room room-key) offset params) - (resp-error "UNKNOWN_ROOM"))) - (redirect-to "http://dump.fm"))) + (let [room-key (if (= (lower-case room-key) "www") "dumpfm" room-key)] + (if (validate-room-access room-key session) + (log session (lookup-room room-key) offset params) + (resp-error "UNKNOWN_ROOM")))) ;; Hiscore test... redis test... (defn redis-ids-test [period] - (let [reddis-server {:host "127.0.0.1" :port 6379 :db 0} - ids (redis/with-server reddis-server + (let [ids (redis/with-server redis-server (redis/zrevrange (str "hiscore:" period) 0 -1)) ids (map maybe-parse-int ids)] ids)) @@ -1070,15 +966,14 @@ WHERE u.user_id = ANY(?)" ;; cons: has to use a <script> tag. seems to freeze browser until results returned ;; (defn json-search [undecoded-url-searchterms params] - (let [tokens (map url-decode (re-split #"\+" undecoded-url-searchterms)) - tokens (map search-replace-weird-chars tokens) - tokens (map #(str "%" %1 "%") tokens) - query (search-query (count tokens)) - rows (do-select (vec (concat [query] tokens)))] - (if (:callback params) - (str (:callback params) "(" (json-str rows) ")") - (json-str rows)))) - + (let [tokens (map url-decode (re-split #"\+" undecoded-url-searchterms)) + tokens (map search-replace-weird-chars tokens) + tokens (map #(str "%" %1 "%") tokens) + query (search-query (count tokens)) + rows (do-select (vec (concat [query] tokens)))] + (if (:callback params) + (str (:callback params) "(" (json-str rows) ")") + (json-str rows)))) ;; Local testing @@ -1507,5 +1402,14 @@ WHERE u.user_id = ANY(?)" (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 835591a..a8c3341 100644 --- a/src/tags.clj +++ b/src/tags.clj @@ -90,22 +90,6 @@ WHERE EXISTS (defn explain-query [query] (str "EXPLAIN ANALYZE " query)) -(defn fetch-dump-by-message-id-query [] (str -" SELECT - m.content, m.message_id, m.created_on, m.user_id, - u.nick, u.avatar, - r.key, r.admin_only, - array_to_string(ARRAY(SELECT nick || ' ' || tag - FROM tags, users - WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags - FROM - messages m, - users u, - rooms r - WHERE m.user_id = u.user_id - AND r.room_id = m.room_id - AND m.message_id = ?")) - ;; OFFSET is very slow when it is large ;; so, a subquery could be used when offset is large ;; one other thing we could do is include message_id in 'next page' url (tumblr & reddit do that for example) @@ -163,9 +147,9 @@ WHERE EXISTS (except! "Unknown direction: " d))) (defnk fetch-dumps [:nick nil :room nil - :date nil :msg-id nil :direction :backward - :image-only true - :user-tag-id nil :hide-vip true :limit 21] + :date nil :msg-id nil :direction :backward + :image-only true + :user-tag-id nil :hide-vip true :limit 21] (cond (and nick room) (except! "Cannot provide both nick and room for fetch-image-dumps") (not (or nick room)) (except! "Must provide nick or room for fetch-image-dumps") @@ -253,11 +237,12 @@ WHERE EXISTS (defnk fetch-dumps-by-message-id-query [:with-tags true :num-messages 1] (str " SELECT m.content, m.message_id, m.created_on, - u.nick, u.avatar, r.key" + u.nick, u.avatar, r.key, r.admin_only" (if with-tags ", array_to_string(ARRAY(SELECT nick || ' ' || tag FROM tags, users - WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags " "") + WHERE message_id = m.message_id AND tags.user_id = users.user_id + ORDER BY tags.created_on), ' ') as tags " "") " FROM messages m, users u, rooms r WHERE m.message_id IN (" (str-join ", " (take num-messages (repeat "?"))) ") " @@ -342,16 +327,29 @@ WHERE EXISTS ORDER BY message_id DESC " ;; needed in case subquery was selected ASC )) +(defn fetch-dumps-by-ids + ([ids] (fetch-dumps-by-ids ids nil)) + ([ids viewer-nick] + (let [ids (map maybe-parse-int ids) + query (fetch-dumps-by-message-id-query :num-messages (count ids)) + raw-rows (do-select (vec (concat [query] ids))) + tagged-rows (map parse-tags-from-row-as-tag-map raw-rows) + index-func (fn [row] + (index-of #(= (:message_id row) %) ids))] + (for [m (sort-by index-func tagged-rows)] + (let [favers (get (:tags m) "favorite") + favorited (and viewer-nick + (boolean (some #(= % viewer-nick) favers)))] + (assoc m + :favers favers + :favorited favorited + :count (count favers))))))) -(defn fetch-dump-by-id [m-id] - (let [query (fetch-dump-by-message-id-query)] - (let [rows (do-select [query (maybe-parse-int m-id -1)])] - (first (map parse-tags-from-row-as-tag-map rows))))) - -(defn fetch-dumps-by-ids [ids] - (let [query (fetch-dumps-by-message-id-query :num-messages (count ids)) - rows (do-select (vec (concat [query] ids)))] - (map parse-tags-from-row-as-tag-map rows))) +(defn fetch-dump-by-id + ([m-id] + (first (fetch-dumps-by-ids [m-id]))) + ([m-id viewer-nick] + (first (fetch-dumps-by-ids [m-id] viewer-nick)))) (defnk fetch-altars [:message-id 0 :user-id false :amount *dumps-per-page* :offset 0] (let [message-id (maybe-parse-int message-id 0) |