path: root/src/datalayer.clj

(ns datalayer
  (:import java.util.Date)
  (:require redis
            tags)
  (:use clojure.contrib.sql
        clojure.contrib.json.write
        clojure.contrib.json.read
        multikey-cache
        config
        jedis
        message
        user
        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 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-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-messages-by-id-uncached [m-ids]
  (when-not (empty? m-ids)
    (let [query "SELECT m.message_id, m.content, m.created_on, m.user_id,
                        m.is_image, 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 = ANY(?)"
          res   (do-select [query
                            (sql-array "int" m-ids)])]
      (sort-by-index-in res m-ids :message_id))))

(def message-cache-size 50000)
(def message-cache (multikey-lru-cache
                    fetch-messages-by-id-uncached
                    message-cache-size
                    to-int))

(defn fetch-messages-by-id [m-ids]
  (get-keys message-cache m-ids))

(defn fetch-message-by-id [m-id]
  (get-key message-cache m-id))

;;;; Popular Posts

(defn redis-popular-key [nick]
  (str "popular:" nick))

(defn fetch-popular-dumps-redis [nick viewer-nick]
  (let [msg-ids   (redis/with-server redis-server
                    (redis/zrevrange (redis-popular-key nick)
                                     0
                                     (dec num-popular-dumps)))
        msg-ids   (map maybe-parse-int msg-ids)]
    (if-not (empty? msg-ids)
      (sort-by
       #(* -1 (:count %))
       (tags/fetch-dumps-by-ids msg-ids viewer-nick)))))


;;;; Redis Favscores and Hall

(def redis-hall-key "hall")

(defn fetch-redis-hall [viewer-nick]
  (let [ids (map maybe-parse-int
                 (redis/with-server redis-server
                   (redis/zrevrange redis-hall-key 0 (dec num-hall-dumps))))]
    (if-not (empty? ids)
      (sort-by
       #(* -1 (:count %))
       (tags/fetch-dumps-by-ids ids viewer-nick)))))

(def score-piece-map
     (zipmap
      [:pawn :knight :bishop :rook :queen :king :skull]
      ["♟" "♞" "♝" "♜" "♛" "♚" "☠"]))

(defn score-to-piece [score]
  (cond (= score -1)   :skull 
        (= score 0)    :pawn
        (< score 50)   :knight
        (< score 150)  :bishop
        (< score 300)  :rook
        (< score 1000) :queen
        :else :king))

(def score-to-entity (comp score-piece-map score-to-piece))

(def redis-favscores-key "favscores")

(defn redis-daily-hall-key [date]
  (str "hall:daily:" (format-yyyymmdd date)))

(defn fetch-redis-zset [key symbol offset num]
  (try
    (for [t (with-jedis
              #(.zrevrangeWithScores %
                                     key
                                     offset
                                     (+ offset num 1)))
          :when (> (int (.getScore t)) 0)]
      {symbol (.getElement t)
       :score (int (.getScore t))})
    (catch Exception e
      (println (new java.util.Date) "jedis exception" e)
      [])))

(defn fetch-redis-daily-hall [date offset num user-id]
  (let [msg-ids  (fetch-redis-zset (redis-daily-hall-key date)
                                   :message_id
                                   offset
                                   num)
        full-msgs (fetch-messages-by-id (map :message_id msg-ids))
        full-msgs (for [[info full] (map list msg-ids full-msgs)]
                    (assoc full :score (:score info)))]
    (if user-id
      (tags/add-user-favs-to-msgs full-msgs user-id)
      full-msgs)))

(defn fetch-redis-directory [page num]
  (vec
   (fetch-redis-zset redis-favscores-key
                     :nick
                     (* page num)
                     (dec (* (inc page) num)))))


;; 2011-03-07: While transitioning from keying favscores by lowercase nick to actual nick,
;;             both must be summed to get accurate score until redis is updated.
;;             Actually, we should just use userids.

(defn- has-uppercase-char? [s]
  (some #(Character/isUpperCase %) s))


(redis/with-server redis-server
  (redis/zscore redis-favscores-key "asdfkasdf"))


(defn fetch-redis-favscore [nick]
  (if (= (lower-case nick) "scottbot")
    -1
    (let [lookup #(or (redis/with-server redis-server
                        (redis/zscore redis-favscores-key %))
                      0)]
      (if (has-uppercase-char? nick)
        (+ (lookup nick) (lookup (lower-case nick)))
        (lookup nick)))))

