Split out member-record module.

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

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
-	     string<?)
-	    ", "))
-    (print "Total IDs: "
-	   (length ids)
-	   " (" (length (filter is-4digit-prime? ids)) " valid)")
-    (let ((invalid-ids (filter (compose not is-4digit-prime?) ids)))
-      (when (not (null? invalid-ids))
-	(print "  Invalid (" (length invalid-ids) "): "
-	       (string-intersperse
-		(map number->string 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)
-			(string<?
-			 (symbol->string (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)))))))
-
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

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 <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 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)
+			 (string<?
+			  (symbol->string (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)))))))
+
+ )

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
+	     string<?)
+	    ", "))
+    (print "Total IDs: "
+	   (length ids)
+	   " (" (length (filter is-4digit-prime? ids)) " valid)")
+    (let ((invalid-ids (filter (compose not is-4digit-prime?) ids)))
+      (when (not (null? invalid-ids))
+	(print "  Invalid (" (length invalid-ids) "): "
+	       (string-intersperse
+		(map number->string invalid-ids)
+		", "))))))
+
  ;; Performs self-tests of this module.
  (define (members-base-tests!)
    (run-tests