extra/crontab/crontab.factor

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