Support for channel-user states (online/offline/etc)

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
+;; Disables a channel-user's online/offline/etc state.
-(define (user-disable-state conn channel hostmask state)
+;; That is, removes a symlink from a /$channel/.users/* directory.
-  (let ([state-link
+(define (channel-user-disable-state! root channel username state)
-		 (create-directory (channel-user-directory-path conn channel hostmask state) #t)])
+  (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
+;; Enables a channel-user's state (online/offline/etc).
-(define (user-enable-state conn channel hostmask state)
+;; That is, makes a symlink to a /$channel/.users/* directory.
-  (let ([state-link
+(define (channel-user-enable-state! root channel username state)
-		 (create-directory (channel-user-directory-path conn channel hostmask state) #t)])
+  (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)
+(define (channel-user-toggle-states! root channel username enabled-state disabled-state)
-  (user-disable-state conn channel hostmask disabled-state)
+  (channel-user-disable-state! root channel username disabled-state)
-  (user-enable-state conn channel hostmask enabled-state))
+  (channel-user-enable-state! root channel username enabled-state))
 
 
 (define (write-string-to-file file value)

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)