App-karr
view release on metacpan or search on metacpan
- Fixed a frontmatter value ending in `---` corrupting the task and
bricking the board. The closing delimiter was not anchored to the start
of a line, so a value that merely ended in `---` — `karr edit 1 --block
"waiting ---"` was enough, and YAML dumps such a value unquoted — cut the
frontmatter mid-line. Every command that loads the board then died with
"Missing required arguments: id, title", `delete` included, so the board
could not be repaired with karr at all. The parser now scans for `---` at
a line start, matching kanban-md.
- Fixed UTF-8 being encoded twice everywhere. karr passed YAML::XS::Dump
output (octets) around as characters, mixed that with character-level
file I/O, and never decoded `@ARGV`. Non-ASCII text was therefore stored
mojibaked in the refs, handed to agents mojibaked through `--json`,
written three encodes deep by `materialize`, and destroyed by
`backup`/`restore`; a correctly encoded kanban-md task file could not be
imported at all ("invalid trailing UTF-8 octet"). `karr show` looked
right only because two errors cancelled out. karr now keeps character
strings internally and encodes only at its edges — argv, stdout/stderr,
Git ref blobs, YAML and JSON — so non-ASCII titles, bodies, tags, and
board names round-trip and kanban-md interop works outside ASCII.
- Boards written by earlier versions keep working and are read correctly:
the double encoding is undone on load for any board without the new
one that also covers the `exit` calls inside command bodies. A command
that died before writing anything still pushes nothing and says nothing,
and a push that fails there warns without touching the exit code. The
global-destruction report above stays as the last resort for embedders
that never drain the registry.
- A writing command whose push fails no longer retries six times. Its
`sync_after` disarms the guard after spending its own three attempts, so
the new `END` flush does not repeat the identical failing push on a
command that is already reporting the failure.
- `karr skill show` no longer warns "Wide character in print". The bundled
skill file is read decoded, so it is now encoded back to UTF-8 bytes at
the one print site. The output bytes were always correct, but the warning
was noise on stderr — and it ended up inside the written file whenever
someone refreshed an installed SKILL.md with `karr skill show >file 2>&1`.
- The installed executables `karr` and `karr-foundation` now carry a
`$VERSION`. Both shipped versionless through 0.400, 0.401 and 0.402: the
woven POD had a VERSION section (generated from the dist version), but the
code itself declared none. Dist::Zilla only inserts a `$VERSION` into a
file that has a `package` statement, which a script does not — so the
line has to exist once, after which every release keeps it in step.
- Fixed silent loss of another agent's work on every shared board. `push`
bin/karr-foundation view on Meta::CPAN
# PODNAME: karr-foundation
# ABSTRACT: Single-shot foundation daemon for periodic karr agent execution
use strict;
use warnings;
our $VERSION = '0.600';
use App::karr::Foundation;
use App::karr::Encoding qw( decode_argv enable_std_utf8 );
use App::karr::Error qw( is_usage_error );
# Same character/octet boundary as F<karr> (ticket #53). The agent output this
# tees to the terminal is raw bytes and is decoded incrementally in
# App::karr::Foundation::Runner, not here.
enable_std_utf8();
decode_argv();
# What is left of @ARGV after option parsing is the hub command, if any
# (`ask`, `answer`, `chain`, `plan`) -- see App::karr::Foundation::run. MooX::Options is
# configured with protect_argv => 0 in that class, which is what makes the
# leftovers visible here.
# An option name with a dash in it does not survive standing behind a boolean
# flag, so the flags are respelled with underscores before MooX::Options looks
lib/App/karr/ActivityLog.pm view on Meta::CPAN
( $self->_legacy_refs, $self->_segment_refs );
}
sub _entries_from {
my ( $self, $ref ) = @_;
my $content = $self->git->read_ref($ref);
return () unless defined $content && length $content;
my @entries;
for my $line (split /\n/, $content) {
next unless length $line;
my $decoded = eval { json_decode($line) };
push @entries, $self->git->maybe_repair_legacy($decoded) if $decoded;
}
return @entries;
}
sub last_entry {
my ($self) = @_;
for my $ref ( reverse( $self->_legacy_refs, $self->_segment_refs ) ) {
my @entries = $self->_entries_from($ref);
return $entries[-1] if @entries;
lib/App/karr/ActivityLog.pm view on Meta::CPAN
Returns the result of L<Git/write_ref_cas>, or C<0> after warning if the entry
could not be written. It never dies: by the time a command logs, it has
already written the task the entry describes, so a failure here must not take
the command down with a half-applied mutation behind it (#75).
=head2 entries
my @entries = $log->entries;
Returns the decoded log entries for this identity, oldest first. Refs written
under the pre-#75 naming schemes are read first and merged in ahead of the
current ref, which is also their chronological order: a board stops being
written under an old scheme the moment it is touched by a karr that knows the
new one. The current scheme's segments (L</Segments>) follow in segment order,
which is chronological for the same reason: only the newest segment is ever
appended to.
=head2 last_entry
my $entry = $log->last_entry;
The most recent decoded log entry for this identity, or C<undef> if none.
Reads the refs newest-first and stops at the first one that yields an entry, so
on a segmented log this is one small ref read rather than the whole history --
the point of L</Segments> being lost if the cheap write path were paid for with
an expensive read of the last line.
=head1 SUPPORT
=head2 Issues
lib/App/karr/BoardStore.pm view on Meta::CPAN
This is the question the commands that clean up or read raw refs
(C<backup>, C<destroy>, C<materialize>, C<repair>) actually have: refusing them
on a half-board would strand the refs a pre-fix karr already left behind, with
no way to remove them from inside karr.
my $anything_here = $store->has_board_refs;
=head2 load_config_overrides
Returns the board's raw config overrides -- whatever C<refs/karr/config>
currently holds, decoded but not merged with the code defaults. A board with
no config ref yet, or one whose ref does not decode to a mapping, answers
C<{}> rather than C<undef> or dying.
my $overrides = $store->load_config_overrides; # sparse, not effective
This is the input L</load_config> merges over
L<App::karr::Config/default_config>; see that method for the merged result,
and L</effective_config> for its cached form.
=head2 load_config
lib/App/karr/Cmd/Context.pm view on Meta::CPAN
my $git = $self->git;
my $log = $self->activity_log;
my @entries;
for my $ref ($git->list_refs('refs/karr/log/')) {
next if $log->owns_ref($ref);
my $content = $git->read_ref($ref);
next unless defined $content && length $content;
for my $line (split /\n/, $content) {
next unless length $line;
my $decoded = eval { json_decode($line) };
push @entries, $git->maybe_repair_legacy($decoded) if $decoded;
}
}
@entries = sort { ($a->{ts} // '') cmp ($b->{ts} // '') } @entries;
my $limit = $self->activity_limit;
@entries = @entries[-$limit .. -1] if $limit && @entries > $limit;
# Newest first, like recently-completed -- the point of a briefing is that
# the most relevant items are the ones on top.
return map {
lib/App/karr/Cmd/Skill.pm view on Meta::CPAN
}
sub _show {
my ($self) = @_;
my $content = $self->_skill_content;
if ($self->json) {
# Characters in, characters out, exactly like the plain branch below:
# print_json goes through App::karr::Encoding::json_encode, which is the
# character-level codec, and STDOUT's :encoding(UTF-8) layer does the one
# and only encode. _skill_content is already decoded (slurp_utf8), so it
# goes in untouched.
return $self->print_json({ content => $content });
}
# Ticket #33 encoded here, because back then the rest of the CLI handed raw
# octets to print and a layer on STDOUT would have double-encoded them.
# Ticket #53 removed that premise: STDOUT now carries :encoding(UTF-8) and
# every command prints characters, so _skill_content goes out as-is.
# Encoding it again here would be the very double encode #33 was avoiding.
print $content;
lib/App/karr/Dispatch.pm view on Meta::CPAN
my (@argv) = @_;
# dispatch operates on the global @ARGV, exactly as bin/karr did inline:
# the two rewrites above and MooX::Cmd::new_with_cmd all read and write it.
# Localising it lets an embedding host call dispatch repeatedly, and lets
# bin/karr pass its own @ARGV in unchanged.
local @ARGV = @argv;
# The character/octet boundary (ticket #53). Everything the OS hands in is
# bytes; everything a command body sees is Perl characters. @ARGV comes in
# decoded, STDOUT and STDERR encode on the way out, and no command body
# encodes anything itself. STDIN stays raw on purpose -- every reader of it
# decodes its own payload (#246).
enable_std_utf8();
decode_argv();
# The caller's own words, kept for the suggestion line an option-parse error
# ends on (ticket k263). Recorded HERE because both rewrites below change
# argv and neither leaves what anyone typed: _refuse_empty_argument's
# diagnosis reads the raw line, and _normalize_option_argv respells
# --claimed-by as --claimed_by and folds a flag-shaped value onto its option
lib/App/karr/Encoding.pm view on Meta::CPAN
return $data unless $data =~ /[^\x00-\x7F]/; # ASCII: nothing to repair
return $data if $data =~ /[^\x00-\xFF]/; # real characters: already right
# LEAVE_SRC on both calls, and it is not cosmetic: with a CHECK argument and
# without it, Encode consumes the source string in place. Omitting it here
# emptied $data, so every string that reached the decode and failed it -- all
# ordinary Latin-1 text -- came back as "" instead of unchanged.
my $octets = eval { encode( 'ISO-8859-1', $data, FB_CROAK | LEAVE_SRC ) };
return $data unless defined $octets;
my $decoded = eval { decode( 'UTF-8', $octets, FB_CROAK | LEAVE_SRC ) };
return defined $decoded ? $decoded : $data;
}
1;
__END__
=pod
=encoding UTF-8
lib/App/karr/Foundation.pm view on Meta::CPAN
=head1 DESCRIPTION
F<karr-foundation> is a single-shot, idempotent CLI meant to be invoked
periodically (cron, systemd-timer, while-loop). It scans configured karr
boards, detects changes or open work, and B<drains> each board by invoking the
configured agent command repeatedly until no actionable task remains.
B<Using this class as a library.> F<bin/karr-foundation> is what most callers
run, and it is also where karr's character/octet boundary gets set up (see
L<App::karr::Encoding>) before any command code runs: a C<:encoding(UTF-8)>
layer goes on C<STDOUT>/C<STDERR>, and C<@ARGV> is decoded before
C<new_with_options> reads it into option values. This class does not repeat
either step -- both are the program's decision, not one a class it merely
loads should make for it (see L<App::karr::Encoding/enable_std_utf8> and
L<App::karr::Encoding/decode_argv>). A caller that loads
C<App::karr::Foundation> directly, instead of invoking that script, is
responsible for both:
use App::karr::Encoding qw( decode_argv enable_std_utf8 );
enable_std_utf8();
decode_argv();
App::karr::Foundation->new_with_options->run(@ARGV);
Skipping the handles does not fail outright: every fixed message this class
prints or warns is plain ASCII (ticket #214). What it does not cover is data
-- a non-ASCII repo path folded into a C<skip $repo -- $wait> line, or a YAML
error carried through C<clean_error> into a C<warn> -- which still risks
C<Wide character in print>/C<warn> the first time it reaches a handle nobody
configured. Skipping C<@ARGV> is quieter, not safer: option values built from
it hold raw UTF-8 octets instead of decoded characters, with no warning to
say so.
B<Config file:> C<~/.config/karr-foundation/config.yml> (or C<--config>).
dirs:
- /path/to/repo1
- /path/to/repo2
scan:
- /path/to/parent-dir # finds all direct subdirs that have a .karr file
lib/App/karr/Foundation/ChainStore.pm view on Meta::CPAN
sub run_entries {
my ( $self, $run ) = @_;
return () unless _valid_run($run);
my @entries;
for my $ref ( $self->_run_segments($run) ) {
my $content = $self->git->read_ref($ref);
next unless defined $content && length $content;
for my $line ( split /\n/, $content ) {
next unless length $line;
my $decoded = try { json_decode($line) } catch { undef };
push @entries, $decoded if $decoded;
}
}
return @entries;
}
sub prune_logs {
my ( $self, %opt ) = @_;
my $keep_days = defined $opt{keep_days} ? $opt{keep_days} : $self->keep_days;
my $keep_runs = defined $opt{keep_runs} ? $opt{keep_runs} : $self->keep_runs;
lib/App/karr/Foundation/ChainStore.pm view on Meta::CPAN
Split out of L</write_chain> because C<karr-foundation plan --dry-run> has to
be able to say "this chain is good" without writing it, and a dry run checking
a chain from its own copy of the rules would be a second opinion rather than
the same one.
=head2 parse_chain_document
my ( $steps, %header ) = $store->parse_chain_document( $document );
Takes the decoded document C<karr-foundation plan> reads -- YAML or JSON, and
JSON only because a YAML parser reads it -- and returns the two arguments
L</write_chain> takes: the step list, and the header options C<limits>, C<note>
and C<planner>.
Two spellings are accepted, because both say the same thing: a mapping with a
C<steps:> list and the header keys beside it, or a bare list, which B<is> the
step list. The second is what L</write_chain>'s own first argument looks like,
so a planner writing only steps has written a whole document.
No step is looked at here -- that is L</validate_chain>, which the write path
lib/App/karr/Foundation/ChainStore.pm view on Meta::CPAN
my @runs = $store->run_ids;
Every run that has a log, oldest first -- which is plain lexical order, because
the name starts with the date. Segments are folded back into the run they
belong to.
=head2 run_entries
my @entries = $store->run_entries($run);
The decoded entries of one run, oldest first, read across every segment.
=head2 prune_logs
my @gone = $store->prune_logs; # the configured policy
my @gone = $store->prune_logs( keep_days => 2 ); # or an explicit one
Drops the run logs the retention policy no longer keeps -- everything older
than L</keep_days>, plus everything past the newest L</keep_runs> -- and
returns the run names it removed. Every segment of a removed run goes.
t/157-encoding-user-name.t view on Meta::CPAN
my ( $bytes, $text, $name ) = @_;
my $ok = 1;
$ok &&= ok( index( $bytes, encode_utf8($text) ) >= 0, "$name: present as UTF-8 octets" );
$ok &&= is( index( $bytes, encode_utf8( encode_utf8($text) ) ), -1, "$name: not double-encoded" );
$ok &&= ok( defined eval { decode( 'UTF-8', $bytes, FB_CROAK | LEAVE_SRC ) },
"$name: payload is valid UTF-8" );
diag( "offending bytes: " . unpack( 'H*', $bytes ) ) unless $ok;
return $ok;
}
subtest 'git_user_name returns decoded characters, not raw octets' => sub {
my $repo = _init_repo();
my $git = App::karr::Git->new( dir => $repo );
is( $git->git_user_name, $NAME,
'git_user_name returns the characters, not the UTF-8 octets' );
ok( utf8::is_utf8( $git->git_user_name ),
'...and the string is flagged as characters' );
is( $git->git_user_email, $EMAIL,
'git_user_email returns the characters' );
t/211-skill-doc-double-encoding.t view on Meta::CPAN
# remember to update this test.
#
# .claude/skills/kanban-issues-karr-cli/SKILL.md (the copy this repo's own
# agents are briefed with) is not scanned here: t/62-skill-doc-sync.t already
# requires its body to be byte-identical to share/claude-skill.md's, so a
# mojibake regression in either file becomes a body mismatch that test
# already catches -- confirmed still passing as of this test being written.
# This test only has to own the encoding shape itself.
# Every double-encoded UTF-8 run in $bytes, as a list of the raw byte
# sequences that matched (not decoded -- the point is to see the bytes that
# went wrong). \xc3[\x80-\xbf] is a UTF-8 lead byte re-encoded as if it were a
# single Latin-1 character; (?:\xc2[\x80-\xbf])+ is one or more UTF-8
# continuation bytes re-encoded the same way. Together they catch any
# double-encoded character, not just the em dash and arrow ticket #211 found.
sub find_double_encoded {
my ($bytes) = @_;
my @hits = $bytes =~ /(\xc3[\x80-\xbf](?:\xc2[\x80-\xbf])+)/g;
return @hits;
}
t/211-skill-doc-double-encoding.t view on Meta::CPAN
subtest "$file" => sub {
my $bytes = $file->slurp_raw;
# Guard against a vacuous pass: if the file lost its non-ASCII content
# entirely, the checks below would all trivially succeed while proving
# nothing about double-encoding.
like $bytes, qr/[^\x00-\x7f]/,
'the file carries non-ASCII bytes worth checking';
# decode() with a CHECK argument modifies its OCTETS argument in place --
# it consumes decoded characters off the front of the buffer it was
# handed, so on full success it leaves the original variable empty. Feed
# it a copy, never $bytes itself, or the double-encoding scan below would
# silently run against an emptied string and pass no matter what.
my $bytes_for_decode = $bytes;
my $decoded = eval { decode( 'UTF-8', $bytes_for_decode, FB_CROAK ) };
my $decode_error = $@;
ok( defined $decoded, 'the file is valid UTF-8' )
or diag("UTF-8 decode failed: $decode_error");
my @hits = find_double_encoded($bytes);
is( scalar @hits, 0, 'no double-encoded UTF-8 sequences (ticket #211)' )
or diag( 'found: ' . join( ', ', map { unpack 'H*', $_ } @hits ) );
SKIP: {
skip 'cannot check for C1 controls in bytes that are not valid UTF-8', 1
unless defined $decoded;
my @c1 = $decoded =~ /([\x{80}-\x{9f}])/g;
is( scalar @c1, 0, 'no stray C1 control characters (U+0080-U+009F)' )
or diag( 'found: ' . join( ', ', map { sprintf 'U+%04X', ord $_ } @c1 ) );
}
};
}
done_testing;
t/242-delete-cross-board-warning.t view on Meta::CPAN
like( $r->{stdout}, qr/Skipped task 1/, 'and the operator could act on it' );
ok( _task( $here, 1 ), 'so the card is still there' );
};
subtest 'the kept card carries them under --json too' => sub {
my $here = _board('boardA');
_create( $here, 'Fix the API', '--escalated-from', 'boardB#5' );
my $r = _run_karr( $here, \"n\n", 'delete', '1', '--json' );
# The confirmation prompt is printed to STDOUT whatever --json says, so the
# object is decoded from where it starts. That is a separate defect of the
# prompt (the neighbour of #241, which fixed its flushing and not its
# channel), not of the warning under test, and this test declines to pin it
# either way.
my ($json) = $r->{stdout} =~ /(\{.*\})/s;
my $data = eval { decode_json( $json // '' ) };
ok( $data, 'STDOUT carries the result object' )
or diag "stdout was: $r->{stdout}";
ok( !$data->{deleted},
'deleted:false says the delete the warning named did not happen' );
like( $data->{cross_board_warnings}[0], qr/was escalated from boardB#5/,
t/26-skill-share-dir.t view on Meta::CPAN
$lib->child('File')->mkpath;
$lib->child('File/ShareDir.pm')->spew_utf8( <<'PERL' );
package File::ShareDir;
sub dist_dir { die "Failed to find share dir for dist 'App-karr'\n" }
1;
PERL
return $lib;
}
# Raw bytes on both sides: the child writes UTF-8 to its stdout, the file holds
# UTF-8, and comparing them undecoded keeps this check about which file was
# found rather than about encoding (t/65 owns that).
sub run_karr {
my ( $cwd, $lib, @args ) = @_;
my $old_cwd = getcwd();
chdir $cwd or die "chdir $cwd: $!";
my $err_fh = gensym;
my $pid = open3( my $in, my $out_fh, $err_fh,
$^X, "-I$lib", "-I$ROOT/lib", $BIN, @args );
close $in;
binmode $out_fh;
t/49-config-skill-options-first.t view on Meta::CPAN
# positional (the action). `skill --agent NAME check` needs the real parser
# because --agent (format=s) swallows its value -- a naive dash-filter would
# read the agent value as the action.
#
# These subtests drive the real bin/karr via a subprocess, so they exercise the
# actual MooX::Cmd protect_argv argv echo that causes the bug (same harness as
# the #11/#13 regressions in t/43 and t/45). RED before the fix: every
# "options-first" subtest died with "Unknown action: --<flag>"; the surplus-arg
# subtests did not reject (config) / had no arity guard (skill).
#
# JSON equality is checked against the *decoded* structure, not raw bytes:
# print_json is not canonical, so two separate processes can emit the same
# config with different hash key order.
# 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(@_) }
sub _git_ok {
t/51-json-output.t view on Meta::CPAN
my $cmd = App::karr::Cmd::Move->new( store => $store );
my ( $err, $out ) = _run_execute( $cmd, '1', 'done' );
is( $err, '', 'move without --json does not die' );
like( $out, qr/Moved task 1/, 'human-readable line printed' );
# A removed guard would leak the results object/array into plain output; the
# human line itself carries no braces, so any brace means JSON leaked through.
unlike( $out, qr/[{}]/, 'no JSON emitted when --json is absent' );
my $decoded = eval { decode_json($out) };
ok( !defined $decoded, 'plain output is not JSON-decodable' );
};
subtest 'edit --json: single id is a bare object with id and title' => sub {
my $store = _fresh_store();
_save( $store, id => 1, title => 'Old title', status => 'todo' );
my $cmd = App::karr::Cmd::Edit->new(
store => $store,
json => 1,
title => $TITLE,
t/51-json-output.t view on Meta::CPAN
# decode_json($out) eq $TITLE cannot distinguish a correct encoder from a
# consistently wrong one, so assert on the octets themselves. Under #53's
# double encode the first index is -1 and the second is 0.
ok( index( $out, encode_utf8($TITLE) ) >= 0,
'the title reaches stdout as singly-encoded UTF-8' )
or diag unpack( 'H*', $out );
is( index( $out, encode_utf8( encode_utf8($TITLE) ) ), -1,
'and never as the double-encoded form' );
ok( index( $out, encode_utf8($BODY) ) >= 0, 'same for the body' );
my $decoded = eval { decode( 'UTF-8', $out, FB_CROAK | LEAVE_SRC ) };
ok( defined $decoded, 'the whole payload is valid UTF-8' );
my $data = eval { decode_json($out) };
is( $data->{title}, $TITLE, 'and it still parses back to the characters that went in' );
is( $data->{body}, $BODY, 'body round-trips too' );
};
done_testing;
t/65-skill-show-utf8.t view on Meta::CPAN
use Cwd qw( abs_path getcwd );
use IPC::Open3 qw( open3 );
use Symbol qw( gensym );
use Path::Tiny qw( path );
use Encode qw( encode_utf8 decode FB_CROAK LEAVE_SRC );
use App::karr::Cmd::Skill;
# The bundled skill file is real Markdown prose and legitimately contains
# non-ASCII (em dashes, ellipses, umlauts). _skill_content hands it back
# decoded (slurp_utf8), so exactly one encode must happen between there and the
# terminal.
#
# Ticket #33 put that encode inside the command, because the rest of the CLI
# handed raw octets to print and a UTF-8 layer on STDOUT would have
# double-encoded them. Ticket #53 moved the boundary: F<bin/karr> now installs
# the layer (App::karr::Encoding::enable_std_utf8) and every command prints
# characters, so the encode in the command became the double encode #33 was
# avoiding and was removed. This file pins the property both fixes were after --
# stdout carries singly-encoded UTF-8 -- rather than either implementation of
# it, so it stays honest across the move.
t/65-skill-show-utf8.t view on Meta::CPAN
is( scalar(@$warnings), 0, 'no warnings at all' )
or diag "warnings emitted: @$warnings";
is( $out, encode_utf8($SKILL_TEXT), 'stdout carries the correctly encoded UTF-8 bytes' );
ok( !utf8::is_utf8($out) || $out !~ /[^\x00-\xff]/,
'nothing wider than a byte reached the output handle' );
# The failure mode the removed encode_utf8 would now produce: bytes that are
# still valid UTF-8, but decode to the mojibake of the real text rather than
# to the text.
my $decoded = eval { decode( 'UTF-8', $out, FB_CROAK | LEAVE_SRC ) };
is( $decoded, $SKILL_TEXT, 'decoding the output once gives the text back (encoded exactly once)' );
isnt( $out, encode_utf8( encode_utf8($SKILL_TEXT) ), 'output is not double-encoded' );
};
subtest '_skill_content stays decoded so check/update comparisons keep working' => sub {
# Guards the tempting wrong fix of slurping raw: that would silence the
# warning but make _check/_update compare bytes against slurp_utf8 text
# (always "outdated") and make _install spew_utf8 a double-encoded file.
my $dir = tempdir( CLEANUP => 1 );
path($dir)->child('claude-skill.md')->spew_utf8($SKILL_TEXT);
require File::ShareDir;
no warnings 'redefine';
local *File::ShareDir::dist_dir = sub { return $dir };
my $content = App::karr::Cmd::Skill->new->_skill_content;
is( $content, $SKILL_TEXT, '_skill_content returns decoded characters' );
is( length($content), length($SKILL_TEXT), 'character length matches (not byte-inflated)' );
};
subtest 'karr skill show through the real CLI emits the bundled file verbatim' => sub {
my $bundled = path($ROOT)->child('share/claude-skill.md');
plan skip_all => "no share/claude-skill.md in this checkout" unless $bundled->exists;
my $raw = do {
open my $fh, '<:raw', "$bundled" or die "open $bundled: $!";
local $/;
t/70-utf8-roundtrip.t view on Meta::CPAN
use Path::Tiny qw( path );
use JSON::MaybeXS qw( decode_json );
use Encode qw( encode_utf8 decode FB_CROAK LEAVE_SRC );
use App::karr::Git;
use App::karr::Task;
use App::karr::Encoding qw( repair_mojibake );
# Ticket #53: karr mixed character strings and UTF-8 octets. YAML::XS::Dump
# emits octets and Load wants them, Path::Tiny's slurp_utf8/spew_utf8 work in
# characters, and @ARGV was never decoded -- so the frontmatter in every ref was
# encoded twice, `--json` handed agents mojibake, materialize wrote three
# encodes deep, and a correctly encoded kanban-md file could not be imported at
# all ("invalid trailing UTF-8 octet"). `karr show` looked right only because
# two errors cancelled.
#
# The contract now is one line: characters inside, octets only at the edges
# (App::karr::Encoding). This file walks a non-ASCII card the whole way round --
# argv, ref, show, --json, materialize, import, ref -- and asserts on the
# *bytes* at every edge, because any assertion that decodes what karr encoded is
# an identity round trip and would stay green under a consistent mis-encoding
t/70-utf8-roundtrip.t view on Meta::CPAN
is_single_utf8( $show->{stdout}, $BODY, 'show stdout body' );
# --json is the interface agents parse and the one #53 got wrong even while
# plain show looked correct.
my $json = _run_karr( $repo, 'show', '1', '--json' );
is( $json->{exit}, 0, 'show --json exits 0' );
is_single_utf8( $json->{stdout}, $TITLE, 'show --json title' );
is_single_utf8( $json->{stdout}, $BODY, 'show --json body' );
my $data = decode_json( $json->{stdout} );
is( $data->{title}, $TITLE, 'decoded json title' );
is( $data->{body}, $BODY, 'decoded json body' );
is_deeply( $data->{tags}, [$TAG], 'decoded json tag' );
my $list = _run_karr( $repo, 'list' );
is( $list->{exit}, 0, 'list exits 0' );
is_single_utf8( $list->{stdout}, $TITLE, 'list stdout title' );
};
subtest 'ref to file view and back: materialize, import, ref' => sub {
my $repo = _init_repo();
is( _run_karr( $repo, 'init', '--name', 'Round Board' )->{exit}, 0, 'board initialized' );
is(
t/71-legacy-encoding-repair.t view on Meta::CPAN
use YAML::XS ();
use JSON::MaybeXS qw( encode_json decode_json );
use Encode qw( encode_utf8 decode );
use App::karr::Git;
use App::karr::Encoding qw( BOARD_ENCODING_VERSION );
# Ticket #53, the half that is about boards that already exist.
#
# karr up to 0.402 fed YAML::XS::Dump the *octets* of every frontmatter value
# (because @ARGV was never decoded) and Dump encoded them a second time, so
# every board written by those versions carries double-encoded UTF-8 in its task
# frontmatter, its config, and its activity log. Task bodies do not: they were
# concatenated onto the document verbatim and are singly encoded. Fixing the
# encoding without accounting for that would have turned every existing board's
# titles into visible mojibake.
#
# The decision, and what this file pins:
#
# * refs/karr/meta/encoding is the discriminator. Absent => a board written
# by 0.402 or earlier,
t/80-skill-show-json.t view on Meta::CPAN
use App::karr::Cmd::Skill;
# Ticket #79: `karr skill show --json` printed the raw skill Markdown, byte for
# byte identical to `karr skill show`, so the flag was ignored and the output
# was not JSON at all (probed pre-fix: `diff <(karr skill show) <(karr skill
# show --json)` empty, decode_json on it dies "malformed number ... before
# '---\nname: karr'"). Its siblings `skill check --json` and `skill install
# --json` were already correct, so only this one action was wrong.
#
# The second half of this file guards the character/octet boundary
# (App::karr::Encoding, tickets #53/#63). _skill_content hands back decoded
# characters and Role::Output::print_json is character-level too, so exactly
# one encode may happen between the share file and the terminal -- the
# :encoding(UTF-8) layer F<bin/karr> installs. See t/65-skill-show-utf8.t for
# the same property on the plain branch.
#
# Written with \x{} escapes so the expectation does not depend on the source
# encoding of this test file.
my $SKILL_TEXT = "# karr \x{2014} skill\n\nBl\x{00f6}cke \x{2026} \x{00fc}ml\x{00e4}ute\n";
my $ROOT = abs_path('.');
t/80-skill-show-json.t view on Meta::CPAN
subtest 'the JSON payload carries the skill content, encoded exactly once' => sub {
my ($json_out) = run_skill_show( json => 1 );
my ($plain_out) = run_skill_show();
# decode_json is octet-level, and $json_out is what actually reached the
# handle, so this asserts on the bytes rather than on an identity round
# trip through the same codec that produced them (the #63 lesson).
my $data = decode_json($json_out);
is $data->{content}, $SKILL_TEXT,
'the decoded content is the skill text, character for character';
is encode_utf8( $data->{content} ), $plain_out,
'and re-encoding it reproduces the plain-output bytes byte for byte';
# The failure mode a second encode anywhere on the JSON path would produce:
# bytes that are still valid UTF-8 but decode to the mojibake of the text.
my $decoded_once = eval { decode( 'UTF-8', $json_out, FB_CROAK | LEAVE_SRC ) };
ok defined $decoded_once, 'stdout decodes as UTF-8 exactly once';
unlike $decoded_once, qr/\x{00e2}\x{0080}\x{0094}/,
'the em dash did not survive as double-encoded bytes';
};
subtest 'plain skill show is unchanged by the --json branch' => sub {
my ( $out, $warnings ) = run_skill_show();
is $out, encode_utf8($SKILL_TEXT), 'stdout still carries singly-encoded UTF-8 bytes';
my @wide = grep { /Wide character/ } @$warnings;
is scalar(@wide), 0, 'still no "Wide character in print" warning'
or diag "@$warnings";
};
t/89-activity-log-refname.t view on Meta::CPAN
'colon:@example.com',
'brack[et@example.com',
'back\\slash@example.com',
'at@{brace@example.com',
'@',
)
{
my $id = _log_for($email);
ok( Git::Native->reference_name_is_valid("refs/karr/log/$id"),
"'$email' -> refs/karr/log/$id is a valid ref name" );
my ( $role, $decoded ) = App::karr::ActivityLog->decode_identity($id);
is( $decoded, $email, "'$email' round-trips out of the ref name" );
is( $role, 'user', "'$email' keeps its role component" );
}
};
subtest 'distinct addresses never share one log ref' => sub {
my @colliding = ( 'a b@x.com', 'a-b@x.com', 'a+b@x.com', 'a/b@x.com', 'a_b@x.com' );
my %seen;
$seen{ _log_for($_) }++ for @colliding;
is( scalar keys %seen, scalar @colliding,
'five addresses that used to sanitize to a_b_x.com get five refs' );
t/89-activity-log-refname.t view on Meta::CPAN
my $from_octets = _log_for($octets);
my $from_chars = _log_for($chars);
is( $from_chars, $from_octets,
'characters and octets encode to the same ref name' );
is( $from_octets, 'user/j%C3%BCrgen%40example.com',
'the UTF-8 octets are percent-encoded, not replaced by _' );
ok( Git::Native->reference_name_is_valid("refs/karr/log/$from_octets"),
'and the name is legal' );
my ( undef, $decoded ) = App::karr::ActivityLog->decode_identity($from_octets);
is( $decoded, $chars, 'decodes back to the original characters' );
};
subtest 'the role component is encoded too' => sub {
my $id = _log_for( 'dev@example.com', role => 'weird/role..name' );
ok( Git::Native->reference_name_is_valid("refs/karr/log/$id"),
"role 'weird/role..name' still yields a valid ref name" );
my ($role) = App::karr::ActivityLog->decode_identity($id);
is( $role, 'weird/role..name', 'role round-trips' );
};
( run in 1.647 second using v1.01-cache-2.11-cpan-364913b4093 )