view release on metacpan or  search on metacpan

lib/Minion/Util.pm  view on Meta::CPAN

    }

    # Hour
    if (!$parsed->[1]{set}{$hour}) {
      my $next = _next_value($parsed->[1]{values}, $hour);
      $t
        = defined $next ? timegm(0, 0, $next, $mday, $mon - 1, $year) : timegm(0, 0, 0, $mday, $mon - 1, $year) + 86400;
      next;
    }

    # Minute
    if (!$parsed->[0]{set}{$min}) {
      my $next = _next_value($parsed->[0]{values}, $min);
      $t
        = defined $next
        ? timegm(0, $next, $hour, $mday, $mon - 1, $year)
        : timegm(0, 0,     $hour, $mday, $mon - 1, $year) + 3600;
      next;
    }

    return $t;
  }

  croak qq{No matching time found for cron expression};
}

sub parse_cron {
  my $expr = shift // '';

  if ($expr =~ /^@/) {
    croak qq{Unknown cron nickname "$expr"} unless exists $NICKNAMES{$expr};
    $expr = $NICKNAMES{$expr};
  }

  my @fields = split /\s+/, $expr;
  croak qq{Invalid cron expression "$expr": expected 5 fields} unless @fields == 5;

  return [map { _parse_field($fields[$_], @{$FIELDS[$_]}) } 0 .. 4];
}

sub _day_match {
  my ($parsed, $mday, $wday) = @_;
  return 1                        if $parsed->[2]{is_star} && $parsed->[4]{is_star};
  return $parsed->[4]{set}{$wday} if $parsed->[2]{is_star};
  return $parsed->[2]{set}{$mday} if $parsed->[4]{is_star};
  return $parsed->[2]{set}{$mday} || $parsed->[4]{set}{$wday};
}

sub _next_value {
  my ($values, $after) = @_;
  for my $v (@$values) { return $v if $v >= $after }
  return undef;
}

sub _parse_field {
  my ($field, $name, $min, $max, $names) = @_;

  my $is_star = $field eq '*' ? 1 : 0;
  my %set;
  for my $part (split /,/, $field) {
    my ($range, $step) = split m{/}, $part, 2;
    $step //= 1;
    croak qq{Invalid step "$step" in $name field} unless $step =~ /^[1-9]\d*$/;

    my ($a, $b);
    if    ($range eq '*')             { ($a, $b) = ($min, $max) }
    elsif ($range =~ /^(\w+)-(\w+)$/) { ($a, $b) = (_resolve($1, $name, $names), _resolve($2, $name, $names)) }
    elsif ($range =~ /^(\w+)$/)       { $a = $b = _resolve($1, $name, $names) }
    else                              { croak qq{Invalid $name field "$part"} }
    croak qq{Value out of range in $name field "$part" ($min-$max)} if $a < $min || $b > $max || $a > $b;

    for (my $v = $a; $v <= $b; $v += $step) { $set{$v} = 1 }
  }

  # Day-of-week 7 is an alias for Sunday (0)
  $set{0} = 1 if $name eq 'day-of-week' && delete $set{7};

  return {set => \%set, values => [sort { $a <=> $b } keys %set], is_star => $is_star};
}

sub _resolve {
  my ($value, $name, $names) = @_;
  return $value + 0 if $value =~ /^\d+$/;
  croak qq{Invalid name "$value" in $name field} unless $names && exists $names->{lc $value};
  return $names->{lc $value};
}

1;

=encoding utf8

=head1 NAME

Minion::Util - Minion utility functions

=head1 SYNOPSIS

  use Minion::Util qw(desired_tasks next_cron_time parse_cron);

=head1 DESCRIPTION

L<Minion::Util> provides utility functions for L<Minion>.

=head1 FUNCTIONS

L<Minion::Util> implements the following functions, which can be imported individually.

=head2 desired_tasks

  my $desired_tasks = desired_tasks $limits, $available_tasks, $active_tasks;

Enforce limits and generate list of currently desired tasks.

  # ['bar']
  desired_tasks {foo => 2}, ['foo', 'bar'], ['foo', 'foo'];

=head2 next_cron_time

  my $epoch = next_cron_time $expr,   $from;
  my $epoch = next_cron_time $parsed, $from;