152 lines
6.2 KiB
Racket
152 lines
6.2 KiB
Racket
#lang racket/base
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Tracking current and historical references to uploaded files.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(require db
|
|
net/uri-codec
|
|
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 (attachment-url-variants reference stored-name)
|
|
(list (attachment-url reference stored-name)
|
|
(format "/uploads/~a/~a"
|
|
reference
|
|
(uri-path-segment-unreserved-encode stored-name))))
|
|
|
|
(define (page-references db page-id)
|
|
(let* ((current
|
|
(query-row db
|
|
"SELECT namespace, slug FROM pages WHERE id = $1"
|
|
page-id))
|
|
(references
|
|
(list (if (string=? (vector-ref current 0) "")
|
|
(vector-ref current 1)
|
|
(string-append (vector-ref current 0) ":" (vector-ref current 1)))))
|
|
(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))))
|
|
(let ((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))))
|
|
(let ((attachment-id (vector-ref row 0))
|
|
(owner-page-id (vector-ref row 1))
|
|
(stored-name (vector-ref row 2))
|
|
(found? #f))
|
|
(for ((reference (in-list (page-references db owner-page-id))))
|
|
(when (for/or ((url (in-list (attachment-url-variants reference stored-name))))
|
|
(string-contains? markdown url))
|
|
(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))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Tests for module attachment-references.rkt.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(module+ test
|
|
(require rackunit)
|
|
|
|
(define urls
|
|
(attachment-url-variants
|
|
"review-zuidas-2026:appreciatie"
|
|
"1788796826-35348-Review ZuidasDok.docx"))
|
|
(check-equal?
|
|
urls
|
|
(list "/uploads/review-zuidas-2026:appreciatie/1788796826-35348-Review ZuidasDok.docx"
|
|
"/uploads/review-zuidas-2026:appreciatie/1788796826-35348-Review%20ZuidasDok.docx")))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; 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))
|