view release on metacpan or  search on metacpan

lib/DateTime/Event/Cron.pm  view on Meta::CPAN

    }
    if (!$self->days_contain($date->day, $date->dow)) {
      my $day_orig = $date->day;
      $date->subtract(days => 1)
        until $self->days_contain($date->day, $date->dow);
      $self->_unit_peak($date, 'month') && next if ($date->day > $day_orig);
      $self->_unit_peak($date, 'day');
      print STDERR "DAY: ", $date->datetime, "\n" if DEBUG;
    }
    if (!$self->hour->contains($date->hour)) {
      my $hour_orig = $date->hour;
      $date->subtract(hours => 1) until $self->hour->contains($date->hour);
      $self->_unit_peak($date, 'day') && next if ($date->hour > $hour_orig);
      $self->_unit_peak($date, 'hour');
      print STDERR "HOR: ", $date->datetime, "\n" if DEBUG;
    }
    if (!$self->minute->contains($date->minute)) {
      my $min_orig = $date->minute;
      $date->subtract(minutes => 1)
        until $self->minute->contains($date->minute);
      $self->_unit_peak($date, 'hour') && next if ($date->minute > $min_orig);
      print STDERR "MIN: ", $date->datetime, "\n" if DEBUG;
    }
  }
  print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
  $date;
}

###

sub _unit_peak {
  my($self, $date, $unit) = @_;
  $date && $unit or croak "DateTime ref and unit required.\n";
  $date->truncate(to => $unit)
       ->add($unit . 's' => 1)
       ->subtract(minutes => 1);
}

sub _next_day {
  my($self, $year, $mon, $day) = @_;
  my $dt = DateTime->new(year => $year, month => $mon, day => $day);
  my $dur = DateTime::Duration->new(days => 1);
  $dt->add_duration($dur);
  while (! $self->days_contain($dt->day, $dt->day_of_week)) {
    $dt->add_duration($dur);
  }
  $dt->day;
}

sub _prev_day {
  my($self, $year, $mon, $day) = @_;
  my $dt = DateTime->new(year => $year, month => $mon, day => $day);
  my $dur = DateTime::Duration->new(days => 1);
  $dt->subtract_duration($dur);
  while (! $self->days_contain($dt->day, $dt->day_of_week)) {
    $dt->subtract_duration($dur);
  }
  $dt->day;
}

### Unit cascades

sub _incr {
  my($self, $date) = @_;
  my $last_min   = $date->minute;
  my $last_hour  = $date->hour;
  my $last_day   = $date->day;
  my $last_month = $date->month;
  my $year       = $date->year;
  my($next_min, $next_hour, $next_day, $next_month) =
    ($last_min, $last_hour, $last_day, $last_month);
  while (1) {
    $next_min = $self->minute->next($last_min);
    if ($next_min <= $last_min) {
      $next_hour = $self->hour->next($last_hour);
      if ($next_hour <= $last_hour) {
        eval { $next_day = $self->_next_day($year, $last_month, $last_day) };
        if ($next_day <= $last_day || $@) {
          $next_month = $self->month->next($last_month);
          if ($next_month <= $last_month) {
            $year += 1;
          }
          $last_month = $next_month;
        }
        $last_day = $next_day;
      }
      $last_hour = $next_hour;
    }
    $last_min = $next_min;
    eval {
      $date->set(
        minute => $next_min,
        hour   => $next_hour,
        day    => $next_day,
        month  => $next_month,
        year   => $year,
      );
    };
    last unless $@;
  }
  $date;
}

sub _decr {
  my($self, $date) = @_;
  my $last_min   = $date->minute;
  my $last_hour  = $date->hour;
  my $last_day   = $date->day;
  my $last_month = $date->month;
  my $year       = $date->year;
  my($prev_min, $prev_hour, $prev_day, $prev_month) =
    ($last_min, $last_hour, $last_day, $last_month);
  while (1) {
    $prev_min = $self->minute->previous($last_min);
    if ($prev_min >= $last_min) {
      $prev_hour = $self->hour->previous($last_hour);
      if ($prev_hour >= $last_hour) {
        eval { $prev_day = $self->_prev_day($year, $last_month, $last_day) };
        if ($prev_day >= $last_day || $@) {
          $prev_month = $self->month->previous($last_month);
          if ($prev_month >= $last_month) {