rdiedrich/clojsa
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: rdiedrich:master
Branches Tags
rdiedrich:master
rdiedrich:work
rdiedrich:heroku/0.1
..
compare: rdiedrich:work
Branches Tags
rdiedrich:master
rdiedrich:work
rdiedrich:heroku/0.1

No commits in common. "master" and "work" have entirely different histories.
master ... work

8 changed files with 197 additions and 264 deletions
Show Stats Expand all files Collapse all files

1
Procfile
View File

@ -1 +0,0 @@
web: java $JVM_OPTS -cp target/clojsa-standalone.jar clojure.main -m clojsa.handler

14
project.clj
View File

@ -2,19 +2,13 @@
:description "FIXME: write description"
:url "http://example.com/FIXME"
:min-lein-version "2.0.0"
:dependencies [[org.clojure/clojure "1.10.1"]
:dependencies [[org.clojure/clojure "1.10.0"]
[compojure "1.6.1"]
[ring/ring-jetty-adapter "1.7.1"]
[ring/ring-defaults "0.3.2"]
[http.async.client "1.3.1"]
[hickory "0.7.1"]
[environ "1.1.0"]]
[hickory "0.7.1"]]
:plugins [[lein-ring "0.12.5"]]
:ring {:handler clojsa.handler/app
:nrepl {:start? true :port 9000}}
:uberjar-name "clojsa-standalone.jar"
:ring {:handler clojsa.handler/app}
:profiles
{:dev {:dependencies [[javax.servlet/servlet-api "2.5"]
[ring/ring-mock "0.3.2"]
[postmortem "0.4.0"]]}
:production {:env {:production true}}})
[ring/ring-mock "0.3.2"]]}})

10
resources/public/css/style.css
View File

