File Coverage

blib/lib/Date/WeekOfYear.pm

Criterion	Covered	Total	%
statement	77	77	100.0
branch	31	34	91.1
condition	21	24	87.5
subroutine	14	14	100.0
pod	8	8	100.0
total	151	157	96.1

#
#  WeekOfYear.pm
#
#  Synopsis: see POD at end of file
#
package Date::WeekOfYear;

use strict;
use warnings;
use Time::Local;
use parent 'Exporter';
use integer;    # Integer math, so we don't need floor

our $VERSION = '1.06';

our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
    'mode' => [ qw( WeekOfYear WOY_OLD_MODE WOY_ISO_MODE ) ],
    'all'  => [ qw( WeekOfYear WOY_OLD_MODE WOY_ISO_MODE is_leap_year day_of_year jan1week_day WeekOfYear week_day week_number ) ],
    );
our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT      = qw( WeekOfYear );

# Weekday constants
use constant {
    SUNDAY    => 0,
    MONDAY    => 1,
    TUESDAY   => 2,
    WEDNESDAY => 3,
    THURSDAY  => 4,
    FRIDAY    => 5,
    SATURDAY  => 6,
    };

# Pseudo constants
sub WOY_OLD_MODE { 1 }
sub WOY_ISO_MODE { 2 }


sub is_leap_year
{

    my $year = shift;  # eg 2014

    # See POD for details of the algorithm.
    my $is_ly = ((($year % 4 == 0) && ($year % 100 != 0)) || ($year % 400 == 0)) ? 1 : 0;
    #print STDERR "is_ly=$is_ly $year\n";

    return $is_ly;
}

sub day_of_year
{
    # Return the day of the year, 1 being the first day (unlike localtime()) based on day of month and month
    my ($year, $month, $day) = @_;   # year is YYYY (eg 2014), month is 1-12, Jan=1, day is day of month

    # Days to mth start         Jan Feb Mar Apr May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
    my @days_in_month = (undef, 0,  31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);

    my $doy = $day + $days_in_month[$month];

    # Need to adjust for leap year if after Feb
    $doy++ if ($month > 2 && is_leap_year($year));

    return $doy;
}

sub jan1week_day
{
    my ($year) = @_;   # year is YYYY (eg 2014)

    # Here weekday 1=Mon, 2=Tue, 7=Sun (not 0 as localtime())
    my $yy     = ($year - 1) % 100;
    my $jan1wd = 1 + (((($year -1 - $yy) / 100 ) % 4) * 5 + $yy + $yy/4) % 7;

    return $jan1wd;
}

sub week_day
{
    # Here weekday 1=Mon, 2=Tue, 3=Wed, 4=Thu,...7=Sun (not 0 as localtime())
    my ($year, $month, $day) = @_;   # year is YYYY (eg 2014), month is 1-12, Jan=1, day is day of month

    my $doy    = day_of_year($year, $month, $day);
    my $jan1wd = jan1week_day($year, $month, $day);

    my $wd = 1 + (($doy + $jan1wd - 2) % 7);

    return $wd;
}

sub week_number
{
    my ($year, $month, $day) = @_;   # year is YYYY (eg 2014), month is 1-12, Jan=1, day is day of month

    my $year_number = $year;
    my $week_number;


    my $is_leap_y      = is_leap_year($year);
    my $is_leap_prev_y = is_leap_year($year - 1);
    my $doy            = day_of_year($year, $month, $day);
    my $jan1wd         = jan1week_day($year, $month, $day);
    my $wd             = week_day($year, $month, $day);

    #print STDERR "year=$year, month=$month, day=$day, is_leap_y=$is_leap_y, is_leap_prev_y=$is_leap_prev_y, doy=$doy, jan1wd=$jan1wd, wd=$wd\n";

    # Does YYYYMMDD fall in year YYYY-1, weeknumber 52 or 53
    if ($doy <= (8 - $jan1wd) && $jan1wd > 4)
    {
        $year_number--;
        if ($jan1wd == 5 || ($jan1wd == 6 && $is_leap_prev_y))
        {
            $week_number = 53;
        }
        else
        {
            $week_number = 52;
        }
    }

    # Does YYYYMMDD fall in YYYY+1, weeknumber 1
    if ($year_number == $year)
    {
        my $days_in_year = $is_leap_y ? 366 : 365;

        if (($days_in_year - $doy) < (4 - $wd))
        {
            $year_number++;
            $week_number = 1;
        }
    }

    # Does YYYYMMDD fall in YYYY weeknumber 1 -> 53
    if ($year_number == $year)
    {
        $week_number = ($doy + 6 - $wd + $jan1wd)/7;
        $week_number-- if ($jan1wd > 4);
    }

    return ($week_number, $year_number);
}

sub WeekOfYear
{
    my ($time, $mode) = @_;

    # Make sure we have a mode
    $mode = 0 unless defined $mode;

    my ($tm_day, $tm_mth, $tm_year, $wkday, $yrday);

    # Post version 1.4 can be passed a hash ref for the time
    # The hash ref must have a year, month and day
    # This allows working past or before dates that can be handled by localtime
    if (($mode == 0 || $mode == WOY_ISO_MODE) && ref($time) eq 'HASH')
    {
        $tm_day  = $time->{day};
        $tm_mth  = $time->{month} - 1;
        $tm_year = $time->{year} - 1900;
    }
    else
    {
        # Set to the current time if nothing provided
        $time = time unless (defined($time) && $time =~ /^\s*\d+\s*$/);

        # wkday is the day of the week, 0=Sunday, 1=Monday.. 4=Thursday
        ($tm_day, $tm_mth, $tm_year, $wkday, $yrday) = (localtime($time))[3..7];
    }

    my $wkNo;

    if ($mode == WOY_OLD_MODE)
    {
        # Pre version 1.4 functionality

        # What is the week day for 1 Jan of the year in question
        my ($soywkday) = jan1week_day($tm_year + 1900);

        $wkNo = int($yrday / 7) + 1 + (($wkday < $soywkday)? 1:0);

        return wantarray ? ($wkNo, $tm_year + 1900) : $wkNo;
    }
    else
    {
        my ($w, $y) = week_number($tm_year + 1900, $tm_mth + 1, $tm_day);

        if ($mode == WOY_ISO_MODE)
        {
            # YYYY-WXX where YYYY is the year, W denotes the week, and XX is the week number, eg 1970-W53
            return sprintf('%d-W%02d', $y, $w);
        }
        else
        {
            # The new default output
            return wantarray ? ($w, $y) : $w;
        }
    }
}


1;
__END__