-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathwikid.scm
110 lines (92 loc) · 3.71 KB
/
wikid.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
;;; -*- Mode: Scheme; Character-encoding: utf-8; -*-
;;; Copyright (C) 2005-2020 beingmeta, inc. All rights reserved.
;;; Copyright (C) 2020-2022 Kenneth Haase ([email protected]).
(in-module 'brico/wikid)
(use-module '{texttools reflection logger varconfig text/stringfmts
knodb knodb/config})
(define-init %loglevel %notify%)
;;(set! %loglevel %debug%)
(module-export! '{wikid.pool wikid.index wikid.source})
(define %nosubst '{wikid.source wikid.pool wikid.index wikid.background})
(define %optmods '{brico logger knodb})
(define-init wikid.source #f)
(define-init wikid.pool #f)
(define-init wikid.setup #f)
(define-init wikid.index #f)
(define-init wikid.indexes #f)
(define-init wikid.opts #[background #f readonly #t basename "wikid.flexpool"])
(define-init wikid.opts #[readonly #t basename "wikid.flexpool"])
(define-init wikid:readonly #t)
;;; WIKID setup/config
(define (setup-wikid pool (opts wikid.opts))
(and (pool? pool) (eq? (pool-base pool) @1/8000000)
(not (config 'brico:disabled))
(not (eq? wikid.setup pool))
(let ((indexes (pool/getindexes pool opts)))
(lognotice |WIKID|
"Configured from " (pool-source pool) " with " (|| indexes) " indexes"
(if (getopt opts 'background) " (in background)")
(printout "\n " pool))
(set! wikid.pool pool)
(set! wikid.index (pool/getindex pool))
(when (getopt opts 'background) (use-index wikid.index))
(set! wikid.indexes indexes)
(set! wikid.source (pool-source pool))
(set-wikid:readonly! wikid:readonly)
(set! wikid.setup pool)
pool)))
(define (set-wikid:readonly! flag)
(knodb/readonly! wikid.pool flag)
(knodb/readonly! wikid.index flag)
(set! wikid:readonly flag))
;;; Configs
(config-def! 'wikid:readonly
(lambda (var (val))
(cond ((unbound? val) wikid:readonly)
((and val wikid:readonly) #f)
((not (or val wikid:readonly)) #f)
((and wikid.pool wikid.index) (set-wikid:readonly! val))
((or wikid.pool wikid.index)
(logwarn |IncompleteWikiDB|
"Can't set readonly to " val " for wikid.pool=" wikid.pool " wikid.index=" wikid.index))
(else (set! wikid:readonly val)))))
(config-def! 'wikid:disabled
(slambda (var (val))
(if (unbound? val) (getopt wikid.opts 'disabled)
(let ((enabling (not val))
(disabled (getopt wikid.opts 'disabled)))
(store! wikid.opts 'disabled val)
(cond (wikid.setup
(unless enabling
(logwarn |WIKID|
"The database is already setup from " wikid.setup
"\n Disabling it has no effect (sorry).")))
((and enabling disabled)
;; This is the case where we are enabling the database and
;; will set it up if required
(if (config 'wikid:source)
(config! 'wikid:source (config 'wikid:source))
(lognotice |WIKID| "Enabling future database configuration"))))))))
(config-def! 'wikid:background
(slambda (var (val))
(cond ((unbound? val) (getopt wikid.opts 'background))
((not wikid.setup) (store! wikid.opts 'background val) val)
((getopt wikid.opts 'background)
(unless val
(logwarn |WIKID| "Clearing config, but cannot remove WIKID from the background"))
(getopt wikid.opts 'background))
(else (use-index wikid.index)
(store! wikid.opts 'background val)
#t))))
(define-init wikidsource-configfn
(knodb/configfn setup-wikid wikid.opts))
;;; Handle wikid:source and wikidsource conflicts
(define-init pre-configured #f)
(unless (or pre-configured (config 'wikid:disabled))
(let ((pre-config (or (config 'wikid:source) (config 'wikidsource))))
(when pre-config
(config! 'wikid:source pre-config)
(config! 'wikidsource pre-config)
(wikidsource-configfn 'wikid:source pre-config))))
(config-def! 'wikid:source wikidsource-configfn)
(config-def! 'wikidsource wikidsource-configfn)