Support for channel-user states (online/offline/etc)
This commit is contained in:
parent
228c591cff
commit
aa4379eda4
28
chatdir.scm
28
chatdir.scm
|
@ -144,29 +144,33 @@
|
||||||
(directory-file-get (subpath root channel ".users" "all" username) key))
|
(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)
|
(if (or (file-exists? state-link)
|
||||||
(symbolic-link? state-link))
|
(symbolic-link? state-link))
|
||||||
(delete-file 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)
|
(if (not (or (file-exists? state-link)
|
||||||
(symbolic-link? state-link)))
|
(symbolic-link? state-link)))
|
||||||
(create-symbolic-link (string-append "../all/" hostmask)
|
(create-symbolic-link user-path
|
||||||
state-link))))
|
state-link))))
|
||||||
|
|
||||||
|
|
||||||
;; Ensures the enabled-state is enabled, and it's opposite (disabled-state) is not
|
;; 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)
|
(define (write-string-to-file file value)
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
(import (chicken sort) srfi-78)
|
(import (chicken sort) srfi-78)
|
||||||
(load "../chatdir.scm")
|
(load "../chatdir.scm")
|
||||||
|
|
||||||
(define *dir* "test chatdir")
|
|
||||||
|
|
||||||
;; ——————————————————————————————————————————————————
|
;; ——————————————————————————————————————————————————
|
||||||
;; Helper functions for making tests
|
;; 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
|
;; General-pupose functions
|
||||||
;; ——————————————————————————————————————————————————
|
;; ——————————————————————————————————————————————————
|
||||||
|
@ -180,6 +187,23 @@
|
||||||
"mawarth")
|
"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)
|
(check-report)
|
||||||
|
|
Reference in New Issue