From 023befa8f86e0001707b61fd224082324cf242bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 18 Mar 2023 14:18:30 +0100 Subject: [PATCH] Split out member-record module. --- Makefile | 21 ++++++++++----- brmsaptool.scm | 54 ++----------------------------------- member-record.scm | 68 +++++++++++++++++++++++++++++++++++++++++++++++ members-base.scm | 28 ++++++++++++++++++- 4 files changed, 111 insertions(+), 60 deletions(-) create mode 100644 member-record.scm diff --git a/Makefile b/Makefile index 2b1dc61..da4a787 100644 --- a/Makefile +++ b/Makefile @@ -28,23 +28,24 @@ all: brmsaptool CSC=csc -BRMSAPTOOL-DEPS=brmsaptool.scm testing.import.scm \ - listing.import.scm dictionary.import.scm month.import.scm \ - period.import.scm ansi.import.scm member-file.import.scm \ +BRMSAPTOOL-DEPS=brmsaptool.scm testing.import.scm listing.import.scm \ + dictionary.import.scm month.import.scm period.import.scm \ + ansi.import.scm member-file.import.scm \ command-line.import.scm members-base.import.scm \ - utils.import.scm primes.import.scm + utils.import.scm primes.import.scm member-record.import.scm BRMSAPTOOL-SOURCES=brmsaptool.scm testing.scm listing.scm \ dictionary.scm month.scm period.scm ansi.scm member-file.scm \ - command-line.scm members-base.scm utils.scm primes.scm + command-line.scm members-base.scm utils.scm primes.scm \ + member-record.scm BRMSAPTOOL-OBJS=testing.o listing.o month.o period.o ansi.o \ member-file.o dictionary.o command-line.o \ - members-base.o utils.o primes.o + members-base.o utils.o primes.o member-record.o BRMSAPTOOL-SHARED=testing.so listing.so month.so period.so ansi.so \ member-file.so dictionary.so command-line.so \ - members-base.so utils.so primes.so + members-base.so utils.so primes.so member-record.so brmsaptool: $(BRMSAPTOOL-DEPS) $(CSC) -o $@ $< @@ -139,3 +140,9 @@ PRIMES-SOURCES=primes.scm testing.import.scm primes.so: $(PRIMES-SOURCES) primes.o: primes.import.scm primes.import.scm: primes.so + +MEMBER-RECORD-SOURCES=member-record.scm + +member-record.so: $(MEMBER-RECORD-SOURCES) +member-record.o: member-record.import.scm +member-record.import.scm: member-record.so diff --git a/brmsaptool.scm b/brmsaptool.scm index cf60e71..748e277 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -33,7 +33,8 @@ utils ansi members-base - primes) + primes + member-record) ;; Print banner (print "brmsaptool 0.3 (c) 2023 Brmlab, z.s.") @@ -86,57 +87,6 @@ (find-member-by-nick MB (-member-nick-)) #f))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - -(import (chicken string) - (chicken sort)) -(define (print-members-base-info mb) - (let ((nicks (list-members-nicks mb)) - (ids (list-members-ids mb))) - (print "Members (" - (length nicks) - "): " - (string-intersperse - (sort - nicks - stringstring invalid-ids) - ", ")))))) - -(define (print-member-record-info mr) - (let* ((id (dict-ref mr 'id)) - (aliases (dict-ref mr 'symlinks)) - (info (dict-ref mr 'info)) - (sinfo (sort info - (lambda (a b) - (stringstring (car a)) - (symbol->string (car b))))))) - (print "User " id " alias(es): " - (string-intersperse - (map symbol->string aliases) - ", ")) - (newline) - (let loop ((sinfo sinfo)) - (when (not (null? sinfo)) - (let* ((kv (car sinfo)) - (k (car kv)) - (v (cdr kv))) - (print " " k ":\t" - (if (member k '(student suspend)) - (periods->string v) - v)) - (loop (cdr sinfo))))))) - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/member-record.scm b/member-record.scm new file mode 100644 index 0000000..53ed452 --- /dev/null +++ b/member-record.scm @@ -0,0 +1,68 @@ +;; +;; member-record.scm +;; +;; Procedures working with complete member record (as loaded by the +;; members-base). +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 member-record)) + +(module + member-record + ( + print-member-record-info + ) + + (import scheme + (chicken base) + (chicken string) + (chicken sort) + dictionary + period + ) + + (define (print-member-record-info mr) + (let* ((id (dict-ref mr 'id)) + (aliases (dict-ref mr 'symlinks)) + (info (dict-ref mr 'info)) + (sinfo (sort info + (lambda (a b) + (stringstring (car a)) + (symbol->string (car b))))))) + (print "User " id " alias(es): " + (string-intersperse + (map symbol->string aliases) + ", ")) + (newline) + (let loop ((sinfo sinfo)) + (when (not (null? sinfo)) + (let* ((kv (car sinfo)) + (k (car kv)) + (v (cdr kv))) + (print " " k ":\t" + (if (member k '(student suspend)) + (periods->string v) + v)) + (loop (cdr sinfo))))))) + + ) diff --git a/members-base.scm b/members-base.scm index 59e142b..2963a86 100644 --- a/members-base.scm +++ b/members-base.scm @@ -33,6 +33,7 @@ find-member-by-nick list-members-ids list-members-nicks + print-members-base-info members-base-tests! ) @@ -43,10 +44,13 @@ (chicken file) (chicken format) (chicken irregex) + (chicken sort) + (chicken string) testing utils dictionary - member-file) + member-file + primes) ;; Gets all files and symbolic links from given directory. The ;; symbolic links are represented by cons cells with car being the @@ -221,6 +225,28 @@ (define (list-members-nicks mb) (map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mb)) + ;; Basic information about members-base in human-readable form. + (define (print-members-base-info mb) + (let ((nicks (list-members-nicks mb)) + (ids (list-members-ids mb))) + (print "Members (" + (length nicks) + "): " + (string-intersperse + (sort + nicks + stringstring invalid-ids) + ", ")))))) + ;; Performs self-tests of this module. (define (members-base-tests!) (run-tests