hans/racket-wiki
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Multiple features. Admin page with verweeste items. Breadcrump working.

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-15 02:13:05 +02:00
parent ea7cd45eed
commit 6eef2d681c
10 changed files with 663 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/attachment-references.rkt
+98
View File
@@ -0,0 +1,98 @@
#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))
private/migrations.rkt
+26 -1
View File
@@ -4,6 +4,7 @@
racket/file
racket/path
racket/string
"attachment-references.rkt"
"config.rkt"
"todo.rkt")
@@ -11,7 +12,7 @@
database-schema-version
migrate-database!)
(define current-schema-version 5)
(define current-schema-version 6)
(define schema-1-statements
(list
@@ -239,6 +240,27 @@ SQL
(record-schema-version! db 5))
(define (migrate-5->6! db)
(query-exec db
#<<SQL
CREATE TABLE IF NOT EXISTS attachment_references (
id BIGSERIAL PRIMARY KEY,
attachment_id BIGINT NOT NULL REFERENCES attachments(id) ON DELETE CASCADE,
page_id BIGINT NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
page_version_id BIGINT REFERENCES page_versions(id) ON DELETE CASCADE,
current_reference BOOLEAN NOT NULL,
referenced_at BIGINT NOT NULL
)
SQL
)
(query-exec db
"CREATE INDEX IF NOT EXISTS attachment_references_attachment_idx ON attachment_references(attachment_id, current_reference, referenced_at DESC)")
(query-exec db
"CREATE INDEX IF NOT EXISTS attachment_references_page_idx ON attachment_references(page_id, current_reference)")
(rebuild-attachment-references! db)
(record-schema-version! db 6))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Bring a racket-wiki PostgreSQL database to the current schema.
; pre : db is a writable PostgreSQL connection and config identifies the
@@ -265,6 +287,9 @@ SQL
(define after-bookmarks (database-schema-version db))
(when (= after-bookmarks 4)
(migrate-4->5! db))
(define after-todo-reindex (database-schema-version db))
(when (= after-todo-reindex 5)
(migrate-5->6! db))
(define resulting-version (database-schema-version db))
(when (> resulting-version current-schema-version)
(error 'migrate-database!
private/storage.rkt
+112 -8
View File
@@ -6,6 +6,7 @@
racket/list
racket/path
racket/string
"attachment-references.rkt"
"config.rkt"
"database.rkt"
"todo.rkt")
@@ -26,6 +27,8 @@
list-bookmarks
set-bookmark!
delete-bookmark!
list-orphaned-uploads
delete-orphaned-upload!
save-upload!
uploaded-file)
@@ -161,12 +164,13 @@
(hash-ref item 'text))))
(define (insert-version! db page-id version title markdown author action summary now tags)
(query-exec db
#<<SQL
(query-value db
#<<SQL
INSERT INTO page_versions(page_id, version, title, markdown, tags, author, action, summary, created_at)
VALUES ($1, $2, $3, $4, $5, $6, $7, $8, $9)
RETURNING id
SQL
page-id version title markdown (tags->text tags) author action summary now))
page-id version title markdown (tags->text tags) author action summary now))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Create a wiki page and its first version.
@@ -193,8 +197,11 @@ VALUES ($1, $2, $3, $4, 1, $5, $5, $6, $6,
RETURNING id
SQL
slug title markdown (tags->text tags) now author))
(insert-version! db page-id 1 title markdown author "create" summary now tags)
(replace-todos! db page-id markdown)))))
(define page-version-id
(insert-version! db page-id 1 title markdown author "create" summary now tags))
(replace-todos! db page-id markdown)
(replace-current-attachment-references! db page-id markdown now)
(record-version-attachment-references! db page-id page-version-id markdown now)))))
(read-page config slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -237,8 +244,12 @@ SET title = $1, markdown = $2, tags = $3, current_version = $4,
WHERE id = $7
SQL
title markdown (tags->text page-tags) next-version now author (vector-ref row 0))
(insert-version! db (vector-ref row 0) next-version title markdown author "edit" summary now page-tags)
(replace-todos! db (vector-ref row 0) markdown)))))
(define page-id (vector-ref row 0))
(define page-version-id
(insert-version! db page-id next-version title markdown author "edit" summary now page-tags))
(replace-todos! db page-id markdown)
(replace-current-attachment-references! db page-id markdown now)
(record-version-attachment-references! db page-id page-version-id markdown now)))))
(read-page config slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -261,7 +272,10 @@ RETURNING id
SQL
(current-seconds) author slug))
(unless id
(error 'archive-page! "unknown page: ~a" slug))))
(error 'archive-page! "unknown page: ~a" slug))
(query-exec db
"DELETE FROM attachment_references WHERE page_id = $1 AND current_reference = TRUE"
id)))
(void))
(define (page-id config slug)
@@ -500,6 +514,96 @@ SQL
user-id slug)))
(void))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List uploads that no current page references.
; pre : PostgreSQL schema 6 or newer is initialized.
; post : Attachment and reference rows have only been read.
; result : A newest-first list with owner and last historical use metadata.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-orphaned-uploads config)
(call-with-wiki-database
config
(λ (db)
(for/list ((row (in-list
(query-rows db
#<<SQL
SELECT a.id,
a.original_name,
a.stored_name,
a.mime_type,
a.size,
a.uploaded_at,
a.uploaded_by,
owner.slug,
owner.title
FROM attachments a
JOIN pages owner ON owner.id = a.page_id
WHERE NOT EXISTS (
SELECT 1
FROM attachment_references current_ref
WHERE current_ref.attachment_id = a.id
AND current_ref.current_reference = TRUE
)
ORDER BY a.uploaded_at DESC, a.id DESC
SQL
))))
(define attachment-id (vector-ref row 0))
(define last-uses
(for/list ((use-row (in-list
(query-rows db
#<<SQL
SELECT p.slug, p.title, pv.version, ar.referenced_at
FROM attachment_references ar
JOIN pages p ON p.id = ar.page_id
LEFT JOIN page_versions pv ON pv.id = ar.page_version_id
WHERE ar.attachment_id = $1
AND ar.current_reference = FALSE
ORDER BY ar.referenced_at DESC, ar.id DESC
LIMIT 5
SQL
attachment-id))))
(hash 'slug (vector-ref use-row 0)
'title (vector-ref use-row 1)
'version (if (sql-null? (vector-ref use-row 2)) #f (vector-ref use-row 2))
'referencedAt (vector-ref use-row 3))))
(hash 'id attachment-id
'originalName (vector-ref row 1)
'storedName (vector-ref row 2)
'mimeType (vector-ref row 3)
'size (vector-ref row 4)
'uploadedAt (vector-ref row 5)
'uploadedBy (vector-ref row 6)
'ownerSlug (vector-ref row 7)
'ownerTitle (vector-ref row 8)
'lastUses last-uses)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Delete an upload only when no current page references it.
; pre : attachment-id identifies a possible attachment.
; post : The attachment and its reference rows are deleted, or an error is raised.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (delete-orphaned-upload! config attachment-id)
(call-with-wiki-database
config
(λ (db)
(call-with-transaction
db
(λ ()
(define current-count
(query-value db
"SELECT COUNT(*) FROM attachment_references WHERE attachment_id = $1 AND current_reference = TRUE"
attachment-id))
(when (> current-count 0)
(error 'delete-orphaned-upload! "attachment is still referenced by a current page"))
(define deleted-id
(query-maybe-value db
"DELETE FROM attachments WHERE id = $1 RETURNING id"
attachment-id))
(unless deleted-id
(error 'delete-orphaned-upload! "unknown attachment: ~a" attachment-id))))))
(void))
(define (safe-file-name name)
(define clean
(regexp-replace* #px"[^A-Za-z0-9._ -]" name "_"))