cron.pas

boomerang library 5.11 internet ed

(* Cron - simple UNIX cron evaluator
 * Copyright (C) 2004 by Tomas Mandys-MandySoft
 *)

unit Cron;

{ Cron.htx }

interface
uses
  SysUtils;

type
  TCronCheck = (cchMinutes, cchHours, cchDays, cchMonths, cchWeekdays, cchYears, cchYearDays, cchSeconds);

type
  TSetOfByte = set of Byte;

type
  TCron = class
  private
    fSets: array[Low(TCronCheck)..High(TCronCheck)] of TSetOfByte;
    fYearDays2Set: TSetOfByte;
    fExtendedSyntax: Boolean;
    function GetField(aPattern: string; I: Integer): string;
    procedure ParseStr(var aPattern: string);
    function GetChecks(Idx: TCronCheck): TSetOfByte;
    procedure SetChecks(Idx: TCronCheck; const Value: TSetOfByte);
    procedure SetPattern(aPattern: string);
    function GetPattern: string;
  protected
    procedure SetPatternItem(aCheck: TCronCheck; aPattern: string); virtual;
    function GetPatternItem(aCheck: TCronCheck): string; virtual;
  public
    function IsEmpty: Boolean;
    function IsMatch(aCheck: TCronCheck; aVal: Word): Boolean; overload;
    function IsMatch(aDT: TDateTime): Boolean; overload;
    procedure SetCheck(aCheck: TCronCheck; aVal: Word; aEnable: Boolean = True); overload;
    procedure SetCheck(aCheck: TCronCheck; aValFrom, aValTo: Word; aEnable: Boolean = True); overload;

    property Pattern: string read GetPattern write SetPattern;
    property Checks[Idx: TCronCheck]: TSetOfByte read GetChecks write SetChecks;

    property ExtendedSyntax: Boolean read fExtendedSyntax write fExtendedSyntax;
  end;


implementation


const
  RangeMin:  array[Low(TCronCheck)..High(TCronCheck)] of Word =  ( 0,  0,  1,  1, 0, 1900    ,   1,  0);
  RangeMax:  array[Low(TCronCheck)..High(TCronCheck)] of Word =  (59, 23, 31, 12, 6{7 is changed to 0 when seeting}, 1900+255, 366, 59);
  RangeName: array[Low(TCronCheck)..High(TCronCheck)] of string = ('Minutes', 'Hours', 'Days', 'Months', 'Weekdays', 'Years', 'Yeardays', 'Seconds');

type
  TCronToken = record
    Name, Value: string;
  end;
const
  CronTokens: array[1..26] of TCronToken = (
    (Name:'@yearly';     Value: '0 0 1 1 *'),
    (Name:'@annually';   Value: '0 0 1 1 *'),
    (Name:'@monthly';    Value: '0 0 1 * *'),
    (Name:'@weekly';     Value: '0 0 * * 0'),
    (Name:'@daily';      Value: '0 0 * * *'),
    (Name:'@midnight';   Value: '0 0 * * *'),
    (Name:'@hourly';     Value: '0 * * * *'),

    (Name:'sun';         Value: '0'),
    (Name:'mon';         Value: '1'),
    (Name:'tue';         Value: '2'),
    (Name:'wed';         Value: '3'),
    (Name:'thu';         Value: '4'),
    (Name:'fri';         Value: '5'),
    (Name:'sat';         Value: '6'),

    (Name:'jan';         Value: '1'),
    (Name:'feb';         Value: '2'),
    (Name:'mar';         Value: '3'),
    (Name:'apr';         Value: '4'),
    (Name:'may';         Value: '5'),
    (Name:'jun';         Value: '6'),
    (Name:'jul';         Value: '7'),
    (Name:'aug';         Value: '8'),
    (Name:'sep';         Value: '9'),
    (Name:'oct';         Value: '10'),
    (Name:'nov';         Value: '11'),
    (Name:'dec';         Value: '12')
  );

const
  OrFields = [cchDays, cchWeekdays, cchYearDays];

{ TCron }

function TCron.GetField(aPattern: string; I: Integer): string;
begin
  repeat
    aPattern:= Trim(aPattern);
    if I = 0 then
      Break;
    Delete(aPattern, 1, Pos(' ', aPattern+' '));
    Dec(I);
  until aPattern = '';
  Result:= Copy(aPattern, 1, Pos(' ', aPattern+' ')-1);
end;

procedure TCron.ParseStr(var aPattern: string);
var
  I, J, K: Integer;
begin
  aPattern:= LowerCase(aPattern);
  for I:= Low(CronTokens) to High(CronTokens) do
  begin
    J:= 0;
    repeat
      K:= Pos(CronTokens[I].Name, Copy(aPattern, J+1, Length(aPattern)));
      if K = 0 then
        Break;
      Inc(J, K);
      if ((J > 1) and not (aPattern[J-1] in ['a'..'z', '0'..'9', '_']) or (J = 1)) and
         ((J+Length(CronTokens[I].Name) > Length(aPattern)) or not (aPattern[J+Length(CronTokens[I].Name)] in ['a'..'z', '0'..'9', '_'])) then
      begin
        Delete(aPattern, J, Length(CronTokens[I].Name));
        Insert(CronTokens[I].Value, aPattern, J);
      end;
    until K = 0;
  end;
