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 io kernel literals locals math
   6 math.order math.parser math.ranges sequences splitting ;
   7
   8 IN: crontab
   9
  10 :: parse-value ( value quot: ( value -- value' ) seq -- value )
  11     value {
  12         { [ CHAR: , over member? ] [
  13             "," split [ quot seq parse-value ] map concat ] }
  14         { [ dup "*" = ] [ drop seq ] }
  15         { [ CHAR: / over member? ] [
  16             "/" split1 [ quot seq parse-value 0 over length 1 - ] dip
  17             string>number <range> swap nths ] }
  18         { [ CHAR: - over member? ] [
  19             "-" split1 quot bi@ [a,b] ] }
  20         [ quot call 1array ]
  21     } cond ; inline recursive
  22
  23 : parse-day ( str -- n )
  24     dup string>number [ ] [
  25         >lower $[ day-abbreviations3 [ >lower ] map ] index
  26     ] ?if ;
  27
  28 : parse-month ( str -- n )
  29     dup string>number [ ] [
  30         >lower $[ month-abbreviations [ >lower ] map ] index
  31     ] ?if ;
  32
  33 TUPLE: cronentry minutes hours days months days-of-week command ;
  34
  35 CONSTANT: aliases H{
  36     { "@yearly"   "0 0 1 1 *" }
  37     { "@annually" "0 0 1 1 *" }
  38     { "@monthly"  "0 0 1 * *" }
  39     { "@weekly"   "0 0 * * 0" }
  40     { "@daily"    "0 0 * * *" }
  41     { "@midnight" "0 0 * * *" }
  42     { "@hourly"   "0 * * * *" }
  43 }
  44
  45 : parse-cronentry ( entry -- cronentry )
  46     " " split1 [ aliases ?at drop ] dip " " glue
  47     " " split1 " " split1 " " split1 " " split1 " " split1 {
  48         [ [ string>number ] T{ range f 0 60 1 } parse-value ]
  49         [ [ string>number ] T{ range f 0 24 1 } parse-value ]
  50         [ [ string>number ] T{ range f 1 31 1 } parse-value ]
  51         [ [ parse-month ] T{ range f 1 12 1 } parse-value ]
  52         [ [ parse-day ] T{ range f 0 7 1 } parse-value ]
  53         [ ]
  54     } spread cronentry boa ;
  55
  56 <PRIVATE
  57
  58 :: (next-time-after) ( cronentry timestamp -- )
  59     timestamp month>> :> month
  60     cronentry months>> [ month >= ] find nip [
  61         dup month = [ drop f ] [
  62             timestamp 1 >>day 0 >>hour 0 >>minute month<< t
  63         ] if
  64     ] [
  65         timestamp 1 >>day 0 >>hour 0 >>minute
  66         cronentry months>> first >>month 1 +year
  67     ] if* [ cronentry timestamp (next-time-after) ] when
  68
  69     timestamp day>> :> day
  70     cronentry days>> [ day >= ] find nip [
  71         dup day = [ drop f ] [
  72             timestamp 0 >>hour 0 >>minute day<< t
  73         ] if
  74     ] [
  75         timestamp 0 >>hour 0 >>minute
  76         cronentry days>> first >>day 1 +month
  77     ] if* [ cronentry timestamp (next-time-after) ] when
  78
  79     timestamp hour>> :> hour
  80     cronentry hours>> [ hour >= ] find nip [
  81         dup hour = [ drop f ] [
  82             timestamp 0 >>minute hour<< t
  83         ] if
  84     ] [
  85         timestamp 0 >>minute
  86         cronentry hours>> first >>hour 1 +day
  87     ] if* [ cronentry timestamp (next-time-after) ] when
  88
  89     timestamp minute>> :> minute
  90     cronentry minutes>> [ minute >= ] find nip [
  91         dup minute = [ drop f ] [ timestamp minute<< t ] if
  92     ] [
  93         timestamp cronentry minutes>> first >>minute 1 +hour
  94     ] if* [ cronentry timestamp (next-time-after) ] when
  95
  96     timestamp day-of-week :> weekday
  97     cronentry days-of-week>> [ weekday >= ] find nip [
  98         cronentry days-of-week>> first 7 +
  99     ] unless* weekday - [
 100         timestamp swap +day drop
 101         cronentry timestamp (next-time-after)
 102     ] unless-zero ;
 103
 104 PRIVATE>
 105
 106 : next-time-after ( cronentry timestamp -- timestamp )
 107     1 minutes time+ 0 >>second [ (next-time-after) ] keep ;
 108
 109 : next-time ( cronentry -- timestamp )
 110     now next-time-after ;
 111
 112 : next-times-after ( cronentry n timestamp -- timestamps )
 113     swap [ dupd next-time-after dup ] replicate 2nip ;
 114
 115 : next-times ( cronentry n -- timestamps )
 116     now next-times-after ;
 117
 118 : read-crontab ( -- entries )
 119     lines harvest [ parse-cronentry ] map ;