99 lines
4.0 KiB
Racket
99 lines
4.0 KiB
Racket
#lang racket/base
|
|
|
|
(require db
|
|
racket/string)
|
|
|
|
(provide replace-current-attachment-references!
|
|
record-version-attachment-references!
|
|
rebuild-attachment-references!)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Supporting functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (attachment-rows db)
|
|
(query-rows db
|
|
#<<SQL
|
|
SELECT a.id, p.slug, a.stored_name
|
|
FROM attachments a
|
|
JOIN pages p ON p.id = a.page_id
|
|
ORDER BY a.id
|
|
SQL
|
|
))
|
|
|
|
(define (attachment-url slug stored-name)
|
|
(format "/uploads/~a/~a" slug stored-name))
|
|
|
|
(define (record-references! db page-id page-version-id markdown current? referenced-at)
|
|
(for ((row (in-list (attachment-rows db))))
|
|
(define attachment-id (vector-ref row 0))
|
|
(define slug (vector-ref row 1))
|
|
(define stored-name (vector-ref row 2))
|
|
(when (string-contains? markdown (attachment-url slug stored-name))
|
|
(query-exec db
|
|
#<<SQL
|
|
INSERT INTO attachment_references
|
|
(attachment_id, page_id, page_version_id, current_reference, referenced_at)
|
|
VALUES ($1, $2, $3, $4, $5)
|
|
SQL
|
|
attachment-id
|
|
page-id
|
|
page-version-id
|
|
current?
|
|
referenced-at))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Replace the current attachment references for one page.
|
|
; pre : page-id identifies a page and markdown is its new current source.
|
|
; post : Current-reference rows for the page reflect markdown exactly.
|
|
; result : void.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (replace-current-attachment-references! db page-id markdown referenced-at)
|
|
(query-exec db
|
|
"DELETE FROM attachment_references WHERE page_id = $1 AND current_reference = TRUE"
|
|
page-id)
|
|
(record-references! db page-id sql-null markdown #t referenced-at)
|
|
(void))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Record attachment references present in an immutable page version.
|
|
; pre : page-version-id identifies the stored version represented by markdown.
|
|
; post : Historical-reference rows for that version reflect markdown exactly.
|
|
; result : void.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (record-version-attachment-references! db page-id page-version-id markdown referenced-at)
|
|
(query-exec db
|
|
"DELETE FROM attachment_references WHERE page_version_id = $1 AND current_reference = FALSE"
|
|
page-version-id)
|
|
(record-references! db page-id page-version-id markdown #f referenced-at)
|
|
(void))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Rebuild all attachment references from current pages and page history.
|
|
; pre : attachment_references and the existing wiki tables are available.
|
|
; post : The reference table reflects every current and historical Markdown page.
|
|
; result : void.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (rebuild-attachment-references! db)
|
|
(query-exec db "DELETE FROM attachment_references")
|
|
(for ((row (in-list
|
|
(query-rows db
|
|
"SELECT id, markdown, updated_at FROM pages WHERE archived = FALSE"))))
|
|
(replace-current-attachment-references! db
|
|
(vector-ref row 0)
|
|
(vector-ref row 1)
|
|
(vector-ref row 2)))
|
|
(for ((row (in-list
|
|
(query-rows db
|
|
"SELECT id, page_id, markdown, created_at FROM page_versions ORDER BY id"))))
|
|
(record-version-attachment-references! db
|
|
(vector-ref row 1)
|
|
(vector-ref row 0)
|
|
(vector-ref row 2)
|
|
(vector-ref row 3)))
|
|
(void))
|