habitual (5498B)
1 #!/usr/bin/env bb 2 ;; vim: ft=clojure 3 4 (ns habitual 5 (:require [clojure.string :as str] 6 [clojure.tools.cli :refer [parse-opts]] 7 [babashka.process :refer [shell]])) 8 9 (defn- positive-step [step part] 10 (when-not (and step (pos? step)) 11 (throw (ex-info (format "Cron step must be positive: %s" part) {:part part}))) 12 step) 13 14 (defn parse-cron-field [field lo hi] 15 (let [all (set (range lo (inc hi)))] 16 (reduce 17 (fn [acc part] 18 (cond 19 (= part "*") 20 (into acc all) 21 22 (re-matches #"\*/\d+" part) 23 (let [step (positive-step (parse-long (subs part 2)) part)] 24 (into acc (range lo (inc hi) step))) 25 26 (re-matches #"\d+-\d+/\d+" part) 27 (let [[range-part step-part] (str/split part #"/") 28 [a b] (map parse-long (str/split range-part #"-")) 29 step (positive-step (parse-long step-part) part)] 30 (into acc (range a (inc b) step))) 31 32 (re-matches #"\d+-\d+" part) 33 (let [[a b] (map parse-long (str/split part #"-"))] 34 (into acc (range a (inc b)))) 35 36 :else 37 (conj acc (parse-long part)))) 38 #{} 39 (str/split field #",")))) 40 41 (defn parse-cron [expr] 42 (let [[minutes hours days months weekdays] (str/split expr #"\s+")] 43 {:minutes (parse-cron-field minutes 0 59) 44 :hours (parse-cron-field hours 0 23) 45 :days (parse-cron-field days 1 31) 46 :months (parse-cron-field months 1 12) 47 :weekdays (parse-cron-field weekdays 0 6) 48 ;; Standard cron OR's day-of-month and day-of-week when both are 49 ;; restricted; AND's them otherwise. 50 :days-restricted? (not= (str/trim days) "*") 51 :weekdays-restricted? (not= (str/trim weekdays) "*")})) 52 53 (defn matches-cron? 54 "True if the given LocalDateTime matches the parsed cron spec." 55 [cron ldt] 56 (let [month (.getMonthValue ldt) ; 1-12 57 mday (.getDayOfMonth ldt) ; 1-31 58 hour (.getHour ldt) ; 0-23 59 minute (.getMinute ldt) ; 0-59 60 weekday (-> ldt .getDayOfWeek .getValue (mod 7)) ; 0=Sun 61 dom-ok ((:days cron) mday) 62 dow-ok ((:weekdays cron) weekday) 63 day-ok (if (and (:days-restricted? cron) (:weekdays-restricted? cron)) 64 (or dom-ok dow-ok) 65 (and dom-ok dow-ok))] 66 (and ((:months cron) month) 67 day-ok 68 ((:hours cron) hour) 69 ((:minutes cron) minute)))) 70 71 (defn next-cron-fire 72 "Find the next match strictly after `last-wall` (a LocalDateTime, or nil 73 for the first call). Returns {:delay-ms n :wall ldt}. The `last-wall` 74 guard prevents firing twice during a DST fall-back, where one wall-clock 75 minute corresponds to two epoch instants." 76 [cron last-wall] 77 (let [zone (java.time.ZoneId/systemDefault) 78 now (System/currentTimeMillis) 79 start (-> now (quot 60000) inc (* 60000)) 80 limit (+ start (* 4 366 24 60 60 1000))] 81 (loop [t start] 82 (when (> t limit) 83 (throw (ex-info "No cron match found within 4 years" {:cron cron}))) 84 (let [ldt (java.time.LocalDateTime/ofInstant 85 (java.time.Instant/ofEpochMilli t) zone)] 86 (if (and (matches-cron? cron ldt) 87 (or (nil? last-wall) (.isAfter ldt last-wall))) 88 {:delay-ms (- t now) :wall ldt} 89 (recur (+ t 60000))))))) 90 91 (defn run-job! [name cron prog] 92 (future 93 (try 94 (loop [last-wall nil] 95 (let [{:keys [delay-ms wall]} (next-cron-fire cron last-wall)] 96 (println (format "[INFO] Scheduling next run for '%s' in %d seconds" 97 name (quot delay-ms 1000))) 98 (Thread/sleep delay-ms) 99 (println (format "[INFO] Running notifier for '%s'" name)) 100 (let [result (shell {:continue true} prog name)] 101 (when (not= 0 (:exit result)) 102 (println (format "[WARN] Command returned %d: %s %s" 103 (:exit result) prog name)))) 104 (recur wall))) 105 (catch Throwable t 106 (println (format "[ERROR] Job '%s' aborted: %s" 107 name (or (ex-message t) (str t)))))))) 108 109 (def cli-options 110 [["-p" "--prog PROG" "Program to send notifications to" 111 :default "notify-send"] 112 ["-h" "--help"]]) 113 114 (defn -main [& args] 115 (let [{:keys [options summary errors]} (parse-opts args cli-options)] 116 (when errors 117 (println (str/join "\n" errors)) 118 (System/exit 1)) 119 (when (:help options) 120 (println "Usage: habitual [options]") 121 (println summary) 122 (System/exit 0)) 123 124 (let [config-file (str (System/getProperty "user.home") 125 "/.config/habitual/habitual") 126 lines (-> config-file slurp str/split-lines) 127 prog (:prog options) 128 jobs (for [line lines 129 :let [line (str/trim line)] 130 :when (and (seq line) (not (str/starts-with? line "#"))) 131 :let [[schedule name] (str/split line #"\|" 2) 132 cron (parse-cron (str/trim schedule))]] 133 (run-job! (str/trim name) cron prog))] 134 (println (format "[INFO] Loaded %d job(s), running..." (count (doall jobs)))) 135 ;; Block forever — futures run the jobs 136 @(promise)))) 137 138 (apply -main *command-line-args*)