App-karr
view release on metacpan or search on metacpan
.claude/agents/karr-board-worker.md view on Meta::CPAN
- getty-perl-moo
---
You are the board-domain worker for **App::karr**. Implement and debug the behavior users
mean when they talk about tasks, statuses, claims, dependencies, filtering, sorting, output,
and activity history. Apply the loaded conventions silently.
## Territory
- `lib/App/karr/Task.pm`, `Config.pm`, `ActivityLog.pm`, and `CrossBoard.pm`
- `Role/TaskMutation.pm`, `DependencyCheck.pm`, `DependencyArgs.pm`, `ClaimTimeout.pm`,
`Output.pm`, `CliArgs.pm`, and `ExitCodes.pm`
- the root CLI and ordinary board commands: `create`, `edit`, `move`, `pick`, `handoff`,
`archive`, `delete`, `list`, `show`, `board`, `context`, `log`, `config`,
`agent-name`, `metrics`, and `needs`
Own a vertical behavior slice, including its command wiring and a focused regression test.
Read the immediate callers and the store contract before changing semantics.
## Boundaries
`--not-blocked` and `--unclaimed`, and `--sort title` (k237, k252).
The cut is the last stage, after filter and sort, so `--sort priority
-n 5` is the five most urgent cards and it applies to `--json` and
`--compact` alike; `0` is no limit and a negative count is a usage
error. An unknown `--class` names the board's own classes and exits 2
rather than printing an empty list, and `--blocked` with
`--not-blocked` is refused. `--unclaimed` lists the cards no
live claim holds -- `claimed_by` unset, empty, or a claim past
`claim_timeout` -- which k237 had taken for a duplicate of
`--claimed-by` but asks a different question; it shares one claim
test with `karr pick` (`Role::ClaimTimeout::claim_held`) so the two
cannot disagree about what is free (k198's shape), and passing it
with `--claimed-by` is a usage error. `--sort title` compares
case-insensitively as kanban-md does, ties break on `id`, and the
comparison is on characters and not collated -- a non-ASCII title
sorts behind every ASCII one, a documented non-goal rather than a gap
(a collating comparator would need a locale two agents need not
share).
- `karr pick` ranks two `fixed-date` cards by the sooner due date
before priority, matching kanban-md's `compareDue`: the one
on its consumer (ticket k141): `git` and `store` from
`Role::BoardDiscovery`, `save_task` and `log_task_write` from
`Role::BoardAccess`, `json` from `Role::Output`. It declared nothing at
all, and composed cleanly into anything, which is the state k128 found
`Role::DependencyCheck` in — so a future command reaching for
`update_task_guarded` would have inherited a compare-and-swap loop whose
collaborators nobody had checked for, and learned about it from inside
the callback as a "Can't locate object method". No command changes: all
five on the mutation path already compose both supplying roles, which is
what hid the gap. The ticket proposed six names; `check_claim` is not
one, because it comes from `Role::ClaimTimeout`, which this role
composes, exactly as `check_dependencies` comes from
`Role::DependencyCheck`. Requiring either would never fail — Role::Tiny
installs a role's methods into the consumer before checking its
requires, so the check finds what the composition just put there. `json`
is now declared twice, here and on `Role::DependencyCheck`; that is
deliberate, since a role that lets one it happens to compose declare a
collaborator on its behalf is how this gap opened.
- `App::karr::Role::ClaimTimeout` now declares the one method it calls on
its consumer (ticket k144): `store`, from `Role::BoardDiscovery`. It
declared nothing at all and composed cleanly into anything, which is the
state k128 found `Role::DependencyCheck` in and k141 fixed for
`Role::TaskMutation` — so a consumer without `store` was still handed
`check_claim`, karr's one claim-ownership rule, and would have found out
from inside a mutation as a "Can't locate object method", on the one run
where a task was actually claimed by somebody else. No command changes:
all seven that compose the role, directly or through
`Role::TaskMutation`, already bring `store` along via
`Role::BoardAccess`, which is what hid the gap. One name is the whole
stray a-circumflex and two control characters where a dash belonged. The
worst was `karr context`, which renders one on every noted item in the
blocked, overdue and recently-completed sections, both on stdout and into
the file `--write-to` names; `karr-foundation` accounted for the other
ten, including the TIMEOUT notice App::karr::Foundation::Runner appends to
`.karr.log`, which corrupted a file on disk and not merely a terminal. All
eleven now spell the character `"\x{2014}"`, which also restores byte
compatibility with kanban-md's own context block. t/124-source-ascii-only.t
polices the class from here on, using PPI so that the em dashes in POD and
comments — harmless, and plentiful — raise nothing.
- Closed the last of the role import leaks: App::karr::Role::ClaimTimeout
and App::karr::Role::TaskMutation no longer compose Time::Piece's
`localtime` and `gmtime` into the commands that consume them — `move`,
`edit`, `delete`, `archive`, `handoff`, `pick` and `unlock` (ticket k105,
finishing k38). These were the worse half of that family, because the two
shadow builtins: a later `sub localtime` or an attribute of that name on a
command class would have fought an inherited Time::Piece export, and the
failure would have read as a core function misbehaving. Time::Piece is not
a drop-in for the usual cure — replacing the builtins is its whole point —
so the call sites were decided one at a time instead of swept.
ClaimTimeout keeps the module and spells its one live call
`Time::Piece::gmtime()`, because `_claim_expired` needs the overloaded
object and the builtin would hand that subtraction a string; TaskMutation
never asked for the time at all and drops the module, since the lifecycle
stamps are written by App::karr::Task. Nothing called either as a method,
so no behaviour changes, and t/121-role-import-leakage.t now runs with an
empty allow-list.
- Finished the sweep that stopped karr's own source locations reaching the
user (ticket k77). `croak` appends " at Some/Module.pm line 42." even to a
message that already ends in a newline, so anyone who ran `karr list`
outside a repository was told "Not a git repository. karr requires Git."
lib/App/karr/Foundation/Overview.pm
lib/App/karr/Foundation/Picker.pm
lib/App/karr/Foundation/Questions.pm
lib/App/karr/Foundation/Runner.pm
lib/App/karr/Foundation/State.pm
lib/App/karr/Git.pm
lib/App/karr/Lock.pm
lib/App/karr/Role/BoardAccess.pm
lib/App/karr/Role/BoardDiscovery.pm
lib/App/karr/Role/ClaimDefault.pm
lib/App/karr/Role/ClaimTimeout.pm
lib/App/karr/Role/CliArgs.pm
lib/App/karr/Role/Color.pm
lib/App/karr/Role/CompactOutput.pm
lib/App/karr/Role/DependencyArgs.pm
lib/App/karr/Role/DependencyCheck.pm
lib/App/karr/Role/ExitCodes.pm
lib/App/karr/Role/Output.pm
lib/App/karr/Role/PickRules.pm
lib/App/karr/Role/SkillFile.pm
lib/App/karr/Role/SyncLifecycle.pm
"version" : "0.601"
},
"App::karr::Role::BoardDiscovery" : {
"file" : "lib/App/karr/Role/BoardDiscovery.pm",
"version" : "0.601"
},
"App::karr::Role::ClaimDefault" : {
"file" : "lib/App/karr/Role/ClaimDefault.pm",
"version" : "0.601"
},
"App::karr::Role::ClaimTimeout" : {
"file" : "lib/App/karr/Role/ClaimTimeout.pm",
"version" : "0.601"
},
"App::karr::Role::CliArgs" : {
"file" : "lib/App/karr/Role/CliArgs.pm",
"version" : "0.601"
},
"App::karr::Role::Color" : {
"file" : "lib/App/karr/Role/Color.pm",
"version" : "0.601"
},
version: '0.601'
App::karr::Role::BoardAccess:
file: lib/App/karr/Role/BoardAccess.pm
version: '0.601'
App::karr::Role::BoardDiscovery:
file: lib/App/karr/Role/BoardDiscovery.pm
version: '0.601'
App::karr::Role::ClaimDefault:
file: lib/App/karr/Role/ClaimDefault.pm
version: '0.601'
App::karr::Role::ClaimTimeout:
file: lib/App/karr/Role/ClaimTimeout.pm
version: '0.601'
App::karr::Role::CliArgs:
file: lib/App/karr/Role/CliArgs.pm
version: '0.601'
App::karr::Role::Color:
file: lib/App/karr/Role/Color.pm
version: '0.601'
App::karr::Role::CompactOutput:
file: lib/App/karr/Role/CompactOutput.pm
version: '0.601'
docs/superpowers/plans/2026-03-19-v0004-implementation.md view on Meta::CPAN
| `lib/App/karr/Cmd/Sync.pm` | Sync command | Rewrite: full sync with materialization |
| `lib/App/karr/Cmd/Pick.pm` | Pick command | Rewrite: Lock integration with immediate push |
| `lib/App/karr/Cmd/List.pm` | List command | Add: `--claimed-by` filter |
| `lib/App/karr/Cmd/Init.pm` | Init command | Remove `.gitignore` manipulation |
| `lib/App/karr/Cmd/Create.pm` | Create command | Remove `_sync_after`, use role's `sync_before`/`sync_after` |
| `lib/App/karr/Cmd/Move.pm` | Move command | Same |
| `lib/App/karr/Cmd/Edit.pm` | Edit command | Same |
| `lib/App/karr/Cmd/Delete.pm` | Delete command | Same |
| `lib/App/karr/Cmd/Archive.pm` | Archive command | Same |
| `lib/App/karr/Cmd/Handoff.pm` | Handoff command | Remove `_sync_after`, `_parse_timeout`, `_claim_expired`; use shared role |
| `lib/App/karr/Role/ClaimTimeout.pm` | Shared claim timeout logic | New: `_parse_timeout`, `_claim_expired` consumed by Pick + Handoff |
| `Dockerfile` | Docker image | Add git identity ENV vars |
| `Changes` | Changelog | Remove "experimental", add v0.004 entries |
### New Files
| File | Responsibility |
|------|---------------|
| `lib/App/karr/Cmd/Log.pm` | Activity log command |
| `t/13-git-refs.t` | Git ref roundtrip tests (commit-wrapped write/read) |
| `t/14-task-parse.t` | `from_string`/`from_file` parity tests |
docs/superpowers/plans/2026-03-19-v0004-implementation.md view on Meta::CPAN
Remove `_sync_after` sub (lines 93-100). Replace line 106 with `$self->sync_before;`. Add `$self->sync_after;` before the json output block.
- [ ] **Step 4: Update Delete.pm**
Remove `_sync_after` sub (lines 22-29). Replace line 35 with `$self->sync_before;`. Add `$self->sync_after;` before the json output block.
- [ ] **Step 5: Update Archive.pm**
Remove `_sync_after` sub (lines 16-23). Replace line 29 with `$self->sync_before;`. Add `$self->sync_after;` before the json output block.
- [ ] **Step 6a: Create ClaimTimeout role**
Create `lib/App/karr/Role/ClaimTimeout.pm` to share `_parse_timeout` and `_claim_expired` between Pick and Handoff:
```perl
# ABSTRACT: Shared claim timeout logic
package App::karr::Role::ClaimTimeout;
use Moo::Role;
use Time::Piece;
sub _parse_timeout {
my ($self, $timeout_str) = @_;
return 3600 unless $timeout_str;
if ($timeout_str =~ /^(\d+)h$/) { return $1 * 3600; }
if ($timeout_str =~ /^(\d+)m$/) { return $1 * 60; }
return 3600;
docs/superpowers/plans/2026-03-19-v0004-implementation.md view on Meta::CPAN
my $claimed = eval { Time::Piece->strptime($task->claimed_at =~ s/Z$//r, '%Y-%m-%dT%H:%M:%S') };
return 0 unless $claimed;
return (gmtime() - $claimed) > $timeout_secs;
}
1;
```
- [ ] **Step 6b: Update Handoff.pm**
Remove `_sync_after` sub. Remove `_parse_timeout` and `_claim_expired`. Add `with 'App::karr::Role::ClaimTimeout';` to the `with` line (alongside BoardAccess and Output). Replace sync call with `$self->sync_before;`. Add `$self->sync_after;` after sa...
- [ ] **Step 7: Update Pick.pm (minimal — full rewrite in Task 8)**
Remove `_sync_after` sub. Remove `_parse_timeout` and `_claim_expired`. Add `with 'App::karr::Role::ClaimTimeout';`. Replace sync call with `$self->sync_before;`. Add `$self->sync_after;` after the json output block.
- [ ] **Step 8: Run all tests**
Run: `prove -l t/`
Expected: All pass
- [ ] **Step 9: Commit**
```bash
git add lib/App/karr/Cmd/Create.pm lib/App/karr/Cmd/Move.pm lib/App/karr/Cmd/Edit.pm \
lib/App/karr/Cmd/Edit.pm view on Meta::CPAN
});
printf "Updated task %d: %s\n", $task->id, $task->title unless $self->json;
# --status goes through apply_status_change, so an edit that takes a card
# up gets the same dependency warning `karr move` does, for free and by
# construction -- the #55 point again (ticket #123). An edit that changes
# anything else records nothing, so this adds no key.
# --release skips check_claim entirely, so an edit that breaks a claim on
# purpose records nothing and adds no key here either: it is not an override
# that went unnoticed, it is the one command whose whole job is saying so
# (App::karr::Role::ClaimTimeout/expired_claim_report, #177).
return { id => $task->id, title => $task->title,
$self->expired_claim_report( $task->id ),
$self->dependency_report( $task->id ) };
});
$self->sync_after;
$self->print_json_results(@$results);
$self->report_batch_failure($failed, scalar @ids);
lib/App/karr/Cmd/Handoff.pm view on Meta::CPAN
);
use App::karr::Role::BoardAccess;
use App::karr::Role::Output;
use App::karr::Role::TaskMutation;
use App::karr::Role::ClaimDefault;
use App::karr::Task;
use App::karr::Config;
use App::karr::Error ();
use Time::Piece;
# TaskMutation composes Role::ClaimTimeout, which is where check_claim comes
# from; handoff no longer names it separately because it no longer applies the
# claim rule on its own terms.
with 'App::karr::Role::BoardAccess', 'App::karr::Role::Output',
'App::karr::Role::TaskMutation', 'App::karr::Role::ClaimDefault';
option claim => (
is => 'ro',
format => 's',
doc => 'Agent name claiming the task (defaults to KARR_CLAIM)',
lib/App/karr/Cmd/List.pm view on Meta::CPAN
use App::karr::Role::Output;
use App::karr::Role::CompactOutput;
use App::karr::Board;
# For --unclaimed, and for nothing else: claim_held is the claim test
# App::karr::Role::PickRules/pickable applies, so the free cards this command
# lists are the free cards `karr pick` hands out (ticket #252). The role is
# composed rather than the predicate rewritten here, which is the whole point
# of the option. The rest of what it brings -- check_claim and its reporting
# half -- belongs to the mutating commands; `list` writes nothing and never
# calls it.
use App::karr::Role::ClaimTimeout;
use App::karr::Role::ClaimDefault;
use App::karr::Task;
use App::karr::Config;
use App::karr::Error qw( user_error command_hint );
with 'App::karr::Role::BoardAccess', 'App::karr::Role::Output',
'App::karr::Role::CompactOutput', 'App::karr::Role::ClaimTimeout',
'App::karr::Role::ClaimDefault';
option status => (
is => 'ro',
format => 's',
doc => 'Filter by status (comma-separated)',
);
option priority => (
lib/App/karr/Cmd/List.pm view on Meta::CPAN
}
# --claimed-by defaults to KARR_CLAIM when omitted (ADR 0005), so an agent
# that exported it sees its own cards from a bare `karr list`. --unclaimed asks
# the opposite question and wins outright: the env default is suppressed under
# it, and an explicit --claimed-by alongside --unclaimed was already rejected
# as a usage error above, so this only steps aside for the env-supplied value.
my $claimed_by = $self->unclaimed ? undef : $self->resolved_claimed_by;
if ( defined $claimed_by && length $claimed_by ) {
@filtered = grep { $_->has_claimed_by && $_->claimed_by eq $claimed_by } @filtered;
}
# The claim test itself is App::karr::Role::ClaimTimeout/claim_held -- the
# one App::karr::Role::PickRules/pickable applies -- so this list and `karr
# pick` cannot come to disagree about which cards are free (#59, #198, #252).
# One window for the whole run, read once here rather than per card: a
# board-wide filter that re-read claim_timeout for every card could in
# principle straddle a config change mid-list, and would certainly do the
# parse N times.
#
# Claim only, as kanban-md's IsUnclaimed is: pickable goes on to exclude
# blocked and terminal cards, and neither is a statement about who holds the
# card. --blocked --unclaimed is a real triage query here, not an empty one.
lib/App/karr/Cmd/List.pm view on Meta::CPAN
does for C<edit --claim --release> and C<move --next --prev> (ticket #235).
=item * C<--unclaimed>
Shows only the cards nobody is holding right now -- C<claimed_by> unset or
empty, or set to a claim older than the board's C<claim_timeout>. It is the
answer to "what is free" that until now only C<karr pick> could give, and
C<pick> answers it by B<taking> the card.
The test is not a second reading of the field: this filter calls
L<App::karr::Role::ClaimTimeout/claim_held>, the same method
L<App::karr::Role::PickRules/pickable> calls, so a card C<list --unclaimed>
shows is a card C<karr pick> can hand out. It asks about the claim and nothing
else, matching kanban-md's C<IsUnclaimed>: blocked cards and cards with unmet
dependencies are unpickable but not claimed, so they are still listed, and
C<--blocked --unclaimed> is a real query rather than an empty one. On a board
with C<claim_timeout: 0s> no claim ever expires, so there C<--unclaimed> means
C<claimed_by> empty and nothing more.
C<--unclaimed> is not the negation of C<--claimed-by>, which is where #237's
reading of the pair went wrong. C<--claimed-by NAME> is an exact string match
lib/App/karr/Cmd/Metrics.pm view on Meta::CPAN
}
# Every timestamp shape a karr board can hold, as epoch seconds, or undef when
# the value is none of them.
#
# * karr's own writer: 2026-08-12T09:41:03Z
# * kanban-md's: 2026-08-12T11:41:03.449764553+02:00 (RFC3339Nano,
# local offset, sub-second precision)
# * a pre-0.403 karr `started`, and any hand-written date: 2026-08-12
#
# App::karr::Role::ClaimTimeout parses the first two for claim expiry and has
# the long-form reasoning; this is the same grammar with the bare date added,
# which that role deliberately does not accept (a claim stamp is never one).
# Duplicated rather than shared because the role's parser is private to it and
# answers a different question -- see the report on ticket #126.
#
# Sub-second precision is dropped: nothing here is measured in less than a
# minute. An offset-less stamp is read as UTC, which is what karr's own writer
# means by it.
sub _epoch {
my ($stamp) = @_;
lib/App/karr/Cmd/Move.pm view on Meta::CPAN
# apply_status_change did not record either of them for this id.
return { id => $task->id, title => $task->title, old_status => $task->status,
new_status => $task->status, changed => JSON::MaybeXS::false() };
}
printf "Moved task %d: %s -> %s\n", $task->id, $old_status, $task->status unless $self->json;
# After the write, not inside the guarded callback that decided it: see
# App::karr::Role::DependencyCheck/dependency_report. Under --json the pair
# it returns lands in this hash instead of on STDERR. Same for the expired
# claim this move may have stepped over
# (App::karr::Role::ClaimTimeout/expired_claim_report, #177), which is
# reported first because it is about who held the card, not about the work.
return { id => $task->id, title => $task->title, old_status => $old_status,
new_status => $task->status, changed => JSON::MaybeXS::true(),
$self->expired_claim_report( $task->id ),
$self->dependency_report( $task->id ) };
});
$self->sync_after;
$self->print_json_results(@$results);
lib/App/karr/Cmd/Pick.pm view on Meta::CPAN
use App::karr::Role::DependencyCheck;
use App::karr::Role::PickRules;
use App::karr::Role::ClaimDefault;
use App::karr::Task;
use App::karr::Config;
use App::karr::Lock;
use App::karr::Error ();
use Time::Piece;
with 'App::karr::Role::BoardAccess', 'App::karr::Role::Output',
'App::karr::Role::CompactOutput', 'App::karr::Role::ClaimTimeout',
'App::karr::Role::DependencyCheck', 'App::karr::Role::PickRules',
'App::karr::Role::ClaimDefault';
option claim => (
is => 'ro',
format => 's',
doc => 'Agent name to claim the task for (defaults to KARR_CLAIM)',
);
lib/App/karr/Cmd/Unlock.pm view on Meta::CPAN
our $VERSION = '0.601';
use Moo;
use MooX::Cmd;
use MooX::Options (
usage_string => 'USAGE: karr unlock [ID[,ID,...]] [--all] [--json]',
);
use App::karr::Role::BoardAccess;
use App::karr::Role::Output;
use App::karr::Lock;
with 'App::karr::Role::BoardAccess', 'App::karr::Role::Output', 'App::karr::Role::ClaimTimeout';
option all => (
is => 'ro',
doc => 'Break every lock on the board',
);
sub execute {
my ($self, $args_ref, $chain_ref) = @_;
lib/App/karr/Config.pm view on Meta::CPAN
my @classes = $config->classes;
=head2 claim_timeout
my $raw = $config->claim_timeout; # '1h', unparsed
Returns the board's configured claim-expiry duration as the raw string from
the config (C<'1h'> when unset), in kanban-md's C<time.ParseDuration> grammar
-- not seconds. Pass it to L</parse_duration> to get a number. Governs how
long C<karr pick> and the C<move>/C<edit>/C<handoff> claim check
(L<App::karr::Role::ClaimTimeout>) honour an existing C<claimed_by> before
treating it as expired; C<'0s'> disables expiry, exactly as it does for
C<lock_timeout>, and means a claim is honoured until it is released. Distinct
from C<lock_timeout>, which bounds a single C<karr pick> transaction rather
than a whole work session.
=head2 foundation_enabled
Returns true when automated agent runs (L<App::karr::Foundation>) are allowed on
this board. The flag lives in the board config under C<foundation.enabled> and
therefore travels with C<refs/karr/config>; a board that never set it is
lib/App/karr/Foundation/Picker.pm view on Meta::CPAN
use Moo;
use App::karr::Role::PickRules;
has store => (
is => 'ro',
required => 1,
);
# The two names App::karr::Role::ClaimTimeout requires beyond store, wanted for
# check_claim's reporting half (its expired_claim_report), which nothing here
# calls -- selection only ever asks _claim_expired. foundation has no --json and
# no --quiet, and it says what it did through .karr.log, so these answer for the
# shape of that: never JSON, never printing.
sub json { 0 }
sub quiet { 1 }
# Composed here, not at the top of the file: Moo applies a role at the point the
# "with" stands, and the role chain requires the three names above it.
lib/App/karr/Foundation/Picker.pm view on Meta::CPAN
agent per repository, so nothing else can take the
card while the run lasts; a second owner would only add a claim with a lifetime
nobody watches. The claim belongs to the agent, which mints its own name with
C<karr agentname> and has to keep using that same name for C<move> and
C<handoff> (#176) -- a name foundation invented could not be handed over
without inventing a protocol for it. So an agent that dies mid-run leaves at
most its own claim, cleared by the board's C<claim_timeout> or by
C<karr unlock>, exactly as it does today.
Claim expiry rides along with those rules, from
L<App::karr::Role::ClaimTimeout>, which L<App::karr::Role::PickRules> composes:
reading an expired claim correctly means parsing an RFC3339 stamp that may
carry a fraction and an offset (#57), and that parser exists once. Foundation
has to see expiry, or a crashed agent's claim would take its card out of the
assignable set for good and a board whose only open card carries such a claim
would go quiet for ever -- nothing would run, so nothing would reap the claim.
=head2 store
The L<App::karr::BoardStore> for the board L</next_ticket> picks from.
Required.
=head2 json
Always false. Exists only to satisfy L<App::karr::Role::ClaimTimeout>'s
contract; karr-foundation's ticket-mode selection has no C<--json> and never
emits any.
=head2 quiet
Always true, for the same reason as L</json>: nothing here prints, ever --
karr-foundation says what it did through F<.karr.log> instead.
=head2 next_ticket
lib/App/karr/Role/ClaimTimeout.pm view on Meta::CPAN
# ABSTRACT: Shared claim timeout logic
package App::karr::Role::ClaimTimeout;
our $VERSION = '0.601';
use Moo::Role;
# Loaded without importing, and every call below is qualified. A Moo::Role
# composes every sub in its package into its consumers, imported ones included,
# so `use Time::Piece;` here put its localtime/gmtime replacements on every
# command that composes this role (#105). Worse than the #38 cases, because
# those two shadow builtins: a future `sub localtime` on a command class would
# fight an inherited export and look like a core function misbehaving.
# App::karr::Role::Output and App::karr::Role::BoardDiscovery state the rule.
#
lib/App/karr/Role/ClaimTimeout.pm view on Meta::CPAN
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
App::karr::Role::ClaimTimeout - Shared claim timeout logic
=head1 VERSION
version 0.601
=head1 DESCRIPTION
Shared helper role for commands that need to interpret C<claim_timeout> values
and determine whether an existing claim should still block other agents.
lib/App/karr/Role/PickRules.pm view on Meta::CPAN
# ABSTRACT: The one definition of which card karr pick may hand out, and in what order
package App::karr::Role::PickRules;
our $VERSION = '0.601';
use Moo::Role;
use App::karr::Config;
# Composed, not required: claim expiry is half the eligibility rule, and its
# RFC3339 parser exists once (App::karr::Role::ClaimTimeout, ticket #57). A
# consumer that also composes ClaimTimeout itself -- App::karr::Cmd::Pick does,
# for the separate lock_timeout parse -- is applying the same role twice, which
# Role::Tiny resolves to one application rather than a method conflict.
with 'App::karr::Role::ClaimTimeout';
sub pickable {
my ( $self, $task, %filter ) = @_;
return 0 unless $task;
my $timeout = defined $filter{timeout} ? $filter{timeout} : $self->claim_timeout_secs;
if ( $filter{statuses} ) {
my %allowed = map { $_ => 1 } @{ $filter{statuses} };
return 0 unless $allowed{ $task->status };
lib/App/karr/Role/PickRules.pm view on Meta::CPAN
# --unclaimed` needed the same answer: two spellings of "free" drift, and
# then a list says a card is available that pick will not hand out.
#
# It could not be borrowed by calling pickable itself, because the whole of
# what used to stand here is the claim, and the next line is not: blocked is
# pick's rule, not part of being claimed, and kanban-md's IsUnclaimed
# (internal/board/filter.go) does not ask it either. That is why the claim
# test moved out and this line stayed behind it.
#
# What moved is exactly what was here, `claimed_by: ""` included -- see
# App::karr::Role::ClaimTimeout/claim_held for the reasoning that came with
# it.
return 0 if $self->claim_held( $task, $timeout );
return 0 if $task->has_blocked;
if ( $filter{tags} ) {
my %wanted = map { $_ => 1 } @{ $filter{tags} };
return 0 unless grep { $wanted{$_} } @{ $task->tags };
}
return 1;
lib/App/karr/Role/PickRules.pm view on Meta::CPAN
at all, and which of the available ones comes first. Both were written twice --
once in L<App::karr::Cmd::Pick> and once in L<App::karr::Foundation::Picker>,
which has to name the card the agent's own C<karr pick> would have handed it or
the coordinator is arguing with its own board. They agreed because they were
copied; nothing kept them agreeing (ticket #198).
This role is the definition both call. It lives in a role rather than in
L<App::karr::Task> or L<App::karr::BoardStore> because the eligibility test
needs three things at once: the task, the board (C<< $self->store >> for the
board's terminal statuses and its C<priorities>/C<classes> lists), and the
claim-expiry parser in L<App::karr::Role::ClaimTimeout> -- which this role
composes, so a consumer gets the whole rule by asking for one name. A function
in C<Task> would have had to be handed all three; a method on C<BoardStore>
would have put command-selection policy in the storage layer, which belongs to
a different owner.
What is deliberately B<not> here: claiming, locking and the compare-and-swap
that binds a pick (L<App::karr::Cmd::Pick/EXCLUSIVITY>), because foundation
must not do any of them (L<App::karr::Foundation::Picker>), and the C<--status>
and C<--tags> option parsing, which stays with the command that has options.
This role takes the filters already split, applies them, and stops.
lib/App/karr/Role/PickRules.pm view on Meta::CPAN
True when C<$task> is available to be picked right now. In order: it exists;
its status is in C<statuses> if that filter was given, and is not one of the
board's terminal statuses if it was not (the board's own final column and
C<archived>, never a hardcoded C<done>); it is not held by a claim that is
still live under C<timeout>, where C<claimed_by> set to the empty string is
kanban-md for "unclaimed"; it is not blocked; and it carries at least one of
C<tags> if that filter was given.
C<timeout> is the claim window in seconds and defaults to
L<App::karr::Role::ClaimTimeout/claim_timeout_secs>. Pass it explicitly when
asking about many cards in one command run, so one answer covers the whole
run. C<0> is not the shortest window but no window at all: a board with
C<claim_timeout: 0s> never expires a claim, so every claimed card stays
unpickable until the claim is released. C<statuses> and C<tags> are
already-split lists, not the comma-separated option strings -- splitting
belongs to the command that owns the option. An absent (or empty) filter is
not the same as an empty list: no C<statuses> means "anything but terminal",
C<< statuses => [] >> means nothing qualifies.
The claim half of the test is L<App::karr::Role::ClaimTimeout/claim_held>,
called rather than restated: C<karr list --unclaimed> asks that same method
about every card on the board, so what the list shows as free is what this
method lets C<karr pick> take (ticket #252). The blocked test deliberately
stayed here and is not part of it -- a blocked card is unpickable, not
claimed.
=head2 pick_rank
my @ranked = $self->pick_rank( @tasks );
lib/App/karr/Role/TaskMutation.pm view on Meta::CPAN
use App::karr::Config;
# Loaded without importing, for the reason spelled out in
# App::karr::Role::Output: a Moo::Role composes every sub in its package into
# its consumers, imported ones included, so `use ... qw( user_error )` here
# would quietly make user_error a method on move, edit, delete, archive and
# handoff.
use App::karr::Error ();
# Same reason, one module over: `use Scalar::Util qw( refaddr );` here would put
# a refaddr method on every command that composes this role.
use Scalar::Util ();
use App::karr::Role::ClaimTimeout;
use App::karr::Role::DependencyCheck;
with 'App::karr::Role::ClaimTimeout', 'App::karr::Role::DependencyCheck';
# What this role calls on its consumer, said out loud (ticket #141; the rule is
# ticket #128's). It declared nothing at all until then, and got away with it
# only because every command on the mutation path composes the roles that supply
# these: git and store from App::karr::Role::BoardDiscovery, save_task and
# log_task_write from App::karr::Role::BoardAccess, json from
# App::karr::Role::Output. Same accident App::karr::Role::DependencyCheck lived
# on before #128, one module over -- and a worse one to leave standing, because
# this role is how a command reaches update_task_guarded without ever naming the
# collaborators that path needs.
lib/App/karr/Role/TaskMutation.pm view on Meta::CPAN
Claim ownership is checked by the caller, inside the callback it hands to
C<update_task_guarded>, rather than by C<update_task_guarded> itself, because
C<edit --release> deliberately acts on somebody else's claim. Putting the check
in the callback is what keeps it under the same guard as the write: a check
made before the loop is a check made against a revision that may no longer be
there (tickets #44, #46, #56).
=head1 SEE ALSO
L<karr>, L<App::karr>, L<App::karr::Role::ClaimTimeout>,
L<App::karr::Cmd::Move>, L<App::karr::Cmd::Edit>, L<App::karr::Cmd::Delete>,
L<App::karr::Cmd::Archive>, L<App::karr::Cmd::Handoff>
=head2 run_batch
Runs one callback per id and keeps going when an id fails, so that a bad id in
the middle of the list cannot skip the ids after it. Returns the collected
per-id results and the number of failures.
my ( $results, $failed ) = $self->run_batch( \@ids, sub {
lib/App/karr/Task.pm view on Meta::CPAN
# newlines, the normal form ticket #78 settled -- but it can arrive from a
# caller in process, and "an empty body gains no separator" is the whole point
# of the branch. Only newlines are trimmed, never other whitespace: an indented
# last line is content.
#
# length, not truth, on the trimmed body: appending to a body of "0" must
# preserve it (ticket #78).
sub append_body {
my ( $self, $text, $timestamp ) = @_;
# The handoff form, deliberately not kanban-md's: karr writes every stamp in
# UTC (App::karr::Role::ClaimTimeout says why), and `[[2006-01-02]]` is
# wiki-link syntax that means nothing here. Opt-in at both call sites -- an
# inline prefix would turn `-a "## Findings"` into a line that is no longer a
# heading, so it cannot be forced on every append.
$text = gmtime->strftime('%Y-%m-%d %H:%M') . ' ' . $text if $timestamp;
my $body = defined $self->body ? $self->body : '';
$body =~ s/\n+\z//;
$self->body( length $body ? $body . "\n\n" . $text : $text );
return $self;
}
t/121-role-import-leakage.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use B ();
use App::karr::Role::BoardAccess;
use App::karr::Role::BoardDiscovery;
use App::karr::Role::ClaimTimeout;
use App::karr::Role::CliArgs;
use App::karr::Role::CompactOutput;
use App::karr::Role::DependencyArgs;
use App::karr::Role::DependencyCheck;
use App::karr::Role::ExitCodes;
use App::karr::Role::Output;
use App::karr::Role::SkillFile;
use App::karr::Role::SyncLifecycle;
use App::karr::Role::TaskMutation;
t/121-role-import-leakage.t view on Meta::CPAN
| MooX::Locale::Passthrough
) \z
}x;
# Imports that leak today, are NOT part of the ticket in hand, and are recorded
# here so that a NEW one fails this test instead of joining them unnoticed. An
# entry also has to describe reality: the loop below fails when a listed leak is
# gone, so fixing one forces the entry out rather than leaving a licence behind
# for a future import of the same name.
#
# Empty since #105 closed the last two: App::karr::Role::ClaimTimeout and
# App::karr::Role::TaskMutation both said `use Time::Piece;`, which put its
# localtime/gmtime replacements on every mutating command class.
my %KNOWN_LEAK = ();
my @ROLES = map { "App::karr::Role::$_" } qw(
BoardAccess BoardDiscovery ClaimTimeout CliArgs CompactOutput
DependencyArgs DependencyCheck ExitCodes Output SkillFile SyncLifecycle
TaskMutation
);
# Every sub in $pkg's symbol table, paired with the package it was really
# defined in. That second half is what tells an import apart from a definition.
sub subs_with_origin {
my ($pkg) = @_;
no strict 'refs';
my %origin;
t/121-role-import-leakage.t view on Meta::CPAN
ok !exists $board{user_error}, 'BoardDiscovery did not swap croak for an imported user_error';
ok !exists $sync{user_error}, 'SyncLifecycle did not either';
};
# Ticket #105: the same hazard in the two mutation roles, which both said
# `use Time::Piece;`. That one shadows builtins, so it was the worse of the
# family: a later `sub localtime` or an attribute of that name on move, edit,
# delete, archive or handoff would have fought an inherited export, and the
# failure would have read as a core function misbehaving.
subtest 'the mutation roles no longer compose Time::Piece over the builtins' => sub {
my %claim = subs_with_origin('App::karr::Role::ClaimTimeout');
my %mut = subs_with_origin('App::karr::Role::TaskMutation');
for my $name (qw( gmtime localtime )) {
ok !exists $claim{$name}, "ClaimTimeout no longer holds Time::Piece::$name";
ok !exists $mut{$name}, "TaskMutation no longer holds Time::Piece::$name";
}
# ClaimTimeout kept the dependency and lost only the import: _claim_expired
# still needs the overloaded object, because the builtin gmtime returns a
# string there and the subtraction against the parsed stamp would be
# nonsense. t/72-claim-timeout.t is what proves the arithmetic still works;
# this only proves the module is still there to do it.
ok $INC{'Time/Piece.pm'}, 'Time::Piece is still loaded';
is $claim{check_claim}, 'App::karr::Role::ClaimTimeout',
'ClaimTimeout still defines its own subs';
};
# Deliberately not a real command class: MooX::Cmd::Role does `use Carp;`
# upstream and composes croak into every one of them, which karr cannot fix from
# here and which would mask a regression in karr's own roles.
{
package RoleConsumer;
use Moo;
use MooX::Options;
with 'App::karr::Role::BoardDiscovery', 'App::karr::Role::SyncLifecycle';
t/142-task-mutation-requires.t view on Meta::CPAN
# apply_status_change $self->store
#
# Nothing was broken, because every real command on the mutation path composes
# App::karr::Role::BoardAccess and App::karr::Role::Output and so brings all
# five along. That is the accident, not the guarantee: the next command to reach
# for update_task_guarded would have inherited a compare-and-swap loop whose
# collaborators nobody had checked for, and found out from inside the callback
# as a "Can't locate object method".
#
# The ticket proposed six names. It is five: check_claim is not the consumer's
# to supply. It comes from App::karr::Role::ClaimTimeout, which this role
# composes, exactly as check_dependencies comes from DependencyCheck -- see the
# third subtest for why declaring either would be worse than leaving it out.
# What the role declares on its own behalf, and who supplies each: git and store
# from App::karr::Role::BoardDiscovery, save_task and log_task_write from
# App::karr::Role::BoardAccess, json from App::karr::Role::Output.
my @DECLARED = qw( git json log_task_write save_task store );
# What it inherits as a requirement from the role it composes, over and above
# its own list (store and json are on both). Role::Tiny hands an unmet requires
t/142-task-mutation-requires.t view on Meta::CPAN
ok( $pkg->can($_), "...and is handed ->$_ by the composition" )
for qw( check_claim check_dependencies );
ok( App::karr::Role::TaskMutation->can($_),
"the role package itself holds ->$_" )
for qw( check_claim check_dependencies );
ok( Role::Tiny::does_role( 'App::karr::Role::TaskMutation', $_ ),
"because it composes $_" )
for map { "App::karr::Role::$_" } qw( ClaimTimeout DependencyCheck );
};
subtest 'every command on the mutation path supplies all of them' => sub {
# Moo reports an unmet requires when the class is compiled, so loading each
# one is most of the test: a name added to the list that a command does not
# have breaks `karr <cmd>` outright, not just this file. The ->can loop is
# what says which name, instead of leaving it to a compile error.
for my $cmd (qw( Move Edit Handoff Delete Archive )) {
my $pkg = "App::karr::Cmd::$cmd";
require_ok($pkg) or next;
t/147-claim-timeout-requires.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use Path::Tiny qw( path );
use App::karr::Role::ClaimTimeout;
# Ticket #144, the last module in the run ticket #128 started.
# App::karr::Role::DependencyCheck declared nothing it called on its consumer;
# #128 fixed that, #137 finished it when it split off
# App::karr::Role::DependencyArgs, and #141 did the same for
# App::karr::Role::TaskMutation. This role -- the third on the mutation path,
# and the one that owns karr's single claim-ownership rule -- still declared
# nothing at all, while claim_timeout_secs called one method on whoever composed
# it:
#
t/147-claim-timeout-requires.t view on Meta::CPAN
# find_task and quiet reach consumers of TaskMutation in
# t/142-task-mutation-requires.t. What it declares is all a consumer must have.
my @ALL = sort @DECLARED;
# A fresh package every time: Moo caches what it has applied to a class, so a
# second composition into the same name would not be the same experiment.
my $seq = 0;
sub compose_with {
my (@supplied) = @_;
my $pkg = 'TimeoutStub' . ++$seq;
my $subs = join "\n", map {"sub $_ { }"} @supplied;
my $ok = eval "package $pkg; use Moo; $subs;
with 'App::karr::Role::ClaimTimeout'; 1";
return ( $ok, $@, $pkg );
}
subtest 'the role declares every call it makes on its consumer' => sub {
# A requires list is only as good as its last edit, and this one went the
# whole life of the role without existing. So read the calls out of the
# source and hold the declaration against them, rather than trusting the
# list above -- or the ticket, whose count for #141 was wrong.
my $file = path( $INC{'App/karr/Role/ClaimTimeout.pm'} );
ok $file->exists, 'found the source of the role to read' or return;
my $src = $file->slurp_utf8;
# POD and comments carry example code, and here that is not hypothetical:
# the =method check_claim synopsis is `$self->check_claim( $task,
# $self->claim )`, and claim is a command's own option, not something this
# role ever asks a consumer for. A scan that kept the POD would demand it.
$src =~ s/^=\w+.*?^=cut\b.*?$//msg;
$src =~ s/^\s*#.*$//mg;
my %called = map { $_ => 1 } $src =~ /\$self->(\w+)/g;
ok !$called{claim}, 'the POD-only $self->claim is not read as a call';
# Its own methods are whatever the role package can do. For
# App::karr::Role::TaskMutation that means more than a `^sub` scan would
# find, because composed roles install into it; here it happens to be just
# the subs in this file, which is the fourth subtest's point.
my %own = map { $_ => 1 }
grep { App::karr::Role::ClaimTimeout->can($_) } keys %called;
# Read out of the role rather than restated here, so removing the requires
# line fails this subtest instead of only the composition ones below.
my %declared =
map { $_ => 1 } @{ $Role::Tiny::INFO{'App::karr::Role::ClaimTimeout'}
{requires} || [] };
is_deeply [ sort keys %declared ], \@ALL,
'the role asks its consumer for exactly the expected names';
my @undeclared = sort grep { !$own{$_} && !$declared{$_} } keys %called;
# Empty, and it stays empty: a new $self->foo in this role is a method
# nobody promised the consumer would have, and the fix is to require it --
# not to add it to this test.
t/147-claim-timeout-requires.t view on Meta::CPAN
is_deeply \@unused, [], 'and nothing is declared that the role never calls'
or diag "unused: @unused";
};
subtest 'a consumer that supplies none of them will not compose' => sub {
# The whole point of a requires is that it fails at composition time rather
# than the first time a claimed task reaches check_claim. Before #144 this
# composed cleanly:
#
# $ perl -Ilib -e 'package Bare; use Moo;
# with "App::karr::Role::ClaimTimeout"; print "composed\n"'
#
# t/72-claim-timeout.t's TimeoutConsumer was exactly that class, and had to
# be given a store stub in the same change.
my ( $ok, $err ) = compose_with();
ok !$ok, 'a bare consumer of ClaimTimeout refuses to compose';
like $err, qr/\bmissing\b/, '...and says so as a missing-method error';
like $err, qr/\b\Q$_\E\b/, "...naming $_" for @DECLARED;
};
subtest 'every declared name is load-bearing' => sub {
# Drop one name at a time. Each has to be the difference between composing
# and not -- which is what a declaration that cannot fail would flunk, and
# is the guard against putting one of this role's own subs on the list.
# Role::Tiny installs a role's methods into the consumer *before* it checks
# the requires (role_application_steps), so requiring a name the role
t/147-claim-timeout-requires.t view on Meta::CPAN
# one -- and must not be, per the subtest above.
my ( $ok, $err, $pkg ) = compose_with(@ALL);
ok $ok, 'a consumer supplying the declared names composes' or diag $err;
my @OWN = qw( _parse_timeout _parse_claim_stamp _claim_expired
claim_timeout_secs claim_held check_claim
expired_claim_report _expired_claims );
ok( $pkg->can($_), "...and is handed ->$_ by the composition" ) for @OWN;
ok( App::karr::Role::ClaimTimeout->can($_),
"the role package itself holds ->$_" ) for @OWN;
# And it holds them because they are written here, not because a composed
# role installed them. This is where App::karr::Role::TaskMutation differs:
# its check_claim and check_dependencies arrive from the two roles it
# composes, which is why they are off its list too but for a different
# reason. This role composes nothing, so "own" has only the one meaning --
# and if a `with` ever appears above, the first subtest's ->can filter will
# quietly start excusing the new role's methods, which is correct but worth
# knowing.
my %applied = %{ $Role::Tiny::APPLIED_TO{'App::karr::Role::ClaimTimeout'}
|| {} };
delete $applied{'App::karr::Role::ClaimTimeout'};
is_deeply [ sort keys %applied ], [],
'the role composes no other role';
};
subtest 'every consumer of the role supplies it' => sub {
# Moo reports an unmet requires when the class is compiled, so loading each
# one is most of the test: a name added to the list that a command does not
# have breaks `karr <cmd>` outright, not just this file. The ->can loop is
# what says which name, instead of leaving it to a compile error.
#
# Pick, Unlock and List compose App::karr::Role::ClaimTimeout by name; the
# rest get it through App::karr::Role::TaskMutation, and Role::Tiny hands an
# unmet requires of a composed role up to whoever composes the composer, so
# the requirement reaches them just the same. All of them satisfy it the
# same way, via App::karr::Role::BoardAccess.
#
# List is the one that writes nothing: it composes the role for claim_held
# alone, so `karr list --unclaimed` and `karr pick` cannot disagree about
# which cards are free (#252). It still has to supply all three names, and
# json and quiet are the interesting ones there -- a read-only command has
# no use for expired_claim_report and could plausibly have been given the
t/163-foundation-sigterm-cleanup.t view on Meta::CPAN
use strict;
use warnings;
# Ticket #163. Foundation installed no SIGTERM handler. Stop it
# mid-drain -- systemd TimeoutStopSec, a deploy, an operator's kill --
# and the agent survived, reparented to init, while .karr.lock named the
# foundation's now-dead pid and the next tick started a second agent.
#
# The fix has two halves:
# - Foundation::run installs SIGTERM/INT/HUP handlers that kill the
# live agent's process group and force-release the lock.
# - the lock now records the work (an open fd, plus pid/pgid as
# evidence), so the handler can find and clean it up.
#
# This test exercises the handler end-to-end. We fork a driver child
t/177-expired-claim-takeover.t view on Meta::CPAN
# expired claim, other name "Handed off task 1 -> review", exit 0, card
# re-stamped to <B>, nothing said anywhere
#
# So the one signal that names the previous holder disappeared exactly when it
# was most useful: an agent that lost its own claim name (#176, `karr agentname`
# mints a fresh one per call) got a success instead of the hint, and
# karr-foundation -- which attributes stalls per claim name -- had its
# attribution moved to a name nobody held, with no record that the card had ever
# belonged to someone else.
#
# App::karr::Role::ClaimTimeout::check_claim now records the override and the
# commands emit it after the write lands, the way
# App::karr::Role::DependencyCheck already reports unsatisfied dependencies:
# STDERR for humans, the `expired_claim` pair under --json, silenced by --quiet.
# Return value and exit code are deliberately unchanged.
# In-process runner (t/lib/TestKarr.pm): same ($cwd, @argv) signature and
# { exit, stdout, stderr } return as the open3 helper this file used to carry,
# dispatched through the shared App::karr::Dispatch path. KARR_TEST_SUBPROC=1
# restores the old open3 path.
sub _run_karr { return run_karr(@_) }
t/223-terminal-claim-released.t view on Meta::CPAN
require_git_c();
use TestKarr qw( run_karr );
use File::Temp qw( tempdir );
use Time::Piece;
use App::karr::Config;
use App::karr::Task;
use App::karr::Error qw( set_original_argv );
use MockStore;
# Ticket #223. App::karr::Role::ClaimTimeout::check_claim knew four cases --
# unclaimed, the claimant matches, the claim expired, otherwise refuse -- and
# not one of them asked what status the card was in. So the agent that finished
# a card went on guarding it for the rest of claim_timeout (1h by default):
#
# karr move 1 done --claim alpha-one
# karr edit 1 -a "a late note" -> Task 1 is claimed by alpha-one
# karr move 1 todo -> Task 1 is claimed by alpha-one
# karr archive 1 -> Task 1 is claimed by alpha-one
#
# CONTEXT.md defines a Claim as the lease an agent holds *while working* a task
t/223-terminal-claim-released.t view on Meta::CPAN
{
package ClaimConsumer;
use Moo;
has store => ( is => 'ro' );
# The other two names the role requires. Nothing here prints: quiet keeps
# expired_claim_report's human copy out of the test output while its return
# value is still the pair the assertions read.
sub json { 0 }
sub quiet { 1 }
with 'App::karr::Role::ClaimTimeout';
}
sub _consumer_for {
my (@statuses) = @_;
my $ec = { %{ App::karr::Config->default_config } };
$ec->{statuses} = [@statuses] if @statuses;
return ClaimConsumer->new( store => MockStore->new( ec => $ec ) );
}
sub _claimed_card {
t/232-claim-timeout-zero-never-expires.t view on Meta::CPAN
# t/232-claim-timeout-zero-never-expires.t
#
# Ticket #232. `claim_timeout: 0s` is documented as "claims never expire" --
# in App::karr::Role::ClaimTimeout/claim_timeout_secs, in the comment over
# _parse_timeout, and by the implementation it is parity with (kanban-md's
# internal/board/filter.go, whose IsUnclaimed asks `timeout > 0 && ClaimedAt !=
# nil` and falls through to "still claimed" on a zero timeout).
#
# It did the exact opposite. _parse_timeout handed the zero through verbatim,
# which is right, and _claim_expired then asked `(now - claimed_at) > 0` -- true
# of every claim more than a second old. So the one setting a board uses to say
# "claims are binding here" was the setting that made every card free for the
# taking, seconds after it was claimed, with nothing said anywhere:
#
t/232-claim-timeout-zero-never-expires.t view on Meta::CPAN
use App::karr::Config;
use App::karr::Git;
use App::karr::Lock;
use App::karr::Task;
my $HOLDER = 'agent-holder';
my $TAKEOVER = 'agent-takeover';
{
package ZeroTimeoutConsumer;
use Moo;
# The three names the role requires. store is the real question here: unlike
# t/72's stub, check_claim below has to read a board's claim_timeout back out
# of it, so this one is a MockStore carrying the value under test.
has store => ( is => 'ro' );
sub json { 0 }
sub quiet { 0 }
with 'App::karr::Role::ClaimTimeout';
}
sub _consumer_for {
my ($timeout) = @_;
my $ec = App::karr::Config->default_config;
$ec->{claim_timeout} = $timeout;
return ZeroTimeoutConsumer->new( store => MockStore->new( ec => $ec ) );
}
sub _claimed_secs_ago {
my ($secs) = @_;
return App::karr::Task->new(
id => 1,
title => 'Held card',
status => 'in-progress',
claimed_by => $HOLDER,
claimed_at => gmtime( time - $secs )->datetime . 'Z',
t/252-list-filter-limit-options.t view on Meta::CPAN
use App::karr::BoardStore;
use App::karr::Task;
use App::karr::Cmd::List;
# Ticket #252: the scope decision on kanban-md's list filter set. Three of the
# four options the maintainer accepted are pinned here -- --limit/-n, --class
# and --blocked/--not-blocked. The fourth, --unclaimed, landed after these and
# is pinned in t/252-list-unclaimed-agrees-with-pick.t, a file of its own: its
# one hard requirement was to reuse App::karr::Role::PickRules/pickable's claim
# test rather than spell a second one, and that test was not reachable on its
# own until it was lifted into App::karr::Role::ClaimTimeout/claim_held.
# Nothing here asserts anything about --unclaimed, which is why this file did
# not have to change when it landed.
#
# Probed against the pre-change code on a default board:
#
# karr list --limit 2 Unknown option: limit (exit 2)
# karr list -n 2 Unknown option: n (exit 2)
# karr list --class expedite Unknown option: class (exit 2)
# karr list --blocked Unknown option: blocked (exit 2)
#
t/252-list-unclaimed-agrees-with-pick.t view on Meta::CPAN
use App::karr::Cmd::Pick;
use App::karr::Foundation::Picker;
# Ticket #252, part four -- the option the first build halted on rather than
# approximate. Its one hard requirement was that `karr list --unclaimed` reuse
# the claim test `karr pick` applies instead of spelling a second one, and that
# was not reachable: App::karr::Role::PickRules/pickable computed the claim as
# three lines mid-chain with `return 0 if $task->has_blocked` on the very next
# line, so borrowing it meant inheriting "and not blocked" with it.
#
# So the claim test moved into App::karr::Role::ClaimTimeout/claim_held, beside
# the expiry parser it calls, and pickable's three lines became a call to it.
# That refactor is the risk in this change, not the option: `karr pick` and
# karr-foundation's ticket mode both hang off pickable. t/198-pick-rules-shared.t
# and t/72-claim-timeout.t hold the behaviour that must not have moved; this
# file holds what is new.
#
# Three things are pinned here, in rising order of what they are worth:
#
# * the option answers about the claim and nothing else -- an expired claim
# is free, `claimed_by: ""` is free (#59), a claim with no stamp is held,
t/252-list-unclaimed-agrees-with-pick.t view on Meta::CPAN
ok $cmd->claim_held( $old, 4 * 3600 ), '...still held under a wider one';
ok $cmd->claim_held( $old, 0 ), '...and held under 0, which disables expiry';
};
#### one definition of "free"
subtest 'list and pick resolve the claim test to the same coderef' => sub {
# Not "both are correct today" but "both are the same method". A copy that
# happens to agree is what #59 and #198 are about, and it is what a
# behavioural test alone cannot rule out.
ok( App::karr::Cmd::List->does('App::karr::Role::ClaimTimeout'),
'karr list composes the claim role' );
ok( App::karr::Cmd::Pick->does('App::karr::Role::PickRules'),
'karr pick composes the pick rules' );
my $listed = App::karr::Cmd::List->can('claim_held');
my $picked = App::karr::Cmd::Pick->can('claim_held');
ok $listed, 'list has claim_held';
is $listed, $picked, 'and it is literally pick\'s claim_held, not a twin';
is $listed, App::karr::Foundation::Picker->can('claim_held'),
'karr-foundation\'s ticket mode resolves to the same one';
t/252-list-unclaimed-agrees-with-pick.t view on Meta::CPAN
# And the expiry test exists once in the whole distribution: a third caller
# reaching past claim_held to _claim_expired is the same fork by another
# route.
my @spellers;
path('lib')->visit(
sub {
my ($p) = @_;
return unless $p->is_file && $p =~ /\.pm\z/;
my $rel = $p->relative('.')->stringify;
return if $rel eq 'lib/App/karr/Role/ClaimTimeout.pm';
push @spellers, $rel if $strip->($rel) =~ /_claim_expired/;
},
{ recurse => 1 }
);
is_deeply \@spellers, [],
'App::karr::Role::ClaimTimeout is the only file that reads a claim stamp';
};
subtest 'the board timeout is read once per run, not once per card' => sub {
# The window has to cover the whole listing, or a long run could judge its
# first card against one number and its last against another. Counted rather
# than reasoned about, because "pass it in" is exactly the kind of detail a
# later edit drops back to a per-card default.
my $repo = _board();
mk( $repo, id => $_, title => "task $_" ) for 1 .. 8;
t/275-list-claim-and-hidden-footer.t view on Meta::CPAN
use App::karr::Cmd::List;
use App::karr::Cmd::Board;
# Ticket #275: `karr list` showed no claim holder, and its footer said
# "0 task(s)" on a board whose every card was done -- the count was true and
# the silence hid that 263 finished cards sat behind the default filter.
#
# Two things are pinned here:
#
# * the table shows a live claim as @name in the meta bracket, using the
# same test --unclaimed and pick apply (App::karr::Role::ClaimTimeout/
# claim_held) and the CONTEXT.md rule that a claim on a terminal card is
# provenance, not a lease: an expired claim is not shown, and neither is
# one on a finished card;
#
# * the footer names what the default filter hid, with the same count
# `karr board`'s footer prints -- computed by the same helper
# (App::karr::Board), so the two commands cannot drift.
sub _init_repo {
my $repo = tempdir( CLEANUP => 1 );
t/72-claim-timeout.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use Time::Piece;
use App::karr::Task;
# Ticket #63: App::karr::Role::ClaimTimeout had no direct coverage at all.
# Mutating `return $1 * 60` to `$1 * 3600` (minutes parsed as hours) and
# replacing the whole of _claim_expired with `return 0` (no claim ever expires,
# so `karr pick` can never take over a stale claim) both left the suite green --
# the role is only exercised indirectly by pick/handoff, and only through claims
# that were fresh either way.
{
package TimeoutConsumer;
use Moo;
# store is the role's one requirement since ticket #144: claim_timeout_secs
# reads $self->store->effective_config, and until then the role declared
# nothing, so this class composed by accident rather than by contract. The
# stub can stay empty -- every method exercised below takes its timeout as an
# argument and never asks the board for one. t/147-claim-timeout-requires.t is
# that one-name list's own test.
sub store { }
# json and quiet joined the list in ticket #177, when check_claim began
# recording the expired claims it lets through and expired_claim_report grew
# the two output options every other warning in karr is gated on. Nothing
# below reports, so the stubs stay empty here too.
sub json { }
sub quiet { }
with 'App::karr::Role::ClaimTimeout';
}
my $c = TimeoutConsumer->new;
subtest '_parse_timeout' => sub {
is( $c->_parse_timeout('1h'), 3600, '1h' );
is( $c->_parse_timeout('2h'), 7200, '2h' );
is( $c->_parse_timeout('24h'), 86400, '24h' );
# The mutation that survived: minutes are minutes, not hours.
is( $c->_parse_timeout('1m'), 60, '1m is 60 seconds, not 3600' );
is( $c->_parse_timeout('30m'), 1800, '30m' );
is( $c->_parse_timeout('90m'), 5400, '90m' );
( run in 4.610 seconds using v1.01-cache-2.11-cpan-85d3896f969 )