| ︙ | | |
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
|
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
|
-
-
+
+
+
|
;; data; a maliciously crafted input could bomb the database. This is acceptable
;; since the database is merely a disposable cache, and since all the input
;; will be coming from me.
(require pollen/setup
pollen/core
pollen/template
pollen/pagetree
crystalize-article!)
crystalize-article!
article-plain-title)
;; ~~~ Private use ~~~
(define DBFILE (build-path (current-project-root) "vitreous.sqlite"))
;; Since the DB exists to serve as a high-speed cache, the tables are constructed so that
;; the most commonly needed data can be grabbed quickly with extremely simple queries. In
;; the even that you want to do something fancy and custom rather than using the pre-cooked
;; HTML, enough info is provided in the other columns to allow you to do so.
;;
(define table_articles-fields
'(pagenode
title_plain
title_html_flow
title_specified
published
updated
author
conceal
series_pagenode
noun_singular
note_count
|
| ︙ | | |
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
|
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
|
+
-
+
-
+
+
|
(define (crystalize-article! pagenode doc)
(define pubdate (select-from-metas 'published (current-metas)))
(define-values (body-txpr note-txprs) (doc->body/notes doc))
(define doc-html (->html (cdr body-txpr)))
(define-values (disposition disp-note-id)
(notes->last-disposition-values note-txprs))
(define title-specified? (non-empty-string? (maybe-meta 'title)))
(define-values (title-plain title-html-flow)
(make-article-titles (maybe-meta 'title (default-title pubdate)) disposition))
(define header (html$-article-open title-html-flow pubdate))
(define header (html$-article-open title-specified? title-html-flow pubdate))
(define footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs)))
(define footer (html$-article-close footertext))
(define notes-section-html (crystalize-notes! pagenode title-plain note-txprs))
;; Values must come in the order defined in table_article_fields
(define article-record
(list (symbol->string pagenode)
title-plain
title-html-flow
(bool->int title-specified?)
pubdate
(maybe-meta 'updated)
(maybe-meta 'author default-authorname)
(maybe-meta 'conceal)
series-node
(maybe-meta 'noun (series-noun))
(length note-txprs)
|
| ︙ | | |
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
-
-
+
+
+
+
+
+
+
+
+
|
(apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
◊string-append{◊header ◊doc-html ◊notes-section-html ◊footer})
;; ~~~ Article-related helper functions ~~~
;;
;; Given a disposition and title, return both a plain-text and HTML version of the title
(define (make-article-titles title-val disposition)
;; Return both a plain-text and HTML version of a title for the current article,
;; supplying a default if no title was specified in the metas.
(define (title-plain+html-values body-tx disposition)
(define title (maybe-meta 'title ""))
(define title-val
(cond [(and (string? title) (string=? title ""))
(format "“~a…”" (first-words (tx-strs body-tx) 5))]
[else title]))
(define disposition-part
(cond [(non-empty-string? disposition)
(define-values (mark _) (disposition-values disposition))
(format "<span class=\"disposition-mark\">~a</span>" mark)]
[else ""]))
(cond [(txexpr? title-val)
|
| ︙ | | |
264
265
266
267
268
269
270
|
274
275
276
277
278
279
280
281
282
283
|
+
+
+
|
" AND `note_id` = ?2), ~a)")
(list->sql-fields table_notes-fields)
(list->sql-parameters table_notes-fields)))
(apply query! save-note-query note-record)
;; return html$ of note
(html$-note-in-article note-id note-date content-html author author-url))
(define (article-plain-title pagenode)
(query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode)))
|
