343 lines
18 KiB
Perl
343 lines
18 KiB
Perl
#!/usr/bin/env perl
|
|
use strict;
|
|
use warnings;
|
|
use Test::More;
|
|
use DateTime;
|
|
use FindBin qw($RealBin);
|
|
use lib "$RealBin/../lib";
|
|
use Mnemosyne::Schedule;
|
|
|
|
# --- 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';
|
|
};
|
|
|
|
done_testing;
|