end;

function TCron.IsMatch(aDT: TDateTime): Boolean;
var
  X: array[Low(TCronCheck)..High(TCronCheck)] of Word;
  S100: Word;
  I, N: TCronCheck;
  Restr: Boolean;
begin
  DecodeDate(aDT, X[cchYears], X[cchMonths], X[cchDays]);
  DecodeTime(aDT, X[cchHours], X[cchMinutes], X[cchSeconds], S100);
  X[cchWeekdays]:= DayOfWeek(aDT)-1;  // [1..7]->[0..6], sunday is 0 or 7
  X[cchYearDays]:= Trunc(aDT-EncodeDate(X[cchYears], 1, 1)+1);
  if fExtendedSyntax then
    N:= High(TCronCheck)
  else
    N:= cchWeekdays;

  Result:= False;
  Restr:= False;
  for I:= Low(X) to N do
  begin
    if I in OrFields then
      if fSets[I] <> [] then
      begin
        Restr:= True;
        if IsMatch(I, X[I]) then
        begin
          Result:= True;
          Break;
        end;
      end;
  end;
  if not Restr then
    Result:= True;
  if Result then
  begin
    for I:= Low(X) to N do
    begin
      if not (I in OrFields) then
        if not IsMatch(I, X[I]) then
        begin
          Result:= False;
          Break;
        end;
    end;
  end;
end;

function TCron.IsMatch(aCheck: TCronCheck; aVal: Word): Boolean;
begin
  if (aCheck = cchWeekdays) and (aVal = 7) then
    aVal:= 0;
  Result:= (aVal >= RangeMin[aCheck]) and (aVal <= RangeMax[aCheck]);
  if Result then
  begin
    if aCheck = cchYears then
      Dec(aVal, RangeMin[cchYears]);

    if (aCheck = cchYearDays) and (aVal > 255) then
      Result:= aVal-255 in fYearDays2Set
    else
      Result:= aVal in fSets[aCheck];
  end;
end;

procedure TCron.SetCheck(aCheck: TCronCheck; aVal: Word; aEnable: Boolean);
begin
  if (aCheck = cchWeekdays) and (aVal = 7) then
    aVal:= 0;
  if (aVal >= RangeMin[aCheck]) and (aVal <= RangeMax[aCheck]) then
  begin
    if aCheck = cchYears then
      Dec(aVal, RangeMin[cchYears]);
    if (aCheck = cchYearDays) and (aVal > 255) then
      if aEnable then
        Include(fYearDays2Set, aVal-255)
      else
        Exclude(fYearDays2Set, aVal-255)
    else
      if aEnable then
        Include(fSets[aCheck], aVal)
      else
        Exclude(fSets[aCheck], aVal);
  end;
  if aCheck = cchWeekdays then
  begin
    if IsMatch(cchWeekdays, 0) then
      Include(fSets[cchWeekdays], 7)
    else
      Exclude(fSets[cchWeekdays], 7);
  end;
end;

procedure TCron.SetCheck(aCheck: TCronCheck; aValFrom, aValTo: Word; aEnable: Boolean);
var
  I: Word;
begin
  for I:= aValFrom to aValTo do
    SetCheck(aCheck, I, aEnable);
end;

function TCron.GetChecks(Idx: TCronCheck): TSetOfByte;
var
  I: Integer;
begin
  Result:= [];
  for I:= RangeMin[Idx] to RangeMax[Idx] do
  begin
    if Idx = cchYears then
      Result:= Result+[I-RangeMin[Idx]]
    else
      Result:= Result+[I];
  end;
  if Idx = cchWeekdays then
    Include(Result, 7);
  Result:= fSets[Idx] * Result;
end;

procedure TCron.SetChecks(Idx: TCronCheck; const Value: TSetOfByte);
begin
  fSets[Idx]:= Value;
  SetCheck(cchWeekdays, 0, IsMatch(cchWeekdays, 0));  // adjust 7 = 0
end;

function TCron.GetPattern: string;
var
  I, N: TCronCheck;
begin
  Result:= '';
  if IsEmpty then   // '_ _ _ _ _' -> ''
    Exit;
  if fExtendedSyntax then
    N:= High(TCronCheck)
  else
    N:= cchWeekdays;
  for I:= Low(TCronCheck) to N do
  begin
    if Result <> '' then
      Result:= Result+' ';
    Result:= Result+GetPatternItem(I);
  end;
end;

procedure TCron.SetPattern(aPattern: string);
var
  I, N: TCronCheck;
