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

Aliases and files recording.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-15 12:37:03 +01:00
parent 29dc5aa1ac
commit 669c17123b
1 changed files with 50 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

57
members-base.scm
View file

@ -37,7 +37,9 @@
(chicken pathname)
(chicken file posix)
(chicken file)
(chicken format)
testing
utils
dictionary)
;; Gets all files and symbolic links from given directory. The
@ -52,20 +54,50 @@
(ffn (make-pathname dn fn)))
(loop (cdr fns)
(if (symbolic-link? ffn)
(cons (cons fn (read-symbolic-link ffn)) rs)
(cons (cons (string->symbol fn)
(string->symbol (read-symbolic-link ffn)))
rs)
(if (regular-file? ffn)
(cons fn rs)
(cons (string->symbol fn) rs)
rs)))))))
;; Converts a list of symlinks and files in aforementioned format
;; into a dictionary of regular files as keys with lists of symlinks
;; as values. If the target file does not exist, adds 'error-0 symbol
;; as the first alias to this list with the number increasing with
;; each nonexistent file encountered. The error record is also
;; generated for symlinks pointing outside of the directory.
(define (files+symlinks->files-dictionary ls)
(let ((links (filter pair? ls))
(files (filter string? ls)))
(print links)
(print files)))
(let* ((links (filter pair? ls))
(files (filter symbol? ls))
(fdict
(let loop ((files files)
(res (make-dict)))
(if (null? files)
res
(loop (cdr files)
(dict-set res (car files) '()))))))
(let loop ((links links)
(res fdict)
(errs 0))
(if (null? links)
res
(let* ((link (car links))
(name (car link))
(target (cdr link)))
(if (dict-has-key? res target)
(loop (cdr links)
(dict-set res target (cons name (dict-ref res target)))
errs)
(loop (cdr links)
(dict-set res target
(list (string->symbol (sprintf "error-~A" errs))
name))
(+ errs 1))))))))
(define (load-members dn)
;; get the directory contents
(files+symlinks->files-dictionary (get-files+symlinks dn))
(print (files+symlinks->files-dictionary (get-files+symlinks dn)))
;; filter all ids
;; resolve links (it might be unknown!)
;; load member files
@ -74,6 +106,17 @@
(define (members-base-tests!)
(run-tests
members-base
(test-equal? files+symlinks->files-dictionary
(files+symlinks->files-dictionary
'(joe (2803 . joe)))
'((joe 2803)))
(test-equal? files+symlinks->files-dictionary
(files+symlinks->files-dictionary
'(joe
(2803 . joe)
(666 . nonexistent)))
'((nonexistent error-0 666)
(joe 2803)))
))
)