blob: 4994412df68e5c545cf14a904d6843f4851f6df8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
(ns weepinbell.storage.h2
(:require [clojure.string :refer [blank? split]]
[next.jdbc :as jdbc]
[next.jdbc.result-set :refer [as-unqualified-lower-maps]]
[next.jdbc.sql :as sql]
[clojure.java.io :as io]
[fast-edn.core :as edn]
[weepinbell.utils.url :refer [get-domain get-path]]))
;; data trasnformation utilities
(defn schema->map
[{:keys [wm_source wm_target hash lastmod
jf2_data photo_url]}]
(let [parse #(if (string? %) (edn/read-string %) %)
jf2 (parse jf2_data)
photo photo_url]
(cond-> {:webmention {:source wm_source
:target wm_target
:id hash
:modified lastmod}}
(some? jf2) (assoc :jf2 jf2)
(some? photo) (assoc :extra {:proxied-photo photo}))))
(defn wm->schema [data]
(let [{:keys [webmention]} data
{:keys [id modified source target]} webmention]
{:hash id ;; weepinbell's id is hash in sqlite
:wm_source source
:wm_target target
:wm_target_domain (get-domain target)
:wm_source_domain (get-domain source)
:wm_source_path (get-path source)
:wm_target_path (get-path target)
:lastmod (or modified (System/currentTimeMillis))}))
(defn jf2->schema [wm_id data]
(let [jf2 (:jf2 data)
get-name #(if % (name %) "mention")]
{:wm_id wm_id
:jf2_type (->> jf2 :wm-property get-name)
;; conver EDN to raw string
:jf2_data (pr-str jf2)}))
;; sql
(defn insert-webmention [ds data]
(jdbc/with-transaction [tx ds]
(let [tx (jdbc/with-options tx {:builder-fn as-unqualified-lower-maps})
jf2 (:jf2 data)
photo (get-in data [:extra :proxied-photo])
wm_result (sql/insert! tx :webmention (wm->schema data))
wm_id (:id wm_result)]
(when jf2
(sql/insert! tx :jf2 (jf2->schema wm_id data)))
(when photo
(sql/insert! tx :proxied_photo
{:wm_id wm_id
:url photo})))))
(defn delete-webmention [ds hashcode]
;; jf2 data and photo will be deleted by
;; cascade rule by SQL, no need to handle it
(sql/delete! ds :webmention {:hash hashcode}))
(def base-sql "SELECT w.*, j.jf2_data, j.jf2_type, p.url AS photo_url
FROM webmention w
LEFT JOIN jf2 j
ON w.id = j.wm_id
LEFT JOIN proxied_photo p
ON w.id = p.wm_id")
(defn get-webmention-by-hash [ds hashcode]
(first (jdbc/execute! ds [(str base-sql "
WHERE hash = ?") hashcode])))
(defn get-webmention-by-pair [ds source target]
(first (jdbc/execute! ds [(str base-sql "
WHERE wm_source = ?
AND wm_target = ?
ORDER BY w.lastmod, w.id")
source target])))
(defn get-webmention
([ds hashcode]
(some->> (get-webmention-by-hash ds hashcode)
schema->map))
([ds source target]
(some->> (get-webmention-by-pair ds source target)
schema->map)))
(defn get-webmentions-by-domain
([ds domain]
(get-webmentions-by-domain ds domain nil))
([ds domain path]
(let [r (if (some? path)
(jdbc/execute! ds [(str base-sql "
WHERE wm_target_domain = ?
AND wm_target_path = ?
ORDER BY w.lastmod, w.id")
domain path])
(jdbc/execute! ds [(str base-sql "
WHERE wm_target_domain = ?
ORDER BY w.lastmod, w.id")
domain]))]
(map schema->map r))))
(defn- update-related! [ds wm_id data]
(let [jf2 (:jf2 data)
photo (get-in data [:extra :proxied-photo])]
(sql/delete! ds :jf2 {:wm_id wm_id})
(when jf2
(sql/insert! ds jf2 (jf2->schema wm_id data)))
(sql/delete! ds :proxied_photo {:wm_id wm_id})
(when photo
(sql/insert! ds :proxied_photo {:wm_id wm_id :url photo}))))
(defn update-webmention
([ds hashcode new]
(jdbc/with-transaction [tx ds]
(let [tx (jdbc/with-options tx {:builder-fn as-unqualified-lower-maps})]
(when-let [wm (get-webmention-by-hash tx hashcode)]
(sql/update! tx :webmention (wm->schema new) {:id (:id wm)})
(update-related! tx (:id wm) new)))))
([ds source target new]
(jdbc/with-transaction [tx ds]
(let [tx (jdbc/with-options tx {:builder-fn as-unqualified-lower-maps})]
(when-let [wm (get-webmention-by-pair tx source target)]
(sql/update! tx :webmention (wm->schema new) {:id (:id wm)})
(update-related! tx (:id wm) new))))))
(defn make-db [db-file]
(io/make-parents db-file)
{:dbtype "h2" :dbname db-file})
(defn make-ds [db]
(jdbc/get-datasource db))
(defn make-datasource [db-file]
(jdbc/with-options (make-ds (make-db db-file))
{:builder-fn as-unqualified-lower-maps}))
(def init-sql-script (io/resource "sql/h2_init.sql"))
(defn create-tables [ds]
(doseq [:let [statements (-> init-sql-script slurp (split #";"))]
statement (remove blank? statements)]
(jdbc/execute! ds [statement])))
(defn use-store [db-file]
(let [ds (make-datasource db-file)]
(create-tables ds)
{:append (partial insert-webmention ds)
:update (partial update-webmention ds)
:delete (partial delete-webmention ds)
:get (partial get-webmention ds)
:get-by-domain (partial get-webmentions-by-domain ds)}))
|
