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.clj126
1 files changed, 91 insertions, 35 deletions
diff --git a/src/site.clj b/src/site.clj
index ef4e773..713dc9d 100755..100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -20,7 +20,8 @@
utils
cookie-login
session-sweeper
- feed))
+ feed
+ tags))
(def *run-flusher* true)
(def *flusher-sleep* (seconds 4))
@@ -123,21 +124,57 @@
(defn add-message [msg room]
(alter (room :messages) (swap cons) msg))
+;; Logging
+
+; 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)))))
+
;; Output
(defn strip-empty-vals [m]
(into {} (filter (fn [[k v]] (non-empty-string? v)) m)))
+(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))]
@@ -159,13 +196,12 @@
(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)))
-(def *dumps-per-page* 20)
-
(defn count-messages-by-room [room-id image-only]
(let [query (str "SELECT COUNT(*)
FROM messages m, users u
@@ -177,11 +213,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]
@@ -204,6 +240,7 @@
LIMIT ? OFFSET ?")]
(do-select [query nick *dumps-per-page* offset]))))
+
(defn fetch-public-message-by-id [id]
(let [query "SELECT m.content, m.created_on, m.user_id, u.nick, u.avatar
FROM messages m, users u, rooms r
@@ -224,7 +261,6 @@
:topic (ref nil)
})
-
;; Login code
(defn is-vip? [session]
@@ -240,11 +276,11 @@
(defn session-assoc-from-db
[user-info]
(session-assoc :user_id (user-info :user_id)
- :nick (user-info :nick)
- :email (user-info :email)
- :is_admin (user-info :is_admin)
- :avatar (user-info :avatar)
- :password_login true))
+ :nick (user-info :nick)
+ :email (user-info :email)
+ :is_admin (user-info :is_admin)
+ :avatar (user-info :avatar)
+ :password_login true))
;; Templates
@@ -342,15 +378,17 @@
(defn profile [session profile-nick offset]
(if-let [user-info (fetch-nick profile-nick)]
- (let [nick (session :nick)
+ (let [st (fetch-template "profile" session)
+ 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)
- st (fetch-template "profile" session)
- dumps (map process-message-for-output dumps)]
+ raw-dumps (logger tags/fetch-dumps-by-nick profile-nick true (+ 1 *dumps-per-page*) dump-offset)
+ dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))
+ dumps (map tags/remove-tags-for-output dumps)
+ dumps (logger doall (map process-message-for-output dumps))]
(do
(.setAttribute st "is_home" is-home)
(doseq [a [:nick :avatar :contact :bio]]
@@ -359,14 +397,14 @@
(if (non-empty-string? v) (escape-html v)))))
(if (> (count dumps) 0)
(.setAttribute st "dumps" dumps))
- (if (< (+ dump-offset *dumps-per-page*) dump-count)
+ (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 "debug_log_items" (logger))
(.toString st)))
(resp-error "NO_USER")))
-
(defn update-user-db [user-id attr val]
(with-connection *db*
(update-values "users" ["user_id = ?" user-id] {attr val})))
@@ -541,9 +579,10 @@
(let [now (System/currentTimeMillis)
nick (session :nick)
st (fetch-template template session)
- message-list (map process-message-for-output
- ; TODO: remove db query
- (reverse (fetch-messages-by-room (room :room_id) false)))]
+ ; TODO: remove db query
+ message-list (reverse (tags/fetch-dumps-by-room (room :room_id) false))
+ message-list (map tags/add-favorited-flag message-list (repeat session))
+ message-list (to-array (map process-message-for-output message-list))]
(if nick
(dosync
(login-user (user-struct-from-session session) room)))
@@ -651,22 +690,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 (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-dumps-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]
@@ -687,6 +733,7 @@
;; Upload
+
(def *max-image-height* 2000)
(def *max-image-width* 2000)
(def *max-avatar-height* 2000)
@@ -837,6 +884,10 @@
(GET "/favicon.ico" (serve-static "static" "favicon.ico"))
(GET "/u/:nick" (profile session (params :nick) "0"))
(GET "/u/:nick/" (profile session (params :nick) "0"))
+ (GET "/u/:nick/tag/:tag" ("nuthin yet"))
+ (GET "/u/:nick/tag/:tag/:offset" ("nuthin yet"))
+ (GET "/u/:nick/favorites" ("nuthin yet"))
+ (GET "/u/:nick/favorites/:offset" ("nuthing yet"))
(GET "/u/:nick/:offset" (profile session
(params :nick)
(params :offset)))
@@ -849,6 +900,10 @@
(GET "/chat/:t" (no-cache (validated-chat session "dumpfm" (-> request :route-params :t))))
(GET "/browser" (browser session))
(GET "/refresh" (validated-refresh session params))
+ (GET "/tag/:tag" ("nuthin yet"))
+ (GET "/tag/:tag/:offset" ("nuthin yet"))
+ (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)
@@ -877,7 +932,8 @@
(GET "/help" (serve-template "help" session))
(GET "/privacy" (serve-template "privacy" session))
(GET "/terms" (serve-template "terms" session))
- (ANY "*" (unknown-page)))
+ (GET "/error/ie" (serve-template "error_ie" session))
+ (ANY "*" (unknown-page params)))
(defroutes multipart
(POST "/upload/message" (upload session params))