summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/rooms.clj4
-rw-r--r--src/site.clj242
-rwxr-xr-xsrc/utils.clj2
3 files changed, 83 insertions, 165 deletions
diff --git a/src/rooms.clj b/src/rooms.clj
index 32239d2..e18a434 100644
--- a/src/rooms.clj
+++ b/src/rooms.clj
@@ -107,10 +107,10 @@
(or (do-select ["SELECT user_id FROM users WHERE lower(nick) = ?"
(lower-case nick)])
(do
+ (println "Creating bot " nick)
(do-select ["INSERT INTO users (nick, hash, email)
VALUES (?, ?, ?) RETURNING user_id"
- nick "GARBAGE" "info@dump.fm"])
- (println "Creating bot " nick)))))
+ nick "GARBAGE" "info@dump.fm"])))))
(defn get-or-create-room-bot! [key]
(let [nick (str "~" key)]
diff --git a/src/site.clj b/src/site.clj
index 4454da3..eefbbc3 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -105,14 +105,9 @@
(map process-user (vals @(room :users))))
(defn updates [room since]
- (let [m {"users" (prepare-user-list room)
- "messages" (map process-message-for-json
- (new-messages room since))}
- topic @(room :topic)]
- (if topic
- (assoc m "topic" topic)
- m)))
-
+ {"users" (prepare-user-list room)
+ "messages" (map process-message-for-json
+ (new-messages room since))})
(defn count-messages-by-nick [nick image-only]
(let [query (str "SELECT COUNT(*)
@@ -146,7 +141,8 @@
;; User-id/nick cache
;; I keep needing to grab user-id from a nick so I thought I'd cache them
-
+;; @timb: I just duplicated this in the user-info map :(
+;; we should reconcile our user caches
(def user-id-cache (ref {}))
(def *user-id-cache-size* 500)
@@ -312,19 +308,46 @@ WHERE t.message_id = m.message_id
AND m.user_id != t.user_id
AND m.user_id = u.user_id
GROUP BY u.nick
-ORDER BY cnt DESC;
+ORDER BY cnt DESC
")
-(def *scores-refresh-period-sec* (* 30 60))
+(def *user-info-query* "
+SELECT u.nick,
+ u.user_id,
+ u.avatar,
+ LAST.content,
+ LAST.message_id
+FROM users u
+ LEFT JOIN messages LAST
+ ON u.user_id = LAST.user_id
+ AND LAST.created_on = (SELECT MAX(created_on)
+ FROM messages
+ WHERE user_id = u.user_id
+ AND room_id != 2
+ AND is_image)
+")
+
+
+(defn build-user-info-map []
+ (let [res (do-select [*user-info-query*])]
+ (zipmap (map :nick res) res)))
-(defn compute-scores []
- (let [res (do-select [*score-query*])]
- (zipmap (map :nick res)
- (map :cnt res))))
+(defn build-score-list []
+ (let [res (vec (do-select [*score-query*]))]
+ {:list res
+ :map (zipmap (map :nick res) (map :cnt res))}))
+
+(def *scores-refresh-period-sec* (* 30 60))
+(def *user-info-refresh-period-sec* 300)
(def *user-scores*
- (scheduled-agent (no-args-adaptor compute-scores)
+ (scheduled-agent (no-args-adaptor build-score-list)
*scores-refresh-period-sec*
+ []))
+
+(def *user-info*
+ (scheduled-agent (no-args-adaptor build-user-info-map)
+ *user-info-refresh-period-sec*
{}))
(def *piece-map*
@@ -343,39 +366,29 @@ ORDER BY cnt DESC;
(def score-to-entity (comp *piece-map* score-to-piece))
-;; Profile
+(defn lookup-score [nick]
+ (if (= (lower-case nick) "scottbot")
+ -1
+ (let [scores (:map (poll *user-scores*))]
+ (get scores nick 0))))
-(def *zoeee-query* "
-SELECT m.content, m.message_id, m.created_on,
- u.nick, u.avatar, r.key,
- 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 u.nick = 'zoeee'
-AND m.user_id = u.user_id
-AND m.message_id <= 519399
-AND m.message_id >= 517713
-AND m.is_image = true
-AND m.room_id = r.room_id
-AND r.room_id = 1
-ORDER BY created_on DESC;
-")
+(defn lookup-user-info [nick]
+ (if-let [i (get (poll *user-info*) nick)]
+ (if-let [score (lookup-score nick)]
+ (assoc i :score (lookup-score nick)
+ :score_ent (score-to-entity score))
+ i)
+ {}))
-(defn zoeee-nudes [session]
- (let [raw-dumps (map tags/parse-tags-from-row-as-tag-map
- (do-select [*zoeee-query*]))
- dumps (map tags/add-favorited-flag raw-dumps (repeat session))
- dumps (map tags/remove-tags-for-output dumps)
- dumps (map process-message-for-output dumps)
- st (fetch-template "profile" session)
- user-info (fetch-nick "zoeee")]
- (doseq [a [:nick :avatar :contact :bio]]
- (let [v (user-info a)]
- (.setAttribute st (name a)
- (if (non-empty-string? v) (escape-html v)))))
- (.setAttribute st "dumps" dumps)
- (.toString st)))
+(defn get-user-ranking [offset num]
+ (let [ranking (:list (poll *user-scores*))
+ count (count ranking)]
+ (subvec ranking
+ (min count (* offset num))
+ (min count (* (inc offset) num)))))
+
+
+;; Profile
(defn profile
([session profile-nick offset] (profile session profile-nick offset "profile"))
@@ -388,9 +401,7 @@ ORDER BY created_on DESC;
is-home (and nick (= nick profile-nick))
has-avatar (non-empty-string? (user-info :avatar))
offset (maybe-parse-int offset 0)
- score (if (= (lower-case profile-nick) "scottbot")
- -1
- (or ((poll *user-scores*) profile-nick) 0))
+ score (lookup-score profile-nick)
dump-offset (* offset *dumps-per-page*)
raw-dumps (logger tags/fetch-dumps-by-nick
:nick profile-nick
@@ -441,51 +452,20 @@ ORDER BY created_on DESC;
;; Directory
(def *per-directory-page* 25)
-(def *directory-refresh-period-sec* (* 60 60))
-
-(def *directory-update-query* "
-SELECT m.user_id,
- u.nick,
- u.avatar,
- message_id,
- m.created_on,
- msg_count,
- content
-FROM (SELECT user_id,
- created_on,
- message_id,
- content,
- MAX(created_on) OVER (PARTITION BY user_id) max_created_on,
- COUNT(*) OVER (PARTITION BY user_id) msg_count
- FROM messages
- WHERE room_id = 1
- AND is_image = true) AS m,
- users u
-WHERE m.created_on = max_created_on
- AND m.user_id = u.user_id
-ORDER BY msg_count DESC")
-
-(defn fetch-directory []
- (vec (do-select [*directory-update-query*])))
-(def *directory-list*
- (scheduled-agent fetch-directory
- *directory-refresh-period-sec*
- []))
-
-(defn directory-search [offset]
- (let [directory (poll *directory-list*)
- users (subvec directory
- (min (count directory)
- (* offset *per-directory-page*))
- (min (count directory)
- (* (inc offset) *per-directory-page*)))]
- (when (> (count users) 0)
- (map process-directory-listing users))))
+(defn process-directory-entry [entry]
+ (let [info (lookup-user-info (:nick entry))]
+ (assoc (stringify-and-escape info)
+ "score_ent" (:score_ent info))))
+(defn get-directory-info [offset]
+ (map process-directory-entry
+ (get-user-ranking offset
+ *per-directory-page*)))
+
(defn directory [session offset]
- (let [st (fetch-template "directory" session)
- users (directory-search offset)]
+ (let [st (fetch-template "directory" session)
+ users (get-directory-info offset)]
(.setAttribute st "users" users)
(cond (= offset 0) (.setAttribute st "prev" false)
(= offset 1) (.setAttribute st "prev" "")
@@ -493,8 +473,6 @@ ORDER BY msg_count DESC")
(if (> offset 0)
(.setAttribute st "cur" offset))
(.setAttribute st "next" (str "/" (inc offset)))
- (if (zero? (count (poll *directory-list*)))
- (.setAttribute st "notloaded" true))
(.toString st)))
;; Single posts
@@ -513,59 +491,6 @@ ORDER BY msg_count DESC")
(resp-error "NO_USER")))
-;; Topics
-
-(defn valid-topic? [topic]
- topic)
-
-(defn valid-deadline? [deadline]
- deadline)
-
-(defn topic-map-from-room [r]
- (let [topic (or @(r :topic) {})]
- {"key" (r :key)
- "topic" (topic :topic)
- "deadline" (topic :deadline)
- "maker" (topic :maker)}))
-
-(defn validate-topic-list [session]
- (if-vip
- (let [st (fetch-template "topic_list" session)]
- (.setAttribute st "rooms"
- (map topic-map-from-room (vals @rooms)))
- (.toString st))))
-
-(defn set-topic! [room topic deadline maker]
- (dosync (ref-set (room :topic)
- {:topic topic
- :deadline deadline
- :maker maker})))
-
-(defn end-topic! [room]
- (dosync (ref-set (room :topic) nil)))
-
-(defn validate-set-topic [session params]
- (if-vip
- (let [room (lookup-room (params :room))
- topic (params :topic)
- deadline (params :deadline)
- maker (params :maker)]
- (cond (not (valid-topic? topic)) (resp-error "INVALID_TOPIC")
- (not (valid-deadline? deadline)) (resp-error "INVALID_DEADLINE")
- (not room) (resp-error "INVALID_ROOM")
- (not maker) (resp-error "NOT_MAKER")
- :else (do
- (set-topic! room topic deadline maker)
- (resp-success "OK"))))))
-
-(defn validate-end-topic [session params]
- (if-vip
- (if-let [room (lookup-room (params :room))]
- (do
- (end-topic! room)
- (resp-success "OK"))
- (resp-error "INVALID_ROOM"))))
-
;; Chat
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -619,16 +544,16 @@ ORDER BY msg_count DESC")
(defn refresh [session params room]
(dosync
- (let [now (System/currentTimeMillis)
- since (maybe-parse-long (params :since) now)
- nick (session :nick)
- users (room :users)]
+ (let [now (System/currentTimeMillis)
+ since (maybe-parse-long (params :since) now)
+ nick (session :nick)
+ users (room :users)]
(if nick
(if-let [user-info (@users nick)]
; Incorporate avatar updates
(commute users assoc nick (merge user-info {:last-seen now
:avatar (session :avatar)}))
- (commute (room :users) assoc nick (user-struct-from-session session))))
+ (commute users assoc nick (user-struct-from-session session))))
(resp-success (assoc (updates room since) :timestamp now :v *chat-version-number*)))))
(defn validated-refresh [session params]
@@ -981,12 +906,9 @@ ORDER BY msg_count DESC")
;; Compojure Routes
(defn serve-static [dir path]
- ; TODO: cache other static files (js, css, etc.)
- (let [cache-header (if (re-find pic-regex path)
- {:headers {"Cache-Control" "max-age=604800,public"}}
- {})]
- [cache-header
- (serve-file dir path)]))
+ (if (= path "")
+ (redirect-to "http://dump.fm")
+ (serve-file dir path)))
(defroutes static
(GET "/static/*" (serve-static "static" (params :*)))
@@ -1034,9 +956,6 @@ ORDER BY msg_count DESC")
(POST "/msg" (validated-msg session params))
(POST "/submit-registration" (register session params))
(POST "/update-profile" (update-profile session params))
- (GET "/topic-list" (validate-topic-list session))
- (POST "/set-topic" (validate-set-topic session params))
- (POST "/end-topic" (validate-end-topic session params))
(GET "/directory" (directory session 0))
(GET "/directory/:offset"
(directory session (maybe-parse-int (params :offset) 0)))
@@ -1064,7 +983,6 @@ ORDER BY msg_count DESC")
(GET "/error/ie" (serve-template "error_ie" session))
;; Put username routes below all others in priority
- (GET "/zoeee/nudes" (zoeee-nudes session))
(GET "/:nick" (profile session (params :nick) "0"))
(GET "/:nick/" (profile session (params :nick) "0"))
(GET "/:nick/:offset" (profile session (params :nick) (params :offset)))
diff --git a/src/utils.clj b/src/utils.clj
index d278e56..52f8399 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -186,7 +186,7 @@
(defn do-count [query]
((first (with-connection *db*
(with-query-results rs query
- (doall rs))))
+ (vec rs))))
:count))
(defn do-delete [table query]
generated by cgit v1.2.3-70-g09d2 (git 2.51.0) at 2025-12-13 09:26:05 +0000