Bettern cmap handling. Lots of changes.
This commit is contained in:
+438
-32
@@ -25,6 +25,7 @@
|
||||
read-page
|
||||
create-page!
|
||||
update-page!
|
||||
rename-page!
|
||||
archive-page!
|
||||
page-history
|
||||
read-version
|
||||
@@ -36,6 +37,10 @@
|
||||
delete-bookmark!
|
||||
list-orphaned-uploads
|
||||
delete-orphaned-upload!
|
||||
list-page-aliases
|
||||
list-page-alias-details
|
||||
cleanup-page-alias!
|
||||
delete-page-alias!
|
||||
save-upload!
|
||||
uploaded-file)
|
||||
|
||||
@@ -168,6 +173,25 @@
|
||||
(define page-columns
|
||||
"slug, title, markdown, created_at, updated_at, created_by, updated_by, tags, current_version, namespace")
|
||||
|
||||
(define page-columns/prefixed
|
||||
"p.slug, p.title, p.markdown, p.created_at, p.updated_at, p.created_by, p.updated_by, p.tags, p.current_version, p.namespace")
|
||||
|
||||
(define (page-id/db db namespace slug)
|
||||
(define current-id
|
||||
(query-maybe-value db
|
||||
"SELECT id FROM pages WHERE namespace = $1 AND slug = $2 AND archived = FALSE"
|
||||
namespace slug))
|
||||
(if current-id
|
||||
current-id
|
||||
(query-maybe-value db
|
||||
#<<SQL
|
||||
SELECT p.id
|
||||
FROM page_aliases a
|
||||
JOIN pages p ON p.id = a.page_id
|
||||
WHERE a.namespace = $1 AND a.slug = $2 AND p.archived = FALSE
|
||||
SQL
|
||||
namespace slug)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : List current wiki page metadata.
|
||||
; pre : The PostgreSQL schema is initialized.
|
||||
@@ -202,8 +226,16 @@
|
||||
(string-append "SELECT " page-columns
|
||||
" FROM pages WHERE namespace = $1 AND slug = $2 AND archived = FALSE")
|
||||
namespace slug))
|
||||
(if row (row->page row) #f))))))
|
||||
|
||||
(define resolved-row
|
||||
(if row
|
||||
row
|
||||
(query-maybe-row db
|
||||
(string-append
|
||||
"SELECT " page-columns/prefixed
|
||||
" FROM page_aliases a JOIN pages p ON p.id = a.page_id"
|
||||
" WHERE a.namespace = $1 AND a.slug = $2 AND p.archived = FALSE")
|
||||
namespace slug)))
|
||||
(if resolved-row (row->page resolved-row) #f))))))
|
||||
|
||||
(define (replace-todos! db page-id markdown)
|
||||
(query-exec db "DELETE FROM todo_items WHERE page_id = $1" page-id)
|
||||
@@ -286,14 +318,10 @@ SQL
|
||||
(error 'update-page! "version-conflict"))
|
||||
(define page-tags
|
||||
(if tags tags (text->tags (vector-ref row 2))))
|
||||
(define target-namespace
|
||||
(if (eq? new-namespace #f)
|
||||
(vector-ref row 3)
|
||||
(string-trim new-namespace)))
|
||||
(unless (or (string=? target-namespace "")
|
||||
(and (valid-slug? target-namespace)
|
||||
(<= (string-length target-namespace) 80)))
|
||||
(error 'update-page! "invalid namespace: ~a" target-namespace))
|
||||
(define target-namespace (vector-ref row 3))
|
||||
(when (and (not (eq? new-namespace #f))
|
||||
(not (string=? (string-trim new-namespace) target-namespace)))
|
||||
(error 'update-page! "use rename-page! to change a page namespace"))
|
||||
(define next-version (+ current-version 1))
|
||||
(define now (current-seconds))
|
||||
(query-exec db
|
||||
@@ -312,7 +340,85 @@ SQL
|
||||
(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 (page-reference (if (eq? new-namespace #f) namespace (string-trim new-namespace)) slug)))
|
||||
(read-page config (page-reference namespace slug)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Rename or move a page while keeping its old address as an alias.
|
||||
; pre : reference identifies a current page; target namespace/slug are valid and unused.
|
||||
; post : The same page_id has the new address/title, the old address remains an alias,
|
||||
; and a new immutable page version records the rename.
|
||||
; result : The renamed page metadata with Markdown.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (rename-page! config reference title target-namespace target-slug author [summary "Renamed page"])
|
||||
(define-values (namespace slug) (split-page-reference reference))
|
||||
(define clean-namespace (string-trim target-namespace))
|
||||
(define clean-slug (string-trim target-slug))
|
||||
(unless (valid-page-reference? (page-reference clean-namespace clean-slug))
|
||||
(error 'rename-page! "invalid page address: ~a" (page-reference clean-namespace clean-slug)))
|
||||
(when (string=? (string-trim title) "")
|
||||
(error 'rename-page! "title is required"))
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(call-with-transaction
|
||||
db
|
||||
(λ ()
|
||||
(define row
|
||||
(query-maybe-row db
|
||||
"SELECT id, title, markdown, tags, current_version FROM pages WHERE namespace = $1 AND slug = $2 AND archived = FALSE FOR UPDATE"
|
||||
namespace slug))
|
||||
(unless row
|
||||
(error 'rename-page! "unknown page: ~a" reference))
|
||||
(define page-id (vector-ref row 0))
|
||||
(define old-title (vector-ref row 1))
|
||||
(define markdown (vector-ref row 2))
|
||||
(define tags (text->tags (vector-ref row 3)))
|
||||
(define current-version (vector-ref row 4))
|
||||
(define address-changed?
|
||||
(or (not (string=? namespace clean-namespace))
|
||||
(not (string=? slug clean-slug))))
|
||||
(when address-changed?
|
||||
(define target-page-id
|
||||
(query-maybe-value db
|
||||
"SELECT id FROM pages WHERE namespace = $1 AND slug = $2 AND archived = FALSE"
|
||||
clean-namespace clean-slug))
|
||||
(when (and target-page-id (not (= target-page-id page-id)))
|
||||
(error 'rename-page! "page address is already in use: ~a"
|
||||
(page-reference clean-namespace clean-slug)))
|
||||
(define target-alias-page-id
|
||||
(query-maybe-value db
|
||||
"SELECT page_id FROM page_aliases WHERE namespace = $1 AND slug = $2"
|
||||
clean-namespace clean-slug))
|
||||
(when (and target-alias-page-id (not (= target-alias-page-id page-id)))
|
||||
(error 'rename-page! "page address is already an alias: ~a"
|
||||
(page-reference clean-namespace clean-slug)))
|
||||
(when target-alias-page-id
|
||||
(query-exec db
|
||||
"DELETE FROM page_aliases WHERE namespace = $1 AND slug = $2 AND page_id = $3"
|
||||
clean-namespace clean-slug page-id))
|
||||
(query-exec db
|
||||
#<<SQL
|
||||
INSERT INTO page_aliases(namespace, slug, title, page_id, created_at, created_by)
|
||||
VALUES ($1, $2, $3, $4, $5, $6)
|
||||
ON CONFLICT (namespace, slug) DO NOTHING
|
||||
SQL
|
||||
namespace slug old-title page-id (current-seconds) author))
|
||||
(define next-version (+ current-version 1))
|
||||
(define now (current-seconds))
|
||||
(query-exec db
|
||||
#<<SQL
|
||||
UPDATE pages
|
||||
SET namespace = $1, slug = $2, title = $3, current_version = $4,
|
||||
updated_at = $5, updated_by = $6,
|
||||
search_document = setweight(to_tsvector('simple', coalesce($3, '')), 'A') ||
|
||||
setweight(to_tsvector('simple', coalesce(markdown, '')), 'B')
|
||||
WHERE id = $7
|
||||
SQL
|
||||
clean-namespace clean-slug title next-version now author page-id)
|
||||
(define page-version-id
|
||||
(insert-version! db page-id next-version title markdown author "rename" summary now tags))
|
||||
(record-version-attachment-references! db page-id page-version-id markdown now)))))
|
||||
(read-page config (page-reference clean-namespace clean-slug)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Archive an existing wiki page.
|
||||
@@ -346,9 +452,7 @@ SQL
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(query-maybe-value db
|
||||
"SELECT id FROM pages WHERE namespace = $1 AND slug = $2 AND archived = FALSE"
|
||||
namespace slug))))
|
||||
(page-id/db db namespace slug))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Read the version history for a wiki page.
|
||||
@@ -361,8 +465,7 @@ SQL
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(define id
|
||||
(query-maybe-value db "SELECT id FROM pages WHERE namespace = $1 AND slug = $2 AND archived = FALSE" namespace slug))
|
||||
(define id (page-id/db db namespace slug))
|
||||
(unless id
|
||||
(error 'page-history "unknown page: ~a" slug))
|
||||
(for/list ((row (in-list
|
||||
@@ -396,15 +499,16 @@ SQL
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(define id (page-id/db db namespace slug))
|
||||
(define row
|
||||
(query-maybe-row db
|
||||
#<<SQL
|
||||
SELECT v.version, v.title, v.markdown, v.author, v.action, v.summary, v.tags, v.created_at
|
||||
FROM page_versions v
|
||||
JOIN pages p ON p.id = v.page_id
|
||||
WHERE p.namespace = $1 AND p.slug = $2 AND p.archived = FALSE AND v.version = $3
|
||||
(and id
|
||||
(query-maybe-row db
|
||||
#<<SQL
|
||||
SELECT version, title, markdown, author, action, summary, tags, created_at
|
||||
FROM page_versions
|
||||
WHERE page_id = $1 AND version = $2
|
||||
SQL
|
||||
namespace slug version-number))
|
||||
id version-number)))
|
||||
(and row
|
||||
(hash 'version (vector-ref row 0)
|
||||
'title (vector-ref row 1)
|
||||
@@ -448,7 +552,8 @@ SQL
|
||||
'namespace (vector-ref row 4)
|
||||
'title (vector-ref row 1)
|
||||
'rank (vector-ref row 2)
|
||||
'snippet (vector-ref row 3)))))))
|
||||
'snippet (vector-ref row 3)
|
||||
'type "page"))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : List unresolved todo(...) markers from all current wiki pages.
|
||||
@@ -679,6 +784,307 @@ SQL
|
||||
(error 'delete-orphaned-upload! "unknown attachment: ~a" attachment-id))))))
|
||||
(void))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Page alias cleanup
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (title->wiki-word title)
|
||||
(define words '())
|
||||
(define out (open-output-string))
|
||||
(define (finish-word!)
|
||||
(define word (get-output-string out))
|
||||
(when (> (string-length word) 0)
|
||||
(set! words (append words (list word))))
|
||||
(set! out (open-output-string)))
|
||||
(for ((char (in-string title)))
|
||||
(if (char-alphabetic? char)
|
||||
(write-char char out)
|
||||
(finish-word!)))
|
||||
(finish-word!)
|
||||
(apply string-append
|
||||
(for/list ((word (in-list words)))
|
||||
(string-titlecase word))))
|
||||
|
||||
(define (classic-wiki-word? text)
|
||||
(regexp-match? #px"^(?:[A-Z][a-z]+){2,}$" text))
|
||||
|
||||
(define (alias-wiki-reference namespace title)
|
||||
(define wiki-word (title->wiki-word title))
|
||||
(if (classic-wiki-word? wiki-word)
|
||||
(if (string=? namespace "")
|
||||
wiki-word
|
||||
(string-append namespace ":" wiki-word))
|
||||
#f))
|
||||
|
||||
(define (replace-wiki-token line old-token new-text)
|
||||
(define out (open-output-string))
|
||||
(define length (string-length line))
|
||||
(let loop ((index 0))
|
||||
(when (< index length)
|
||||
(define char (string-ref line index))
|
||||
(if (or (char-alphabetic? char) (char=? char #\:))
|
||||
(let find-end ((end index))
|
||||
(if (and (< end length)
|
||||
(let ((candidate (string-ref line end)))
|
||||
(or (char-alphabetic? candidate) (char=? candidate #\:))))
|
||||
(find-end (+ end 1))
|
||||
(let ((token (substring line index end)))
|
||||
(display (if (string=? token old-token) new-text token) out)
|
||||
(loop end))))
|
||||
(begin
|
||||
(write-char char out)
|
||||
(loop (+ index 1))))))
|
||||
(get-output-string out))
|
||||
|
||||
(define (replace-alias-reference-in-line line old-reference new-reference old-wiki new-wiki)
|
||||
(define result line)
|
||||
(set! result
|
||||
(string-replace result
|
||||
(string-append "(" old-reference ")")
|
||||
(string-append "(" new-reference ")")))
|
||||
(set! result
|
||||
(string-replace result
|
||||
(string-append "(" old-reference " ")
|
||||
(string-append "(" new-reference " ")))
|
||||
(set! result
|
||||
(string-replace result
|
||||
(string-append "/uploads/" old-reference "/")
|
||||
(string-append "/uploads/" new-reference "/")))
|
||||
(if old-wiki
|
||||
(replace-wiki-token result old-wiki new-wiki)
|
||||
result))
|
||||
|
||||
(define (replace-alias-reference markdown old-namespace old-slug old-title
|
||||
new-namespace new-slug new-title)
|
||||
(define old-reference (page-reference old-namespace old-slug))
|
||||
(define new-reference (page-reference new-namespace new-slug))
|
||||
(define old-wiki (alias-wiki-reference old-namespace old-title))
|
||||
(define target-wiki (alias-wiki-reference new-namespace new-title))
|
||||
(define new-wiki
|
||||
(if target-wiki
|
||||
target-wiki
|
||||
(format "[~a](~a)" new-title new-reference)))
|
||||
(define in-fence? #f)
|
||||
(define result
|
||||
(for/list ((line (in-list (string-split markdown "\n" #:trim? #f))))
|
||||
(define fence? (regexp-match? #px"^[ \t]*(```|~~~)" line))
|
||||
(cond
|
||||
(fence?
|
||||
(set! in-fence? (not in-fence?))
|
||||
line)
|
||||
((or in-fence?
|
||||
(string-prefix? line " ")
|
||||
(string-prefix? line "\t")
|
||||
(string-contains? line "`"))
|
||||
line)
|
||||
(else
|
||||
(replace-alias-reference-in-line line old-reference new-reference old-wiki new-wiki)))))
|
||||
(string-join result "\n"))
|
||||
|
||||
(define (page-alias-row db alias-id)
|
||||
(query-maybe-row db
|
||||
#<<SQL
|
||||
SELECT a.id, a.namespace, a.slug, a.title, a.page_id,
|
||||
p.namespace, p.slug, p.title
|
||||
FROM page_aliases a
|
||||
JOIN pages p ON p.id = a.page_id
|
||||
WHERE a.id = $1 AND p.archived = FALSE
|
||||
SQL
|
||||
alias-id))
|
||||
|
||||
(define (alias-current-reference-pages db alias-row)
|
||||
(define old-namespace (vector-ref alias-row 1))
|
||||
(define old-slug (vector-ref alias-row 2))
|
||||
(define old-title (vector-ref alias-row 3))
|
||||
(define new-namespace (vector-ref alias-row 5))
|
||||
(define new-slug (vector-ref alias-row 6))
|
||||
(define new-title (vector-ref alias-row 7))
|
||||
(filter
|
||||
(λ (item) (hash-ref item 'changed #f))
|
||||
(for/list ((row (in-list
|
||||
(query-rows db
|
||||
"SELECT id, namespace, slug, title, markdown, current_version, tags FROM pages WHERE archived = FALSE ORDER BY lower(namespace), lower(title), title"))))
|
||||
(define markdown (vector-ref row 4))
|
||||
(define replaced
|
||||
(replace-alias-reference markdown
|
||||
old-namespace old-slug old-title
|
||||
new-namespace new-slug new-title))
|
||||
(hash 'id (vector-ref row 0)
|
||||
'namespace (vector-ref row 1)
|
||||
'pageSlug (vector-ref row 2)
|
||||
'slug (page-reference (vector-ref row 1) (vector-ref row 2))
|
||||
'title (vector-ref row 3)
|
||||
'markdown markdown
|
||||
'replacement replaced
|
||||
'currentVersion (vector-ref row 5)
|
||||
'tags (text->tags (vector-ref row 6))
|
||||
'changed (not (string=? markdown replaced))))))
|
||||
|
||||
(define (alias-historical-reference-pages db alias-row)
|
||||
(define old-namespace (vector-ref alias-row 1))
|
||||
(define old-slug (vector-ref alias-row 2))
|
||||
(define old-title (vector-ref alias-row 3))
|
||||
(define new-namespace (vector-ref alias-row 5))
|
||||
(define new-slug (vector-ref alias-row 6))
|
||||
(define new-title (vector-ref alias-row 7))
|
||||
(filter
|
||||
(λ (item) (hash-ref item 'changed #f))
|
||||
(for/list ((row (in-list
|
||||
(query-rows db
|
||||
#<<SQL
|
||||
SELECT p.namespace, p.slug, p.title, pv.version, pv.markdown, pv.created_at
|
||||
FROM page_versions pv
|
||||
JOIN pages p ON p.id = pv.page_id
|
||||
ORDER BY pv.created_at DESC, pv.id DESC
|
||||
SQL
|
||||
))))
|
||||
(define markdown (vector-ref row 4))
|
||||
(define replaced
|
||||
(replace-alias-reference markdown
|
||||
old-namespace old-slug old-title
|
||||
new-namespace new-slug new-title))
|
||||
(hash 'slug (page-reference (vector-ref row 0) (vector-ref row 1))
|
||||
'title (vector-ref row 2)
|
||||
'version (vector-ref row 3)
|
||||
'createdAt (vector-ref row 5)
|
||||
'changed (not (string=? markdown replaced))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Replace current references to one retained alias with its canonical page address.
|
||||
; pre : alias-id identifies a retained alias and author is the administrator performing cleanup.
|
||||
; post : Every changed current page receives a normal immutable version; history itself is untouched.
|
||||
; result : A hash containing the number of pages changed and historical references left untouched.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (cleanup-page-alias! config alias-id author)
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(call-with-transaction
|
||||
db
|
||||
(λ ()
|
||||
(define alias-row (page-alias-row db alias-id))
|
||||
(unless alias-row
|
||||
(error 'cleanup-page-alias! "unknown page alias: ~a" alias-id))
|
||||
(define old-reference
|
||||
(page-reference (vector-ref alias-row 1) (vector-ref alias-row 2)))
|
||||
(define new-reference
|
||||
(page-reference (vector-ref alias-row 5) (vector-ref alias-row 6)))
|
||||
(define pages (alias-current-reference-pages db alias-row))
|
||||
(define now (current-seconds))
|
||||
(for ((page (in-list pages)))
|
||||
(define page-id (hash-ref page 'id))
|
||||
(define next-version (+ (hash-ref page 'currentVersion) 1))
|
||||
(define markdown (hash-ref page 'replacement))
|
||||
(define summary (format "Updated page alias ~a -> ~a" old-reference new-reference))
|
||||
(query-exec db
|
||||
#<<SQL
|
||||
UPDATE pages
|
||||
SET markdown = $1, current_version = $2, updated_at = $3, updated_by = $4,
|
||||
search_document = setweight(to_tsvector('simple', coalesce(title, '')), 'A') ||
|
||||
setweight(to_tsvector('simple', coalesce($1, '')), 'B')
|
||||
WHERE id = $5
|
||||
SQL
|
||||
markdown next-version now author page-id)
|
||||
(define page-version-id
|
||||
(insert-version! db page-id next-version
|
||||
(hash-ref page 'title) markdown author "alias-cleanup" summary now
|
||||
(hash-ref 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))
|
||||
(hash 'changedPages (length pages)
|
||||
'historicalReferences (length (alias-historical-reference-pages db alias-row))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Remove one retained page alias after current content no longer refers to it.
|
||||
; pre : alias-id identifies an alias and no current page still contains a recognized old reference.
|
||||
; post : The alias row is deleted; historical page versions are never modified.
|
||||
; result : void.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (delete-page-alias! config alias-id)
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(call-with-transaction
|
||||
db
|
||||
(λ ()
|
||||
(define alias-row (page-alias-row db alias-id))
|
||||
(unless alias-row
|
||||
(error 'delete-page-alias! "unknown page alias: ~a" alias-id))
|
||||
(define current-pages (alias-current-reference-pages db alias-row))
|
||||
(when (> (length current-pages) 0)
|
||||
(error 'delete-page-alias! "page alias still has ~a current reference(s)" (length current-pages)))
|
||||
(query-exec db "DELETE FROM page_aliases WHERE id = $1" alias-id)))))
|
||||
(void))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : List retained page aliases and current pages that still contain the old reference.
|
||||
; pre : PostgreSQL schema 8 or newer is initialized.
|
||||
; post : Alias and page rows have only been read.
|
||||
; result : Newest-first alias hashes with canonical targets and literal reference pages.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (list-page-aliases config)
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(for/list ((row (in-list
|
||||
(query-rows db
|
||||
#<<SQL
|
||||
SELECT a.id, a.namespace, a.slug, a.title, a.created_at, a.created_by,
|
||||
p.namespace, p.slug, p.title
|
||||
FROM page_aliases a
|
||||
JOIN pages p ON p.id = a.page_id
|
||||
WHERE p.archived = FALSE
|
||||
ORDER BY a.created_at DESC, a.id DESC
|
||||
SQL
|
||||
))))
|
||||
(hash 'id (vector-ref row 0)
|
||||
'namespace (vector-ref row 1)
|
||||
'pageSlug (vector-ref row 2)
|
||||
'title (vector-ref row 3)
|
||||
'slug (page-reference (vector-ref row 1) (vector-ref row 2))
|
||||
'createdAt (vector-ref row 4)
|
||||
'createdBy (vector-ref row 5)
|
||||
'targetNamespace (vector-ref row 6)
|
||||
'targetPageSlug (vector-ref row 7)
|
||||
'targetSlug (page-reference (vector-ref row 6) (vector-ref row 7))
|
||||
'targetTitle (vector-ref row 8))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : List page aliases with current pages that still contain the old address.
|
||||
; pre : PostgreSQL schema 8 or newer is initialized.
|
||||
; post : Alias and current page rows have only been read.
|
||||
; result : Alias hashes augmented with a references list for administration.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (list-page-alias-details config)
|
||||
(define aliases (list-page-aliases config))
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(for/list ((alias (in-list aliases)))
|
||||
(define alias-row (page-alias-row db (hash-ref alias 'id)))
|
||||
(define current-references (alias-current-reference-pages db alias-row))
|
||||
(define historical-references (alias-historical-reference-pages db alias-row))
|
||||
(define with-references
|
||||
(hash-set
|
||||
alias
|
||||
'references
|
||||
(for/list ((page (in-list current-references)))
|
||||
(hash 'slug (hash-ref page 'slug)
|
||||
'title (hash-ref page 'title)))))
|
||||
(define with-history
|
||||
(hash-set
|
||||
with-references
|
||||
'historicalReferences
|
||||
(for/list ((page (in-list (take historical-references (min 10 (length historical-references))))))
|
||||
(hash 'slug (hash-ref page 'slug)
|
||||
'title (hash-ref page 'title)
|
||||
'version (hash-ref page 'version)
|
||||
'createdAt (hash-ref page 'createdAt)))))
|
||||
(hash-set with-history 'historicalReferenceCount (length historical-references))))))
|
||||
|
||||
|
||||
(define (safe-file-name name)
|
||||
(define clean
|
||||
(regexp-replace* #px"[^A-Za-z0-9._ -]" name "_"))
|
||||
@@ -743,17 +1149,17 @@ SQL
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(define id (page-id/db db namespace slug))
|
||||
(define row
|
||||
(query-maybe-row db
|
||||
#<<SQL
|
||||
SELECT a.original_name, a.stored_name, a.mime_type, a.content, a.size
|
||||
FROM attachments a
|
||||
JOIN pages p ON p.id = a.page_id
|
||||
WHERE p.slug = $1 AND p.archived = FALSE AND a.stored_name = $2
|
||||
ORDER BY CASE WHEN p.namespace = $3 THEN 0 ELSE 1 END, a.id
|
||||
(and id
|
||||
(query-maybe-row db
|
||||
#<<SQL
|
||||
SELECT original_name, stored_name, mime_type, content, size
|
||||
FROM attachments
|
||||
WHERE page_id = $1 AND stored_name = $2
|
||||
LIMIT 1
|
||||
SQL
|
||||
slug stored-name namespace))
|
||||
id stored-name)))
|
||||
(if row
|
||||
(hash 'originalName (vector-ref row 0)
|
||||
'storedName (vector-ref row 1)
|
||||
|
||||
Reference in New Issue
Block a user