27

cmd/todaybd.cmd

+@echo off
+setlocal enableextensions
+
+set "ods_root=c:/denis/denis_core/odysseus"
+
+racket %ods_root%/cmd/todaybd.rkt %*
+
+endlocal

cmd/todaybd.rkt

+#lang racket
+
+(require racket/cmdline)
+
+(require (file "c:/denis/denis_core/denis_personal/my_people/all.rkt"))
+(require "../lib/all.rkt")
+(require "../pmf/people.rkt")
+(require "../pmf/people_verify.rkt")
+(require "../graphics/console.rkt")
+(require "../reports/csv.rkt")
+
+(define ns (module->namespace (string->path "c:/denis/denis_core/denis_personal/my_people/all.rkt")))
+
+(define day #f)
+(define total-count (make-parameter #f))
+
+(define (todaybd people (day #f))
+  (let* ((curdate (if day day (current-date)))
+        (cur-day-month (day-month curdate))
+        (filtered-people (filter
+                  (λ (p) (let ((bd (hash-ref p 'bdate #f)))
+                            (if bd
+                                (equal? cur-day-month (day-month bd))
+                                #f)))
+                  people)))
+    (ppl-output '("bdate" "phone" "sn") filtered-people)))
+
+(define (count-bd people)
+  (display
+    (str
+      (esc-sec (string-text-color 'green))
+      (length (filter (λ (p) (hash-ref p 'bdate #f)) people))
+      (esc-sec (string-text-color 'default)))))
+
+(define (ppl-output fields people-sublist (csvfile ""))
+  (if (nil? csvfile)
+    (display (people->string people-sublist fields))
+    (write-csv-file
+      (merge
+        (list 'surname 'name)
+        (map string->symbol fields))
+      people-sublist
+      csvfile)))
+
+;>ppl -q "(city=? \"Мурманск\")"
+;>ppl -q "(city=? \"Мурманск\")" -f "phone,email"
+
+(command-line
+  #:program "todaybd"
+  #:multi
+    [("-d" "--day") d
+                    "day in the year for which find the birthdays"
+										(set! day d)]
+    [("-c" "--total-count")
+                    "total amount of persons with birthdays in database"
+										(total-count #t)]
+  #:args
+    ()
+    (cond
+      (day (todaybd people day))
+      ((total-count) (count-bd people))
+      (else (todaybd people))))

lib/strings.rkt

@@ -40,10 +40,12 @@
     ((false? x) 0)
     (else x)))
 
-(define (format-number format-str number)
+(define (format-number format-str number #:filler (filler ""))
   (define (format-number-iter format-str number-str res-str)
       (cond
-        ((null? number-str) res-str)
+        ((null? number-str) (str
+                              (dupstr filler (count-element format-str "d"))
+                              res-str))
         ((null? format-str) (str (implode (reverse number-str)) res-str))
         (else
           (let ((cur-f (car format-str))

lib/tests/time_test.rkt

@@ -41,7 +41,11 @@
   (check-false (d< "07.04.2017" "28.08.1979"))
 
   (check-false (d= "07.04.2017" "28.08.1979"))
-  (check-true (d= "7.04.2017" "07.04.2017")) 
+  (check-true (d= "7.04.2017" "07.04.2017"))
+
+  (check-equal? (day-month "07.04.2017") "07.04")
+  (check-equal? (day-month "06.06.198x") "06.06")
+  (check-equal? (day-month "06.10") "06.10")
 
   ;(check-equal? (datetime-diff "15.03.2017 1:56:48" "07.04.2017 4:12:50") ...)
 )

lib/time.rkt

@@ -3,6 +3,8 @@
 (require "base.rkt")
 (require "type.rkt")
 (require "seqs.rkt")
+(require "strings.rkt")
+(require "regexp.rkt")
 
 (provide (all-defined-out))
 
@@ -124,7 +126,7 @@
         (f (fract x))
         (m (*f 60 f))
         (s (*f 3600 (- f (/ m 60)))))
-    (list i m s)))        
+    (list i m s)))
 
 ; 2017-01-19T18:00:00 -> (hash 'year "2017" 'month "01" 'day "19" 'hour "18" 'min "00" 'sec "00")
 (define (parse-time timestr)
@@ -145,3 +147,19 @@
 (define (time-reformat timestr)
   (th->string
     (parse-time timestr)))
+
+(define (current-date)
+  (let* ((curdate (seconds->date (current-seconds)))
+        (day (format-number "dd" (date-day curdate) #:filler "0"))
+        (month (format-number "dd" (date-month curdate) #:filler "0"))
+        (year (date-year curdate)))
+    (format "~a.~a.~a" day month year)))
+
+(define (day-month adate)
+  (let* ((parts (get-matches
+                  "([0-9x]{2}).([0-9x]{2})(.([0-9x]{4}[~?]?))?"
+                  adate))
+        (parts (if (notnil? parts) (car parts) #f)))
+    (if parts
+      (str (second parts) "." (third parts))
+      "")))