Start work on new member record handling.

member2-record.scm

@@ -0,0 +1,75 @@
+;;
+;; member2-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 member2-record))
+
+(module
+ member2-record
+ (
+  make-member-record
+  member-record-tests!
+  )
+
+ (import scheme
+	 (chicken base)
+	 (chicken keyword)
+	 dictionary
+	 testing)
+
+ ;; Creates new member record based on the file and symlinks
+ ;; information received from the members directory. Any keyword
+ ;; arguments are converted to respective symbols in the dictionary.
+ (define (make-member-record file-name file-path symlinks . args)
+   (let loop ((args args)
+	      (pairs `((file-name . ,file-name)
+		       (file-path . ,file-path)
+		       (symlinks . ,symlinks))))
+     (if (null? args)
+	 (make-dict pairs)
+	 (if (not (keyword? (car args)))
+	     (error 'make-member-record "Optional arguments must be keywords" (car args))
+	     (if (null? (cdr args))
+		 (error 'make-member-record "Each optional keyword argument must have a value" (car args))
+		 (loop (cddr args)
+		       (cons (cons (string->symbol (keyword->string (car args)))
+				   (cadr args))
+			     pairs)))))))
+
+ (define (member-record-tests!)
+   (run-tests
+    member-record
+    (test-equal? make-member-record
+		 (make-member-record "1234" "members/1234" '("member"))
+		 '((file-name . "1234")
+		   (file-path . "members/1234")
+		   (symlinks "member")))
+    ))
+
+ )
+
+(import member2-record)
+
+(member-record-tests!)