79 lines
2 KiB
Scheme
79 lines
2 KiB
Scheme
;;
|
|
;; members-base.scm
|
|
;;
|
|
;; Storage for member files.
|
|
;;
|
|
;; ISC License
|
|
;;
|
|
;; Copyright 2023 Brmlab, z.s.
|
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
|
;;
|
|
;; Permission to use, copy, modify, and/or distribute this software
|
|
;; for any purpose with or without fee is hereby granted, provided
|
|
;; that the above copyright notice and this permission notice appear
|
|
;; in all copies.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
|
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
|
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
|
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
|
|
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
|
|
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
|
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
|
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
;;
|
|
|
|
(declare (unit members-base))
|
|
|
|
(module
|
|
members-base
|
|
(
|
|
load-members
|
|
members-base-tests!
|
|
)
|
|
|
|
(import scheme
|
|
(chicken base)
|
|
(chicken pathname)
|
|
(chicken file posix)
|
|
(chicken file)
|
|
testing
|
|
dictionary)
|
|
|
|
;; Gets all files and symbolic links from given directory. The
|
|
;; symbolic links are represented by cons cells with car being the
|
|
;; name and cdr the link target.
|
|
(define (get-files+symlinks dn)
|
|
(let loop ((fns (directory dn))
|
|
(rs '()))
|
|
(if (null? fns)
|
|
rs
|
|
(let* ((fn (car fns))
|
|
(ffn (make-pathname dn fn)))
|
|
(loop (cdr fns)
|
|
(if (symbolic-link? ffn)
|
|
(cons (cons fn (read-symbolic-link ffn)) rs)
|
|
(if (regular-file? ffn)
|
|
(cons fn rs)
|
|
rs)))))))
|
|
|
|
(define (files+symlinks->files-dictionary ls)
|
|
(let ((links (filter pair? ls))
|
|
(files (filter string? ls)))
|
|
(print links)
|
|
(print files)))
|
|
|
|
(define (load-members dn)
|
|
;; get the directory contents
|
|
(files+symlinks->files-dictionary (get-files+symlinks dn))
|
|
;; filter all ids
|
|
;; resolve links (it might be unknown!)
|
|
;; load member files
|
|
1)
|
|
|
|
(define (members-base-tests!)
|
|
(run-tests
|
|
members-base
|
|
))
|
|
|
|
)
|