1 ! Copyright (C) 2018 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays ascii assocs calendar calendar.english
5 calendar.private combinators combinators.short-circuit io kernel
6 literals math math.order math.parser ranges sequences splitting ;
10 ERROR: invalid-cronentry value ;
12 :: parse-value ( value quot: ( value -- value' ) seq -- value )
14 { [ CHAR: , over member? ] [
15 "," split [ quot seq parse-value ] map concat ] }
16 { [ dup "*" = ] [ drop seq ] }
17 { [ CHAR: / over member? ] [
18 "/" split1 [ quot seq parse-value 0 over length 1 - ] dip
19 string>number <range> swap nths ] }
20 { [ CHAR: - over member? ] [
21 "-" split1 quot bi@ [a..b] ] }
23 } cond ; inline recursive
25 : parse-day ( str -- n )
26 dup string>number [ ] [
27 >lower $[ day-abbreviations3 [ >lower ] map ] index
30 : parse-month ( str -- n )
31 dup string>number [ ] [
32 >lower $[ month-abbreviations [ >lower ] map ] index
35 TUPLE: cronentry minutes hours days months days-of-week command ;
38 { "@yearly" "0 0 1 1 *" }
39 { "@annually" "0 0 1 1 *" }
40 { "@monthly" "0 0 1 * *" }
41 { "@weekly" "0 0 * * 0" }
42 { "@daily" "0 0 * * *" }
43 { "@midnight" "0 0 * * *" }
44 { "@hourly" "0 * * * *" }
47 : check-cronentry ( cronentry -- cronentry )
49 [ days-of-week>> [ 0 6 between? ] all? ]
50 [ months>> [ 1 12 between? ] all? ]
52 [ days>> 1 ] [ months>> ] bi [
53 { 0 31 29 31 30 31 30 31 31 30 31 30 31 } nth
54 ] map supremum [ between? ] 2curry all?
56 [ minutes>> [ 0 59 between? ] all? ]
57 [ hours>> [ 0 23 between? ] all? ]
58 } 1&& [ invalid-cronentry ] unless ;
60 : parse-cronentry ( entry -- cronentry )
61 " " split1 [ aliases ?at drop ] dip " " glue
62 " " split1 " " split1 " " split1 " " split1 " " split1 {
63 [ [ string>number ] T{ range f 0 60 1 } parse-value ]
64 [ [ string>number ] T{ range f 0 24 1 } parse-value ]
65 [ [ string>number ] T{ range f 1 31 1 } parse-value ]
66 [ [ parse-month ] T{ range f 1 12 1 } parse-value ]
67 [ [ parse-day ] T{ range f 0 7 1 } parse-value ]
69 } spread cronentry boa check-cronentry ;
73 :: (next-time-after) ( cronentry timestamp -- )
75 f ! should we keep searching for a matching time
77 timestamp month>> :> month
78 cronentry months>> [ month >= ] find nip
79 dup month = [ drop ] [
80 [ cronentry months>> first timestamp 1 +year drop ] unless*
81 timestamp 1 >>day 0 >>hour 0 >>minute month<< drop t
84 timestamp day-of-week :> weekday
85 cronentry days-of-week>> [ weekday >= ] find nip [
86 cronentry days-of-week>> first 7 +
87 ] unless* weekday - :> days-to-weekday
89 timestamp day>> :> day
90 cronentry days>> [ day >= ] find nip [
91 cronentry days>> first timestamp days-in-month +
92 ] unless* day - :> days-to-day
94 cronentry days-of-week>> T{ range f 0 7 1 } =
95 cronentry days>> T{ range f 1 31 1 } = 2array
97 { { f t } [ days-to-weekday ] }
98 { { t f } [ days-to-day ] }
99 [ drop days-to-weekday days-to-day min ]
101 timestamp 0 >>hour 0 >>minute swap +day 2drop t
104 timestamp hour>> :> hour
105 cronentry hours>> [ hour >= ] find nip
106 dup hour = [ drop ] [
107 [ cronentry hours>> first timestamp 1 +day drop ] unless*
108 timestamp 0 >>minute hour<< drop t
111 timestamp minute>> :> minute
112 cronentry minutes>> [ minute >= ] find nip
113 dup minute = [ drop ] [
114 [ cronentry minutes>> first timestamp 1 +hour drop ] unless*
115 timestamp minute<< drop t
118 [ cronentry timestamp (next-time-after) ] when ;
122 : next-time-after ( cronentry timestamp -- timestamp )
123 1 minutes time+ 0 >>second [ (next-time-after) ] keep ;
125 : next-time ( cronentry -- timestamp )
126 now next-time-after ;
128 : next-times-after ( cronentry n timestamp -- timestamps )
129 swap [ dupd next-time-after dup ] replicate 2nip ;
131 : next-times ( cronentry n -- timestamps )
132 now next-times-after ;
134 : read-crontab ( -- entries )
135 read-lines harvest [ parse-cronentry ] map ;