@ -14,27 +14,21 @@ body {
margin: 0 auto;
}
#login-form .control {
min-width: 20rem;
max-width: 30vw;
}
nav.pagination {
background-color: #fff;
margin-top: 2rem;
}
.userinfo .registered {
.userinfo > dd.registered {
font-size: 0.75rem;
}
.userinfo .avatar-title {
.userinfo > dd.title {
margin-top: 1rem;
font-size: inherit;
font-weight: inherit;
line-height: inherit;
}
.userinfo .avatar-title img.img { vertical-align: bottom; }
.content .bbc-block > h4 {
font-size: 1rem;

104
src/clojsa/awful/parser.clj
View File

@ -1,104 +0,0 @@
(ns clojsa.awful.parser
(:require [clojure.string :as string]
[clojure.pprint :refer [pprint]]
[hickory.core :refer :all]
[hickory.select :as s]
[hickory.convert :refer [hickory-to-hiccup]]))
(defn hickory-doc [doc]
(-> doc parse as-hickory))
(defn hickory-div [content class]
{:type :element
:attrs {:class class}
:tag :div
:content content})
(defmulti element-node (fn [kw htree] kw))
(defmethod element-node :author [_ htree]
(-> (s/select (s/child (s/class :author)) htree)
first :content first))
(defmethod element-node :bookmarks [_ htree]
(s/select (s/descendant
(s/id :forum) (s/tag :tbody) (s/tag :tr)) htree))
(defmethod element-node :pagecount [_ htree]
(-> (s/select (s/descendant
(s/class :pages) (s/tag :option)) htree)
last :content first Integer/parseInt))
(defmethod element-node :title [_ htree]
(-> (s/select (s/child (s/tag :title)) htree)
first :content first
(string/replace #" - The Something Awful Forums" "")))
(defmethod element-node :thread [_ htree]
(let [thread-tree (first (s/select (s/descendant
(s/id :thread)) htree))
td-classes [:userinfo :postdate :postbody]]
(for [class-key td-classes]
(s/select (s/descendant
(s/and (s/tag :td) (s/class class-key))) thread-tree))))
(defmulti processed-element (fn [kw elem] kw))
(defmethod processed-element :bookmark [_ elem]
(when-let [link (first
(s/select (s/descendant
(s/class :info) (s/tag :a)) elem))]
(let [thread-id (re-find #"\d+$" (:href (:attrs link)))
title (-> link :content first string/trim)]
{:id thread-id :title title})))
(defmethod processed-element :postbody [_ elem]
(hickory-to-hiccup (hickory-div (:content elem) "postbody")))
(defmethod processed-element :postdate [_ elem]
(string/trim (last (hickory-to-hiccup elem))))
(defmethod processed-element :userinfo [_ elem]
(let [ui (first (s/select (s/descendant (s/tag :dl)) elem))
author (-> (s/select (s/descendant (s/class :author)) ui)
first :content first)
regdate (-> (s/select (s/descendant (s/class :registered)) ui)
first :content first)
title (-> (s/select (s/descendant (s/class :title)) ui) first)
avatar (-> (s/select (s/descendant (s/tag :img)) title) first)]
{:author author
:regdate regdate
:avatar-title (hickory-to-hiccup
(hickory-div (:content title) "avatar-title"))
:avatar (when avatar (hickory-to-hiccup avatar))}))
(defn thread-map [id page doc]
(let [htree (hickory-doc doc)
title (element-node :title htree)
page-count (element-node :pagecount htree)
thread-tree (element-node :thread htree)
[userinfo postdate postbody] thread-tree]
{:title title
:id id
:page page
:page-count page-count
:content
(for [[ui pd pb] (partition 3 (interleave userinfo postdate postbody))
:when (not= "Adbot" (element-node :author ui))]
{:ui (processed-element :userinfo ui)
:pd (processed-element :postdate pd)
:pb (processed-element :postbody pb)})}))
(defn bookmarks-map [page doc]
(let [htree (hickory-doc doc)
title (element-node :title htree)
page-count (element-node :pagecount htree)
bookmarks-tree (element-node :bookmarks htree)]
{:title title
:page page
:page-count page-count
:content
(for [row bookmarks-tree
:let [parsed-row (processed-element :bookmark row)]
:when parsed-row]
parsed-row)}))

54
src/clojsa/handler.clj
View File

@ -1,62 +1,40 @@
(ns clojsa.handler
(:require [clojsa.views :as views]
[clojsa.awful.client :as client]
[clojsa.awful.parser :as parser]
[compojure.core :refer [defroutes GET POST]]
[clojsa.saclient :as client]
[clojsa.saparser :as parser]
[compojure.core :refer :all]
[compojure.route :as route]
[compojure.coercions :refer [as-int]]
[ring.middleware.defaults :refer [wrap-defaults site-defaults]]
[ring.middleware.session :refer [wrap-session]]
[ring.middleware.session.cookie :refer (cookie-store)]
[ring.adapter.jetty :as jetty]
[environ.core :refer [env]]))
[ring.middleware.session.cookie :refer (cookie-store)]))
(defn get-thread [session id page]
(let [turl (client/thread-url id page)
tresp (client/text-response session turl)]
tresp (client/thread-response session turl)]
(parser/thread-map id page tresp)))
(defn thread-page [session id page]
(let [thread (get-thread session id page)
{:keys [id page page-count title]} thread
login-part (views/login-form
["/thread/%d?page=%d" id page]
(get session :loggedin false))
header-part (views/header-fragment login-part)
thread-part (views/thread-page thread)
paginate-part (views/paginate
(str "/thread/" id) page page-count)]
(views/main-template {:title title}
header-part thread-part paginate-part)))
(defn get-bookmarks [session page]
(let [burl (client/bookmarks-url page)
bresp (client/text-response session burl)]
bresp (client/bookmarks-response session burl)]
(parser/bookmarks-map page bresp)))
(defroutes app-routes
(GET "/" request (views/index-page request))
(GET "/login" []
(views/main-template
{:title "Login"}
(-> (views/login-form ["/bookmarks"] false)
(views/login-page))))
(GET "/login" [] (views/login-page))
(POST "/login" [username password next :as {session :session}]
(POST "/login" [username password :as {session :session}]
(let [resp-cookies (client/login-response username password session)]
{:status 302
:headers {"Location" next}
:session (assoc session :cookies resp-cookies :loggedin true)}))
:headers {"Location" "/bookmarks"}
:session (assoc session :cookies resp-cookies)}))
(GET "/bookmarks" [page :<< as-int
:as {session :session}]
(if (get session :loggedin)
(let [beems (get-bookmarks session page)]
(views/bookmarks-page beems))
{:status 302
:headers {"Location" "/login"}}))
(views/bookmarks-page beems)))
(GET "/bookmarks" []
{:status 302 :headers {"Location" "/bookmarks?page=1"}})
@ -64,7 +42,8 @@
(GET "/thread/:id" [id :<< as-int
page :<< as-int
:as {session :session}]
(thread-page session id page))
(let [thread (get-thread session id page)]
(views/thread-page thread)))
(GET "/thread/:id" [id]
{:status 302 :headers {"Location" (str "/thread/" id "?page=1")}})
@ -75,9 +54,4 @@
(-> app-routes
(wrap-defaults site-defaults)
(wrap-session {:cookie-attrs {:max-age (* 7 24 3600)}
:store (cookie-store {:key (or (env :cskey)
"699a7e4bd79b3f56")})})))
(defn -main [& [port]]
(let [port (Integer. (or port (env :port) 5000))]
(jetty/run-jetty app {:port port :join? false})))
:store (cookie-store {:key "699a7e4bd79b3f56"})})))

23
src/clojsa/awful/client.clj → src/clojsa/saclient.clj
View File

