diff options
Diffstat (limited to 'src')
| -rw-r--r--[-rwxr-xr-x] | src/site.clj | 99 | ||||
| -rw-r--r-- | src/tags.clj | 121 |
2 files changed, 200 insertions, 20 deletions
diff --git a/src/site.clj b/src/site.clj index 75b0f52..eb6d153 100755..100644 --- a/src/site.clj +++ b/src/site.clj @@ -19,7 +19,8 @@ utils cookie-login session-sweeper - feed)) + feed + tags)) (def *run-flusher* true) (def *flusher-sleep* (seconds 4)) @@ -119,19 +120,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))] @@ -158,8 +206,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 @@ -171,11 +217,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] @@ -227,7 +273,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))) @@ -331,12 +377,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 @@ -351,6 +398,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"))) @@ -640,22 +688,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] @@ -676,6 +731,7 @@ ;; Upload + (def *max-image-height* 2000) (def *max-image-width* 2000) (def *max-avatar-height* 2000) @@ -801,6 +857,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) @@ -827,6 +885,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 diff --git a/src/tags.clj b/src/tags.clj new file mode 100644 index 0000000..ba32635 --- /dev/null +++ b/src/tags.clj @@ -0,0 +1,121 @@ +(ns tags + (:import java.lang.System) + (:use clojure.contrib.sql + clojure.contrib.json.write + compojure + utils)) + +; save all spaces in tags as dashes +(defn normalize-tag-for-db [tag] (str tag)) +; (.replace tag " " "-")) +; todo: remove unicode escape sequences and line breaks and stuff? + + +; maybe show all dashes as spaces on output? +(defn normalize-tag-for-out [tag] (str tag)) + +(defn add-tag [user-id message-id tag] + (let [query "INSERT INTO tags2(user_id, message_id, tag) VALUES(?, ?, ?)"] + (try + (do-select [query user-id (maybe-parse-int message-id) (normalize-tag-for-db tag)]) + ; catch error when inserting duplicate tags + (catch org.postgresql.util.PSQLException e + resp-error "TAG_EXISTS_ALREADY_OR_SOMETHING_ELSE_IS_FUCKED") + ))) + +; to do: don't let people set tags on messages they can't access +(defn validated-add-tag [session params] + (if (session :nick) + (add-tag (session :user_id) (params :message_id) (params :tag)) + (resp-error "NO_USER"))) + +(defn remove-tag [user-id message-id tag] + (let [query "DELETE FROM tags2 WHERE user_id = ? AND message_id = ? AND lower(tag) = ?"] + (do-select [query user-id (maybe-parse-int message-id) (normalize-tag-for-db (.toLowerCase tag))]))) + +(defn validated-remove-tag [session params] + (if (session :nick) + (remove-tag (session :user_id) (params :message_id) (params :tag)) + (resp-error "NO_USER"))) + + +(defn fetch-messages-by-tag []) + +; lol "Can't remove struct key" +(defn remove-tags-for-output [row] + (dissoc (into {} row) :tags)) + +(defn get-json-tags [row] + (assoc row :tags_json (json-str (row :tags)))) + +; turn "a 1 b 2" to ({:nick a :tag 1}, {:nick b :tag 2}) +; this seems to be a waste of cpu and memory, but i'm trying to make these easily accessible from templates +; also: i can't figure out how to access array indexes directly in StringTemplate templates +(defn parse-tags-from-row [row] + (assoc row :tags + (for [t (partition 2 (.split (row :tags) " "))] + {"nick" (first t) "tag" (last t)}))) + +(defn parse-tags-from-string [string] + (partition 2 (.split string " "))) + +(defn build-tag-map-by-tag [tags nick-tag] + (let [nick (first nick-tag) tag (last nick-tag)] + (if (tags tag) + (assoc tags tag (conj (tags tag) nick)) + (assoc tags tag [nick])))) + +; making something like {"tag1": ["nick a", "nick b"], "tag2": ["nick c", "nick d"]} +; why is building data structures in clojure so hard for me +(defn parse-tags-from-row-as-map-by-tag [row] + (assoc row :tags + (reduce build-tag-map-by-tag {} (parse-tags-from-string (row :tags))))) + +(defn does-tag-exist? + ([tags tag] + (contains? tags tag)) + ([tags tag from-nick] + (if (contains? tags tag) + (some #{from-nick} (tags tag))))) + +(defn add-favorited-flag [row session] + (if (does-tag-exist? (row :tags) "favorite" (session :nick)) + (assoc row :favorited true) + row)) + + +(defn explain-query [query] (str "EXPLAIN ANALYZE " query)) + +; todo: offset is slow. probably need to include message_id in 'next page' url (tumblr & reddit do that) +(defn fetch-messages-with-tags-by-room-query [image-only] + (str "SELECT m.content, m.message_id, m.created_on, u.nick, u.avatar, + array_to_string(ARRAY(SELECT nick || ' ' || tag + FROM tags2, users + WHERE message_id = m.message_id AND tags2.user_id = users.user_id), ' ') as tags + 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 ?")) + +; offset is slow... problem with this one though it doesn't take into account deleted messages +(defn fetch-messages-with-tags-by-room-fast-paging-query [image-only] + (str "SELECT m.content, m.message_id, m.created_on, u.nick, u.avatar, + array_to_string(ARRAY(SELECT nick || ' ' || tag + FROM tags2, users + WHERE message_id = m.message_id AND tags2.user_id = users.user_id), ' ') as tags + FROM users u, messages m + WHERE room_id = ? AND m.user_id = u.user_id + AND m.message_id BETWEEN ? AND ? " + (if image-only "AND m.is_image = true " "") + "ORDER BY created_on DESC + LIMIT ?")) + +(defn fetch-messages-with-tags-by-room + ([] (fetch-messages-with-tags-by-room 1 true *dumps-per-page* 0)) + ([room-id] (fetch-messages-with-tags-by-room room-id true *dumps-per-page* 0)) + ([room-id image-only] (fetch-messages-with-tags-by-room room-id image-only *dumps-per-page* 0)) + ([room-id image-only amount offset] + (let [query (fetch-messages-with-tags-by-room-query image-only)] + (let [rows (do-select [query room-id amount offset])] + (map parse-tags-from-row-as-map-by-tag rows))))) |