diff --git a/chatdir.scm b/chatdir.scm index 89b9c89..cb3f710 100644 --- a/chatdir.scm +++ b/chatdir.scm @@ -144,29 +144,33 @@ (directory-file-get (subpath root channel ".users" "all" username) key)) -;; Disables a user-state (that is, removes a symlink from a .users directory -(define (user-disable-state conn channel hostmask state) - (let ([state-link - (create-directory (channel-user-directory-path conn channel hostmask state) #t)]) +;; Disables a channel-user's online/offline/etc state. +;; That is, removes a symlink from a /$channel/.users/* directory. +(define (channel-user-disable-state! root channel username state) + (let ([state-link (subpath root channel ".users" state username)]) (if (or (file-exists? state-link) (symbolic-link? state-link)) (delete-file state-link)))) -;; Enables a user-state (that is, makes a symlink to a .users directory -(define (user-enable-state conn channel hostmask state) - (let ([state-link - (create-directory (channel-user-directory-path conn channel hostmask state) #t)]) +;; Enables a channel-user's state (online/offline/etc). +;; That is, makes a symlink to a /$channel/.users/* directory. +(define (channel-user-enable-state! root channel username state) + (let* ([state-path + (create-directory (subpath root channel ".users" state) #t)] + [user-path (subpath ".." "all" username)] + [state-link (subpath state-path username)]) + (print state-path) (if (not (or (file-exists? state-link) (symbolic-link? state-link))) - (create-symbolic-link (string-append "../all/" hostmask) + (create-symbolic-link user-path state-link)))) ;; Ensures the enabled-state is enabled, and it's opposite (disabled-state) is not -(define (user-toggle-state conn channel hostmask enabled-state disabled-state) - (user-disable-state conn channel hostmask disabled-state) - (user-enable-state conn channel hostmask enabled-state)) +(define (channel-user-toggle-states! root channel username enabled-state disabled-state) + (channel-user-disable-state! root channel username disabled-state) + (channel-user-enable-state! root channel username enabled-state)) (define (write-string-to-file file value) diff --git a/tests/tests.scm b/tests/tests.scm index db7f797..a9a8681 100644 --- a/tests/tests.scm +++ b/tests/tests.scm @@ -1,7 +1,6 @@ (import (chicken sort) srfi-78) (load "../chatdir.scm") -(define *dir* "test chatdir") ;; —————————————————————————————————————————————————— ;; Helper functions for making tests @@ -13,6 +12,14 @@ +;; —————————————————————————————————————————————————— +;; Set up testing environment +;; —————————————————————————————————————————————————— +(define *dir* "test chatdir") +(create-directory "test chatdir/dining room/.meta" #t) + + + ;; —————————————————————————————————————————————————— ;; General-pupose functions ;; —————————————————————————————————————————————————— @@ -180,6 +187,23 @@ "mawarth") +;; Make sure user-states (online/offline) work! +(channel-user-enable-state! *dir* *new-room* "mawa" "online") +(check (read-symbolic-link (subpath *new-room-users* "online" "mawa")) + => + "../all/mawa") + +(channel-user-toggle-states! *dir* *new-room* "mawa" "offline" "online") +(check (list (symbolic-link? (subpath *new-room-users* "online" "mawa")) + (read-symbolic-link (subpath *new-room-users* "offline" "mawa"))) + => + '(#f "../all/mawa")) + +(channel-user-disable-state! *dir* *new-room* "mawa" "offline") +(check (symbolic-link? (subpath *new-room-users* "offline" "mawa")) + => + #f) + ;; —————————————————————————————————————————————————— (check-report)