|
Revision 3681, 1.4 kB
(checked in by ksprotte, 4 months ago)
|
checkpoint
|
| Line | |
|---|
| 1 |
(in-package :bos.m2) |
|---|
| 2 |
|
|---|
| 3 |
(defun delete-expired-contracts () |
|---|
| 4 |
(let ((unpaid-contracts (remove-if #'contract-paidp (all-contracts))) |
|---|
| 5 |
deleting) |
|---|
| 6 |
(dolist (contract unpaid-contracts) |
|---|
| 7 |
(when (contract-is-expired contract) |
|---|
| 8 |
(push contract deleting))) |
|---|
| 9 |
(when deleting |
|---|
| 10 |
(send-system-mail :subject "Unbezahlte QuadratmeterkÀufe wurden gelöscht" |
|---|
| 11 |
:text (with-output-to-string (*standard-output*) |
|---|
| 12 |
(format t "Die folgenden QuadratmeterkÀufe wurden nicht bezahlt und wurden aus der Datenbank gelöscht~%~%") |
|---|
| 13 |
(format t " Datum Zeit Sponsor-ID Contract-ID Anzahl-QM~%") |
|---|
| 14 |
(format t "----------------------------------------------------~%") |
|---|
| 15 |
(mapc #'(lambda (contract) |
|---|
| 16 |
(format t "~A ~9D ~9D ~8D~%" |
|---|
| 17 |
(format-date-time (contract-date contract)) |
|---|
| 18 |
(store-object-id (contract-sponsor contract)) |
|---|
| 19 |
(store-object-id contract) |
|---|
| 20 |
(length (contract-m2s contract))) |
|---|
| 21 |
(delete-object contract)) |
|---|
| 22 |
deleting)))))) |
|---|
