summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rwxr-xr-xsrc/feed.clj93
-rw-r--r--src/rooms.clj114
-rw-r--r--src/scheduled_agent.clj4
-rw-r--r--src/site.clj86
-rw-r--r--src/user.clj2
-rwxr-xr-xsrc/utils.clj16
6 files changed, 204 insertions, 111 deletions
diff --git a/src/feed.clj b/src/feed.clj
index d3cf3f6..fdeb0be 100755
--- a/src/feed.clj
+++ b/src/feed.clj
@@ -1,15 +1,20 @@
(ns feed
+ (:import java.util.Date)
(:require [clojure.contrib.str-utils2 :as s])
(:use clojure.contrib.condition
clojure.contrib.duck-streams
+ clojure.contrib.seq-utils
+ clojure.contrib.sql
compojure
+ rooms
+ scheduled-agent
utils))
(def *feeds-path* "docs/feeds.csv")
(defn parse-line [line]
(let [r (s/split line #",")]
- (zipmap [:room-name :desc :feed-link :site-link :contact]
+ (zipmap [:room-key :desc :feed-link :site-link :contact]
(map #(.trim (.replaceAll % "\"" ""))
r))))
@@ -21,16 +26,31 @@ SELECT *
FROM UNNEST(?) as v
WHERE NOT EXISTS (SELECT 1
FROM feed_images f
- WHERE f.external_url = v
+ WHERE f.image_url = v
AND f.room_id = ?)
")
(defn filter-posted-images [urls room-id]
(if (empty? urls)
[]
- (do-select [*image-posted-qry*
- (sql-array "text" urls)
- room-id])))
+ (map :v
+ (do-select [*image-posted-qry*
+ (sql-array "text" urls)
+ room-id]))))
+
+(defn insert-feed-image-to-db! [room-id feed img user-id]
+ (with-connection *db*
+ (transaction
+ (let [acc (comp :message_id first)
+ m-id (acc
+ (do-select ["INSERT INTO messages (user_id, room_id, content, is_image)
+ VALUES (?, ?, ?, true) RETURNING message_id"
+ user-id room-id img]))]
+ (do-prepared "INSERT INTO feed_images
+ (feed_url, image_url, room_id, message_id)
+ VALUES (?, ?, ?, ?)"
+ [feed img room-id m-id])
+ m-id))))
; http://stackoverflow.com/questions/169625/regex-to-check-if-valid-url-that-ends-in-jpg-png-or-gif
(def *image-regex*
@@ -50,30 +70,51 @@ WHERE NOT EXISTS (SELECT 1
image-filters)
[img nil]))
-(defn filter-images [imgs]
- (let [filtered (map filter-image imgs)]
- [(for [[img r] filtered :when (nil? r)]
- img)
- (for [[img r] filtered :when r]
- [img r])]))
+(defn classify-images [imgs]
+ (let [good? (comp not boolean second)
+ res (group-by good? (map filter-image imgs))]
+ [(map first (res true))
+ (res false)]))
(defn classify-images-from-feed [feed]
- (let [[ms text] (with-timing (slurp* feed))
- [g b] (filter-images (extract-images text))]
+ (let [[ms text] (with-timing (download-http-url feed))
+ [g b] (classify-images (extract-images text))]
[g b ms]))
-(defn download-all-feeds! []
- (doseq [f (read-feeds)]
+(defn process-feed [f]
+ (let [room-key (:room-key f)
+ room-id (get-or-create-room! room-key)
+ [bot-nick bot-id] (get-or-create-room-bot! room-key)
+ feed (:feed-link f)
+ [good bad time] (classify-images-from-feed feed)
+ filtered-good (filter-posted-images good room-id)]
+ (doseq [img filtered-good]
+ (println (format "Inserting %s into room-id %s" img room-key))
+ (let [msg-id (insert-feed-image-to-db! room-id feed img bot-id)
+ msg {:msg_id msg-id
+ :nick bot-nick
+ :created_on (new Date)
+ :content img}]
+ (dosync
+ (add-message msg (lookup-room room-key)))))))
+
+(defn process-all-feeds! []
+ (doseq [f (shuffle (read-feeds))]
(try
- (when-let [url (:feed-link f)]
- (let [c (slurp* url)
- images (extract-images c)]
- (println url images)))
+ (if (and (:room-key f) (:feed-link f))
+ (process-feed f)
+ (println "Incomplete feed " f))
(catch Exception e
(print-stack-trace e)))))
-(defn download-feed [room-id feed-user-nick feed]
- "TODO")
+;; Feed download schedule
+
+(def *feed-refresh-period-sec* (* 30 60))
+
+;(def *feed-downloader*
+; (scheduled-agent process-all-feeds!
+; *feed-refresh-period-sec*
+; nil))
;; Testing
@@ -97,14 +138,13 @@ WHERE NOT EXISTS (SELECT 1
[:div
[:a {:href img}
[:img {:src img}]]]))
-
(defn feed-test [session params]
(if-vip
(if-let [feed (params :url)]
- (let [[slurp-ms text] (with-timing (slurp* feed))
+ (let [[slurp-ms text] (with-timing (download-http-url feed))
[process-ms imgs] (with-timing (extract-images text))
- [good-imgs bad-imgs] (filter-images imgs)]
+ [good-imgs bad-imgs] (classify-images imgs)]
(html [:body
[:h1 (str "Images for " feed)]
[:div (format "Downloaded in %s ms" slurp-ms)]
@@ -117,8 +157,5 @@ WHERE NOT EXISTS (SELECT 1
(show-bad-images bad-imgs)
[:hr]
[:h2 "Raw Feed Contents"]
- [:pre (escape-html text)]
- ]))
+ [:pre (escape-html text)]]))
(redirect-to "/feed-test"))))
-
-
diff --git a/src/rooms.clj b/src/rooms.clj
new file mode 100644
index 0000000..57fbf3a
--- /dev/null
+++ b/src/rooms.clj
@@ -0,0 +1,114 @@
+(ns rooms
+ (:use clojure.contrib.str-utils
+ utils))
+
+(def *run-flusher* true)
+(def *flusher-sleep* (seconds 4))
+(def *user-timeout* (seconds 15))
+
+(def rooms (ref {}))
+(def flusher (agent nil))
+
+(defn flush-inactive-users! [x]
+ (doseq [[rid room] @rooms]
+ (dosync
+ (let [users (room :users)
+ now (System/currentTimeMillis)
+ cutoff (- now *user-timeout*)
+ alive? (fn [[n u]] (> (u :last-seen) cutoff))]
+ (ref-set users
+ (into {} (filter alive? (ensure users)))))))
+ (Thread/sleep *flusher-sleep*)
+ (when *run-flusher*
+ (send *agent* #'flush-inactive-users!))
+ x)
+
+(defn start-user-flusher! []
+ (send flusher flush-inactive-users!))
+
+(def *default-room* "dumpfm")
+
+(defn default-room? [key]
+ (= (lower-case key) *default-room*))
+
+(defn lookup-room [key]
+ (@rooms (lower-case key)))
+
+(defn fetch-room [key]
+ (first (do-select ["SELECT * FROM rooms WHERE key = LOWER(?)" key])))
+
+(defn fetch-rooms []
+ (do-select ["SELECT * FROM ROOMS"]))
+
+(defn count-messages-by-room [room-id image-only]
+ (let [query (str "SELECT COUNT(*)
+ FROM messages m, users u
+ WHERE room_id = ? AND m.user_id = u.user_id"
+ (if image-only " AND m.is_image = true " ""))]
+ (do-count [query room-id])))
+
+(defn fetch-messages-by-room
+ ([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 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 build-room-map-from-db [room-db]
+ {:admin_only (room-db :admin_only)
+ :room_id (room-db :room_id)
+ :key (room-db :key)
+ :name (room-db :name)
+ :description (room-db :description)
+ :users (ref {})
+ :messages (ref (fetch-messages-by-room (room-db :room_id) false))
+ :topic (ref nil)
+ })
+
+
+(defn load-rooms! []
+ (dosync
+ (doseq [room-db (fetch-rooms)]
+ (alter rooms assoc (lower-case (room-db :key))
+ (build-room-map-from-db room-db)))))
+
+;; Room helpers
+
+(defn login-user [user room]
+ (alter (room :users) assoc (user :nick) user))
+
+(defn add-message [msg room]
+ (alter (room :messages) (swap cons) msg))
+
+(defn create-and-add-room! [key]
+ (do-select ["INSERT INTO rooms (key, name, description)
+ VALUES (?, ?, ?) RETURNING room_id"
+ key key key])
+ (if-let [room-db (fetch-room key)]
+ (dosync
+ (alter rooms assoc (lower-case key)
+ (build-room-map-from-db room-db))
+ room-db)))
+
+(defn get-or-create-room! [key]
+ (:room_id
+ (or (first (do-select ["SELECT room_id FROM rooms WHERE lower(key) = ?"
+ (lower-case key)]))
+ (create-and-add-room!)
+ (throw (Exception. (str "Unable to create room " key))))))
+
+(defn- get-or-create-room-bot-id! [nick]
+ ((comp :user_id first)
+ (or (do-select ["SELECT user_id FROM users WHERE lower(nick) = ?"
+ (lower-case nick)])
+ (do-select ["INSERT INTO users (nick, hash, email)
+ VALUES (?, ?, ?) RETURNING user_id"
+ nick "GARBAGE" "info@dump.fm"]))))
+
+(defn get-or-create-room-bot! [key]
+ (let [nick (str key "bo†")]
+ [nick (get-or-create-room-bot-id! nick)])) \ No newline at end of file
diff --git a/src/scheduled_agent.clj b/src/scheduled_agent.clj
index b42bb57..b1d7fbf 100644
--- a/src/scheduled_agent.clj
+++ b/src/scheduled_agent.clj
@@ -12,8 +12,8 @@
data (ref init)
pfunc (runnable-proxy (fn []
(try
- (dosync
- (ref-set data (func (ensure data))))
+ (let [val (func)]
+ (dosync (ref-set data val)))
(catch Exception e
(print-stack-trace e 5)))))
future (.scheduleWithFixedDelay pool pfunc 0 period TimeUnit/SECONDS)]
diff --git a/src/site.clj b/src/site.clj
index cda6dc0..c116f53 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -19,14 +19,11 @@
cookie-login
session-sweeper
feed
+ rooms
tags
scheduled-agent
user))
-(def *run-flusher* true)
-(def *flusher-sleep* (seconds 4))
-(def *user-timeout* (seconds 15))
-
(defstruct user-struct :nick :user_id :avatar :last-seen)
(defstruct message-struct :nick :content :created_on :msg_id)
@@ -34,26 +31,6 @@
(struct user-struct (session :nick) (session :user_id) (session :avatar)
(System/currentTimeMillis)))
-(def rooms (ref {}))
-(def flusher (agent nil))
-
-(defn flush-inactive-users! [x]
- (doseq [[rid room] @rooms]
- (dosync
- (let [users (room :users)
- now (System/currentTimeMillis)
- cutoff (- now *user-timeout*)
- alive? (fn [[n u]] (> (u :last-seen) cutoff))]
- (ref-set users
- (into {} (filter alive? (ensure users)))))))
- (Thread/sleep *flusher-sleep*)
- (when *run-flusher*
- (send *agent* #'flush-inactive-users!))
- x)
-
-(defn start-user-flusher! []
- (send flusher flush-inactive-users!))
-
;; Configuration
(def *server-url*
@@ -69,24 +46,6 @@
(.mkdir (new File *image-directory*))
(.mkdir (new File *avatar-directory*))
-;; Room handling
-
-(def *default-room* "dumpfm")
-
-(defn default-room? [key]
- (= (lower-case key) *default-room*))
-
-(defn lookup-room [key]
- (@rooms (lower-case key)))
-
-(defn fetch-rooms []
- (do-select ["SELECT * FROM ROOMS"]))
-
-(defn login-user [user room]
- (alter (room :users) assoc (user :nick) user))
-
-(defn add-message [msg room]
- (alter (room :messages) (swap cons) msg))
;; Logging
@@ -154,25 +113,6 @@
(assoc m "topic" topic)
m)))
-
-(defn count-messages-by-room [room-id image-only]
- (let [query (str "SELECT COUNT(*)
- FROM messages m, users u
- WHERE room_id = ? AND m.user_id = u.user_id"
- (if image-only " AND m.is_image = true " ""))]
- (do-count [query room-id])))
-
-(defn fetch-messages-by-room
- ([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 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]
(let [query (str "SELECT COUNT(*)
FROM messages m, users u, rooms r
@@ -203,17 +143,6 @@
AND m.message_id = ?"]
(first (do-select [query (maybe-parse-int m-id -1)]))))
-(defn build-room-map-from-db [room-db]
- {:admin_only (room-db :admin_only)
- :room_id (room-db :room_id)
- :key (room-db :key)
- :name (room-db :name)
- :description (room-db :description)
- :users (ref {})
- :messages (ref (fetch-messages-by-room (room-db :room_id) false))
- :topic (ref nil)
- })
-
;; User-id/nick cache
;; I keep needing to grab user-id from a nick so I thought I'd cache them
@@ -345,7 +274,7 @@
(set (read-lines *reserved-nicks-path*)))
(def *reserved-nicks*
- (scheduled-agent (no-args-adaptor load-invalid-nicks)
+ (scheduled-agent load-invalid-nicks
*reserved-nicks-refresh-period-sec*
(load-invalid-nicks)))
@@ -359,7 +288,7 @@
email (or (params :email) "")
hash (or (params :hash) "")
invalid-nick-reason (is-invalid-nick? nick)]
- (cond invalid-nick-reason (resp-error invalid-nick-reason)
+ (cond invalid-nick-reason (resp-error invalid-nick-reason)
(nick-reserved? nick) (resp-error "NICK_TAKEN")
:else (do
(do-insert :users
@@ -489,7 +418,7 @@ ORDER BY msg_count DESC")
(vec (do-select [*directory-update-query*])))
(def *directory-list*
- (scheduled-agent (no-args-adaptor fetch-directory)
+ (scheduled-agent fetch-directory
*directory-refresh-period-sec*
[]))
@@ -1129,12 +1058,8 @@ ORDER BY msg_count DESC")
(with-session *session-cookie-params*)
(with-multipart))
-;; Load messages from database
-(dosync
- (doseq [room-db (fetch-rooms)]
- (alter rooms assoc (lower-case (room-db :key))
- (build-room-map-from-db room-db))))
+;;; Startup Code
(defn start-server [port]
(run-server {:port port}
@@ -1153,6 +1078,7 @@ ORDER BY msg_count DESC")
(def options
(apply parse-command-args *command-line-args*))
+(load-rooms!)
(start-server (options :port))
(start-user-flusher!)
(start-session-pruner!)
diff --git a/src/user.clj b/src/user.clj
index b948a8f..d105e29 100644
--- a/src/user.clj
+++ b/src/user.clj
@@ -2,7 +2,7 @@
(:use compojure
utils))
-(def *nick-regex* #"^[A-Za-z0-9\-_∆˚†]*$")
+(def *nick-regex* #"^[A-Za-z0-9\-_âˆb˚†]*$")
(defn is-invalid-nick? [n]
(cond
diff --git a/src/utils.clj b/src/utils.clj
index 5d7af94..d278e56 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -1,5 +1,6 @@
(ns utils
(:import java.text.SimpleDateFormat
+ java.net.URL
java.util.Date
java.util.TimeZone
java.io.File
@@ -10,6 +11,7 @@
org.antlr.stringtemplate.StringTemplateGroup)
(:use clojure.contrib.json.write
clojure.contrib.sql
+ clojure.contrib.duck-streams
clojure.contrib.str-utils
compojure))
@@ -31,6 +33,12 @@
;; Misc
+(defn download-http-url [u]
+ (let [url (URL. u)]
+ (if (= (.getProtocol url) "http")
+ (slurp* url)
+ (throw (Exception. (str "Invalid url " u))))))
+
(defn append [& vecs]
(reduce into vecs))
@@ -197,6 +205,14 @@
(with-connection *db*
(.createArrayOf (connection) type (into-array arr))))
+(defn execute-query! [query & objects]
+ (with-connection *db*
+ (let [stmt (.prepareStatement (connection) query)]
+ (doseq [[i o] (map vector (iterate inc 1) objects)]
+ (.setObject stmt i o))
+ (println "update: " (.executeQuery stmt)))))
+
+
;; Parsing
(defn maybe-parse-int
generated by cgit v1.2.3-70-g09d2 (git 2.51.0) at 2025-12-10 19:55:13 +0000