279 lines
9.6 KiB
Perl
279 lines
9.6 KiB
Perl
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) → string
|
|
# 'inactive' | 'due' | 'overdue' | 'upcoming' | 'not_relevant'
|
|
#
|
|
# opts:
|
|
# last_completed_dt => DateTime or undef
|
|
# upcoming_horizon => integer days (default 7)
|
|
# medium_float_days => integer (default 3)
|
|
|
|
sub status {
|
|
my ($class, $task, $today, %opts) = @_;
|
|
return 'inactive' unless $task->{active};
|
|
return _resolve($task, $today, %opts)->{status};
|
|
}
|
|
|
|
# resolve($class, $task_href, $today_dt, %opts) → \%result
|
|
# %result keys:
|
|
# status => same strings as status()
|
|
# date => DateTime of relevant occurrence (or undef)
|
|
# overdue → the missed date; due → that date; upcoming → next date
|
|
# days_until => integer: negative=overdue, 0=due, positive=upcoming (undef for floating/inactive)
|
|
|
|
sub resolve {
|
|
my ($class, $task, $today, %opts) = @_;
|
|
return { status => 'inactive', date => undef, days_until => undef }
|
|
unless $task->{active};
|
|
my $r = _resolve($task, $today, %opts);
|
|
if (defined $r->{date}) {
|
|
$r->{days_until} = _days_diff($today, $r->{date});
|
|
}
|
|
return $r;
|
|
}
|
|
|
|
# -----------------------------------------------------------------------
|
|
# Internal dispatcher
|
|
# -----------------------------------------------------------------------
|
|
|
|
sub _resolve {
|
|
my ($task, $today, %opts) = @_;
|
|
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";
|
|
}
|
|
|
|
# -----------------------------------------------------------------------
|
|
# Per-class handlers — all return { status => ..., date => ... }
|
|
# -----------------------------------------------------------------------
|
|
|
|
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);
|
|
|
|
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;
|
|
}
|
|
|
|
my $pre_creation = $created && _cmp($curr_occ, $created) < 0;
|
|
my $completed = $pre_creation
|
|
|| ($last_comp && _cmp($last_comp, $curr_occ) >= 0);
|
|
|
|
unless ($completed) {
|
|
my $st = _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
|
|
return { status => $st, date => $curr_occ };
|
|
}
|
|
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) {
|
|
my $st = _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
|
|
return { status => $st, date => $curr_occ };
|
|
}
|
|
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});
|
|
|
|
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) {
|
|
my $st = _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
|
|
return { status => $st, date => $curr_occ };
|
|
}
|
|
return _from_next($next_occ, $today, $horizon);
|
|
}
|
|
|
|
sub _interval {
|
|
my ($task, $today, $last_comp, $horizon) = @_;
|
|
my $interval = $task->{interval_days};
|
|
|
|
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);
|
|
|
|
return { status => 'overdue', date => $next_due } if $days < 0;
|
|
return { status => 'due', date => $next_due } if $days == 0;
|
|
return { status => 'upcoming', date => $next_due } if $days <= $horizon;
|
|
return { status => 'not_relevant', date => undef };
|
|
}
|
|
|
|
sub _floating {
|
|
my ($task, $today, $medium_days) = @_;
|
|
my $priority = $task->{priority} // 'medium';
|
|
|
|
return { status => 'due', date => undef } 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') {
|
|
my $shown = $days_since % $medium_days == 0;
|
|
return { status => $shown ? 'due' : 'not_relevant', date => undef };
|
|
}
|
|
|
|
if ($priority eq 'low') {
|
|
my $task_id = $task->{id} // 0;
|
|
my $shown = ($days_since + $task_id) % LOW_FLOAT_DAYS == 0;
|
|
return { status => $shown ? 'due' : 'not_relevant', date => undef };
|
|
}
|
|
|
|
return { status => 'not_relevant', date => undef };
|
|
}
|
|
|
|
# -----------------------------------------------------------------------
|
|
# Date helpers
|
|
# -----------------------------------------------------------------------
|
|
|
|
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));
|
|
}
|
|
|
|
# weekday: 1=Mon .. 7=Sun (DateTime day_of_week); ordinal: 1-4 or -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);
|
|
}
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
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') {
|
|
my $total_months = ($today->year - $anchor->year) * 12
|
|
+ ($today->month - $anchor->month);
|
|
my $k = int($total_months / $n);
|
|
$k = 0 if $k < 0;
|
|
|
|
while (1) {
|
|
last if _cmp(_add_period($anchor, $k + 1, $n, $unit), $today) > 0;
|
|
$k++;
|
|
}
|
|
while ($k > 0) {
|
|
last if _cmp(_add_period($anchor, $k, $n, $unit), $today) <= 0;
|
|
$k--;
|
|
}
|
|
return $k;
|
|
}
|
|
croak "Unknown period_unit: $unit";
|
|
}
|
|
|
|
# Days from d1 to d2 using Julian Day Numbers — DST-safe (never counts seconds).
|
|
sub _days_diff {
|
|
my ($d1, $d2) = @_;
|
|
return int($d2->jd - $d1->jd);
|
|
}
|
|
|
|
sub _from_next {
|
|
my ($next, $today, $horizon) = @_;
|
|
my $days = _days_diff($today, $next);
|
|
return { status => 'due', date => $next } if $days == 0;
|
|
return { status => 'upcoming', date => $next } if $days > 0 && $days <= $horizon;
|
|
return { status => 'not_relevant', date => undef };
|
|
}
|
|
|
|
sub _cmp { DateTime->compare($_[0], $_[1]) }
|
|
|
|
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 { _parse_date($_[0]->{created_at}) }
|
|
|
|
1;
|