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/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 "_"))