Better wording.
[doldaconnect.git] / lib / guile / dolcon / util.scm
CommitLineData
d3372da9 1(define-module (dolcon util))
2(use-modules (dolcon ui))
3
4(define fnetnodes '())
c5233277 5(define loop-procs '())
6(define fn-procs '())
d3372da9 7
8(define-public dc-fn-update
9 (lambda ()
10 (set! fnetnodes
11 (let ((resp (dc-ecmd "lsnodes")) (er #f))
12 (if (and resp (begin (set! er (dc-extract resp)) er) (= (cdr (assq 'code er)) 200))
13 (map (lambda (o)
c5233277 14 (apply (lambda (id net name users state uid)
d3372da9 15 (cons id
16 (list (cons 'id id)
17 (cons 'net net)
18 (cons 'name name)
19 (cons 'users users)
c5233277 20 (cons 'state (list-ref '(syn hs est dead) state))
21 (cons 'uid uid))))
d3372da9 22 o))
23 (dc-intall resp))
24 '())))
25 fnetnodes))
26
27(define-public dc-fn-getattrib
28 (lambda (id attrib)
29 (if (not (assq id fnetnodes))
30 (dc-fn-update))
31 (let ((aform (assq id fnetnodes)))
32 (if aform
33 (cdr (assq attrib (cdr aform)))
34 #f))))
35
36(define-public dc-fn-getname
37 (lambda (id)
38 (dc-fn-getattrib id 'name)))
39
40(define-public dc-getfnetnodes
41 (lambda ()
42 (map (lambda (o) (car o))
43 fnetnodes)))
c5233277 44
45(define fn-updattr
46 (lambda (id attr val)
47 (let ((aform (assq id fnetnodes)))
48 (if aform
49 (set-cdr! (assq attr (cdr aform)) val)
50 #f))))
51
52(define-public dc-fnproc-reg
53 (lambda (event proc)
54 (set! fn-procs (cons (list event proc)
55 fn-procs))))
56
57(define-public dc-handle-fn
58 (lambda ()
59 (dc-fn-update)
60 (let* ((notify (lambda (event data) (for-each (lambda (o) (if (eq? event (car o)) ((cadr o) data))) fn-procs)))
a7b765eb 61 (ua (lambda (r a) (let* ((ires (dc-intresp r))
62 (hubform (assq (car ires) fnetnodes)))
bf21dd04 63 (if hubform
64 (begin (fn-updattr (car ires) a (cadr ires))
65 (notify a (cdr (assq (car ires) fnetnodes)))))))))
e6848bc1 66 (dc-loop-reg ".notify" 601 (lambda (r er) (let* ((ires (dc-intresp r))
1a893343 67 (hubform (assq (car ires) fnetnodes)))
e6848bc1 68 (if hubform
69 (begin (fn-updattr (car ires) 'state (list-ref '(syn hs est dead) (cadr ires)))
1a893343 70 (notify 'state (cdr hubform)))))))
c5233277 71 (dc-loop-reg ".notify" 602 (lambda (r er) (ua r 'name)))
72 (dc-loop-reg ".notify" 605 (lambda (r er) (ua r 'users)))
73 (dc-loop-reg ".notify" 604 (lambda (r er)
74 (let* ((ires (dc-intresp r))
75 (new (list (cons 'id (car ires))
76 (cons 'net (cadr ires))
77 (cons 'name "")
78 (cons 'users 0)
79 (cons 'state 'syn))))
80 (set! fnetnodes
81 (cons (cons (car ires) new)
82 fnetnodes))
83 (notify 'creat new))))
84 (dc-loop-reg ".notify" 603 (lambda (r er)
85 (let* ((ires (dc-intresp r)) (nform (assq (car ires) fnetnodes)))
86 (notify 'dstr (cdr nform))
87 (set! fnetnodes (delq nform fnetnodes))))))))
88
89(define-public dc-loop-reg
90 (lambda (cmd code proc)
91 (set! loop-procs (cons (cons (cons cmd code) proc)
92 loop-procs))))
93
94(define-public dc-loop
95 (lambda ()
96 (while #t
97 (dc-select 10000)
98 (while (let ((resp (dc-getresp)))
99 (if resp
100 (let* ((er (dc-extract resp)) (code (cdr (assq 'code er))) (cmd (cdr (assq 'cmd er))))
101 (for-each
102 (lambda (o)
103 (if (and (or (not (caar o)) (equal? cmd (caar o)))
104 (or (not (cdar o)) (equal? code (cdar o))))
105 ((cdr o) resp er)))
106 loop-procs))
107 #f))
108 #f)
109 (for-each (lambda (o)
110 (if (equal? (caar o) ".periodic")
111 ((cdr o))))
112 loop-procs))))