Added redis back for popular posts, fixed CTRL-M chars in src/site.clj, tweaked single_message.st

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)