summaryrefslogtreecommitdiff
path: root/src/site.clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/site.clj')
-rw-r--r--[-rwxr-xr-x]src/site.clj99
1 files changed, 79 insertions, 20 deletions
diff --git a/src/site.clj b/src/site.clj
index 63d2eec..7f8e22c 100755..100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -18,7 +18,8 @@
utils
cookie-login
session-sweeper
- feed))
+ feed
+ tags))
(def *run-flusher* true)
(def *flusher-sleep* (seconds 4))
@@ -118,19 +119,66 @@
;; Output
+; is there a better way to do this or am i insane for introducing state? just wanna do
+; (let [log (debug-log)]
+; (log "something")
+; (log "something else")
+; (log)) ; gets log array for output to template
+(defn make-debug-logger
+ ([] (make-debug-logger (new java.util.ArrayList)))
+ ([log]
+ (fn
+ ([] (to-array log))
+ ([s] (make-debug-logger (.add log s))))))
+
+(defn make-time-logger
+ ([] (make-time-logger (new java.util.ArrayList)))
+ ([log]
+ (fn
+ ([] (to-array log));
+ ([f & args]
+ (let [start (.getTime (new Date))
+ ret (apply f args)
+ log-string (str f ": " (- (.getTime (new Date)) start) " msecs" )]
+ (.add log log-string)
+ ret)))))
+
+;(defn log-time [log f & args]
+; (let [start (.getTime (new Date))]
+; (let [ret (apply f args)]
+; (log (str f ": " (- (.getTime (new Date)) start) " msecs" ))
+; ret)))
+
+
(defn strip-empty-vals [m]
(into {} (filter (fn [[k v]] (non-empty-string? v)) m)))
+(defn name-if-possible [x]
+ (if
+ (or (keyword? x) (symbol? x))
+ (name x)
+ (str x)))
+
+(declare stringify-and-escape)
+(defn escape-html-deep [o]
+ (if (map? o)
+ (stringify-and-escape o)
+ (if (seq? o)
+ (map escape-html-deep o)
+ (escape-html o))))
+
(defn stringify-and-escape [m]
- (zipmap (map name (keys m)) (map escape-html (vals m))))
+ (zipmap (map str* (keys m)) (map escape-html-deep (vals m))))
(defn process-message-for-json [d]
(assoc d :created_on (.getTime (d :created_on))))
(defn process-message-for-output [d]
- (stringify-and-escape
- (strip-empty-vals
- (assoc d :created_on (.format formatter (d :created_on))))))
+ (escape-html-deep
+ (strip-empty-vals
+ (if (contains? d :created_on)
+ (assoc d :created_on (.format formatter (d :created_on)))
+ d))))
(defn new-messages [room since-ts]
(let [since-date (new Date (long since-ts))]
@@ -157,8 +205,6 @@
(assoc m "topic" topic)
m)))
-(def *dumps-per-page* 20)
-
(defn count-messages-by-room [room-id image-only]
(let [query (str "SELECT COUNT(*)
FROM messages m, users u
@@ -170,11 +216,11 @@
([room-id image-only] (fetch-messages-by-room room-id image-only 0))
([room-id image-only offset]
(let [query (str "SELECT m.content, m.message_id, m.created_on, u.nick, u.avatar
- FROM messages m, users u
- WHERE room_id = ? AND m.user_id = u.user_id "
- (if image-only "AND m.is_image = true " "")
- "ORDER BY created_on DESC
- LIMIT ? OFFSET ?")]
+ FROM users u, messages m
+ WHERE room_id = ? AND m.user_id = u.user_id "
+ (if image-only "AND m.is_image = true " "")
+ "ORDER BY created_on DESC
+ LIMIT ? OFFSET ?")]
(do-select [query room-id *dumps-per-page* offset]))))
(defn count-messages-by-nick [nick image-only]
@@ -226,7 +272,7 @@
(do (.setAttribute st "user_nick" (session :nick))
(if (non-empty-string? (session :avatar)) (.setAttribute st "user_avatar" (session :avatar)))
(.setAttribute st "isadmin" (session :is_admin))))
- st))
+ st))
(defn serve-template [template session]
(.toString (fetch-template template session)))
@@ -329,12 +375,13 @@
(defn profile [session profile-nick offset]
(if-let [user-info (fetch-nick profile-nick)]
(let [nick (session :nick)
+ logger (make-time-logger)
is-home (and nick (= nick profile-nick))
has-avatar (non-empty-string? (user-info :avatar))
offset (maybe-parse-int offset 0)
dump-offset (* offset *dumps-per-page*)
dumps (fetch-messages-by-nick profile-nick true dump-offset)
- dump-count (count-messages-by-nick profile-nick true)
+ dump-count (logger count-messages-by-nick profile-nick true)
st (fetch-template "profile" session)
dumps (to-array (map process-message-for-output dumps))]
(do
@@ -349,6 +396,7 @@
(.setAttribute st "next" (inc offset)))
(if (not= offset 0)
(.setAttribute st "prev" (max (dec offset) 0)))
+ (.setAttribute st "debug_log_items" (logger))
(.toString st)))
(resp-error "NO_USER")))
@@ -633,22 +681,29 @@
;; Chat Log
; TODO: Optimize dump counts
+; timb: ^^ done... i changed it to fetch one more than is shown per page to determine if next page is needed
(defn log [session room offset params]
(let [st (fetch-template "log" session)
+ logger (make-time-logger)
offset (maybe-parse-int offset 0)
- dump-offset (* offset *dumps-per-page*)
- image-only (and (not (room :admin_only))
+ dump-offset (* offset *dumps-per-page*)
+ image-only (and (not (room :admin_only))
(not= (params :show) "all"))
- dumps (to-array (map process-message-for-output
- (fetch-messages-by-room (room :room_id) image-only dump-offset)))
- dump-count (count-messages-by-room (room :room_id) image-only)]
- (if (< (+ dump-offset *dumps-per-page*) dump-count)
+ raw-dumps (logger tags/fetch-messages-with-tags-by-room (room :room_id) image-only (+ 1 *dumps-per-page*) dump-offset)
+ dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))
+ json-tags (for [dump dumps :when (not (empty? (dump :tags)))]
+ (json-str {"id" (dump :message_id) "tags" (dump :tags) }))
+ dumps (map tags/remove-tags-for-output dumps)
+ dumps (logger doall (map process-message-for-output dumps))]
+ (if (> (count raw-dumps) *dumps-per-page*)
(.setAttribute st "next" (inc offset)))
(if (not= offset 0)
(.setAttribute st "prev" (max (dec offset) 0)))
(.setAttribute st "dumps" dumps)
+ (.setAttribute st "json_tags" json-tags)
(.setAttribute st "roomkey" (room :key))
(.setAttribute st "roomname" (room :name))
+ (.setAttribute st "debug_log_items" (logger))
(.toString st)))
(defn validated-log [session room-key offset params]
@@ -658,6 +713,7 @@
;; Upload
+
(def *max-image-height* 2000)
(def *max-image-width* 2000)
(def *vip-max-file-size* (mbytes 5)) ; don't be nuts guys
@@ -785,6 +841,8 @@
(GET "/chat/:t" (no-cache (validated-chat session "dumpfm" (-> request :route-params :t))))
(GET "/browser" (browser session))
(GET "/refresh" (validated-refresh session params))
+ (POST "/cmd/tag/add" (validated-add-tag session params))
+ (POST "/cmd/tag/rm" (validated-remove-tag session params))
(GET "/log" (validated-log session "dumpfm" "0" params))
(GET "/:room/log" (validated-log session
(-> request :route-params :room)
@@ -807,6 +865,7 @@
(GET "/help" (serve-template "help" session))
(GET "/privacy" (serve-template "privacy" session))
(GET "/terms" (serve-template "terms" session))
+ (GET "/error/ie" (serve-template "error_ie" session))
(ANY "*" (unknown-page params)))
(defroutes multipart
generated by cgit v1.2.3-70-g09d2 (git 2.51.0) at 2025-12-10 19:50:58 +0000