Format today as ISO date.
This commit is contained in:
parent
779aa80ba3
commit
09bce0be88
3 changed files with 34 additions and 7 deletions
|
@ -35,6 +35,7 @@
|
||||||
*jendasap-checked*
|
*jendasap-checked*
|
||||||
*bank-dir*
|
*bank-dir*
|
||||||
*email-from*
|
*email-from*
|
||||||
|
*summary-mailto*
|
||||||
|
|
||||||
load-configuration!
|
load-configuration!
|
||||||
)
|
)
|
||||||
|
@ -73,6 +74,10 @@
|
||||||
(define *email-from* (make-parameter #f))
|
(define *email-from* (make-parameter #f))
|
||||||
(define =email-from= "Brmlab - Rada <rada@brmlab.cz>")
|
(define =email-from= "Brmlab - Rada <rada@brmlab.cz>")
|
||||||
|
|
||||||
|
;; TODO - later move to configuration
|
||||||
|
(define *summary-mailto* (make-parameter #f))
|
||||||
|
(define =summary-mailto= "rada@brmlab.cz")
|
||||||
|
|
||||||
;; Loads the configuration file and possibly changes the default
|
;; Loads the configuration file and possibly changes the default
|
||||||
;; parameters.
|
;; parameters.
|
||||||
(define (load-configuration!)
|
(define (load-configuration!)
|
||||||
|
@ -101,6 +106,9 @@
|
||||||
((email-from)
|
((email-from)
|
||||||
(when (not (*email-from*))
|
(when (not (*email-from*))
|
||||||
(*email-from* v)))
|
(*email-from* v)))
|
||||||
|
((summary-mailto)
|
||||||
|
(when (not (*summary-mailto*))
|
||||||
|
(*summary-mailto* v)))
|
||||||
)))
|
)))
|
||||||
(loop (cdr lines))))))
|
(loop (cdr lines))))))
|
||||||
(when (not (*members-directory*))
|
(when (not (*members-directory*))
|
||||||
|
@ -111,6 +119,8 @@
|
||||||
(*jendasap-checked* =jendasap-checked=))
|
(*jendasap-checked* =jendasap-checked=))
|
||||||
;; No bank-dir - #f default
|
;; No bank-dir - #f default
|
||||||
(when (not (*email-from*))
|
(when (not (*email-from*))
|
||||||
(*email-from* =email-from=)))
|
(*email-from* =email-from=))
|
||||||
|
(when (not (*summary-mailto*))
|
||||||
|
(*summary-mailto* =summary-mailto=)))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -43,10 +43,8 @@
|
||||||
members-payments
|
members-payments
|
||||||
util-format
|
util-format
|
||||||
brmember-format
|
brmember-format
|
||||||
configuration)
|
configuration
|
||||||
|
util-time)
|
||||||
;; TODO - later move to configuration
|
|
||||||
(define *summary-mailto* (make-parameter "rada@brmlab.cz"))
|
|
||||||
|
|
||||||
;; Prints email to the console
|
;; Prints email to the console
|
||||||
(define (print-notification-email em)
|
(define (print-notification-email em)
|
||||||
|
@ -117,7 +115,8 @@
|
||||||
(define (make-summary-email mb)
|
(define (make-summary-email mb)
|
||||||
(make-ldict
|
(make-ldict
|
||||||
`((to . ,(*summary-mailto*))
|
`((to . ,(*summary-mailto*))
|
||||||
(subject . "xxx")
|
(subject . ,(format "Členské příspěvky ~A"
|
||||||
|
(today/iso)))
|
||||||
(body . ,(summary-email-body mb)))))
|
(body . ,(summary-email-body mb)))))
|
||||||
|
|
||||||
(define (make+print-summary-email mb)
|
(define (make+print-summary-email mb)
|
||||||
|
|
|
@ -29,10 +29,13 @@
|
||||||
util-time
|
util-time
|
||||||
(
|
(
|
||||||
current-util-milliseconds
|
current-util-milliseconds
|
||||||
|
today/iso
|
||||||
)
|
)
|
||||||
|
|
||||||
(import scheme
|
(import scheme
|
||||||
(chicken time))
|
(chicken time)
|
||||||
|
(chicken time posix)
|
||||||
|
(chicken format))
|
||||||
|
|
||||||
;; Compatibility wrapper
|
;; Compatibility wrapper
|
||||||
(define (current-util-milliseconds)
|
(define (current-util-milliseconds)
|
||||||
|
@ -46,5 +49,20 @@
|
||||||
(else
|
(else
|
||||||
(current-process-milliseconds))))
|
(current-process-milliseconds))))
|
||||||
|
|
||||||
|
;; Returns today as YYYY-MM-DD string
|
||||||
|
(define (today/iso)
|
||||||
|
(let ((d (seconds->local-time)))
|
||||||
|
(format "~A-~A-~A"
|
||||||
|
(number->string
|
||||||
|
(+ 1900 (vector-ref d 5)))
|
||||||
|
(substring
|
||||||
|
(number->string
|
||||||
|
(+ 101 (vector-ref d 4)))
|
||||||
|
1)
|
||||||
|
(substring
|
||||||
|
(number->string
|
||||||
|
(+ 100 (vector-ref d 3)))
|
||||||
|
1))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue