Finished Schedule.pm
This commit is contained in:
parent
989415ec1f
commit
df0babf775
@ -1,36 +1,277 @@
|
||||
package Mnemosyne::Schedule;
|
||||
use strict;
|
||||
use warnings;
|
||||
use DateTime;
|
||||
use Carp qw(croak);
|
||||
|
||||
# Resolves whether a task is due/upcoming/overdue/irrelevant for a given date.
|
||||
# This module is the heart of the scheduling logic and must be well unit-tested.
|
||||
use constant {
|
||||
UPCOMING_HORIZON => 7,
|
||||
MEDIUM_FLOAT_DAYS => 3,
|
||||
LOW_FLOAT_DAYS => 7,
|
||||
};
|
||||
|
||||
# Public interface
|
||||
# -----------------------------------------------------------------------
|
||||
|
||||
# status($class, $task_href, $today_dt, %opts) → one of:
|
||||
# 'inactive' | 'due' | 'overdue' | 'upcoming' | 'not_relevant'
|
||||
#
|
||||
# Public interface (all take a task hashref + a DateTime object for "today"):
|
||||
#
|
||||
# TODO: status($task, $today_dt) — returns one of: 'overdue', 'due', 'upcoming', 'inactive'
|
||||
# Dispatches to the appropriate class handler below.
|
||||
#
|
||||
# TODO: next_due_date($task, $today_dt) — returns a DateTime of the next occurrence,
|
||||
# or undef if the task has no upcoming date (e.g. inactive).
|
||||
#
|
||||
# --- Per-class handlers ---
|
||||
#
|
||||
# TODO: _monthly_date_due($task, $today_dt)
|
||||
# Rule: fires on day_of_month each month.
|
||||
# Short-month rule: if day_of_month > days-in-month, fire on last day of month.
|
||||
#
|
||||
# TODO: _monthly_weekday_due($task, $today_dt)
|
||||
# Rule: fires on the Nth weekday (ordinal 1-4, or -1 for last) each month.
|
||||
#
|
||||
# TODO: _every_n_period_due($task, $today_dt)
|
||||
# Rule: occurrences = anchor_date + k * (interval_n period_units), k=0,1,2,...
|
||||
# Calendar-anchored; NOT reset by completion.
|
||||
#
|
||||
# TODO: _interval_due($task, $today_dt, $last_completion_dt)
|
||||
# Rule: next_due = last_completion_dt + interval_days (or created_at if never done).
|
||||
#
|
||||
# TODO: _floating_show($task, $today_dt, $last_completion_dt)
|
||||
# Rule: high → always; medium → every medium_float_days; low → weekly + randomised.
|
||||
# Returns true/false (floating tasks are never "overdue", just shown or not).
|
||||
# opts:
|
||||
# last_completed_dt => DateTime or undef (most recent completion)
|
||||
# upcoming_horizon => integer days (default 7)
|
||||
# medium_float_days => integer (default 3)
|
||||
|
||||
sub status {
|
||||
my ($class, $task, $today, %opts) = @_;
|
||||
|
||||
return 'inactive' unless $task->{active};
|
||||
|
||||
my $horizon = $opts{upcoming_horizon} // UPCOMING_HORIZON;
|
||||
my $medium_days = $opts{medium_float_days} // MEDIUM_FLOAT_DAYS;
|
||||
my $last_comp = $opts{last_completed_dt};
|
||||
my $tc = $task->{class} // croak "task has no class";
|
||||
|
||||
return _monthly_date ($task, $today, $last_comp, $horizon) if $tc eq 'monthly_date';
|
||||
return _monthly_weekday($task, $today, $last_comp, $horizon) if $tc eq 'monthly_weekday';
|
||||
return _every_n_period ($task, $today, $last_comp, $horizon) if $tc eq 'every_n_period';
|
||||
return _interval ($task, $today, $last_comp, $horizon) if $tc eq 'interval';
|
||||
return _floating ($task, $today, $medium_days) if $tc eq 'floating';
|
||||
croak "Unknown task class: $tc";
|
||||
}
|
||||
|
||||
# next_due_date($class, $task_href, $today_dt, %opts) → DateTime or undef
|
||||
# TODO: implement when needed by Digest/commands
|
||||
sub next_due_date { undef }
|
||||
|
||||
# -----------------------------------------------------------------------
|
||||
# Per-class handlers
|
||||
# -----------------------------------------------------------------------
|
||||
|
||||
sub _monthly_date {
|
||||
my ($task, $today, $last_comp, $horizon) = @_;
|
||||
my $dom = $task->{day_of_month};
|
||||
my $created = _created_date($task);
|
||||
|
||||
my $this_occ = _dom_in_month($dom, $today->year, $today->month);
|
||||
|
||||
# curr_occ: most recent occurrence on or before today
|
||||
# next_occ: the one after that
|
||||
my ($curr_occ, $next_occ);
|
||||
if (_cmp($this_occ, $today) <= 0) {
|
||||
$curr_occ = $this_occ;
|
||||
my $nm = $today->clone->add(months => 1);
|
||||
$next_occ = _dom_in_month($dom, $nm->year, $nm->month);
|
||||
} else {
|
||||
my $pm = $today->clone->subtract(months => 1);
|
||||
$curr_occ = _dom_in_month($dom, $pm->year, $pm->month);
|
||||
$next_occ = $this_occ;
|
||||
}
|
||||
|
||||
# Pre-creation occurrences carry no obligation
|
||||
my $pre_creation = $created && _cmp($curr_occ, $created) < 0;
|
||||
my $completed = $pre_creation
|
||||
|| ($last_comp && _cmp($last_comp, $curr_occ) >= 0);
|
||||
|
||||
unless ($completed) {
|
||||
return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
|
||||
}
|
||||
return _from_next($next_occ, $today, $horizon);
|
||||
}
|
||||
|
||||
sub _monthly_weekday {
|
||||
my ($task, $today, $last_comp, $horizon) = @_;
|
||||
my ($weekday, $ordinal) = ($task->{weekday}, $task->{ordinal});
|
||||
my $created = _created_date($task);
|
||||
|
||||
my $this_occ = _nth_weekday($today->year, $today->month, $weekday, $ordinal);
|
||||
|
||||
my ($curr_occ, $next_occ);
|
||||
if (_cmp($this_occ, $today) <= 0) {
|
||||
$curr_occ = $this_occ;
|
||||
my $nm = $today->clone->add(months => 1);
|
||||
$next_occ = _nth_weekday($nm->year, $nm->month, $weekday, $ordinal);
|
||||
} else {
|
||||
my $pm = $today->clone->subtract(months => 1);
|
||||
$curr_occ = _nth_weekday($pm->year, $pm->month, $weekday, $ordinal);
|
||||
$next_occ = $this_occ;
|
||||
}
|
||||
|
||||
my $pre_creation = $created && _cmp($curr_occ, $created) < 0;
|
||||
my $completed = $pre_creation
|
||||
|| ($last_comp && _cmp($last_comp, $curr_occ) >= 0);
|
||||
|
||||
unless ($completed) {
|
||||
return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
|
||||
}
|
||||
return _from_next($next_occ, $today, $horizon);
|
||||
}
|
||||
|
||||
sub _every_n_period {
|
||||
my ($task, $today, $last_comp, $horizon) = @_;
|
||||
my $anchor = _parse_date($task->{anchor_date})
|
||||
or croak "every_n_period task missing valid anchor_date";
|
||||
my ($n, $unit) = ($task->{interval_n}, $task->{period_unit});
|
||||
|
||||
# Anchor hasn't arrived yet
|
||||
if (_cmp($anchor, $today) > 0) {
|
||||
return _from_next($anchor, $today, $horizon);
|
||||
}
|
||||
|
||||
my $k = _find_k($anchor, $n, $unit, $today);
|
||||
my $curr_occ = _add_period($anchor, $k, $n, $unit);
|
||||
my $next_occ = _add_period($anchor, $k + 1, $n, $unit);
|
||||
|
||||
my $completed = $last_comp && _cmp($last_comp, $curr_occ) >= 0;
|
||||
|
||||
unless ($completed) {
|
||||
return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
|
||||
}
|
||||
return _from_next($next_occ, $today, $horizon);
|
||||
}
|
||||
|
||||
sub _interval {
|
||||
my ($task, $today, $last_comp, $horizon) = @_;
|
||||
my $interval = $task->{interval_days};
|
||||
|
||||
# Seed: last completion, or created_at (so a new task doesn't scream overdue on day one)
|
||||
my $seed = $last_comp
|
||||
? $last_comp->clone->truncate(to => 'day')
|
||||
: _created_date($task);
|
||||
|
||||
my $next_due = $seed->clone->add(days => $interval);
|
||||
my $days = _days_diff($today, $next_due); # positive = future
|
||||
|
||||
return 'overdue' if $days < 0;
|
||||
return 'due' if $days == 0;
|
||||
return 'upcoming' if $days <= $horizon;
|
||||
return 'not_relevant';
|
||||
}
|
||||
|
||||
sub _floating {
|
||||
my ($task, $today, $medium_days) = @_;
|
||||
my $priority = $task->{priority} // 'medium';
|
||||
|
||||
return 'due' if $priority eq 'high';
|
||||
|
||||
my $created = _created_date($task);
|
||||
my $days_since = _days_diff($created, $today);
|
||||
$days_since = 0 if $days_since < 0;
|
||||
|
||||
if ($priority eq 'medium') {
|
||||
return $days_since % $medium_days == 0 ? 'due' : 'not_relevant';
|
||||
}
|
||||
|
||||
if ($priority eq 'low') {
|
||||
my $task_id = $task->{id} // 0;
|
||||
return ($days_since + $task_id) % LOW_FLOAT_DAYS == 0 ? 'due' : 'not_relevant';
|
||||
}
|
||||
|
||||
return 'not_relevant';
|
||||
}
|
||||
|
||||
# -----------------------------------------------------------------------
|
||||
# Date helpers
|
||||
# -----------------------------------------------------------------------
|
||||
|
||||
# Day-of-month occurrence in a given month, clamped to the last day.
|
||||
# e.g. _dom_in_month(31, 2026, 6) → Jun 30
|
||||
sub _dom_in_month {
|
||||
my ($dom, $year, $month) = @_;
|
||||
my $last = DateTime->last_day_of_month(year => $year, month => $month)->day;
|
||||
return DateTime->new(year => $year, month => $month, day => ($dom > $last ? $last : $dom));
|
||||
}
|
||||
|
||||
# Nth weekday of a month.
|
||||
# weekday: 1=Mon .. 7=Sun (DateTime day_of_week)
|
||||
# ordinal: 1-4 for first-fourth, -1 for last
|
||||
sub _nth_weekday {
|
||||
my ($year, $month, $weekday, $ordinal) = @_;
|
||||
if ($ordinal == -1) {
|
||||
my $last = DateTime->last_day_of_month(year => $year, month => $month);
|
||||
my $diff = ($last->day_of_week - $weekday) % 7;
|
||||
return $last->clone->subtract(days => $diff);
|
||||
} else {
|
||||
my $first = DateTime->new(year => $year, month => $month, day => 1);
|
||||
my $diff = ($weekday - $first->day_of_week) % 7;
|
||||
return $first->clone->add(days => $diff + ($ordinal - 1) * 7);
|
||||
}
|
||||
}
|
||||
|
||||
# Advance an anchor by k * (n period_units), with end-of-month clamping for months.
|
||||
sub _add_period {
|
||||
my ($anchor, $k, $n, $unit) = @_;
|
||||
return $anchor->clone if $k == 0;
|
||||
my $dt = $anchor->clone;
|
||||
if ($unit eq 'day') { $dt->add(days => $k * $n) }
|
||||
elsif ($unit eq 'week') { $dt->add(weeks => $k * $n) }
|
||||
elsif ($unit eq 'month') { $dt->add(months => $k * $n, end_of_month => 'limit') }
|
||||
else { croak "Unknown period_unit: $unit" }
|
||||
return $dt;
|
||||
}
|
||||
|
||||
# Largest k such that anchor + k*(n units) <= today.
|
||||
sub _find_k {
|
||||
my ($anchor, $n, $unit, $today) = @_;
|
||||
|
||||
if ($unit eq 'day') {
|
||||
return int(_days_diff($anchor, $today) / $n);
|
||||
}
|
||||
if ($unit eq 'week') {
|
||||
return int(_days_diff($anchor, $today) / ($n * 7));
|
||||
}
|
||||
if ($unit eq 'month') {
|
||||
# Approximate, then walk to correct value
|
||||
my $total_months = ($today->year - $anchor->year) * 12
|
||||
+ ($today->month - $anchor->month);
|
||||
my $k = int($total_months / $n);
|
||||
$k = 0 if $k < 0;
|
||||
|
||||
# Ensure anchor + (k+1)*period > today
|
||||
while (1) {
|
||||
my $next = _add_period($anchor, $k + 1, $n, $unit);
|
||||
last if _cmp($next, $today) > 0;
|
||||
$k++;
|
||||
}
|
||||
# Ensure anchor + k*period <= today
|
||||
while ($k > 0) {
|
||||
my $curr = _add_period($anchor, $k, $n, $unit);
|
||||
last if _cmp($curr, $today) <= 0;
|
||||
$k--;
|
||||
}
|
||||
return $k;
|
||||
}
|
||||
croak "Unknown period_unit: $unit";
|
||||
}
|
||||
|
||||
# Days from d1 to d2 (positive if d2 is later).
|
||||
# Uses Julian Day Numbers — safe across DST boundaries (never counts seconds).
|
||||
sub _days_diff {
|
||||
my ($d1, $d2) = @_;
|
||||
return int($d2->jd - $d1->jd);
|
||||
}
|
||||
|
||||
# Status based solely on how far away the next occurrence is.
|
||||
sub _from_next {
|
||||
my ($next, $today, $horizon) = @_;
|
||||
my $days = _days_diff($today, $next);
|
||||
return 'due' if $days == 0;
|
||||
return 'upcoming' if $days > 0 && $days <= $horizon;
|
||||
return 'not_relevant';
|
||||
}
|
||||
|
||||
# Compare two DateTime objects; returns -1, 0, 1.
|
||||
sub _cmp { DateTime->compare($_[0], $_[1]) }
|
||||
|
||||
# Parse an ISO date/datetime string to a day-granular DateTime.
|
||||
sub _parse_date {
|
||||
my ($s) = @_;
|
||||
return undef unless defined $s && $s =~ /^(\d{4})-(\d{2})-(\d{2})/;
|
||||
return DateTime->new(year => $1+0, month => $2+0, day => $3+0);
|
||||
}
|
||||
|
||||
sub _created_date {
|
||||
my ($task) = @_;
|
||||
return _parse_date($task->{created_at});
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
364
t/schedule.t
364
t/schedule.t
@ -2,35 +2,341 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
use DateTime;
|
||||
use FindBin qw($RealBin);
|
||||
use lib "$RealBin/../lib";
|
||||
use Mnemosyne::Schedule;
|
||||
|
||||
# Schedule.pm unit tests — date math across all five task classes.
|
||||
# This file is a placeholder; tests will be added as Schedule.pm is implemented.
|
||||
#
|
||||
# Priority test cases to cover:
|
||||
#
|
||||
# monthly_date:
|
||||
# - Normal case: day_of_month=15, today=2026-06-15 → due
|
||||
# - Short-month clamp: day_of_month=31, today=2026-06-30 → due (last day of June)
|
||||
# - Short-month clamp: day_of_month=31, today=2026-06-15 → upcoming
|
||||
# - Overdue: day_of_month=1, today=2026-06-05, no completion → overdue
|
||||
#
|
||||
# monthly_weekday:
|
||||
# - 4th Monday: 2026-06 → 2026-06-22
|
||||
# - last Monday: 2026-06 → 2026-06-29
|
||||
# - ordinal=1, weekday=0 (Mon): 2026-06 → 2026-06-01
|
||||
#
|
||||
# every_n_period:
|
||||
# - every 2 weeks from 2026-01-01: check correct occurrence dates
|
||||
# - every 3 months from 2026-01-15: Feb has 28 days — verify month arithmetic
|
||||
#
|
||||
# interval:
|
||||
# - never completed: due = created_at + interval_days
|
||||
# - completed yesterday: interval=30 → not due yet
|
||||
# - completed 31 days ago: interval=30 → overdue
|
||||
#
|
||||
# floating:
|
||||
# - high priority → always shown
|
||||
# - medium: shown at day 0 and day 3, not at day 1 or 2
|
||||
# --- helpers ---
|
||||
|
||||
sub dt { DateTime->new(year => $_[0], month => $_[1], day => $_[2]) }
|
||||
|
||||
sub task {
|
||||
my %h = (id => 1, active => 1, created_at => '2026-01-01T00:00:00Z', @_);
|
||||
return \%h;
|
||||
}
|
||||
|
||||
sub status {
|
||||
my ($task, $today, %opts) = @_;
|
||||
return Mnemosyne::Schedule->status($task, $today, %opts);
|
||||
}
|
||||
|
||||
# ============================================================
|
||||
# monthly_date
|
||||
# ============================================================
|
||||
# June 2026: 30 days. July 2026: 31 days. Feb 2026: 28 days.
|
||||
|
||||
subtest 'monthly_date — basic' => sub {
|
||||
my $t = task(class => 'monthly_date', day_of_month => 15);
|
||||
|
||||
is status($t, dt(2026,6,15)), 'due', 'due on the day';
|
||||
is status($t, dt(2026,6,16)), 'overdue', 'overdue day after';
|
||||
is status($t, dt(2026,6,20)), 'overdue', 'overdue a week later';
|
||||
is status($t, dt(2026,6,15), last_completed_dt => dt(2026,6,15)),
|
||||
'not_relevant','done today → not relevant (Jul 15 is 30 days out)';
|
||||
|
||||
# Upcoming: Jun 15 is 7 days from Jun 8 (= horizon), 6 days from Jun 9
|
||||
is status($t, dt(2026,6,8), last_completed_dt => dt(2026,5,15)), 'upcoming', '7 days out = within horizon';
|
||||
is status($t, dt(2026,6,9), last_completed_dt => dt(2026,5,15)), 'upcoming', '6 days out';
|
||||
is status($t, dt(2026,6,7), last_completed_dt => dt(2026,5,15)), 'not_relevant', '8 days out = beyond horizon';
|
||||
|
||||
# Completed this cycle → upcoming next month
|
||||
is status($t, dt(2026,6,20), last_completed_dt => dt(2026,6,15)), 'not_relevant', 'completed; Jul 15 is 25 days out';
|
||||
};
|
||||
|
||||
subtest 'monthly_date — short-month clamping' => sub {
|
||||
# day=31: June has 30 days, so occurrence is Jun 30
|
||||
my $t31 = task(class => 'monthly_date', day_of_month => 31);
|
||||
is status($t31, dt(2026,6,30)), 'due', 'day=31 in June clamps to Jun 30 → due';
|
||||
is status($t31, dt(2026,6,29), last_completed_dt => dt(2026,5,31)),
|
||||
'upcoming','day=31 in June: Jun 30 is 1 day out (May 31 done)';
|
||||
is status($t31, dt(2026,7,1)), 'overdue', 'day=31: Jul 1, Jun 30 missed';
|
||||
is status($t31, dt(2026,7,31)), 'due', 'day=31 in July (31 days) → Jul 31 due';
|
||||
|
||||
# day=29: Feb 2026 has 28 days
|
||||
my $t29 = task(class => 'monthly_date', day_of_month => 29);
|
||||
is status($t29, dt(2026,2,28)), 'due', 'day=29 in Feb 2026 clamps to Feb 28 → due';
|
||||
is status($t29, dt(2026,3,1)), 'overdue', 'day=29: Mar 1, Feb 28 missed';
|
||||
is status($t29, dt(2026,3,29)), 'due', 'day=29 in March (31 days) → Mar 29 due';
|
||||
|
||||
# day=31: Apr has 30 days → clamps to Apr 30
|
||||
my $t31b = task(class => 'monthly_date', day_of_month => 31);
|
||||
is status($t31b, dt(2026,4,30)), 'due', 'day=31 in April clamps to Apr 30 → due';
|
||||
};
|
||||
|
||||
subtest 'monthly_date — pre-creation guard' => sub {
|
||||
# Task created Jun 1; previous occurrence (May 15) is before creation → not overdue
|
||||
my $t = task(
|
||||
class => 'monthly_date',
|
||||
day_of_month => 15,
|
||||
created_at => '2026-06-01T00:00:00Z',
|
||||
);
|
||||
# today = Jun 8: curr_occ would be May 15 (before created_at) → treat as done → upcoming Jun 15
|
||||
is status($t, dt(2026,6,8)), 'upcoming', 'pre-creation occurrence not flagged overdue';
|
||||
is status($t, dt(2026,6,7)), 'not_relevant', 'pre-creation; Jun 15 still 8 days out';
|
||||
};
|
||||
|
||||
subtest 'monthly_date — inactive' => sub {
|
||||
my $t = task(class => 'monthly_date', day_of_month => 15, active => 0);
|
||||
is status($t, dt(2026,6,15)), 'inactive', 'inactive task';
|
||||
};
|
||||
|
||||
# ============================================================
|
||||
# monthly_weekday
|
||||
# ============================================================
|
||||
# June 2026: Jun 1 = Monday
|
||||
# 4th Monday = Jun 22
|
||||
# 5th/last Monday = Jun 29
|
||||
# July 2026: Jul 1 = Wednesday
|
||||
# 1st Monday = Jul 6
|
||||
# Feb 2026: Feb 1 = Sunday
|
||||
# 1st Friday = Feb 6
|
||||
# last Friday = Feb 27
|
||||
|
||||
subtest 'monthly_weekday — 4th Monday June 2026' => sub {
|
||||
# weekday 1=Monday, ordinal 4
|
||||
my $t = task(class => 'monthly_weekday', weekday => 1, ordinal => 4);
|
||||
|
||||
is status($t, dt(2026,6,22)), 'due', '4th Monday Jun = Jun 22, due';
|
||||
is status($t, dt(2026,6,21), last_completed_dt => dt(2026,5,25)),
|
||||
'upcoming', 'Jun 21: Jun 22 is 1 day out';
|
||||
is status($t, dt(2026,6,23)), 'overdue', 'Jun 23: Jun 22 missed';
|
||||
is status($t, dt(2026,6,22), last_completed_dt => dt(2026,6,22)),
|
||||
'not_relevant','completed Jun 22; Jul 27 is far';
|
||||
};
|
||||
|
||||
subtest 'monthly_weekday — last Monday June 2026' => sub {
|
||||
my $t = task(class => 'monthly_weekday', weekday => 1, ordinal => -1);
|
||||
|
||||
is status($t, dt(2026,6,29)), 'due', 'last Monday Jun = Jun 29, due';
|
||||
is status($t, dt(2026,6,28), last_completed_dt => dt(2026,5,25)),
|
||||
'upcoming', 'Jun 28: Jun 29 is 1 day out';
|
||||
is status($t, dt(2026,6,30)), 'overdue', 'Jun 30: Jun 29 missed';
|
||||
};
|
||||
|
||||
subtest 'monthly_weekday — 1st Monday July 2026' => sub {
|
||||
my $t = task(class => 'monthly_weekday', weekday => 1, ordinal => 1);
|
||||
is status($t, dt(2026,7,6)), 'due', '1st Monday Jul = Jul 6, due';
|
||||
is status($t, dt(2026,7,5), last_completed_dt => dt(2026,6,1)),
|
||||
'upcoming', 'Jul 5: Jul 6 is 1 day out';
|
||||
is status($t, dt(2026,7,7)), 'overdue', 'Jul 7: Jul 6 missed';
|
||||
};
|
||||
|
||||
subtest 'monthly_weekday — last Friday Feb 2026' => sub {
|
||||
# Feb 2026: last day = Feb 28 (Saturday). Last Friday = Feb 27.
|
||||
my $t = task(class => 'monthly_weekday', weekday => 5, ordinal => -1);
|
||||
is status($t, dt(2026,2,27)), 'due', 'last Friday Feb = Feb 27, due';
|
||||
is status($t, dt(2026,2,28)), 'overdue', 'Feb 28: Feb 27 missed';
|
||||
};
|
||||
|
||||
subtest 'monthly_weekday — 1st Friday Feb 2026' => sub {
|
||||
# Feb 1 = Sunday; 1st Friday = Feb 6
|
||||
my $t = task(class => 'monthly_weekday', weekday => 5, ordinal => 1);
|
||||
is status($t, dt(2026,2,6)), 'due', '1st Friday Feb = Feb 6, due';
|
||||
is status($t, dt(2026,2,5), last_completed_dt => dt(2026,1,2)),
|
||||
'upcoming', 'Feb 5: Feb 6 is 1 day out';
|
||||
is status($t, dt(2026,2,7)), 'overdue', 'Feb 7: Feb 6 missed';
|
||||
};
|
||||
|
||||
# ============================================================
|
||||
# every_n_period
|
||||
# ============================================================
|
||||
|
||||
subtest 'every_n_period — every 2 weeks from 2026-01-01' => sub {
|
||||
# Occurrences: Jan 1, Jan 15, Jan 29, Feb 12, ...
|
||||
my $t = task(class => 'every_n_period', interval_n => 2, period_unit => 'week',
|
||||
anchor_date => '2026-01-01');
|
||||
|
||||
is status($t, dt(2026,1,15)), 'due', 'Jan 15 occurrence due';
|
||||
is status($t, dt(2026,1,16)), 'overdue', 'Jan 16: Jan 15 missed';
|
||||
is status($t, dt(2026,1,14), last_completed_dt => dt(2026,1,1)),
|
||||
'upcoming', 'Jan 14: Jan 15 is 1 day out';
|
||||
# Jan 15 done; Jan 29 is 14 days away — beyond default horizon of 7
|
||||
is status($t, dt(2026,1,15), last_completed_dt => dt(2026,1,15)),
|
||||
'not_relevant','Jan 15 done; Jan 29 is 14 days out > horizon';
|
||||
|
||||
# Check with wider horizon
|
||||
is status($t, dt(2026,1,15),
|
||||
last_completed_dt => dt(2026,1,15),
|
||||
upcoming_horizon => 14),
|
||||
'upcoming', 'Jan 15 done; Jan 29 upcoming with horizon=14';
|
||||
|
||||
is status($t, dt(2026,1,29)), 'due', 'Jan 29 occurrence due';
|
||||
is status($t, dt(2026,2,12)), 'due', 'Feb 12 occurrence due';
|
||||
};
|
||||
|
||||
subtest 'every_n_period — anchor in future' => sub {
|
||||
my $t = task(class => 'every_n_period', interval_n => 1, period_unit => 'week',
|
||||
anchor_date => '2026-06-15');
|
||||
is status($t, dt(2026,6,8)), 'upcoming', 'anchor Jun 15 is 7 days out';
|
||||
is status($t, dt(2026,6,7)), 'not_relevant', 'anchor Jun 15 is 8 days out';
|
||||
is status($t, dt(2026,6,15)), 'due', 'anchor date itself is due';
|
||||
};
|
||||
|
||||
subtest 'every_n_period — every 1 month from 2026-01-31 (short-month clamping)' => sub {
|
||||
# Occurrences: Jan 31, Feb 28 (clamp), Mar 31, Apr 30 (clamp)
|
||||
my $t = task(class => 'every_n_period', interval_n => 1, period_unit => 'month',
|
||||
anchor_date => '2026-01-31');
|
||||
|
||||
is status($t, dt(2026,2,28)), 'due', 'Feb 28 (clamped from 31)';
|
||||
is status($t, dt(2026,3,1)), 'overdue', 'Mar 1: Feb 28 missed';
|
||||
is status($t, dt(2026,3,31)), 'due', 'Mar 31 due';
|
||||
is status($t, dt(2026,4,30)), 'due', 'Apr 30 (clamped from 31)';
|
||||
is status($t, dt(2026,5,31)), 'due', 'May 31 due';
|
||||
|
||||
is status($t, dt(2026,2,27), last_completed_dt => dt(2026,1,31)),
|
||||
'upcoming', 'Jan 31 done; Feb 28 is 1 day out';
|
||||
};
|
||||
|
||||
subtest 'every_n_period — every 3 months' => sub {
|
||||
# Anchor Jan 15: occurrences Jan 15, Apr 15, Jul 15, Oct 15
|
||||
my $t = task(class => 'every_n_period', interval_n => 3, period_unit => 'month',
|
||||
anchor_date => '2026-01-15');
|
||||
|
||||
is status($t, dt(2026,4,15)), 'due', 'Apr 15 occurrence';
|
||||
is status($t, dt(2026,4,14), last_completed_dt => dt(2026,1,15)),
|
||||
'upcoming', 'Apr 14: Apr 15 is 1 day out';
|
||||
is status($t, dt(2026,4,16)), 'overdue', 'Apr 16: Apr 15 missed';
|
||||
};
|
||||
|
||||
subtest 'every_n_period — every 3 days' => sub {
|
||||
my $t = task(class => 'every_n_period', interval_n => 3, period_unit => 'day',
|
||||
anchor_date => '2026-06-01');
|
||||
# Occurrences: Jun 1, Jun 4, Jun 7, Jun 10 ...
|
||||
is status($t, dt(2026,6,4)), 'due', 'Jun 4 due';
|
||||
is status($t, dt(2026,6,5)), 'overdue', 'Jun 5: Jun 4 missed';
|
||||
is status($t, dt(2026,6,3), last_completed_dt => dt(2026,6,1)),
|
||||
'upcoming', 'Jun 3: Jun 4 is 1 day out';
|
||||
};
|
||||
|
||||
# ============================================================
|
||||
# interval (reset-on-completion)
|
||||
# ============================================================
|
||||
|
||||
subtest 'interval — seeded from created_at' => sub {
|
||||
# interval=30, created May 1: next_due = May 31
|
||||
my $t = task(class => 'interval', interval_days => 30,
|
||||
created_at => '2026-05-01T00:00:00Z');
|
||||
|
||||
is status($t, dt(2026,5,31)), 'due', 'May 31 = created + 30 days';
|
||||
is status($t, dt(2026,6,1)), 'overdue', 'Jun 1 is past due';
|
||||
is status($t, dt(2026,5,30)), 'upcoming', 'May 30: due tomorrow';
|
||||
is status($t, dt(2026,5,24)), 'upcoming', 'May 24: due in 7 days (= horizon)';
|
||||
is status($t, dt(2026,5,23)), 'not_relevant', 'May 23: due in 8 days';
|
||||
is status($t, dt(2026,5,1)), 'not_relevant', 'created today: due in 30 days';
|
||||
};
|
||||
|
||||
subtest 'interval — reset on completion' => sub {
|
||||
my $t = task(class => 'interval', interval_days => 30,
|
||||
created_at => '2026-01-01T00:00:00Z');
|
||||
|
||||
# last_comp = May 15 → next_due = Jun 14
|
||||
is status($t, dt(2026,6,14), last_completed_dt => dt(2026,5,15)), 'due', 'Jun 14 = May 15 + 30';
|
||||
is status($t, dt(2026,6,15), last_completed_dt => dt(2026,5,15)), 'overdue', 'Jun 15: past due';
|
||||
is status($t, dt(2026,6,13), last_completed_dt => dt(2026,5,15)), 'upcoming', 'Jun 13: due tomorrow';
|
||||
|
||||
# Completion resets: last_comp = Jun 14 → next_due = Jul 14
|
||||
is status($t, dt(2026,7,14), last_completed_dt => dt(2026,6,14)), 'due', 'Jul 14 = Jun 14 + 30';
|
||||
};
|
||||
|
||||
subtest 'interval — zero days since creation' => sub {
|
||||
# interval=7, created Jun 10 → next_due = Jun 17 (7 days out = exactly at default horizon)
|
||||
my $t = task(class => 'interval', interval_days => 7,
|
||||
created_at => '2026-06-10T00:00:00Z');
|
||||
is status($t, dt(2026,6,10)), 'upcoming', 'created today: Jun 17 is 7 days out, within horizon';
|
||||
is status($t, dt(2026,6,10), upcoming_horizon => 6), 'not_relevant', '7 days out > horizon=6';
|
||||
};
|
||||
|
||||
# ============================================================
|
||||
# floating
|
||||
# ============================================================
|
||||
|
||||
subtest 'floating — high priority' => sub {
|
||||
my $t = task(class => 'floating', priority => 'high', created_at => '2026-06-01T00:00:00Z');
|
||||
is status($t, dt(2026,6,1)), 'due', 'high: shown on day 0';
|
||||
is status($t, dt(2026,6,10)), 'due', 'high: shown every day';
|
||||
is status($t, dt(2026,7,4)), 'due', 'high: shown weeks later';
|
||||
};
|
||||
|
||||
subtest 'floating — medium priority (every 3 days)' => sub {
|
||||
my $t = task(class => 'floating', priority => 'medium', created_at => '2026-06-01T00:00:00Z');
|
||||
# day 0 (Jun 1): 0 % 3 == 0 → shown
|
||||
# day 1 (Jun 2): 1 % 3 != 0 → not shown
|
||||
# day 2 (Jun 3): 2 % 3 != 0 → not shown
|
||||
# day 3 (Jun 4): 3 % 3 == 0 → shown
|
||||
# day 6 (Jun 7): 6 % 3 == 0 → shown
|
||||
is status($t, dt(2026,6,1), medium_float_days => 3), 'due', 'medium day 0';
|
||||
is status($t, dt(2026,6,2), medium_float_days => 3), 'not_relevant', 'medium day 1';
|
||||
is status($t, dt(2026,6,3), medium_float_days => 3), 'not_relevant', 'medium day 2';
|
||||
is status($t, dt(2026,6,4), medium_float_days => 3), 'due', 'medium day 3';
|
||||
is status($t, dt(2026,6,7), medium_float_days => 3), 'due', 'medium day 6';
|
||||
is status($t, dt(2026,6,8), medium_float_days => 3), 'not_relevant', 'medium day 7';
|
||||
};
|
||||
|
||||
subtest 'floating — low priority (weekly, rotated by task_id)' => sub {
|
||||
# shown when (days_since_created + task_id) % 7 == 0
|
||||
# task_id=6, created Jun 1:
|
||||
# day 0: (0+6)%7=6 → not shown
|
||||
# day 1: (1+6)%7=0 → shown
|
||||
my $t6 = task(id => 6, class => 'floating', priority => 'low', created_at => '2026-06-01T00:00:00Z');
|
||||
is status($t6, dt(2026,6,1)), 'not_relevant', 'low id=6 day 0: not shown';
|
||||
is status($t6, dt(2026,6,2)), 'due', 'low id=6 day 1: shown';
|
||||
is status($t6, dt(2026,6,3)), 'not_relevant', 'low id=6 day 2: not shown';
|
||||
is status($t6, dt(2026,6,9)), 'due', 'low id=6 day 8: shown (8+6=14, 14%7=0)';
|
||||
|
||||
# task_id=7, created Jun 1:
|
||||
# day 0: (0+7)%7=0 → shown
|
||||
my $t7 = task(id => 7, class => 'floating', priority => 'low', created_at => '2026-06-01T00:00:00Z');
|
||||
is status($t7, dt(2026,6,1)), 'due', 'low id=7 day 0: shown';
|
||||
is status($t7, dt(2026,6,2)), 'not_relevant', 'low id=7 day 1: not shown';
|
||||
is status($t7, dt(2026,6,8)), 'due', 'low id=7 day 7: shown';
|
||||
};
|
||||
|
||||
subtest 'floating — inactive' => sub {
|
||||
my $t = task(class => 'floating', priority => 'high', active => 0);
|
||||
is status($t, dt(2026,6,1)), 'inactive', 'inactive floating task';
|
||||
};
|
||||
|
||||
# ============================================================
|
||||
# DST-safe day arithmetic
|
||||
# ============================================================
|
||||
# US Eastern: spring forward Mar 8, 2026; fall back Nov 1, 2026.
|
||||
# We use Julian Day Numbers for _days_diff, never seconds — so DST cannot corrupt results.
|
||||
|
||||
subtest 'DST — interval across spring-forward (Mar 8, 2026)' => sub {
|
||||
# created Mar 7, interval=7 → due Mar 14 (crosses DST boundary)
|
||||
my $t = task(class => 'interval', interval_days => 7,
|
||||
created_at => '2026-03-07T00:00:00Z');
|
||||
is status($t, dt(2026,3,14)), 'due', 'interval 7d across spring-forward: due Mar 14';
|
||||
is status($t, dt(2026,3,13)), 'upcoming','Mar 13: due tomorrow';
|
||||
is status($t, dt(2026,3,15)), 'overdue', 'Mar 15: missed';
|
||||
};
|
||||
|
||||
subtest 'DST — every_n_period across fall-back (Nov 1, 2026)' => sub {
|
||||
# every 1 week from Oct 25 → Nov 1 (DST fall-back day), then Nov 8
|
||||
my $t = task(class => 'every_n_period', interval_n => 1, period_unit => 'week',
|
||||
anchor_date => '2026-10-25');
|
||||
is status($t, dt(2026,11,1)), 'due', 'Nov 1 occurrence on fall-back day';
|
||||
is status($t, dt(2026,10,31), last_completed_dt => dt(2026,10,25)),
|
||||
'upcoming', 'Oct 31: Nov 1 is 1 day out';
|
||||
is status($t, dt(2026,11,2)), 'overdue', 'Nov 2: Nov 1 missed';
|
||||
};
|
||||
|
||||
subtest 'DST — interval across fall-back (Nov 1, 2026)' => sub {
|
||||
# created Oct 28, interval=7 → due Nov 4
|
||||
my $t = task(class => 'interval', interval_days => 7,
|
||||
created_at => '2026-10-28T00:00:00Z');
|
||||
is status($t, dt(2026,11,4)), 'due', 'interval 7d across fall-back: due Nov 4';
|
||||
is status($t, dt(2026,11,3)), 'upcoming','Nov 3: due tomorrow';
|
||||
};
|
||||
|
||||
# ============================================================
|
||||
# Edge: unknown class
|
||||
# ============================================================
|
||||
|
||||
subtest 'unknown class croaks' => sub {
|
||||
eval { status(task(class => 'bogus'), dt(2026,6,1)) };
|
||||
like $@, qr/unknown.*class/i, 'unknown class throws';
|
||||
};
|
||||
|
||||
plan skip_all => 'Schedule.pm not yet implemented';
|
||||
done_testing;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user