summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rwxr-xr-xsrc/feed.clj8
-rw-r--r--src/site.clj86
-rw-r--r--src/tags.clj30
-rw-r--r--src/user.clj6
4 files changed, 87 insertions, 43 deletions
diff --git a/src/feed.clj b/src/feed.clj
index 3a3cc35..ada83fc 100755
--- a/src/feed.clj
+++ b/src/feed.clj
@@ -108,10 +108,10 @@ WHERE NOT EXISTS (SELECT 1
(def *feed-refresh-period-sec* (* 20 60))
-(def *feed-downloader*
- (scheduled-agent process-all-feeds!
- *feed-refresh-period-sec*
- nil))
+;(def *feed-downloader*
+; (scheduled-agent process-all-feeds!
+; *feed-refresh-period-sec*
+; nil))
;; Testing
diff --git a/src/site.clj b/src/site.clj
index 45ee9e5..6c6a9dd 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -24,12 +24,6 @@
scheduled-agent
user))
-(defstruct user-struct :nick :user_id :avatar :last-seen)
-
-(defn user-struct-from-session [session]
- (struct user-struct (session :nick) (session :user_id) (session :avatar)
- (System/currentTimeMillis)))
-
;; Configuration
(def *server-url*
@@ -87,10 +81,13 @@
(assoc d :created_on (format-timestamp (d :created_on)))
d))))
-(defn new-messages [room since-ts]
- (let [since-date (new Date (long since-ts))]
- (reverse (take-while (fn [m] (.after (m :created_on) since-date))
- @(room :messages)))))
+(defn new-messages [room ts]
+ (reverse (take-while #(.after (% :created_on) ts)
+ @(room :messages))))
+
+(defn new-favs [nick ts]
+ (filter #(.after (:added %) ts)
+ (get @fav-map nick [])))
(defn process-user [u]
(stringify-and-escape (strip-empty-vals u)))
@@ -103,10 +100,11 @@
; Sorting is done on client
(map process-user (vals @(room :users))))
-(defn updates [room since]
+(defn updates [nick room ts]
{"users" (prepare-user-list room)
"messages" (map process-message-for-json
- (new-messages room since))})
+ (new-messages room ts))
+ "favs" (new-favs nick ts)})
(defn count-messages-by-nick [nick image-only]
(let [query (str "SELECT COUNT(*)
@@ -128,16 +126,20 @@
LIMIT ? OFFSET ?")]
(do-select [query nick *dumps-per-page* offset]))))
-
-(defn fetch-public-message-by-id [m-id]
- (let [query "SELECT m.content, m.created_on, m.user_id, u.nick, u.avatar
+(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 r.admin_only = false
AND m.message_id = ?"]
(first (do-select [query (maybe-parse-int m-id -1)]))))
+(defn fetch-public-message-by-id [m-id]
+ (let [msg (fetch-message-by-id m-id)]
+ (if (and msg (not (:admin_only msg)))
+ msg)))
+
;; 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 :(
@@ -544,16 +546,18 @@ FROM users u
(defn refresh [session params room]
(dosync
(let [now (System/currentTimeMillis)
- since (maybe-parse-long (params :since) now)
+ old-ts (new Date (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)}))
+ :avatar (session :avatar)}))
(commute users assoc nick (user-struct-from-session session))))
- (resp-success (assoc (updates room since) :timestamp now :v *chat-version-number*)))))
+ (resp-success (assoc (updates nick room old-ts)
+ :timestamp now
+ :v *chat-version-number*)))))
(defn validated-refresh [session params]
(let [room-key (params :room)
@@ -675,21 +679,39 @@ FROM users u
(let [path-without-domain (nth (re-find #"//[^/]+/(.+)" url) 1)]
(nth (re-split #"/|\?" path-without-domain) position)))
-(defn add-tag [user-id message-id tag]
+(defn add-tag [user msg tag]
(try
- (do-insert "tags" ["user_id" "message_id" "tag"] [user-id (maybe-parse-int message-id) (normalize-tag-for-db tag)])
- true
+ (do-insert "tags"
+ ["user_id" "message_id" "tag"]
+ [(:user_id user) (msg :message_id) tag])
+ (if (and (= tag "favorite")
+ (not (= (msg :nick) (user :nick))))
+ (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 false)))
-; to do: don't let people set tags on messages they can't access
(defn validated-add-tag [session params]
(if (session :nick)
- (if (add-tag (session :user_id) (params :message_id) (params :tag))
- (resp-success "OK")
- (resp-error "TAG_EXISTS_ALREADY_OR_SOMETHING_ELSE_IS_FUCKED"))
- (resp-error "NO_USER")))
+ (let [nick (session :nick)
+ user-id (session :user_id)
+ user-admin? (session :admin-only)
+ 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)))]
+ (cond (not msg) (resp-error "NO_MSG")
+ (not access) (resp-error "NO_MSG")
+ (not tag) (resp-error "NO_TAG")
+ :else (if (add-tag session msg tag)
+ (resp-success "OK")
+ (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) = ?"]
@@ -962,14 +984,14 @@ FROM users u
(POST "/reset" (reset-account! session params))
;; Admin stuff (should be own route?)
- (GET "/debug" (debug-page session flash))
+ (GET "/debug" (debug-page session flash))
(POST "/debug" (debug-commmand! session params))
- (GET "/mutes" (show-mutes session))
+ (GET "/mutes" (show-mutes session))
(POST "/mute" (mute! session params))
(POST "/cancel-mute" (handle-cancel-mute! session params))
- (GET "/feed-test" (feed-test-page session))
+ (GET "/feed-test" (feed-test-page session))
(POST "/feed-test" (feed-test session params))
- (GET "/profile-test/:t" (profile session "ryder" "0" (params :t)))
+ (GET "/profile-test/:t" (profile session "ryder" "0" (params :t)))
;; Footer pages
(GET "/about_us" (serve-template "about_us" session))
diff --git a/src/tags.clj b/src/tags.clj
index 3878a18..7fdc0cd 100644
--- a/src/tags.clj
+++ b/src/tags.clj
@@ -1,5 +1,6 @@
(ns tags
- (:import java.lang.System)
+ (:import java.lang.System
+ java.util.Date)
(:use clojure.contrib.sql
clojure.contrib.def
clojure.contrib.json.write
@@ -7,6 +8,10 @@
compojure
utils))
+(defn validate-tag [tag]
+ (if (re-matches #"[A-Za-z]{3,12}" tag)
+ (.toLowerCase tag)))
+
; save all spaces in tags as dashes?
(defn normalize-tag-for-db [tag] (str tag))
; (.replace tag " " "-"))
@@ -224,9 +229,20 @@
(map parse-tags-from-row-as-tag-map rows)))
-
-
-
-
-
- \ No newline at end of file
+(def fav-map (ref {}))
+
+(defn filter-old-favs [fs]
+ (let [threshold (new Date (ms-in-future -60000))]
+ (filter #(.after (:added %) threshold)
+ fs)))
+
+(defn insert-fav-notification! [to-nick from-nick from-avatar msg]
+ (dosync
+ (let [favs (ensure fav-map)
+ cur-favs (filter-old-favs (or (favs to-nick) []))
+ fav {:from from-nick
+ :avatar from-avatar
+ :msg msg
+ :added (new Date)}
+ new-fs (conj cur-favs fav)]
+ (alter fav-map assoc to-nick new-fs)))) \ No newline at end of file
diff --git a/src/user.clj b/src/user.clj
index d105e29..387a7ad 100644
--- a/src/user.clj
+++ b/src/user.clj
@@ -2,6 +2,12 @@
(:use compojure
utils))
+(defstruct user-struct :nick :user_id :avatar :last-seen)
+
+(defn user-struct-from-session [session]
+ (struct user-struct (session :nick) (session :user_id) (session :avatar)
+ (System/currentTimeMillis)))
+
(def *nick-regex* #"^[A-Za-z0-9\-_âˆb˚†]*$")
(defn is-invalid-nick? [n]
generated by cgit v1.2.3-70-g09d2 (git 2.51.0) at 2025-12-10 15:54:52 +0000