view release on metacpan or  search on metacpan

t/70-utf8-roundtrip.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use lib 't/lib';
use TestGit qw( require_git_c );
require_git_c();
use TestKarr qw( run_karr );
use File::Temp qw( tempdir );
use Cwd qw( abs_path );
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
# (ticket #63).

# The expectations here are character strings, so a failure diagnostic printing
# one would otherwise warn "Wide character in print" and show the wrong bytes --
# in an encoding test that is the worst possible time for illegible output.
binmode( Test::More->builder->$_, ':encoding(UTF-8)' )
  for qw( output failure_output todo_output );

my $ROOT = abs_path('.');

my $TITLE = "Fix \x{dc}nicode \x{2014} \x{e4}rger";
my $BODY  = "Caf\x{e9} \x{2014} na\x{ef}ve";
my $TAG   = "gr\x{fc}n";

# 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. The encode_utf8(...)
# calls below hand it raw octets already; TestKarr passes an argv element
# through untouched unless it still carries the utf8 flag, so this file's
# whole point -- exact bytes at the argv edge -- still holds in-process.
# KARR_TEST_SUBPROC=1 restores the old open3 path.
sub _run_karr { return run_karr(@_) }

sub _init_repo {
  my $repo = tempdir( CLEANUP => 1 );
  system( 'git', 'init', '-q', $repo );
  system( 'git', '-C', $repo, 'config', 'user.email', 'test@example.com' );
  system( 'git', '-C', $repo, 'config', 'user.name', 'Test User' );
  return $repo;
}

# The stored bytes, straight out of git and untouched by any karr code path.
sub _blob {
  my ( $repo, $ref ) = @_;
  open my $fh, '-|', 'git', '-C', $repo, 'cat-file', '-p', "$ref:data"
    or die "git cat-file: $!";
  binmode $fh;
  my $raw = do { local $/; <$fh> };
  close $fh;
  return defined $raw ? $raw : '';
}

# "Encoded exactly once" as an assertion: the text is present as UTF-8 octets,
# the double encode of it is not, and the payload as a whole is valid UTF-8
# (which rules out three encodes and any partial decode).
sub is_single_utf8 {
  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 'argv to ref: a non-ASCII card is stored as singly-encoded UTF-8' => sub {
  my $repo = _init_repo();
  is( _run_karr( $repo, 'init', '--name', encode_utf8("Board \x{fc}") )->{exit}, 0, 'board initialized' );
  is(
    _run_karr( $repo, 'create', encode_utf8($TITLE),
      '--body', encode_utf8($BODY), '--tags', encode_utf8($TAG) )->{exit},
    0, 'task created from UTF-8 argv'
  );

  my $blob = _blob( $repo, 'refs/karr/tasks/1/data' );
  is_single_utf8( $blob, $TITLE, 'ref blob title' );
  is_single_utf8( $blob, $BODY,  'ref blob body' );
  is_single_utf8( $blob, $TAG,   'ref blob tag' );

  is_single_utf8( _blob( $repo, 'refs/karr/config' ), "Board \x{fc}", 'config ref board name' );

  # And the same bytes parse back to the characters that were typed.
  my $git = App::karr::Git->new( dir => $repo );
  my $task = $git->load_task_ref(1);
  is( $task->title, $TITLE, 'title reads back as characters' );
  is( $task->body,  $BODY,  'body reads back as characters' );
  is_deeply( $task->tags, [$TAG], 'tag reads back as characters' );
};

subtest 'ref to stdout: show and show --json are both singly encoded' => sub {
  my $repo = _init_repo();
  is( _run_karr( $repo, 'init', '--name', 'Show Board' )->{exit}, 0, 'board initialized' );
  is(
    _run_karr( $repo, 'create', encode_utf8($TITLE),
      '--body', encode_utf8($BODY), '--tags', encode_utf8($TAG) )->{exit},
    0, 'task created'
  );

  my $show = _run_karr( $repo, 'show', '1' );
  is( $show->{exit}, 0, 'show exits 0' );
  is_single_utf8( $show->{stdout}, $TITLE, 'show stdout title' );
  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(
    _run_karr( $repo, 'create', encode_utf8($TITLE),
      '--body', encode_utf8($BODY), '--tags', encode_utf8($TAG) )->{exit},
    0, 'task created'
  );
  my $before = _blob( $repo, 'refs/karr/tasks/1/data' );

  is( _run_karr( $repo, 'materialize' )->{exit}, 0, 'materialize exits 0' );

  my ($card) = path($repo)->child('tasks')->children(qr/\.md$/);
  ok( $card, 'a card was written' );
  my $raw = do { open my $fh, '<:raw', "$card" or die $!; local $/; <$fh> };
  is_single_utf8( $raw, $TITLE, 'materialized file title' );
  is_single_utf8( $raw, $BODY,  'materialized file body' );

  my $cfg = do {
    open my $fh, '<:raw', path($repo)->child('config.yml')->stringify or die $!;
    local $/;
    <$fh>;
  };
  ok( defined eval { decode( 'UTF-8', $cfg, FB_CROAK | LEAVE_SRC ) }, 'config.yml is valid UTF-8' );

  is( App::karr::Task->from_file($card)->title, $TITLE, 'the file parses back to the characters' );

  is( _run_karr( $repo, 'import', '--yes' )->{exit}, 0, 'import --yes exits 0' );
  is( _blob( $repo, 'refs/karr/tasks/1/data' ), $before,
    'materialize then import leaves the ref byte-identical' );
};

subtest 'karr reads a task file written by kanban-md' => sub {
  # Not a file karr produced: a plain UTF-8 kanban-md card. Under #53 the whole
  # import died with "YAML::XS::Load Error: invalid trailing UTF-8 octet", so
  # the interop goal was broken for every non-ASCII board.
  my $repo = _init_repo();
  my $tasks = path($repo)->child('tasks');
  $tasks->mkpath;

  my $doc = join '',
    "---\n",
    "id: 1\n",
    "title: " . $TITLE . "\n",
    "status: backlog\n",
    "priority: medium\n",
    "class: standard\n",
    "created: 2026-01-01T00:00:00Z\n",
    "updated: 2026-01-01T00:00:00Z\n",
    "tags:\n",
    "- " . $TAG . "\n",
    "---\n",
    "\n",
    $BODY . "\n";