Prepare for notifications.

src/bbstool.scm

@@ -32,7 +32,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 	month
 	period
 	command-line
-	utils
+	util-list
 	ansi
 	members-base
 	primes
@@ -70,6 +70,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 (define -jendasap-checked- (make-parameter "checked.ntlm"))
 (define -ml-all- (make-parameter #f))
 (define -show-destroyed- (make-parameter #f))
+(define -notify-months- (make-parameter 1))
 
 ;; Arguments parsing
 (command-line
@@ -144,6 +145,12 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 	   (-action- 'mlcheck))
  (-mlsync () "Synchronize internal ML"
 	  (-action- 'mlsync))
+ (-notify () "Members with debt for more than 1 month"
+	   (-notify-months- 1)
+	   (-action- 'notify))
+ (-notify3 () "Members with debt for more than 3 month"
+	   (-notify-months- 3)
+	   (-action- 'notify))
  )
 
 ;; Run tests
@@ -152,7 +159,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   (dictionary-tests!)
   (month-tests!)
   (period-tests!)
-  (utils-tests!)
+  (util-list-tests!)
   (ansi-tests!)
   (command-line-tests!)
   (members-dir-tests!)
@@ -297,6 +304,8 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 	     (print "  Missing: " missing))
 	   (when (not (null? surplus))
 	     (print "  Outsiders: " surplus))))))
+  ((notify)
+   (print "Notify" (-notify-months-)))
   (else
    (print "Nothing to do."))
   

src/members-payments.scm

@@ -32,6 +32,7 @@
   members-payments-process
   member-balance
   member-total-balance
+  members-to-notify
   )
 
  (import scheme
@@ -211,5 +212,17 @@
 		     (else 0))))
 	       (member-payments mr))))
 
+ ;; Return members to notify because of late payments for more than
+ ;; given number of months
+ (define (members-to-notify mb months)
+   (filter-members-by-predicate
+    mb
+    (lambda (mr)
+      (let ((total (member-total-balance mr))
+	    (fee (lookup-member-fee (if (member-student? mr)
+					'student
+					'regular))))
+	(and (< total 0)
+	     (< total (- (* months fee))))))))
 
  )

src/util-list.scm

@@ -29,7 +29,7 @@
  util-list
  (
   filter
-  utils-tests!
+  util-list-tests!
   )
 
  (import scheme
@@ -51,9 +51,9 @@
 		   res)))))
 
  ;; Performs utils module self-tests.
- (define (utils-tests!)
+ (define (util-list-tests!)
    (run-tests
-    utils
+    util-list
     (test-equal? filter (filter odd? '(1 2 3 4)) '(1 3))
     (test-equal? filter (filter odd? '(2 4)) '())
     ))