begin
  ParseStr(aPattern);
  if aPattern = '' then
    begin
      for I:= Low(fSets) to High(fSets) do
        fSets[I]:= [];
      fYearDays2Set:= [];
    end
  else
    begin
      if fExtendedSyntax then
        N:= High(TCronCheck)
      else
        N:= cchWeekdays;
      for I:= Low(TCronCheck) to N do
      begin
        SetPatternItem(I, GetField(aPattern, Byte(I)));
      end;
    end;
end;

function TCron.GetPatternItem(aCheck: TCronCheck): string;
var
  M, N, K: Word;
  I, J, L: Integer;
  F: Boolean;

  function NextCh(I: Word): Integer;
  begin
    Result:= -1;
    while I <= N do
    begin
      if IsMatch(aCheck, I) then
      begin
        Result:= I;
        Break;
      end;
      Inc(I);
    end;
  end;
begin
  M:= RangeMin[aCheck];
  N:= RangeMax[aCheck];
  J:= M-1;
  Result:= '';
  repeat
    I:= NextCh(J+1);
    if I = -1 then
      Break;
    J:= NextCh(I+1);
    K:= 1;
    if J = -1 then    // last check
      J:= I
    else
      begin
        K:= J-I;      // try to find series (1,4,7,10,13 etc.)
        L:= J+1;
        while L <= N do
        begin
          F:= IsMatch(aCheck, L);
          if F xor ((L-I) mod K = 0) then
            Break;
          if F then
            J:= L;
          Inc(L);
        end;
        if (J-I) div K < 2 then  // serie too short
        begin
          J:= I;
          K:= 1;
        end;
      end;

    if (I = M) and (J = N) then
      Result:= '*'
    else if I = J then
      Result:= Result+IntToStr(I)
    else if J > I then
      begin
        Result:= Result+IntToStr(I);
        if J = I+1 then
          Result:= Result+','
        else
          Result:= Result+'-';
        Result:= Result+IntToStr(J);
      end;

    if K > 1 then
      Result:= Result + '/' +IntToStr(K);
    Result:= Result+',';

  until (I >= N);
  while (Result <> '') and (Result[Length(Result)] = ',') do
    Delete(Result, Length(Result), 1);
  if Result = '' then
    if aCheck in OrFields then
      Result:= '*'
    else
      Result:= '_';
end;

procedure TCron.SetPatternItem(aCheck: TCronCheck; aPattern: string);
var
  M, N: Word;
  I, J, K: Integer;

  function GetNum: Integer;
  var
    I: Integer;
  begin
    I:= 1;
    while (I <= Length(aPattern)) and (aPattern[I] in ['0'..'9']) do
    begin
      Inc(I);
    end;
    Result:= StrToIntDef(Copy(aPattern, 1, I-1), -1);
    Delete(aPattern, 1, I-1);
  end;
begin
  M:= RangeMin[aCheck];
  N:= RangeMax[aCheck];
  if (aPattern = '*') or (aPattern = '') then
    begin
      SetCheck(aCheck, M, N, not (aCheck in OrFields));  // remove all checks if "or field"
    end
  else
    begin
      SetCheck(aCheck, M, N, False);
      repeat
        while (aPattern <> '') and (aPattern[1] = ',') do
          Delete(aPattern, 1, 1);

        I:= GetNum;
        J:= -1;
        if (aPattern <> '') and (aPattern[1] = '*') then
        begin
          I:= M; J:= N;
          while (aPattern <> '') and (aPattern[1] = '*') do
            Delete(aPattern, 1, 1);
        end;
        if (aPattern <> '') and (aPattern[1] = '-') then
        begin
          if I = -1 then
            I:= M;
          while (aPattern <> '') and (aPattern[1] = '-') do
            Delete(aPattern, 1, 1);
          J:= GetNum;
          if (aPattern <> '') and (aPattern[1] = '-') then
            Delete(aPattern, 1, 1);
          if J = -1 then
            J:= N;
        end;
        if J = -1 then
          J:= I;
        K:= -1;
        if (aPattern <> '') and (aPattern[1] = '/') then
        begin
          if (aPattern <> '') and (aPattern[1] = '/') then
            Delete(aPattern, 1, 1);
          K:= GetNum;
        end;
        if (I >= 0) and (J >= 0) then
        begin
          if K = -1 then
            K:= 1;
          while I <= J do
          begin
            SetCheck(aCheck, I, True);
            Inc(I, K);
          end;
        end;
      until (aPattern = '') or not (aPattern[1] in ['0'..'9', ',' ,'-', '/', '*']);
    end;
end;

function TCron.IsEmpty: Boolean;
var
  I: TCronCheck;
begin
  Result:= False;
  I:= Low(fSets);
  while not Result and (I <= High(fSets)) do
  begin
    Result:= not (I in OrFields) and ((fSets[I] = []) and ((I <> cchYearDays) or (fYearDays2Set = [])));
    Inc(I);
  end;
end;

end.