package Mnemosyne::Schedule; use strict; use warnings; use DateTime; use Carp qw(croak); 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' # # 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;