jadedctrl/ chicken-chatdir
Archived
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

channel-message-get, more resiliant parsing

This commit is contained in:
Jaidyn Ann 2023-05-30 23:17:47 -05:00
parent e4e42ebb8f
commit 5801f14046
1 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
chatdir.scm
View File

@ -21,7 +21,7 @@
user-enable-state! user-disable-state! user-toggle-states! user-enable-state! user-disable-state! user-toggle-states!
channel-users channel-user-add! channel-user-file-set! channel-user-file-get channel-users channel-user-add! channel-user-file-set! channel-user-file-get
channel-user-disable-state! channel-user-enable-state! channel-user-toggle-states! channel-user-disable-state! channel-user-enable-state! channel-user-toggle-states!
channel-message-add! channel-messages channel-message-add! channel-messages channel-message-get
channel-messages-by-xattr channel-messages-by-sender channel-messages-by-xattr channel-messages-by-sender
channel-messages-by-date channel-messages-by-date* channel-messages-by-date-range channel-messages-by-date channel-messages-by-date* channel-messages-by-date-range
) )
@ -253,7 +253,17 @@
;; List all messages of the given channel. ;; List all messages of the given channel.
(define (channel-messages root channel) (define (channel-messages root channel)
(directory (subpath root channel))) (filter
(lambda (file)
(let ([path (subpath root channel file)])
(and (file-exists? path)
(not (directory-exists? path)))))
(directory (subpath root channel))))
;; Return a message's whole data.
(define (channel-message-get root channel message)
(directory-file-get* (subpath root channel) message))
;; List all messages that have the given xattr set to the given value. ;; List all messages that have the given xattr set to the given value.
@ -332,19 +342,25 @@
;; Get the contents of the given file as astring. ;; Get the contents of the given file as astring.
(define (directory-file-get directory key) (define (directory-file-get directory key)
(read-file-to-string (subpath directory key))) (let ([path (subpath directory key)])
(if (and (file-exists? path)
(not (directory-exists? path)))
(read-file-to-string (subpath directory key))
#f)))
;; Get the contents of the given file as a string, including the all ;; Get the contents of the given file as a string, including the all
;; extended attributes as an alist. ;; extended attributes as an alist.
;; (contents (xattr . value) (xattr .value) …) ;; (contents (xattr . value) (xattr .value) …)
(define (directory-file-get* directory key) (define (directory-file-get* directory key)
(let ([path (subpath directory key)]) (let ([path (subpath directory key)]
(cons (directory-file-get directory key) [contents (directory-file-get directory key)])
(if contents
(cons contents
(map (lambda (xattr) (map (lambda (xattr)
(cons (string->symbol xattr) (cons (string->symbol xattr)
(xattr:get-xattr path xattr))) (xattr:get-xattr path xattr)))
(xattr:list-xattrs path))))) (xattr:list-xattrs path))))))
;; Given a directory and a filename, return a unique filename by appending ;; Given a directory and a filename, return a unique filename by appending