extra/raptor/cron/cron.factor

   1
   2 USING: kernel namespaces threads sequences calendar
   3        combinators.lib debugger ;
   4
   5 IN: raptor.cron
   6
   7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   8
   9 TUPLE: when minute hour day-of-month month day-of-week ;
  10
  11 C: <when> when
  12
  13 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  14
  15 : slot-match? ( now-slot when-slot -- ? ) dup f = [ 2drop t ] [ member? ] if ;
  16
  17 : minute-match? ( now when -- ? )
  18   [ timestamp-minute ] [ when-minute ] bi* slot-match? ;
  19
  20 : hour-match? ( now when -- ? )
  21   [ timestamp-hour ] [ when-hour ] bi* slot-match? ;
  22
  23 : day-of-month-match? ( now when -- ? )
  24   [ timestamp-day ] [ when-day-of-month ] bi* slot-match? ;
  25
  26 : month-match? ( now when -- ? )
  27   [ timestamp-month ] [ when-month ] bi* slot-match? ;
  28
  29 : day-of-week-match? ( now when -- ? )
  30   [ day-of-week ] [ when-day-of-week ] bi* slot-match? ;
  31
  32 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  33
  34 : when=now? ( when -- ? )
  35   now swap
  36   { [ minute-match? ]
  37     [ hour-match? ]
  38     [ day-of-month-match? ]
  39     [ month-match? ]
  40     [ day-of-week-match? ] }
  41   <--&& ;
  42
  43 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  44
  45 : recurring-job ( when quot -- )
  46   [ swap when=now? [ try ] [ drop ] if 60000 sleep ] [ recurring-job ] 2bi ;
  47
  48 : schedule ( when quot -- ) [ recurring-job ] 2curry in-thread ;
  49
  50 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  51
  52 SYMBOL: cron-jobs-hourly
  53 SYMBOL: cron-jobs-daily
  54 SYMBOL: cron-jobs-weekly
  55 SYMBOL: cron-jobs-monthly
  56
  57 : schedule-cron-jobs ( -- )
  58   { 17 } f f f f         <when> [ cron-jobs-hourly  get call ] schedule
  59   { 25 } { 6 } f f f     <when> [ cron-jobs-daily   get call ] schedule
  60   { 47 } { 6 } f f { 7 } <when> [ cron-jobs-weekly  get call ] schedule
  61   { 52 } { 6 } { 1 } f f <when> [ cron-jobs-monthly get call ] schedule ;
  62