TaskForest::Calendar - TaskForest::Calendar documentation

 use TaskForest::LocalTime;

 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = &LocalTime::localtime();
 #
 # THE MONTH IS 1-BASED, AND THE YEAR IS THE FULL YEAR
 # (i.e.,  $mon++; $year += 1900; is not required)

 &LocalTime::setTime({ year  => $year,
                                   month => $mon,
                                   day   => $day,
                                   hour  => $hour,
                                   min   => $min,
                                   sec   => $sec,
                                   tz    => $tz
                                   });
 # ...
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = &LocalTime::localtime(); 
 #
 # THE MONTH IS 1-BASED, AND THE YEAR IS THE FULL YEAR
 # (i.e.,  $mon++; $year += 1900; is not required)

################################################################################
#
# $Id: Calendar.pm 211 2009-05-25 06:05:50Z aijaz $
# 
################################################################################

package TaskForest::Calendar;
use strict;
use warnings;
use Carp;
use DateTime;
use Time::Local;
use Data::Dumper;

BEGIN {
    use vars qw($VERSION);
    $VERSION     = '1.30';
}


my $time_offset = 0;

# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
sub canRunToday {
    my $args = shift;

    my $rules = $args->{rules};
    my $tz    = $args->{tz};

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = &TaskForest::LocalTime::ft($tz);

    # for each rule, see if today applies (yes or no or inconclusive).
    # default is no.
    # last matching rule that returns yes or no wins

    my $today_hash = {
        sec   => $sec,
        min   => $min,
        hour  => $hour,
        mday  => $mday,
        mon   => $mon,
        year  => $year,
        wday  => $wday,
        yday  => $yday,
        isdst => $isdst,
    };

    my $ok = '-';
    foreach my $rule (@$rules) {
        $rule =~ s/\#.*//;
        next unless $rule =~ /\S/;
        my $match = doesRuleMatch($today_hash, $rule);
        if ($match eq '+' or $match eq '-') {
            $ok = $match;
        }
        elsif ($match eq 'N/A') {
            # not applicable - do nothing
        }
        else {
            return $match;
        }
    }

    return $ok;
}