@ -1,5 +1,6 @@
(ns clojsa.awful.client
(:require [http.async.client :as http]))
(ns clojsa.saclient
(:require [clojure.string :as string]
[http.async.client :as http]))
(def url "https://forums.somethingawful.com/")
@ -21,6 +22,7 @@
query {:pagenumber page}]
{:href base-url :params query})))
(defn login-response [username password session]
(with-open [client (http/create-client)]
(let [login-url (str url "account.php")
@ -34,7 +36,7 @@
http/await
http/cookies))))
(defn text-response [session url]
(defn bookmarks-response [session url]
(with-open [client (http/create-client)]
(let [{:keys [href params]} url
req-cookies (:cookies session)
@ -43,6 +45,15 @@
headers (http/headers resp)]
(-> resp
http/await
http/body
.toByteArray
(String. "windows-1252")))))
http/string))))
(defn thread-response [session url]
(with-open [client (http/create-client)]
(let [{:keys [href params]} url
req-cookies (:cookies session)
resp (http/GET client href :query params :cookies req-cookies)
status (http/status resp)
headers (http/headers resp)]
(-> resp
http/await
http/string))))

89
src/clojsa/saparser.clj Normal file
View File

@ -0,0 +1,89 @@
(ns clojsa.saparser
(:require [clojsa.saclient :refer [thread-url thread-response]]
[clojure.string :as string]
[hickory.core :refer :all]
[hickory.select :as s]
[hickory.convert :refer [hickory-to-hiccup]]))
(defn hickory-doc [doc]
(-> doc parse as-hickory))
(defn parse-title [htree]
(-> (s/select (s/child (s/tag :title)) htree)
first :content first
(string/replace #" - The Something Awful Forums" "")))
(defn parse-pagecount [htree]
(-> (s/select (s/descendant
(s/class :pages) (s/tag :option)) htree)
last :content first Integer/parseInt))
(defn parse-thread [htree]
(-> (s/select (s/descendant
(s/id :thread))
htree)
first))
(defn select-td [class-key htree]
(s/select (s/descendant
(s/and (s/tag :td) (s/class class-key))) htree))
(defn parse-ui [ui]
(let [ui (first (s/select (s/descendant (s/tag :dl)) ui))]
(hickory-to-hiccup ui)))
(defn parse-pd [pd]
(string/trim (last (hickory-to-hiccup pd))))
(defn hickory-div [class content]
{:type :element,
:attrs {:class class},
:tag :div,
:content content})
(defn parse-pb [pb]
(let [pb (-> pb :content)]
(hickory-to-hiccup (hickory-div "postbody" pb))))
(defn thread-map [id page doc]
(let [htree (hickory-doc doc)
title (parse-title htree)
page-count (parse-pagecount htree)
thread-tree (parse-thread htree)
userinfo (select-td :userinfo thread-tree)
postdate (select-td :postdate thread-tree)
postbody (select-td :postbody thread-tree)]
{:title title
:id id
:page page
:page-count page-count
:content
(for [[ui pd pb] (partition 3 (interleave userinfo postdate postbody))
:when (not= "Adbot" (-> (s/select (s/child (s/class :author)) ui)
first :content first))]
{:ui (parse-ui ui) :pd (parse-pd pd) :pb (parse-pb pb)})}))
(defn parse-bookmarks [htree]
(s/select (s/descendant
(s/id :forum)
(s/tag :tbody)
(s/tag :tr))
htree))
(defn parse-row [htree]
(let [link (-> (s/select (s/descendant (s/class :info) (s/tag :a)) htree) first)
thread-id (re-find #"\d+$" (:href (:attrs link)))
title (-> link :content first string/trim)]
{:id thread-id :title title}))
(defn bookmarks-map [page doc]
(let [htree (hickory-doc doc)
title (parse-title htree)
page-count (parse-pagecount htree)
bookmarks-tree (parse-bookmarks htree)]
{:title title
:page page
:page-count page-count
:content
(for [row bookmarks-tree]
(parse-row row))}))

116
src/clojsa/views.clj
View File

@ -1,47 +1,17 @@
(ns clojsa.views
(:require [hiccup.core :refer [html]]
[hiccup.page :refer [html5 include-css include-js]]
(:use [hiccup core page])
(:require [clojure.string :as string]
[clojure.pprint]
[clojure.java.io :as io]
[cheshire.core :as json]
[ring.util.anti-forgery :refer [anti-forgery-field]]))
(defn login-form [next loggedin]
(if loggedin
[:a.navbar-item "Logout"]
[:div.navbar-item.has-dropdown.is-hoverable
[:a.navbar-link "Login"]
[:div.navbar-dropdown.is-right
[:div.navbar-item
[:form#login-form {:action "/login" :method "post"}
(anti-forgery-field)
[:input {:type "hidden" :name "next"
:value (apply format next)}]
[:div.field
[:label.label {:for "username"} "username"]
[:div.control
[:input#username.input {:name "username" :type "text"
:placeholder "enter your username"}]]]
[:div.field
[:label.label {:for "password"} "password"]
[:div.control
[:input#password.input {:name "password" :type "password"
:placeholder "enter your password"}]]]
[:div.field
[:div.control
[:button.button.is-primary "Submit"]]]]]]]))
(defn header-fragment []
(html
[:nav]))
(defn header-fragment [login]
[:nav.navbar.is-transparent
[:div.navbar-brand
[:a.burger.navbar-burger {:role "button" :data-target "mainNav"}
(repeat 3 [:span {:aria-hidden "true"}])]]
[:div#mainNav.navbar-menu
[:div.navbar-start
[:a.navbar-item {:href "/bookmarks"} "Bookmarks"]]
[:div.navbar-end
login]]])
(defn main-template [opts header & insert-body-here]
(defn main-template [opts & insert-body-here]
(html5
{:lang "de"}
[:head
@ -55,7 +25,7 @@
[:body
{:hx-boost "false"}
[:header
header]
(header-fragment)]
[:main
insert-body-here]
(include-js "/js/main.js")]))
@ -67,64 +37,70 @@
[:pre.output
[:code (with-out-str (clojure.pprint/pprint req))]]]))
(defn login-page [login]
(defn login-page []
(main-template
{:title "login"}
[:div.container.box
login])
[:form#login-form {:action "/login" :method "post"}
(anti-forgery-field)
[:div.field
[:label.label {:for "username"}
"username"]
[:div.control
[:input#username.input {:name "username" :type "text" :placeholder "enter your username"}]]]
[:div.field
[:label.label {:for "password"}
"password"]
[:div.control
[:input#password.input {:name "password" :type "password" :placeholder "enter your password"}]]]
[:div.field
[:div.control
[:button.button.is-primary "Submit"]]]]]))
(defn paginate [base cur last]
(let [page-fstring "%s?page=%d"
href (partial format page-fstring base)]
[:section
[:nav.container.box.pagination {:hx-boot "false"}
[:a.pagination-previous
{:href (href (dec cur))} "<"]
{:href (format "%s?page=%d" base (dec cur))} "<"]
[:a.pagination-next
{:href (href (inc cur))} ">"]
{:href (format "%s?page=%d" base (inc cur))} ">"]
[:ul.pagination-list
[:li
[:a.pagination-link
{:href (href 1)} (str 1)]]
{:href (format "%s?page=%d" base 1)} (str 1)]]
[:li
[:span.pagination-ellipsis "&hellip;"]]
(for [i (range (- cur 2) (+ cur 3))]
[:li
[:a.pagination-link
{:href (href i)
{:href (format "%s?page=%d" base i)
:class (when (= i cur) "is-current")} (str i)]])
[:li
[:span.pagination-ellipsis "&hellip;"]]
[:li
[:a.pagination-link
{:href (href last)} (str last)]]]]]))
{:href (format "%s?page=%d" base last)} (str last)]]]])
(defn thread-page [{:keys [title content]}]
(list
[:section.title [:div.container
[:h1.is-size-3.mb-4 title]]]
(defn thread-page [thread]
(let [{:keys [id title page page-count content]} thread]
(main-template
{:title title}
[:div.container
[:h1.is-size-3.mb-4 title]]
[:section.thread
(for [post content]
[:article.container.box
[:div.tile.is-ancestor
[:aside.userinfo.card.is-shadowless.tile.is-3.is-parent
[:div.card-content.px-0.py-0
(let [{:keys [author regdate avatar avatar-title]} (:ui post)]
(list
[:div.media
(when avatar
[:div.media-left.is-hidden-tablet
[:figure.image.is-64x64 avatar]])
[:div.media-content
[:p.author.title.is-4 author]
[:p.regdate.subtitle.is-6 regdate]]]
[:div.is-hidden-mobile
avatar-title]))]]
[:main.postbody.tile.is-9.is-parent.is-vertical
[:div.content.is-size-6.tile.is-child
[:aside.userinfo.tile.is-3.is-parent
(:ui post)]
[:main.postbody.content.tile.is-9.is-parent.is-vertical
[:div.tile.is-child
(:pb post)]
[:div.level.is-mobile.tile.is-child.is-12
[:div.level.tile.is-child.is-12
[:div.level-right
[:span.postdate.level-item
(:pd post)]]]]]])]))
(:pd post)]]]]]])]
[:section
(paginate (str "/thread/" id) page page-count)])))
(defn bookmarks-page [beems]
(let [{:keys [title page page-count content]} beems]