brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Basic loading.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-16 10:41:59 +01:00
parent 165794f317
commit 62882aab27
2 changed files with 15 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

3
member-file.scm
View file

@ -49,7 +49,8 @@
;; Specification of known keys for various types of parsing ;; Specification of known keys for various types of parsing
(define known-keys '(nick mail phone name born joined destroyed (define known-keys '(nick mail phone name born joined destroyed
mail2 ID email suspended tel)) ;; Unknown keys ;; mail2 ID email suspended tel ;; Unknown keys
))
(define start/stop-keys '(student suspend)) (define start/stop-keys '(student suspend))
(define multi-keys '(card desfire credit)) (define multi-keys '(card desfire credit))

29
members-base.scm
View file

@ -120,37 +120,34 @@
;; Returns dictionary containing only records with either 4-digit ;; Returns dictionary containing only records with either 4-digit
;; name or one of its aliases being 4-digit. ;; name or one of its aliases being 4-digit.
(define (files-dictionary-filter-4digit-symbols d) (define (files-dictionary-filter-4digit-symbols d)
(let loop ((keys (dict-keys d)) (dict-filter
(res (make-dict))) (lambda (k v)
(if (null? keys) (list-contains-4digit-symbol? (cons k v)))
res d))
(let* ((key (car keys))
(val (dict-ref d key)))
(loop (cdr keys)
(if (list-contains-4digit-symbol? (cons key val))
(dict-set res key val)
res))))))
;; Returns a dictionary containing file-name, symlinks, id and info ;; Returns a dictionary containing file-name, symlinks, id and info
;; keys. The info key contains whatever load-member-file from the ;; keys. The info key contains whatever load-member-file from the
;; member-file module returns. The id key contains whatever is the ;; member-file module returns. The id key contains whatever is the
;; first 4-digit symbol in (cons fname aliases) list. ;; first 4-digit symbol in (cons fname aliases) list.
(define (members-base-load-member mdir fname aliases) (define (members-base-load-member mdir fname symlinks)
(let* ((mr0 (make-dict)) (let* ((mr0 (make-dict))
(mr-fn (dict-set mr0 'file-name fname)) (mr-fn (dict-set mr0 'file-name fname))
(mr-sl (dict-set mr-fn 'symlinks aliases))) (mr-sl (dict-set mr-fn 'symlinks symlinks)))
(dict-set mr-sl 'info (dict-set mr-sl 'info
(load-member-file (load-member-file
(make-pathname mdir fname))))) (make-pathname mdir fname)))))
;; Loads members database
(define (load-members dn) (define (load-members dn)
;; get the directory contents
(let ((fss (files-dictionary-filter-4digit-symbols (let ((fss (files-dictionary-filter-4digit-symbols
(files+symlinks->files-dictionary (files+symlinks->files-dictionary
(get-files+symlinks dn))))) (get-files+symlinks dn)))))
(void)) (dict-map
;; load member files (lambda (symfn symlinks)
1) (members-base-load-member dn
(symbol->string symfn)
symlinks))
fss)))
(define (members-base-tests!) (define (members-base-tests!)
(run-tests (run-tests