From 4f9d0f6425f00856da3217e467d8ac11a5311c0f Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Fri, 19 May 2023 16:02:54 -0500 Subject: [PATCH] Add/refactor channel-add! and channel-cleanup! --- chatdir.scm | 28 +++++++++++++-------------- tests/tests.scm | 51 ++++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 58 insertions(+), 21 deletions(-) diff --git a/chatdir.scm b/chatdir.scm index 3913407..3615d85 100644 --- a/chatdir.scm +++ b/chatdir.scm @@ -75,30 +75,30 @@ "all/" hostmask)) -;; Tidies up a channel directory; removes `online` and `offline` user links, etc. -(define (cleanup-channel conn channel) - (let ([users-dir (channel-users-directory-path conn channel)]) +;; Tidies up a channel directory: Removes `online` and `offline` user links. +(define (channel-cleanup! root channel) + (let ([users-dir (subpath root channel ".users")]) (map (lambda (state-dir) (if (not (substring-index state-dir "/all")) (map (lambda (link) - (let ([link-path (string-append users-dir state-dir "/" link)]) + (let ([link-path (subpath users-dir state-dir link)]) (if (symbolic-link? link-path) (delete-file link-path)))) - (directory (string-append users-dir state-dir))))) + (directory (subpath users-dir state-dir))))) (directory users-dir)))) -;; Creates a channel's file hierarchy, if need be -(define (make-channel conn channel) - (let* ([path (channel-directory-path conn channel)] - [subpath (lambda (leaf) (string-append path leaf))]) - (create-directory (subpath ".in") #t) - (create-directory (subpath ".users/online") #t) - (create-directory (subpath ".users/offline") #t) - (create-directory (subpath ".users/all") #t) - (cleanup-channel conn channel))) +;; Creates a channel's file hierarchy; safe to run, even if the channel +;; has already been created. +(define (channel-add! root channel) + (let* ([path (subpath root channel)]) + (create-directory (subpath path ".in") #t) + (create-directory (subpath path ".users" "online") #t) + (create-directory (subpath path ".users" "offline") #t) + (create-directory (subpath path ".users" "all") #t) + (channel-cleanup! root channel))) ;; Creates a user's info files in the given channel, if need bee diff --git a/tests/tests.scm b/tests/tests.scm index dd90919..b6e71f4 100644 --- a/tests/tests.scm +++ b/tests/tests.scm @@ -1,4 +1,4 @@ -(import srfi-78) +(import (chicken sort) srfi-78) (load "../chatdir.scm") (define *dir* "test chatdir") @@ -21,8 +21,9 @@ "/etc/systemd/user/momma") + ;; —————————————————————————————————————————————————— -;; File sets/gets [rooms, users, general] +;; Room metadata sets/gets ;; —————————————————————————————————————————————————— (define *room* "dining room") (define *room-path* "test chatdir/dining room") @@ -35,7 +36,6 @@ (check (directory-file-get *room-meta-path* "topic") => *room-topic*) - (check (directory-file-get* *room-meta-path* "topic") => (cons *room-topic* *room-topic-xattrs*)) @@ -43,23 +43,28 @@ (define *room-topic-2* (randomize-string *room-topic*)) (define *room-topic-xattrs-2* (alist-update 'user.chat.user "admin-mom" *room-topic-xattrs*)) + (channel-metadata-set! *dir* *room* "topic" *room-topic-2* *room-topic-xattrs-2*) (check (channel-metadata-get *dir* *room* "topic") => *room-topic-2*) - (check (channel-metadata-get* *dir* *room* "topic") => (cons *room-topic-2* *room-topic-xattrs-2*)) + +;; —————————————————————————————————————————————————— +;; Message creating/reading +;; —————————————————————————————————————————————————— (define *msg-sender* "maya") (define *msg-text* "eee… hiya, papaya!") (define *msg-date* (current-date)) (define *msg-xattr* '(user.bovo . "muuuu")) (define *msg-name* (message-file-leaf *dir* *room* *msg-date*)) + (channel-message-add! *dir* *room* *msg-text* *msg-sender* *msg-date* `(,*msg-xattr*)) (check (directory-file-get* (subpath *dir* *room*) *msg-name*) => @@ -69,14 +74,13 @@ (cons 'user.chat.sender *msg-sender*) (cons 'user.chat.channel *room*))) + (define *msg-sender-2* "bildinto") (define *msg-text-2* "he? ĉu vi bonsanas?") (define *msg-date-2* *msg-date*) -(print "uwu") (define *msg-name-2* (message-file-leaf *dir* *room* *msg-date-2*)) -(print "YAY") -(channel-message-add! *dir* *room* *msg-text-2* *msg-sender-2* *msg-date-2*) +(channel-message-add! *dir* *room* *msg-text-2* *msg-sender-2* *msg-date-2*) (check (directory-file-get* (subpath *dir* *room*) *msg-name-2*) => (list *msg-text-2* @@ -84,4 +88,37 @@ (cons 'user.chat.sender *msg-sender-2*) (cons 'user.chat.channel *room*))) + + +;; —————————————————————————————————————————————————— +;; Channel creation/management +;; —————————————————————————————————————————————————— +(define *new-room* "living room") +(define *new-room-path* (subpath *dir* *new-room*)) +(define *new-room-all* (subpath *new-room-path* ".users" "all")) +(if (directory-exists? *new-room-path*) + (delete-directory (subpath *dir* *new-room*) #t)) +(channel-add! *dir* *new-room*) +(check (and (directory-exists? *new-room-path*) + (directory-exists? *new-room-all*)) + => + *new-room-all*) + + +(define *new-room-online* (subpath *new-room-path* ".users" "online")) +(create-symbolic-link "./" (subpath *new-room-online* "birdo")) +(create-symbolic-link "./" (subpath *new-room-online* "mondo")) +(check (sort (directory *new-room-online*) string<) + => + '("birdo" "mondo")) + + +(channel-cleanup! *dir* *new-room*) +(check (directory *new-room-online*) + => + '()) + + + +;; —————————————————————————————————————————————————— (check-report)