File Coverage

blib/lib/Pinwheel/Model/DateBase.pm

Criterion	Covered	Total	%
statement	97	97	100.0
branch	56	56	100.0
condition	15	17	88.2
subroutine	36	36	100.0
pod	0	30	0.0
total	204	236	86.4

package Pinwheel::Model::DateBase;

use strict;
use warnings;

use POSIX qw();


# Date/time values

sub year { $_[0]->{t}[5] + 1900 }
sub month { $_[0]->{t}[4] + 1 }
sub day { $_[0]->{t}[3] }
sub mm { sprintf('%02d', $_[0]->{t}[4] + 1) }
sub dd { sprintf('%02d', $_[0]->{t}[3]) }
sub wday { $_[0]->{t}[6] }
sub yday { $_[0]->{t}[7] }

sub bbc_year
{
    $_[0]->_calculate_bbc_week if (!$_[0]->{bbc_week});
    return $_[0]->{bbc_year};
}

sub bbc_week
{
    $_[0]->_calculate_bbc_week if (!$_[0]->{bbc_week});
    return $_[0]->{bbc_week};
}

sub _calculate_bbc_week
{
    my $adjust = 3 - (($_[0]->{t}[6] + 1) % 7);
    my @t = gmtime($_[0]->{s} + ($adjust * 86400));
    $_[0]->{bbc_year} = $t[5] + 1900;
    $_[0]->{bbc_week} = int($t[7] / 7) + 1;
}

sub iso_year
{
    $_[0]->_calculate_iso_week if (!$_[0]->{iso_week});
    return $_[0]->{iso_year};
}

sub iso_week
{
    $_[0]->_calculate_iso_week if (!$_[0]->{iso_week});
    return $_[0]->{iso_week};
}

sub iso_weekday
{
    return $_[0]->{t}[6] || 7;
}

sub _calculate_iso_week
{
    my $adjust = 3 - (($_[0]->{t}[6] - 1) % 7);
    my @t = gmtime($_[0]->{s} + ($adjust * 86400));
    $_[0]->{iso_year} = $t[5] + 1900;
    $_[0]->{iso_week} = int($t[7] / 7) + 1;
}

sub days_in_month
{
    my ($y, $m);

    $y = $_[0]->{t}[5] + 1900;
    $m = $_[0]->{t}[4];
    return (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)[$m] if ($m != 1);
    return (!($y % 4) && (($y % 100) || !($y % 400))) ? 29 : 28;
}


# Formatting

sub month_name
{
    return qw(
        January February March April May June July
        August September October November December
    )[$_[0]->{t}[4]];
}

sub short_month_name
{
    return qw(
        Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
    )[$_[0]->{t}[4]];
}

sub day_name
{
    return qw(
        Sunday Monday Tuesday Wednesday Thursday Friday Saturday
    )[$_[0]->{t}[6]];
}

sub short_day_name
{
    return qw(Sun Mon Tue Wed Thu Fri Sat)[$_[0]->{t}[6]];
}

sub day_suffix
{
    my $day = $_[0]->{t}[3];
    return 'th' if ($day >= 10 && $day < 20);
    return qw(th st nd rd th th th th th th)[$day % 10];
}

sub day_ordinal
{
    return $_[0]->day . $_[0]->day_suffix;
}

sub strftime
{
    return POSIX::strftime($_[1], @{$_[0]->{t}});
}


# Date/time adjustment

sub replace
{
    my ($self, %values) = @_;
    my ($ss, $mm, $hh, $d, $m, $y) = @{$self->{t}};

    $ss = $values{sec} if exists($values{sec});
    $ss = 0 if $ss < 0; $ss = 59 if $ss > 59;
    $mm = $values{min} if exists($values{min});
    $mm = 0 if $mm < 0; $mm = 59 if $mm > 59;
    $hh = $values{hour} if exists($values{hour});
    $hh = 0 if $hh < 0; $hh = 23 if $hh > 23;

    $d = $values{day} if exists($values{day});
    $m = $values{month} - 1 if exists($values{month});
    $m = 0 if $m < 0; $m = 11 if $m > 11;
    $y = exists($values{year}) ? $values{year} : $y + 1900;
    $d = _correct_day($y, $m, $d);

    return $self->_derived($y, $m, $d, $hh, $mm, $ss);
}

sub offset
{
    my ($self, %deltas) = @_;
    my ($i, $ss, $mm, $hh, $d, $m, $y) = (undef, @{$self->{t}});

    if (exists($deltas{days})) {
        $i = $self->{s} + ((12 - $hh) * 3600) + ($deltas{days} * 86400);
        ($d, $m, $y) = (gmtime $i)[3 .. 5];
    }
    if (exists($deltas{months})) {
        $i = $m + $deltas{months};
        $m = $i % 12;
        $y += ($i - $m) / 12;
    }
    $y += 1900;
    $y += $deltas{years} if exists($deltas{years});
    $d = _correct_day($y, $m, $d);
    return $self->_derived($y, $m, $d, $hh, $mm, $ss);
}

sub next_day
{
    return $_[0]->offset(days => 1);
}

sub previous_day
{
    return $_[0]->offset(days => -1);
}

sub next_week
{
    return $_[0]->offset(days => 7);
}

sub previous_week
{
    return $_[0]->offset(days => -7);
}

sub next_month
{
    return $_[0]->offset(months => 1);
}

sub previous_month
{
    return $_[0]->offset(months => -1);
}

sub last_of_month
{
    return $_[0]->replace(day => 31);
}

sub first_of_month
{
    return $_[0]->replace(day => 1);
}

sub _correct_day
{
    my ($y, $m, $d) = @_;
    my $i;

    return 1 if $d < 1;

    $i = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)[$m];
    if ($d > $i) {
        # XXX No year divisible by 100 and not 400 with a 32-bit time_t
        $i++ if ($m == 1 && !($y % 4) && (($y % 100) || !($y % 400)));
        $d = $i if $d > $i;
    }
    return $d;
}


1;

__DATA__