package Time::Moment::Adjusters; use strict; use warnings; use Carp qw[]; BEGIN { our $VERSION = '0.43'; our @EXPORT_OK = qw[ NextDayOfWeek NextOrSameDayOfWeek PreviousDayOfWeek PreviousOrSameDayOfWeek FirstDayOfWeekInMonth LastDayOfWeekInMonth NthDayOfWeekInMonth WesternEasterSunday OthodoxEasterSunday NearestMinuteInterval ]; our %EXPORT_TAGS = ( all => [ @EXPORT_OK ], ); require Exporter; *import = \&Exporter::import; } sub NextDayOfWeek { @_ == 1 or Carp::croak(q); my ($day) = @_; ($day >= 1 && $day <= 7) or Carp::croak(q); return sub { my ($tm) = @_; return $tm->plus_days(($day - $tm->day_of_week + 6) % 7 + 1); }; } sub NextOrSameDayOfWeek { @_ == 1 or Carp::croak(q); my ($day) = @_; ($day >= 1 && $day <= 7) or Carp::croak(q); return sub { my ($tm) = @_; return $tm->plus_days(($day - $tm->day_of_week) % 7); }; } sub PreviousDayOfWeek { @_ == 1 or Carp::croak(q); my ($day) = @_; ($day >= 1 && $day <= 7) or Carp::croak(q); return sub { my ($tm) = @_; return $tm->minus_days(($tm->day_of_week - $day + 6) % 7 - 1); }; } sub PreviousOrSameDayOfWeek { @_ == 1 or Carp::croak(q); my ($day) = @_; ($day >= 1 && $day <= 7) or Carp::croak(q); return sub { my ($tm) = @_; return $tm->minus_days(($tm->day_of_week - $day) % 7); }; } sub FirstDayOfWeekInMonth { @_ == 1 or Carp::croak(q); my ($day) = @_; ($day >= 1 && $day <= 7) or Carp::croak(q); return sub { my ($tm) = @_; $tm = $tm->with_day_of_month(1); return $tm->plus_days(($day - $tm->day_of_week) % 7); }; } sub LastDayOfWeekInMonth { @_ == 1 or Carp::croak(q); my ($day) = @_; ($day >= 1 && $day <= 7) or Carp::croak(q); return sub { my ($tm) = @_; $tm = $tm->at_last_day_of_month; return $tm->minus_days(($tm->day_of_week - $day) % 7); }; } sub NthDayOfWeekInMonth { @_ == 2 or Carp::croak(q); my ($ordinal, $day) = @_; ($ordinal >= -4 && $ordinal <= 4 && $ordinal != 0) or Carp::croak(q); ($day >= 1 && $day <= 7) or Carp::croak(q); if ($ordinal > 0) { my $days = 7 * --$ordinal; return sub { my ($tm) = @_; $tm = $tm->with_day_of_month(1); return $tm->plus_days($days + ($day - $tm->day_of_week) % 7); }; } else { my $days = 7 * ++$ordinal; return sub { my ($tm) = @_; $tm = $tm->at_last_day_of_month; return $tm->plus_days($days - ($tm->day_of_week - $day) % 7); }; } } sub WesternEasterSunday { @_ == 0 or Carp::croak(q); return sub { my ($tm) = @_; return $tm->with_rdn(Time::Moment::Internal::western_easter_sunday($tm->year)); }; } sub OrthodoxEasterSunday { @_ == 0 or Carp::croak(q); return sub { my ($tm) = @_; return $tm->with_rdn(Time::Moment::Internal::orthodox_easter_sunday($tm->year)); }; } sub NearestMinuteInterval { @_ == 1 or Carp::croak(q); my ($interval) = @_; ($interval >= 1 && $interval <= 1440) or Carp::croak(q); my $msec = $interval * 60 * 1000; my $mid = int(($msec + 1) / 2); return sub { my ($tm) = @_; my $msod = $msec * int(($tm->millisecond_of_day + $mid) / $msec); return $tm->with_millisecond_of_day($msod); }; } 1;