105 lines
		
	
	
		
			3.3 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			105 lines
		
	
	
		
			3.3 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2018 John Benediktsson
 | 
						|
! See http://factorcode.org/license.txt for BSD license
 | 
						|
 | 
						|
USING: accessors arrays ascii assocs calendar calendar.english
 | 
						|
calendar.private combinators io kernel literals locals math
 | 
						|
math.order math.parser math.ranges sequences splitting ;
 | 
						|
 | 
						|
IN: crontab
 | 
						|
 | 
						|
:: parse-value ( value quot: ( value -- value' ) seq -- value )
 | 
						|
    value {
 | 
						|
        { [ CHAR: , over member? ] [
 | 
						|
            "," split [ quot seq parse-value ] map concat ] }
 | 
						|
        { [ dup "*" = ] [ drop seq ] }
 | 
						|
        { [ CHAR: / over member? ] [
 | 
						|
            "/" split1 [ quot seq parse-value 0 over length 1 - ] dip
 | 
						|
            string>number <range> swap nths ] }
 | 
						|
        { [ CHAR: - over member? ] [
 | 
						|
            "-" split1 quot bi@ [a,b] ] }
 | 
						|
        [ quot call 1array ]
 | 
						|
    } cond ; inline recursive
 | 
						|
 | 
						|
: parse-day ( str -- n )
 | 
						|
    dup string>number [ ] [
 | 
						|
        >lower $[ day-abbreviations3 [ >lower ] map ] index
 | 
						|
    ] ?if ;
 | 
						|
 | 
						|
: parse-month ( str -- n )
 | 
						|
    dup string>number [ ] [
 | 
						|
        >lower $[ month-abbreviations [ >lower ] map ] index
 | 
						|
    ] ?if ;
 | 
						|
 | 
						|
TUPLE: cronentry minutes hours days months days-of-week command ;
 | 
						|
 | 
						|
CONSTANT: aliases H{
 | 
						|
    { "@yearly"   "0 0 1 1 *" }
 | 
						|
    { "@annually" "0 0 1 1 *" }
 | 
						|
    { "@monthly"  "0 0 1 * *" }
 | 
						|
    { "@weekly"   "0 0 * * 0" }
 | 
						|
    { "@daily"    "0 0 * * *" }
 | 
						|
    { "@midnight" "0 0 * * *" }
 | 
						|
    { "@hourly"   "0 * * * *" }
 | 
						|
}
 | 
						|
 | 
						|
: parse-cronentry ( entry -- cronentry )
 | 
						|
    " " split1 [ aliases ?at drop ] dip " " glue
 | 
						|
    " " split1 " " split1 " " split1 " " split1 " " split1 {
 | 
						|
        [ [ string>number ] T{ range f 0 60 1 } parse-value ]
 | 
						|
        [ [ string>number ] T{ range f 0 24 1 } parse-value ]
 | 
						|
        [ [ string>number ] T{ range f 0 31 1 } parse-value ]
 | 
						|
        [ [ parse-month ] T{ range f 0 12 1 } parse-value ]
 | 
						|
        [ [ parse-day ] T{ range f 0 7 1 } parse-value ]
 | 
						|
        [ ]
 | 
						|
    } spread cronentry boa ;
 | 
						|
 | 
						|
:: next-time-after ( cronentry timestamp -- )
 | 
						|
 | 
						|
    timestamp month>> :> month
 | 
						|
    cronentry months>> [ month >= ] find nip [
 | 
						|
        dup month = [ drop f ] [ timestamp month<< t ] if
 | 
						|
    ] [
 | 
						|
        timestamp cronentry months>> first >>month 1 +year
 | 
						|
    ] if* [ cronentry timestamp next-time-after ] when
 | 
						|
 | 
						|
    timestamp hour>> :> hour
 | 
						|
    cronentry hours>> [ hour >= ] find nip [
 | 
						|
        dup hour = [ drop f ] [
 | 
						|
            timestamp hour<< 0 timestamp minute<< t
 | 
						|
        ] if
 | 
						|
    ] [
 | 
						|
        timestamp cronentry hours>> first >>hour 1 +day
 | 
						|
    ] if* [ cronentry timestamp next-time-after ] when
 | 
						|
 | 
						|
    timestamp minute>> :> minute
 | 
						|
    cronentry minutes>> [ minute >= ] find nip [
 | 
						|
        dup minute = [ drop f ] [ timestamp minute<< t ] if
 | 
						|
    ] [
 | 
						|
        timestamp cronentry minutes>> first >>minute 1 +hour
 | 
						|
    ] if* [ cronentry timestamp next-time-after ] when
 | 
						|
 | 
						|
    timestamp day-of-week :> weekday
 | 
						|
    cronentry days-of-week>> [ weekday >= ] find nip [
 | 
						|
        cronentry days-of-week>> first 7 +
 | 
						|
    ] unless* weekday -
 | 
						|
 | 
						|
    timestamp day>> :> day
 | 
						|
    cronentry days>> [ day >= ] find nip [
 | 
						|
        day -
 | 
						|
    ] [
 | 
						|
        timestamp 1 months time+
 | 
						|
        cronentry days>> first >>day
 | 
						|
        day-of-year timestamp day-of-year -
 | 
						|
    ] if*
 | 
						|
 | 
						|
    min [
 | 
						|
        timestamp swap +day drop
 | 
						|
        cronentry timestamp next-time-after
 | 
						|
    ] unless-zero ;
 | 
						|
 | 
						|
: next-time ( cronentry -- timestamp )
 | 
						|
    now 0 >>second [ next-time-after ] keep ;
 | 
						|
 | 
						|
: parse-crontab ( -- entries )
 | 
						|
    lines [ [ f ] [ parse-cronentry ] if-empty ] map harvest ;
 |