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

multimethods

Browse Source
This commit is contained in:
Rüdiger Diedrich 2020-06-30 18:36:19 +02:00
parent 0c81a2f51a
commit 00f57ae117
1 changed files with 48 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
src/clojsa/saparser.clj
View File

@ -14,64 +14,63 @@
:tag :div :tag :div
:content content}) :content content})
(defn element-node [kw htree] (defmulti element-node (fn [kw htree] kw))
(case kw
:author (defmethod element-node :author [_ htree]
(-> (s/select (s/child (s/class :author)) htree) (-> (s/select (s/child (s/class :author)) htree)
first :content first) first :content first))
:bookmarks (defmethod element-node :bookmarks [_ htree]
(s/select (s/descendant (s/select (s/descendant
(s/id :forum) (s/tag :tbody) (s/tag :tr)) htree) (s/id :forum) (s/tag :tbody) (s/tag :tr)) htree))
:pagecount (defmethod element-node :pagecount [_ htree]
(-> (s/select (s/descendant (-> (s/select (s/descendant
(s/class :pages) (s/tag :option)) htree) (s/class :pages) (s/tag :option)) htree)
last :content first Integer/parseInt) last :content first Integer/parseInt))
:title (defmethod element-node :title [_ htree]
(-> (s/select (s/child (s/tag :title)) htree) (-> (s/select (s/child (s/tag :title)) htree)
first :content first first :content first
(string/replace #" - The Something Awful Forums" "")) (string/replace #" - The Something Awful Forums" "")))
:thread (defmethod element-node :thread [_ htree]
(let [thread-tree (first (s/select (s/descendant (let [thread-tree (first (s/select (s/descendant
(s/id :thread)) htree)) (s/id :thread)) htree))
td-classes [:userinfo :postdate :postbody]] td-classes [:userinfo :postdate :postbody]]
(for [class-key td-classes] (for [class-key td-classes]
(s/select (s/descendant (s/select (s/descendant
(s/and (s/tag :td) (s/class class-key))) thread-tree))))) (s/and (s/tag :td) (s/class class-key))) thread-tree))))
(defn processed-element [kw elem] (defmulti processed-element (fn [kw elem] kw))
(case kw
:bookmark
(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}))
:postbody (defmethod processed-element :bookmark [_ elem]
(hickory-to-hiccup (hickory-div (:content elem) "postbody")) (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})))
:postdate (defmethod processed-element :postbody [_ elem]
(string/trim (last (hickory-to-hiccup elem))) (hickory-to-hiccup (hickory-div (:content elem) "postbody")))
:userinfo (defmethod processed-element :postdate [_ elem]
(let [ui (first (s/select (s/descendant (s/tag :dl)) elem)) (string/trim (last (hickory-to-hiccup elem))))
author (-> (s/select (s/descendant (s/class :author)) ui)
first :content first) (defmethod processed-element :userinfo [_ elem]
regdate (-> (s/select (s/descendant (s/class :registered)) ui) (let [ui (first (s/select (s/descendant (s/tag :dl)) elem))
first :content first) author (-> (s/select (s/descendant (s/class :author)) ui)
title (-> (s/select (s/descendant (s/class :title)) ui) first) first :content first)
avatar (-> (s/select (s/descendant (s/tag :img)) title) first)] regdate (-> (s/select (s/descendant (s/class :registered)) ui)
{:author author first :content first)
:regdate regdate title (-> (s/select (s/descendant (s/class :title)) ui) first)
:avatar-title (hickory-to-hiccup avatar (-> (s/select (s/descendant (s/tag :img)) title) first)]
(hickory-div (:content title) "avatar-title")) {:author author
:avatar (when avatar (hickory-to-hiccup avatar))}))) :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] (defn thread-map [id page doc]
(let [htree (hickory-doc doc) (let [htree (hickory-doc doc)