Split out member-record module.

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)))))))
+
+ )