129 lines
5.3 KiB
Racket
129 lines
5.3 KiB
Racket
#lang racket/base
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Tracking current and historical references to uploaded files.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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, a.page_id, a.stored_name
|
|
FROM attachments a
|
|
ORDER BY a.id
|
|
SQL
|
|
))
|
|
|
|
(define (attachment-url reference stored-name)
|
|
(format "/uploads/~a/~a" reference stored-name))
|
|
|
|
(define (page-references db page-id)
|
|
(define current
|
|
(query-row db
|
|
"SELECT namespace, slug FROM pages WHERE id = $1"
|
|
page-id))
|
|
(define references
|
|
(list (if (string=? (vector-ref current 0) "")
|
|
(vector-ref current 1)
|
|
(string-append (vector-ref current 0) ":" (vector-ref current 1)))))
|
|
(define aliases-available?
|
|
(query-value db "SELECT to_regclass('page_aliases') IS NOT NULL"))
|
|
(when aliases-available?
|
|
(for ((row (in-list
|
|
(query-rows db
|
|
"SELECT namespace, slug FROM page_aliases WHERE page_id = $1 ORDER BY id"
|
|
page-id))))
|
|
(define reference
|
|
(if (string=? (vector-ref row 0) "")
|
|
(vector-ref row 1)
|
|
(string-append (vector-ref row 0) ":" (vector-ref row 1))))
|
|
(set! references (cons reference references))))
|
|
references)
|
|
|
|
(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 owner-page-id (vector-ref row 1))
|
|
(define stored-name (vector-ref row 2))
|
|
(define found? #f)
|
|
(for ((reference (in-list (page-references db owner-page-id))))
|
|
(when (string-contains? markdown (attachment-url reference stored-name))
|
|
(set! found? #t)))
|
|
(when found?
|
|
(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))
|