sub doesRuleMatch {
    my ($today, $rule) = @_;

    # [+|-] ( [ [first | second | third | fourth | fifth] [last] DOW ]  | (YYYY|*)/(MM|*)/(DD|*) )
    # trim white space 
    $rule =~ s/^\s+//;
    $rule =~ s/\s+$//;
    $rule =~ tr/A-Z/a-z/;
    
    my @components = split(/\s+/, $rule);
    return "No components" unless (@components);

    my $plus_or_minus = '+';

    # if +/- isn't defined, assume it's a +
    #
    if ($components[0] eq '+' || $components[0] eq '-') {
        $plus_or_minus = shift(@components);
    }
    return "No components after plus or minus" unless (@components);

    
    my $nth = undef;
    my $dow = undef;
    my %offsets = ( first => 1, second => 2, third => 3, fourth => 4, fifth => 5, last => -1, every => 0, );
    my %dows = (  sun => 0 , mon => 1, tue => 2, wed => 3, thu => 4, fri => 5, sat => 6, );
    
    # if the second item is _/_/_, then assume that there is no nth DOW
    
    if (defined $offsets{$components[0]}) {
        return "No components after offset" if (scalar(@components) < 2);
        
        $nth = $offsets{$components[0]};
        
        if ($components[1] eq 'last') {
            $nth = ($nth > 0)? $nth * -1 : -1;
            splice(@components, 1, 1);  # get rid of 'last'
        }
        return "No components after offset last" if (scalar(@components) < 2);
 
        $dow = $dows{substr($components[1], 0, 3)};

        # now get rid of the first 2
        splice(@components, 0, 2);
    }

    my ($y, $m, $d);
    if ($components[0]) {
        my $yyyymmdd = $components[0];
        my ($y, $m, $d) = split(/\//, $yyyymmdd);

        if (defined $nth) {
            return "Date of month not allowed when specifying day of week" if $d;  # can't have last Friday in 2009/November/1
            $d = '*';          # do this to make the check for keep_going easier
        }
        return "Date not specified in a valid format" unless ($y && $m && $d);

        if ($y ne '*') { $y *= 1; if ($y < 1970                ) { return "Invalid year";  } }
        if ($m ne '*') { $m *= 1; if ($m < 1 || $m > 12        ) { return "Invalid month"; } }
        if ($d ne '*') { $d *= 1; if ($d < 1 || $d > 31        ) { return "Invalid day"; } }


        # now try to eliminate based on yyyy mm and dd

        my $keep_going;

        if ( ($y eq '*' || $y == $today->{year})
             &&
             ($m eq '*' || $m == $today->{mon})
             &&
             ($d eq '*' || $d == $today->{mday})
            )
        {
            $keep_going = 1;
            $y = $today->{year};
            $m = $today->{mon};
            $d = $today->{mday};
        }
        else {
            $keep_going = 0;
        }

        return 'N/A' unless $keep_going;
        #return '-' unless $keep_going;

        # now we know that the date part matches.
        # now check for the day of week part, if present

        if (defined $nth && defined $dow) {
            # $nth could be 0 (every)

            if ($dow == $today->{wday}) {
                # check nth.  Check easy ones first
                #
                if ($nth == 0) { return $plus_or_minus; }

                # find days of week
                my $dates = findDaysOfWeek($y, $m, $dow);

                if ($nth > 0) { $nth--; } # so we can use it as an array subscript

                return '-' if $nth == 4 and scalar(@$dates) < 5;  # If the fifth dow does exist
                
                if ($dates->[$nth] == $today->{mday}) {
                    return $plus_or_minus;
                }
                else {
                    #return '-';
                    return 'N/A';
                }
            }
            else {
                #return '-';
                return 'N/A';
            }
        }
        else {
            return $plus_or_minus;
        }
             
    }

    return 'Applicable date range not present';

}

# returns an array of 4 or 5 mdays, each of which correspond to the nth dow of y/m
sub findDaysOfWeek {
    my ($y, $m, $dow) = @_;

    # find the first dow
    #my ($sec1,$min1,$hour1,$mday1,$mon1,$year1,$wday1,$yday1,$isdst1) = localtime(timelocal(0, 0, 0, 1, $m - 1, $y - 1900));
    my $dt = DateTime->new(year => $y,
                           month => $m,
                           day => 1,
                           hour => 0,
                           minute => 0,
                           second => 0,
        );
    my $wday1 = $dt->day_of_week;
    $wday1 = 0 if $wday1 == 7;
    
    # dow  $wday1  transform
    # 3    0       + 3       = 3
    # 3    1       + (3 - 1) = 2
    # 3    2       + (3 - 2) = 1
    # 3    3       + (3 - 3) = 0           
    # 3    4       + (3 - 4) = -1 + 7 = 6
    # 3    5       + (3 - 5) = -2 + 7 = 5
    # 3    6       + (3 - 6) = -3 + 7 = 4
    # 0    0       0
    # 0    1       0 - 1 + 7 = 6

    my @result = ();
    $result[0] = ($dow >= $wday1) ? $dow - $wday1 + 1 : $dow - $wday1 + 1 + 7;

    my @days_in_month = (-1, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
    if ($m == 2 and $dt->is_leap_year()) {
        #$days_in_month[2] += ($y % 4) ? 0 : ($y % 100) ? 1 : ($y % 400) ? 0: 1;
        $days_in_month[2] ++;
    }

    my $days_in_month = $days_in_month[$m];

    my $next = 0;
    for (my $next = $result[0] + 7; $next <= $days_in_month; $next += 7) {
        push(@result, $next);
    }

    return (\@result);
}

1;