(defn incrby-redis-favscore! [msg incr]
  (let [msg-id      (str (:message_id msg))
        is-image?   (:is_image msg)
        nick        (:nick msg)
        incr        (double incr)]
    (with-jedis
      #(do
         (.zincrby % redis-favscores-key incr nick)
         (when is-image?
           (.zincrby % (redis-daily-hall-key (:created_on msg)) incr msg-id)
           (.zincrby % (redis-popular-key nick) incr msg-id)
           (.zincrby % redis-hall-key incr msg-id))))))

;;;; Message insertion

(defn direct-message-key [u-id]
  (str "directmessage:" u-id))

(def msg-insert-query
  "INSERT INTO messages (user_id, room_id, content, is_image, is_text)
   VALUES (?, ?, ?, ?, ?) RETURNING message_id, created_on")

;; Note: direct-message recipients are inserted into postgres, but topics aren't.
(defn insert-message-into-postgres! [author-id room-id content is-image is-text recips]
  (with-connection *db*
    (transaction
     (let [{msg-id :message_id ts :created_on}
           (first
            (do-select [msg-insert-query
                        author-id room-id content is-image is-text]))]
       (doseq [r recips]
         (insert-values
          :direct_messages
          [:message_id :author_id :recip_id]
          [msg-id author-id (:user_id r)]))
       [msg-id ts]))))

(defn insert-recips-into-redis! [recips author-id dt content room-key]
  (let [msg-json (json-str {"author_id" author-id
                            "recips" (map :nick recips)
                            "key"    room-key
                            "content" content})
        ts       (.getTime dt)]
    (redis/with-server redis-server
      (redis/atomically
       (doseq [r recips]
         (redis/zadd (direct-message-key (:user_id r))
                     ts
                     msg-json))))))

(defn topic-key [topic]
  (str "topic:" topic))

(defn insert-topics-into-redis! [topics recips author-nick author-avatar dt msg-id content room-key]
  (let [ts         (.getTime dt)
        msg-json   (json-str {"nick"          author-nick
                              "avatar"        author-avatar
                              "recips"        (map :nick recips)
                              "content"       content
                              "key"           room-key
                              "message_id"    msg-id
                              "ts"            ts})]
    (redis/with-server redis-server
      (redis/atomically
       (doseq [t topics]
         (redis/lpush (topic-key t)
                      msg-json))))))

(defn insert-message! [author-id author-nick author-avatar room content]
  (let [msg-type    (classify-msg content)
        is-image    (boolean (#{:image :mixed} msg-type))
        is-text     (boolean (#{:mixed :text} msg-type))
        recips      (get-recips content)
        topics      (get-topics content)
        [msg-id dt] (insert-message-into-postgres! author-id
                                                   (:room_id room)
                                                   content
                                                   is-image
                                                   is-text
                                                   recips)]
    (when-not (:admin_only room)
      (if-not (empty? recips)
        (insert-recips-into-redis! recips author-id dt content (:key room)))
      (if-not (empty? topics)
        (insert-topics-into-redis! topics recips author-nick author-avatar dt msg-id content (:key room))))
    {:author  author-nick
     :msg-id  msg-id
     :room    (:room_id room)
     :db-ts   dt
     :content content
     :recips  (map :nick recips)
     }))

(defn fetch-direct-messages [user-id]
  (for [dm (redis/with-server redis-server
             (redis/zrevrange (direct-message-key user-id) 0 40))]
    (let [dm    (read-json dm)
          info  (fetch-user-id (get dm "author_id"))]
      {"nick"    (:nick info)
       "content" (get dm "content")
       "recips"  (get dm "recips" [])
       "avatar" (:avatar info)})))

(def topic-fetch-num 40)

(defn fetch-topic [viewer-id topic]
  (let [redis-msgs (redis/with-server redis-server
                     (redis/lrange (topic-key topic) 0 topic-fetch-num))
        raw-msgs (for [m redis-msgs]
                   (let [m (keywordify (read-json m))]
                     (assoc m
                       :created_on (Date. (:ts m)))))]
    (if viewer-id
      (tags/add-user-favs-to-msgs
       raw-msgs
       viewer-id)
      raw-msgs)))