File Coverage

blib/lib/Time/Moment/Adjusters.pm

Criterion	Covered	Total	%
statement	86	90	95.5
branch	22	44	50.0
condition	11	33	33.3
subroutine	25	27	92.5
pod	11	11	100.0
total	155	205	75.6

package Time::Moment::Adjusters;
use strict;
use warnings;

use Carp qw[];

BEGIN {
    our $VERSION    = '0.46';
    our @EXPORT_OK  = qw[ NextDayOfWeek
                          NextOrSameDayOfWeek
                          PreviousDayOfWeek
                          PreviousOrSameDayOfWeek
                          NearestDayOfWeek
                          FirstDayOfWeekInMonth
                          LastDayOfWeekInMonth
                          NthDayOfWeekInMonth
                          WesternEasterSunday
                          OrthodoxEasterSunday
                          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 NearestDayOfWeek {
    @_ == 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 + 3) % 7) - 3);
    };
}

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;