Split out member-file module.

brmsaptool-orig.scm

@@ -31,135 +31,16 @@
 	(chicken time)
 	(chicken time posix)
 	(chicken process-context)
-	testing
 	dictionary
 	month
-	period)
+	period
+	member-file)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Static default configuration
 
 (define *members-directory* (make-parameter "members"))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Testing
-
-(define-syntax with-handler
-  (syntax-rules ()
-    ((_ handler body ...)
-     (call-with-current-continuation
-      (lambda (k)
-	(with-exception-handler
-	 (lambda (x) (k (handler x)))
-	 (lambda () body ...)))))))
-
-(define-syntax unit-test
-  (syntax-rules ()
-    ((_ name condition)
-     (if (with-handler (lambda (x) #f)
-		       condition)
-	 (display ".")
-	 (error 'unit-test name)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Member info data file
-
-;; Member File Parser: remove comments from line and return the result
-(define (mfp:line:remove-comments l)
-  (let ((si (substring-index "#" l)))
-    (if si
-	(if (= si 0)
-	    ""
-	    (car (string-chop l si)))
-	l)))
-
-;; Parses given key-value line. Key is up to first space, value is the
-;; rest of the line. If the line doesn't contain anything, returns #f.
-(define (parse-member-line l)
-  (let ((sp (string-split (mfp:line:remove-comments l) " ")))
-    (and sp
-	 (not (null? sp))
-	 (list (string->symbol (car sp))
-	       (string-intersperse (cdr sp))))))
-
-;; If given symbol represents start/stop symbol of either kind,
-;; returns a list of the symbol representing the type and start/stop
-;; symbol. It returns false otherwise.
-(define (split-start/stop-symbol s)
-  (cond ((eq? s 'studentstart) '(student start))
-	((eq? s 'studentstop) '(student stop))
-	((eq? s 'suspendstart) '(suspend start))
-	((eq? s 'suspendstop) '(suspend stop))
-	(else #f)))
-
-;; Processes member line adding given value v to the dictionary d
-;; under key k. Special handling for start/stop symbols means given
-;; value is prepended to given start/stop key (student/suspend) as
-;; parsed month for later processing of student/suspend periods.
-(define (process-member-line d k v)
-  (let ((ss (split-start/stop-symbol k)))
-    (if ss
-	(let ((pk (car ss))
-	      (pd (cadr ss))
-	      (vl (string-split v " ")))
-	  (if (null? vl)
-	      (error 'process-member-line "Missing date for start/stop symbol" k)
-	      (let ((ds (car vl)))
-		(dict-set d pk
-			  (cons (cons pd (string->month ds))
-				(dict-ref d pk '()))))))
-	(case k
-	  ((card desfire credit) (dict-set d k (cons v (dict-ref d k '()))))
-	  (else
-	   (dict-set d k v))))))
-
-;; Converts given key in member info dictionary from period markers
-;; list to periods.
-(define (convert-member-key:markers->periods m k)
-  (dict-set m k
-	    (period-markers->periods
-	     (sort-period-markers
-	      (dict-ref m k '())))))
-
-;; Converts all given keys using period-markers->periods.
-(define (convert-member-keys:markers->periods m . ks)
-  (let loop ((m m)
-	     (ks ks))
-    (if (null? ks)
-	m
-	(loop (convert-member-key:markers->periods m (car ks))
-	      (cdr ks)))))
-
-;; Fills-in the defaults
-(define (make-default-member-info)
-  (dict-set
-   (make-dict)
-   'joined
-   "2015-01"))
-
-;; Processes all lines and returns a dictionary representing given
-;; member.
-(define (parse-member-lines ls)
-  (let loop ((ls ls)
-	     (r (make-default-member-info)))
-    (if (null? ls)
-	(convert-member-keys:markers->periods r 'suspend 'student)
-	(let ((p (parse-member-line (car ls))))
-	  (loop (cdr ls)
-		(if p
-		    (apply process-member-line r p)
-		    r))))))
-
-;; Loads lines from given file in (*members-directory*) and parses
-;; them.
-(define (load-member-file fn)
-  (let* ((ffn (make-pathname (*members-directory*) fn))
-	 (f (open-input-file ffn))
-	 (ls (read-lines f))
-	 (md (parse-member-lines ls)))
-    (display ".")
-    md))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Members database
 
@@ -210,7 +91,10 @@
     (if (null? ei)
 	mdb
 	(let ((mi (car ei)))
-	  (let ((mid (load-member-file (dict-ref mi 'file))))
+	  (let ((mid (load-member-file
+		      (make-pathname
+		       (*members-directory*)
+		       (dict-ref mi 'file)))))
 	    (loop (cdr ei)
 		  (cons (dict-set mi
 				  'info