Finished Digest.pm and testing script

This commit is contained in:
Rodger Castle 2026-06-04 15:21:24 -04:00
parent df0babf775
commit c2d300d2f8
4 changed files with 591 additions and 83 deletions

View File

@ -129,6 +129,29 @@ sub config_set {
); );
} }
# --- Task / completion queries used by Digest ---
# Returns arrayref of all active task hashrefs, ordered by title.
sub active_tasks {
my ($self) = @_;
return $self->{_dbh}->selectall_arrayref(
'SELECT * FROM tasks WHERE active = 1 ORDER BY title',
{ Slice => {} }
);
}
# Returns { task_id => last_completed_at_ISO_string } for every task that has
# at least one completion row.
sub last_completions {
my ($self) = @_;
my $rows = $self->{_dbh}->selectall_arrayref(
'SELECT task_id, MAX(completed_at) AS completed_at
FROM completions GROUP BY task_id',
{ Slice => {} }
);
return { map { $_->{task_id} => $_->{completed_at} } @$rows };
}
sub DESTROY { sub DESTROY {
my ($self) = @_; my ($self) = @_;
$self->{_dbh}->disconnect if $self->{_dbh}; $self->{_dbh}->disconnect if $self->{_dbh};

View File

@ -1,27 +1,301 @@
package Mnemosyne::Digest; package Mnemosyne::Digest;
use strict; use strict;
use warnings; use warnings;
use DateTime;
use Mnemosyne::Schedule;
use Carp qw(croak);
# Assembles the "Day at a Glance" digest content and sends it via Telegram. use constant TELEGRAM_MAX_LEN => 4096;
# Also used by the /today and /glance commands for on-demand delivery.
my @MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @WEEKDAYS = qw(Mon Tue Wed Thu Fri Sat Sun);
# -----------------------------------------------------------------------
# Public interface
# -----------------------------------------------------------------------
# build($class, $db, $today_dt) → \%digest
# #
# Sections (in order), each omitted when empty: # Returns:
# 1. Overdue — dated tasks past their due date with no completion # {
# 2. Today — tasks due today # date => $today_dt,
# 3. Upcoming — tasks due in the next upcoming_horizon days (default 7) # sections => [
# 4. Floating — priority-driven selection per Schedule::_floating_show rules # { key => 'overdue', header => '...', tasks => [$enriched_task, ...] },
# { key => 'due', header => '...', tasks => [...] },
# { key => 'upcoming', header => '...', tasks => [...] },
# { key => 'floating', header => '...', tasks => [...] },
# ],
# all_clear => 0|1,
# }
# #
# Each actionable line gets a Mark Done inline keyboard button. # Each $enriched_task is the DB task hashref plus:
# A friendly "all clear" line is shown when all sections are empty. # status => 'overdue'|'due'|'upcoming'
# # date => DateTime or undef
# TODO: build($db, $config, $today_dt) — returns an arrayref of message segments # days_until => integer (negative = N days overdue; positive = N days away)
# (Telegram has a 4096-char limit; split into multiple messages if needed)
# sub build {
# TODO: send($db, $config, $telegram, $chat_id, $today_dt) my ($class, $db, $today) = @_;
# — calls build(), sends via Telegram, records last_digest_sent in config table
# my $horizon = ($db->config_get('upcoming_horizon') // 7) + 0;
# TODO: already_sent_today($db, $today_dt) my $medium_days = ($db->config_get('medium_float_days') // 3) + 0;
# — checks last_digest_sent config row; returns true if digest was sent today
# — used by mnemosyne-digest script to prevent duplicate sends my $tasks = $db->active_tasks;
my $last_comps = $db->last_completions; # { task_id => ISO string }
my (@overdue, @due, @upcoming, @floating);
for my $task (@$tasks) {
my $lc_str = $last_comps->{ $task->{id} };
my $lc_dt = $lc_str ? _parse_dt($lc_str) : undef;
my $r = Mnemosyne::Schedule->resolve(
$task, $today,
last_completed_dt => $lc_dt,
upcoming_horizon => $horizon,
medium_float_days => $medium_days,
);
my $enriched = { %$task, %$r };
my $st = $r->{status};
if ($task->{class} eq 'floating') {
push @floating, $enriched if $st eq 'due';
} else {
if ($st eq 'overdue') { push @overdue, $enriched }
elsif ($st eq 'due') { push @due, $enriched }
elsif ($st eq 'upcoming') { push @upcoming, $enriched }
}
}
# Sort each bucket
@overdue = sort { $a->{days_until} <=> $b->{days_until}
|| $a->{title} cmp $b->{title} } @overdue; # most-overdue first
@due = sort { $a->{title} cmp $b->{title} } @due;
@upcoming = sort { $a->{days_until} <=> $b->{days_until}
|| $a->{title} cmp $b->{title} } @upcoming; # soonest first
my %pri = (high => 1, medium => 2, low => 3);
@floating = sort { ($pri{$a->{priority}//''} // 9) <=> ($pri{$b->{priority}//''} // 9)
|| $a->{title} cmp $b->{title} } @floating;
my $date_str = _fmt_date_long($today);
my @sections;
push @sections, { key => 'overdue', header => "\x{1F534} Overdue",
tasks => \@overdue } if @overdue;
push @sections, { key => 'due', header => "\x{1F4C5} Today \x{2014} $date_str",
tasks => \@due } if @due;
push @sections, { key => 'upcoming', header => "\x{1F440} Upcoming (next $horizon days)",
tasks => \@upcoming } if @upcoming;
push @sections, { key => 'floating', header => "\x{1F4AD} On the radar",
tasks => \@floating } if @floating;
return {
date => $today,
sections => \@sections,
all_clear => (@sections == 0) ? 1 : 0,
};
}
# already_sent_today($class, $db, $today_dt) → bool
sub already_sent_today {
my ($class, $db, $today) = @_;
my $last = $db->config_get('last_digest_sent') // '';
return $last eq $today->strftime('%Y-%m-%d');
}
# -----------------------------------------------------------------------
# Rendering — plain text (terminal / debug)
# -----------------------------------------------------------------------
# render_text($class, $digest) → $string
sub render_text {
my ($class, $digest) = @_;
my $width = 50;
my $rule = "\x{2501}" x $width; # ━━━
my $out = '';
$out .= "$rule\n";
$out .= _center("Day at a Glance", $width) . "\n";
$out .= _center(_fmt_date_long($digest->{date}), $width) . "\n";
$out .= "$rule\n";
if ($digest->{all_clear}) {
$out .= "\n \x{2705} All clear \x{2014} nothing on the radar today.\n";
} else {
for my $sec (@{ $digest->{sections} }) {
$out .= "\n$sec->{header}\n\n";
for my $task (@{ $sec->{tasks} }) {
$out .= _render_task_text($task, $sec->{key});
}
}
}
$out .= "\n$rule\n";
return $out;
}
sub _render_task_text {
my ($task, $section_key) = @_;
my $title = $task->{title};
my $detail = '';
if ($section_key eq 'overdue') {
my $days = abs($task->{days_until} // 0);
my $since = $task->{date} ? _fmt_date($task->{date}) : '?';
$detail = "since $since" . ($days > 0 ? " \x{B7} $days day" . ($days == 1 ? '' : 's') . " overdue" : '');
} elsif ($section_key eq 'upcoming') {
my $days = $task->{days_until} // 0;
my $when = $task->{date} ? _fmt_date($task->{date}) : '?';
my $rel = $days == 1 ? 'tomorrow' : "in $days days";
$detail = "$when \x{B7} $rel";
} elsif ($section_key eq 'floating') {
my %stars = (high => "\x{2605}\x{2605}\x{2605}", medium => "\x{2605}\x{2605}", low => "\x{2605}");
$detail = ($stars{ $task->{priority} // '' } // '?') . ' ' . ($task->{priority} // '');
}
my $line;
if ($detail) {
$line = sprintf(" \x{2022} %-28s %s\n", $title, $detail);
} else {
$line = " \x{2022} $title\n";
}
return $line;
}
# -----------------------------------------------------------------------
# Rendering — Telegram HTML
# -----------------------------------------------------------------------
# render_telegram($class, $digest) → \@parts
# Each part: { text => $html_string, task_ids => [$id, ...] }
# task_ids is the ordered list of actionable tasks in this message (for inline keyboard).
sub render_telegram {
my ($class, $digest) = @_;
my @parts;
my ($cur_text, @cur_ids) = ('');
my $flush = sub {
return unless length $cur_text;
push @parts, { text => $cur_text, task_ids => [@cur_ids] };
($cur_text, @cur_ids) = ('');
};
if ($digest->{all_clear}) {
$cur_text = "\x{2705} All clear \x{2014} nothing on the radar today.";
$flush->();
return \@parts;
}
for my $sec (@{ $digest->{sections} }) {
my $block = "<b>$sec->{header}</b>\n\n";
my @block_ids;
for my $task (@{ $sec->{tasks} }) {
my ($line, $is_actionable) = _render_task_html($task, $sec->{key});
$block .= $line;
push @block_ids, $task->{id} if $is_actionable;
}
$block .= "\n";
# Start a new message if this block would push us over the limit
if (length($cur_text) + length($block) > TELEGRAM_MAX_LEN) {
$flush->();
}
$cur_text .= $block;
push @cur_ids, @block_ids;
}
$flush->();
return \@parts;
}
sub _render_task_html {
my ($task, $section_key) = @_;
my $title = _html_esc($task->{title});
my $detail = '';
if ($section_key eq 'overdue') {
my $days = abs($task->{days_until} // 0);
my $since = $task->{date} ? _fmt_date($task->{date}) : '?';
$detail = "<i>since $since" . ($days > 0 ? " \x{B7} $days day" . ($days==1?'':'s') . " overdue" : '') . "</i>";
} elsif ($section_key eq 'upcoming') {
my $days = $task->{days_until} // 0;
my $when = $task->{date} ? _fmt_date($task->{date}) : '?';
my $rel = $days == 1 ? 'tomorrow' : "in $days days";
$detail = "<i>$when \x{B7} $rel</i>";
} elsif ($section_key eq 'floating') {
my %stars = (high => "\x{2605}\x{2605}\x{2605}", medium => "\x{2605}\x{2605}", low => "\x{2605}");
$detail = $stars{ $task->{priority} // '' } // '';
}
my $line = "\x{2022} $title" . ($detail ? " $detail" : '') . "\n";
return ($line, 1); # 1 = actionable (all digest tasks get a Mark Done button)
}
# -----------------------------------------------------------------------
# Send (stub — requires Telegram.pm)
# -----------------------------------------------------------------------
sub send {
my ($class, $db, $telegram, $chat_id, $today) = @_;
croak "send() requires a Telegram client" unless $telegram;
return if $class->already_sent_today($db, $today);
my $digest = $class->build($db, $today);
my $parts = $class->render_telegram($digest);
for my $part (@$parts) {
$telegram->send_message(
$chat_id,
$part->{text},
parse_mode => 'HTML',
# reply_markup built by Telegram.pm once that module exists:
# reply_markup => Mnemosyne::Telegram->mark_done_keyboard($part->{task_ids}),
);
}
$db->config_set('last_digest_sent', $today->strftime('%Y-%m-%d'));
}
# -----------------------------------------------------------------------
# Helpers
# -----------------------------------------------------------------------
sub _parse_dt {
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 _fmt_date {
my ($dt) = @_;
return sprintf('%s %s %d', $WEEKDAYS[$dt->day_of_week - 1], $MONTHS[$dt->month - 1], $dt->day);
}
sub _fmt_date_long {
my ($dt) = @_;
return sprintf('%s, %s %d %d', $WEEKDAYS[$dt->day_of_week - 1],
$MONTHS[$dt->month - 1],
$dt->day,
$dt->year);
}
sub _center {
my ($str, $width) = @_;
my $pad = int(($width - length($str)) / 2);
$pad = 0 if $pad < 0;
return (' ' x $pad) . $str;
}
sub _html_esc {
my ($s) = @_;
$s =~ s/&/&amp;/g;
$s =~ s/</&lt;/g;
$s =~ s/>/&gt;/g;
return $s;
}
1; 1;

View File

@ -10,22 +10,48 @@ use constant {
LOW_FLOAT_DAYS => 7, LOW_FLOAT_DAYS => 7,
}; };
# -----------------------------------------------------------------------
# Public interface # Public interface
# ----------------------------------------------------------------------- # -----------------------------------------------------------------------
# status($class, $task_href, $today_dt, %opts) → one of: # status($class, $task_href, $today_dt, %opts) → string
# 'inactive' | 'due' | 'overdue' | 'upcoming' | 'not_relevant' # 'inactive' | 'due' | 'overdue' | 'upcoming' | 'not_relevant'
# #
# opts: # opts:
# last_completed_dt => DateTime or undef (most recent completion) # last_completed_dt => DateTime or undef
# upcoming_horizon => integer days (default 7) # upcoming_horizon => integer days (default 7)
# medium_float_days => integer (default 3) # medium_float_days => integer (default 3)
sub status { sub status {
my ($class, $task, $today, %opts) = @_; my ($class, $task, $today, %opts) = @_;
return 'inactive' unless $task->{active}; 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 $horizon = $opts{upcoming_horizon} // UPCOMING_HORIZON;
my $medium_days = $opts{medium_float_days} // MEDIUM_FLOAT_DAYS; my $medium_days = $opts{medium_float_days} // MEDIUM_FLOAT_DAYS;
my $last_comp = $opts{last_completed_dt}; my $last_comp = $opts{last_completed_dt};
@ -39,12 +65,8 @@ sub status {
croak "Unknown task class: $tc"; 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 # Per-class handlers — all return { status => ..., date => ... }
# ----------------------------------------------------------------------- # -----------------------------------------------------------------------
sub _monthly_date { sub _monthly_date {
@ -54,8 +76,6 @@ sub _monthly_date {
my $this_occ = _dom_in_month($dom, $today->year, $today->month); 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); my ($curr_occ, $next_occ);
if (_cmp($this_occ, $today) <= 0) { if (_cmp($this_occ, $today) <= 0) {
$curr_occ = $this_occ; $curr_occ = $this_occ;
@ -67,13 +87,13 @@ sub _monthly_date {
$next_occ = $this_occ; $next_occ = $this_occ;
} }
# Pre-creation occurrences carry no obligation
my $pre_creation = $created && _cmp($curr_occ, $created) < 0; my $pre_creation = $created && _cmp($curr_occ, $created) < 0;
my $completed = $pre_creation my $completed = $pre_creation
|| ($last_comp && _cmp($last_comp, $curr_occ) >= 0); || ($last_comp && _cmp($last_comp, $curr_occ) >= 0);
unless ($completed) { unless ($completed) {
return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue'; my $st = _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
return { status => $st, date => $curr_occ };
} }
return _from_next($next_occ, $today, $horizon); return _from_next($next_occ, $today, $horizon);
} }
@ -101,7 +121,8 @@ sub _monthly_weekday {
|| ($last_comp && _cmp($last_comp, $curr_occ) >= 0); || ($last_comp && _cmp($last_comp, $curr_occ) >= 0);
unless ($completed) { unless ($completed) {
return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue'; my $st = _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
return { status => $st, date => $curr_occ };
} }
return _from_next($next_occ, $today, $horizon); return _from_next($next_occ, $today, $horizon);
} }
@ -112,7 +133,6 @@ sub _every_n_period {
or croak "every_n_period task missing valid anchor_date"; or croak "every_n_period task missing valid anchor_date";
my ($n, $unit) = ($task->{interval_n}, $task->{period_unit}); my ($n, $unit) = ($task->{interval_n}, $task->{period_unit});
# Anchor hasn't arrived yet
if (_cmp($anchor, $today) > 0) { if (_cmp($anchor, $today) > 0) {
return _from_next($anchor, $today, $horizon); return _from_next($anchor, $today, $horizon);
} }
@ -124,7 +144,8 @@ sub _every_n_period {
my $completed = $last_comp && _cmp($last_comp, $curr_occ) >= 0; my $completed = $last_comp && _cmp($last_comp, $curr_occ) >= 0;
unless ($completed) { unless ($completed) {
return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue'; my $st = _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
return { status => $st, date => $curr_occ };
} }
return _from_next($next_occ, $today, $horizon); return _from_next($next_occ, $today, $horizon);
} }
@ -133,57 +154,54 @@ sub _interval {
my ($task, $today, $last_comp, $horizon) = @_; my ($task, $today, $last_comp, $horizon) = @_;
my $interval = $task->{interval_days}; 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 my $seed = $last_comp
? $last_comp->clone->truncate(to => 'day') ? $last_comp->clone->truncate(to => 'day')
: _created_date($task); : _created_date($task);
my $next_due = $seed->clone->add(days => $interval); my $next_due = $seed->clone->add(days => $interval);
my $days = _days_diff($today, $next_due); # positive = future my $days = _days_diff($today, $next_due);
return 'overdue' if $days < 0; return { status => 'overdue', date => $next_due } if $days < 0;
return 'due' if $days == 0; return { status => 'due', date => $next_due } if $days == 0;
return 'upcoming' if $days <= $horizon; return { status => 'upcoming', date => $next_due } if $days <= $horizon;
return 'not_relevant'; return { status => 'not_relevant', date => undef };
} }
sub _floating { sub _floating {
my ($task, $today, $medium_days) = @_; my ($task, $today, $medium_days) = @_;
my $priority = $task->{priority} // 'medium'; my $priority = $task->{priority} // 'medium';
return 'due' if $priority eq 'high'; return { status => 'due', date => undef } if $priority eq 'high';
my $created = _created_date($task); my $created = _created_date($task);
my $days_since = _days_diff($created, $today); my $days_since = _days_diff($created, $today);
$days_since = 0 if $days_since < 0; $days_since = 0 if $days_since < 0;
if ($priority eq 'medium') { if ($priority eq 'medium') {
return $days_since % $medium_days == 0 ? 'due' : 'not_relevant'; my $shown = $days_since % $medium_days == 0;
return { status => $shown ? 'due' : 'not_relevant', date => undef };
} }
if ($priority eq 'low') { if ($priority eq 'low') {
my $task_id = $task->{id} // 0; my $task_id = $task->{id} // 0;
return ($days_since + $task_id) % LOW_FLOAT_DAYS == 0 ? 'due' : 'not_relevant'; my $shown = ($days_since + $task_id) % LOW_FLOAT_DAYS == 0;
return { status => $shown ? 'due' : 'not_relevant', date => undef };
} }
return 'not_relevant'; return { status => 'not_relevant', date => undef };
} }
# ----------------------------------------------------------------------- # -----------------------------------------------------------------------
# Date helpers # 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 { sub _dom_in_month {
my ($dom, $year, $month) = @_; my ($dom, $year, $month) = @_;
my $last = DateTime->last_day_of_month(year => $year, month => $month)->day; my $last = DateTime->last_day_of_month(year => $year, month => $month)->day;
return DateTime->new(year => $year, month => $month, day => ($dom > $last ? $last : $dom)); 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 or -1 for last
# weekday: 1=Mon .. 7=Sun (DateTime day_of_week)
# ordinal: 1-4 for first-fourth, -1 for last
sub _nth_weekday { sub _nth_weekday {
my ($year, $month, $weekday, $ordinal) = @_; my ($year, $month, $weekday, $ordinal) = @_;
if ($ordinal == -1) { if ($ordinal == -1) {
@ -197,45 +215,35 @@ sub _nth_weekday {
} }
} }
# Advance an anchor by k * (n period_units), with end-of-month clamping for months.
sub _add_period { sub _add_period {
my ($anchor, $k, $n, $unit) = @_; my ($anchor, $k, $n, $unit) = @_;
return $anchor->clone if $k == 0; return $anchor->clone if $k == 0;
my $dt = $anchor->clone; my $dt = $anchor->clone;
if ($unit eq 'day') { $dt->add(days => $k * $n) } if ($unit eq 'day') { $dt->add(days => $k * $n) }
elsif ($unit eq 'week') { $dt->add(weeks => $k * $n) } elsif ($unit eq 'week') { $dt->add(weeks => $k * $n) }
elsif ($unit eq 'month') { $dt->add(months => $k * $n, end_of_month => 'limit') } elsif ($unit eq 'month') { $dt->add(months => $k * $n, end_of_month => 'limit') }
else { croak "Unknown period_unit: $unit" } else { croak "Unknown period_unit: $unit" }
return $dt; return $dt;
} }
# Largest k such that anchor + k*(n units) <= today.
sub _find_k { sub _find_k {
my ($anchor, $n, $unit, $today) = @_; my ($anchor, $n, $unit, $today) = @_;
if ($unit eq 'day') { if ($unit eq 'day') { return int(_days_diff($anchor, $today) / $n) }
return int(_days_diff($anchor, $today) / $n); if ($unit eq 'week') { return int(_days_diff($anchor, $today) / ($n * 7)) }
}
if ($unit eq 'week') {
return int(_days_diff($anchor, $today) / ($n * 7));
}
if ($unit eq 'month') { if ($unit eq 'month') {
# Approximate, then walk to correct value
my $total_months = ($today->year - $anchor->year) * 12 my $total_months = ($today->year - $anchor->year) * 12
+ ($today->month - $anchor->month); + ($today->month - $anchor->month);
my $k = int($total_months / $n); my $k = int($total_months / $n);
$k = 0 if $k < 0; $k = 0 if $k < 0;
# Ensure anchor + (k+1)*period > today
while (1) { while (1) {
my $next = _add_period($anchor, $k + 1, $n, $unit); last if _cmp(_add_period($anchor, $k + 1, $n, $unit), $today) > 0;
last if _cmp($next, $today) > 0;
$k++; $k++;
} }
# Ensure anchor + k*period <= today
while ($k > 0) { while ($k > 0) {
my $curr = _add_period($anchor, $k, $n, $unit); last if _cmp(_add_period($anchor, $k, $n, $unit), $today) <= 0;
last if _cmp($curr, $today) <= 0;
$k--; $k--;
} }
return $k; return $k;
@ -243,35 +251,28 @@ sub _find_k {
croak "Unknown period_unit: $unit"; croak "Unknown period_unit: $unit";
} }
# Days from d1 to d2 (positive if d2 is later). # Days from d1 to d2 using Julian Day Numbers — DST-safe (never counts seconds).
# Uses Julian Day Numbers — safe across DST boundaries (never counts seconds).
sub _days_diff { sub _days_diff {
my ($d1, $d2) = @_; my ($d1, $d2) = @_;
return int($d2->jd - $d1->jd); return int($d2->jd - $d1->jd);
} }
# Status based solely on how far away the next occurrence is.
sub _from_next { sub _from_next {
my ($next, $today, $horizon) = @_; my ($next, $today, $horizon) = @_;
my $days = _days_diff($today, $next); my $days = _days_diff($today, $next);
return 'due' if $days == 0; return { status => 'due', date => $next } if $days == 0;
return 'upcoming' if $days > 0 && $days <= $horizon; return { status => 'upcoming', date => $next } if $days > 0 && $days <= $horizon;
return 'not_relevant'; return { status => 'not_relevant', date => undef };
} }
# Compare two DateTime objects; returns -1, 0, 1.
sub _cmp { DateTime->compare($_[0], $_[1]) } sub _cmp { DateTime->compare($_[0], $_[1]) }
# Parse an ISO date/datetime string to a day-granular DateTime.
sub _parse_date { sub _parse_date {
my ($s) = @_; my ($s) = @_;
return undef unless defined $s && $s =~ /^(\d{4})-(\d{2})-(\d{2})/; return undef unless defined $s && $s =~ /^(\d{4})-(\d{2})-(\d{2})/;
return DateTime->new(year => $1+0, month => $2+0, day => $3+0); return DateTime->new(year => $1+0, month => $2+0, day => $3+0);
} }
sub _created_date { sub _created_date { _parse_date($_[0]->{created_at}) }
my ($task) = @_;
return _parse_date($task->{created_at});
}
1; 1;

210
scripts/print-digest Executable file
View File

@ -0,0 +1,210 @@
#!/usr/bin/env perl
# print-digest — seeds a temporary in-memory database with sample tasks covering
# all five task classes and every status bucket, then prints the Day at a Glance
# digest to the terminal. No Telegram connection required.
#
# Reference date: 2026-06-04 (Thu) ← pinned so the output is reproducible.
# Pass --date YYYY-MM-DD to use a different date.
#
# Usage:
# perl scripts/print-digest
# perl scripts/print-digest --date 2026-07-01
use strict;
use warnings;
use utf8;
use open ':std', ':encoding(UTF-8)';
use FindBin qw($RealBin);
use lib "$RealBin/../lib";
use DateTime;
use Mnemosyne::DB;
use Mnemosyne::Digest;
# ---- reference date -------------------------------------------------------
my $ref_date_str = '2026-06-04';
while (@ARGV) {
my $arg = shift @ARGV;
if ($arg eq '--date' && @ARGV) { $ref_date_str = shift @ARGV }
}
$ref_date_str =~ /^(\d{4})-(\d{2})-(\d{2})$/ or die "Bad date: $ref_date_str\n";
my $TODAY = DateTime->new(year => $1+0, month => $2+0, day => $3+0);
# ---- in-memory database ---------------------------------------------------
my $db = Mnemosyne::DB->new(':memory:');
my $dbh = $db->dbh;
# Helper: insert a task row, return its new id
sub insert_task {
my (%h) = @_;
$dbh->do(q{
INSERT INTO tasks
(title, notes, class, active,
day_of_month, weekday, ordinal,
interval_n, period_unit, anchor_date,
interval_days, priority, created_at)
VALUES (?,?,?,?, ?,?,?, ?,?,?, ?,?,?)
}, undef,
$h{title}, $h{notes}//'', $h{class}, $h{active}//1,
$h{day_of_month}, $h{weekday}, $h{ordinal},
$h{interval_n}, $h{period_unit},$h{anchor_date},
$h{interval_days},$h{priority}, $h{created_at}//'2026-01-01T00:00:00Z',
);
return $dbh->last_insert_id(undef,undef,'tasks',undef);
}
sub complete { # mark task done on a given date
my ($task_id, $date_str) = @_;
$dbh->do("INSERT INTO completions (task_id, completed_at) VALUES (?,?)",
undef, $task_id, "${date_str}T12:00:00Z");
}
# ===========================================================================
# Seed data — all dates chosen relative to TODAY = 2026-06-04 (Thu)
#
# Jun 2026: Jun 1=Mon, Jun 4=Thu, Jun 6=Sat, Jun 8=Mon, Jun 11=Thu
# May 2026: May 1=Fri, May 7=Thu, May 8=Fri, May 28=Thu
# ===========================================================================
# ── OVERDUE ─────────────────────────────────────────────────────────────────
# monthly_date: fires on the 1st; Jun 1 was 3 days ago, no completion
my $id1 = insert_task(
title => 'Pay credit card',
class => 'monthly_date',
day_of_month => 1,
notes => 'Autopay is off — do it manually',
);
# interval: every 90 days from 2026-01-01 → due 2026-04-01, now 64 days overdue
my $id2 = insert_task(
title => 'Rotate tires',
class => 'interval',
interval_days => 90,
created_at => '2026-01-01T00:00:00Z',
);
# ── DUE TODAY (2026-06-04) ──────────────────────────────────────────────────
# monthly_weekday: 1st Thursday of every month; May's was May 7 (completed), June's is Jun 4
my $id3 = insert_task(
title => 'Weekly review',
class => 'monthly_weekday',
weekday => 4, # 4 = Thursday (DateTime: 1=Mon..7=Sun)
ordinal => 1,
);
complete($id3, '2026-05-07'); # completed last month's occurrence
# interval: every 7 days; last done 2026-05-28 → next due 2026-06-04
my $id4 = insert_task(
title => 'Backup servers',
class => 'interval',
interval_days => 7,
);
complete($id4, '2026-05-28');
# ── UPCOMING ────────────────────────────────────────────────────────────────
# monthly_date: fires on the 8th; May 8 completed → Jun 8 is 4 days out
my $id5 = insert_task(
title => 'Pay rent',
class => 'monthly_date',
day_of_month => 8,
);
complete($id5, '2026-05-08');
# every_n_period: anchor 2026-06-06 (future) → 2 days out; recurs weekly
my $id6 = insert_task(
title => 'Newsletter draft',
class => 'every_n_period',
interval_n => 1,
period_unit => 'week',
anchor_date => '2026-06-06',
);
# every_n_period: anchor 2026-06-11 (future) → 7 days out; recurs weekly
my $id7 = insert_task(
title => 'Team meeting prep',
class => 'every_n_period',
interval_n => 1,
period_unit => 'week',
anchor_date => '2026-06-11',
);
# ── FLOATING ────────────────────────────────────────────────────────────────
# id=8: low priority, created Jun 4 → days_since=0; (0+8)%7=1 → NOT shown (rotation)
# id=9: low priority, created Jun 4 → days_since=0; (0+9)%7=2 → NOT shown
# We want id=7 for a shown low item: (0+7)%7=0 → shown.
# Insert order above gives us id 1-7 already used; next inserts get 8+.
# So: insert a "shown low" task at a created_at where days_since makes it work.
# days_since=6, id=8: (6+8)%7=0 → shown. created_at = Jun 4 - 6 days = May 29.
my $id8 = insert_task(
title => 'Learn Spanish',
class => 'floating',
priority => 'low',
created_at => '2026-05-29T00:00:00Z', # days_since=6; (6+8)%7=0 → shown
);
# medium: created Jun 1 → days_since=3; 3%3=0 → shown
my $id9 = insert_task(
title => 'Call parents',
class => 'floating',
priority => 'medium',
created_at => '2026-06-01T00:00:00Z',
);
# high: always shown
my $id10 = insert_task(
title => 'Plan summer vacation',
class => 'floating',
priority => 'high',
);
# low task that is NOT shown today (demonstrates rotation)
my $id11 = insert_task(
title => 'Read more books',
class => 'floating',
priority => 'low',
created_at => '2026-06-04T00:00:00Z', # days_since=0; (0+11)%7=4 → not shown
);
# inactive task — should never appear
insert_task(
title => 'Old habit tracker',
class => 'floating',
active => 0,
);
# ===========================================================================
# Build and render
# ===========================================================================
my $digest = Mnemosyne::Digest->build($db, $TODAY);
print Mnemosyne::Digest->render_text($digest);
# Also dump a quick summary of what's hidden (for verification)
print "\n[Hidden floating tasks — not shown today by rotation/frequency:\n";
my $all = $db->active_tasks;
my $lc_map = $db->last_completions;
for my $task (grep { $_->{class} eq 'floating' } @$all) {
my $r = Mnemosyne::Schedule->resolve($task, $TODAY);
if ($r->{status} eq 'not_relevant') {
my $id = $task->{id};
my $created = substr($task->{created_at}, 0, 10);
my $days_since = DateTime->compare(
DateTime->new(year=>substr($created,0,4)+0,
month=>substr($created,5,2)+0,
day=>substr($created,8,2)+0),
$TODAY
);
# compute days_since manually
my $cd = DateTime->new(year=>substr($created,0,4)+0,
month=>substr($created,5,2)+0,
day=>substr($created,8,2)+0);
my $ds = int($TODAY->jd - $cd->jd);
print " • $task->{title} (id=$id, priority=$task->{priority}, days_since=$ds, "
. "show_check=" . (($ds + $id) % 7) . " mod 7)\n";
}
}
print "]\n";