diff --git a/bbstool.scm b/bbstool.scm index 5555119..c3455b8 100644 --- a/bbstool.scm +++ b/bbstool.scm @@ -45,7 +45,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. members-dir) ;; Print banner -(print "bbstool 0.5 (c) 2023 Brmlab, z.s.") +(print "bbstool 0.6 (c) 2023 Brmlab, z.s.") (newline) ;; Command-line options and configurable parameters diff --git a/configuration.scm b/configuration.scm index bb73b2a..0204174 100644 --- a/configuration.scm +++ b/configuration.scm @@ -30,7 +30,6 @@ ( *current-month* *member-file-context* - *member-default-joined* *member-suspend-max-months* ) @@ -50,10 +49,6 @@ ;; Configuration of error reporting (define *member-file-context* (make-parameter 3)) - ;; Default as specified by the original implementation if the 'joined - ;; key is missing in member file. - (define *member-default-joined* (make-parameter (make-month 2015 1))) - ;; How long the member can be suspended without any action required? (define *member-suspend-max-months* (make-parameter 24)) diff --git a/member-parser.scm b/member-parser.scm index b67cbb6..d845c6d 100644 --- a/member-parser.scm +++ b/member-parser.scm @@ -132,7 +132,6 @@ (apply member-record-sub-ensure mr 'info - 'member (list (make-period (*member-default-joined*) #f)) (join (map (lambda (mk) (list mk #f)) mandatory-keys)))) ;; Pass 0: Removes any comments and removes any leading and trailing diff --git a/member-record.scm b/member-record.scm index 604228e..78c9323 100644 --- a/member-record.scm +++ b/member-record.scm @@ -45,6 +45,7 @@ member-record-info member-missing-keys member-has-highlights? + member-record-usable? member-has-problems? member-destroyed? @@ -221,16 +222,26 @@ (define (member-has-errors? mr) (member-highlights-has-type? mr 'error)) + ;; Absolutely required + (define (member-record-usable? mr) + (dict-has-key? (dict-ref mr 'info) 'member)) + ;; True if member record is OK (define (member-has-problems? mr) (or (member-has-errors? mr) + (not (member-record-usable? mr)) (not (is-4digit-prime? (member-id mr))))) ;; Returns true if the member record represents non-existing ;; member. The *current-month* is a global parameter from period ;; module. (define (member-destroyed? mr) - (not (member-existing? mr))) + (and (not (member-existing? mr)) + (let ((member (member-record-info mr 'member))) + (if (null? member) + #f + (month>=? (*current-month*) + (period-since (car member))))))) ;; Generic period-based predicate (define ((member-period-predicate? key) mr) diff --git a/members-base.scm b/members-base.scm index a6a0415..3e72612 100644 --- a/members-base.scm +++ b/members-base.scm @@ -133,8 +133,9 @@ (map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mb)) ;; Returns dictionary with statistics about the members base. - (define (members-base-info mb) - (let* ((di0 (make-dict)) + (define (members-base-info mb-arg) + (let* ((mb (filter-members-by-predicate mb-arg member-record-usable?)) + (di0 (make-dict)) (di1 (dict-set di0 'invalid (filter-members-by-predicate mb (compose not is-4digit-prime? member-id)))) @@ -150,12 +151,15 @@ (di7 (dict-set di6 'total mb))) di7)) + (define (members-base-oldest-month mb) + (make-month 2015 1)) + ;; Returns a list two lists: keys, data. ;; Each data record contains values for all keys. (define (members-base-stats mb) (let ((keys '(month total active suspended students destroyed invalid))) (let mloop ((data '()) - (month (*member-default-joined*))) + (month (members-base-oldest-month mb))) (if (month