test page for feed import

3 files changed, 169 insertions, 33 deletions

diff --git a/src/feed.clj b/src/feed.clj
index 30ff973..e075e69 100755
--- a/src/feed.clj
+++ b/src/feed.clj
@@ -1 +1,120 @@
-(ns feed)
+(ns feed
+  (:require [clojure.contrib.str-utils2 :as s])
+  (:use clojure.contrib.condition
+        clojure.contrib.duck-streams
+        compojure
+        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]
+            (map #(.trim (.replaceAll % "\"" ""))
+                 r))))
+
+(defn read-feeds []
+  (rest (map parse-line (read-lines *feeds-path*))))
+
+(def *image-posted-qry* "
+SELECT *
+FROM   UNNEST(?) as v
+WHERE  NOT EXISTS (SELECT 1 
+                   FROM   feed_images f 
+                   WHERE  f.external_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])))
+
+; http://stackoverflow.com/questions/169625/regex-to-check-if-valid-url-that-ends-in-jpg-png-or-gif
+(def *image-regex*
+     #"(?i)https?://(?:[a-z\-]+\.)+[a-z]{2,6}(?:/[^/#?]+)+\.(?:jpeg|jpg|gif|png)")
+
+(defn extract-images [text]
+  (re-seq *image-regex* text))
+
+(defn is-thumbnail? [img]
+  (boolean (re-find #"(?i)[-._](thumb|small|thumbs)[-._]" img)))
+
+(def image-filters [["THUMBNAIL" is-thumbnail?]])
+
+(defn filter-image [img]
+  (or (some
+       (fn [[r f]] (if (f img) [img r]))
+       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-from-feed [feed]
+  (let [[ms text]  (with-timing (slurp* feed))
+        [g b]      (filter-images (extract-images text))]
+    [g b ms]))
+
+(defn download-all-feeds! []
+  (doseq [f (read-feeds)]
+    (try
+     (when-let [url (:feed-link f)]
+       (let [c      (slurp* url)
+             images (extract-images c)]
+         (println url images)))
+     (catch Exception e
+       (print-stack-trace e)))))
+
+(defn download-feed [room-id feed-user-nick feed]
+  "TODO")
+
+;; Testing
+
+(defn feed-test-page [session]
+  (if-vip
+   (html [:body
+               [:h1 "Feed Test"]
+               [:form {:action "/feed-test" :method "post"}
+                [:input {:type "text" :name "url"}]
+                [:input {:type "submit" :value "Send"}]]])))
+
+(defn show-bad-images [imgs]
+  (for [[img reason] imgs]
+    [:div
+     reason
+     [:a {:href img}
+      [:img {:src img}]]]))
+
+(defn show-good-images [imgs]
+  (for [img imgs]
+    [:div
+     [:a {:href img}
+      [:img {:src img}]]]))
+  
+
+(defn feed-test [session params]
+  (if-vip
+   (if-let [feed (params :url)]
+     (let [[ms text]            (with-timing (slurp* feed))
+           imgs                 (extract-images text)
+           [good-imgs bad-imgs] (filter-images imgs)]
+       (html [:body 
+              [:h1 (str "Images for " feed)]
+              [:div (format "Downloaded in %s ms" ms)]
+              [:h3 "Images"]
+              (show-good-images good-imgs)
+              [:h3 "Filtered Images"]
+              (show-bad-images bad-imgs)
+              [:h3 "Raw Feed Contents"]
+              [:pre (escape-html text)]
+              ]))
+     (redirect-to "/feed-test"))))
+
+
diff --git a/src/site.clj b/src/site.clj
index baec484..56b7167 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -239,19 +239,19 @@
 
 (defn session-map-from-db
   [user-info]
-  {:user_id (user-info :user_id)
-   :nick (user-info :nick)
+  {:user_id  (user-info :user_id)
+   :nick     (user-info :nick)
    :is_admin (user-info :is_admin)
-   :avatar (user-info :avatar)})
+   :avatar   (user-info :avatar)})
 
 (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)
+   :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))
 
 ;; login-token functions
@@ -318,8 +318,8 @@
 (defn login [session params cookies]
   (let [nick         (or (params :nick) "")
         hash         (or (params :hash) "")
-        db-user      (authorize-nick-hash nick hash)
         remember-me  (= (params :rememberme) "yes")
+        db-user      (authorize-nick-hash nick hash)
         login-cookie (if remember-me
                        (make-login-token db-user)
                        (clear-login-token *login-token-key*))]
@@ -344,7 +344,7 @@
 (defn load-invalid-nicks []
   (set (read-lines *reserved-nicks-path*)))
 
-(def *reserved-nicks* 
+(def *reserved-nicks*
      (scheduled-agent (no-args-adaptor load-invalid-nicks)
                       *reserved-nicks-refresh-period-sec*
                       (load-invalid-nicks)))
@@ -390,7 +390,7 @@ ORDER BY created_on DESC;
 ")
 
 (defn zoeee-nudes [session]
-  (let [raw-dumps    (map tags/parse-tags-from-row-as-tag-map 
+  (let [raw-dumps    (map tags/parse-tags-from-row-as-tag-map
                           (do-select [*zoeee-query*]))
         dumps        (map tags/add-favorited-flag raw-dumps (repeat session))
         dumps        (map tags/remove-tags-for-output dumps)
@@ -406,18 +406,21 @@ ORDER BY created_on DESC;
 
 (defn profile [session profile-nick offset]
   (if-let [user-info (fetch-nick profile-nick)]
-    (let [st (fetch-template "profile" session)
-          profile-nick (:nick user-info)
-          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*)
-          raw-dumps (logger tags/fetch-dumps-by-nick :nick profile-nick :amount (+ 1 *dumps-per-page*) :offset 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))]
+    (let [st            (fetch-template "profile" session)
+          profile-nick  (:nick user-info)
+          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*)
+          raw-dumps     (logger tags/fetch-dumps-by-nick
+                                :nick profile-nick
+                                :amount (+ 1 *dumps-per-page*)
+                                :offset 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]]
@@ -1068,6 +1071,8 @@ ORDER  BY msg_count DESC")
   (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))
+  (POST "/feed-test" (feed-test session params))
 
   ;; Footer pages
   (GET "/about_us" (serve-template "about_us" session))
diff --git a/src/utils.clj b/src/utils.clj
index 3f3efab..5d7af94 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -4,6 +4,8 @@
            java.util.TimeZone
            java.io.File
            java.net.URLDecoder
+           javax.sql.DataSource
+	   org.postgresql.ds.PGPoolingDataSource
            org.apache.commons.codec.digest.DigestUtils
            org.antlr.stringtemplate.StringTemplateGroup)
   (:use clojure.contrib.json.write
@@ -12,13 +14,16 @@
         compojure))
 
 (let [db-host "localhost"
-      db-port 5432
-      db-name "dumpfm"]
-  (def *db* {:classname "org.postgresql.Driver"
-             :subprotocol "postgresql"
-             :subname (str "//" db-host ":" db-port "/" db-name)
-             :user "postgres"
-             :password "root"}))
+      db-name "dumpfm"
+      db-user "postgres"
+      db-pass "root"]
+  ; TODO: use c3p0 for pooling?
+  (def *db* {:datasource (doto (new PGPoolingDataSource)
+                           (.setServerName   db-host)
+                           (.setDatabaseName db-name)
+                           (.setUser         db-user)
+                           (.setPassword     db-pass)
+                           (.setMaxConnections 3))}))
 
 ;;  moved this to here which doesn't seem right... maybe a 'settings.clj' or something?
 (def *dumps-per-page* 20)
@@ -26,6 +31,9 @@
 
 ;; Misc
 
+(defn append [& vecs]
+  (reduce into vecs))
+
 (declare stringify-and-escape)
 (defn escape-html-deep [o]
   (if (map? o)
@@ -78,11 +86,11 @@
 (defn sha1-hash [& more]
   (DigestUtils/shaHex (apply str more)))
 
-(defmacro with-timing [e] 
+(defmacro with-timing [e]
   `(let [s# (System/nanoTime)
          r# ~e
          f# (System/nanoTime)]
-     [(int (/ (- f# s#) 1000000.0)) r#]))
+     [(int (/ (- f# s#) 1e6)) r#]))
 
 
 ;; Formatters
@@ -185,6 +193,10 @@
   ([res ok err] (if (not (= (first res) 1)) err ok))
   ([res] (assert-update res true false)))
 
+(defn sql-array [type arr]
+  (with-connection *db*
+    (.createArrayOf (connection) type (into-array arr))))
+
 ;; Parsing
 
 (defn maybe-parse-int