view release on metacpan or  search on metacpan

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

  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";
  { open my $fh, '>:raw', $tasks->child('001-cafe.md')->stringify or die $!;
    print {$fh} encode_utf8($doc);
    close $fh }

  my $direct = App::karr::Task->from_file( $tasks->child('001-cafe.md') );
  is( $direct->title, $TITLE, 'from_file decodes a kanban-md title' );
  is( $direct->body,  $BODY,  'from_file decodes a kanban-md body' );
  is_deeply( $direct->tags, [$TAG], 'from_file decodes a kanban-md tag' );

  my $rv = _run_karr( $repo, 'import', '--yes' );
  is( $rv->{exit}, 0, 'import --yes succeeds on a kanban-md view' ) or diag $rv->{stderr};
  unlike( $rv->{stderr}, qr/invalid trailing UTF-8 octet/, 'no YAML::XS decode error' );

  is_single_utf8( _blob( $repo, 'refs/karr/tasks/1/data' ), $TITLE, 'imported ref title' );
  is( App::karr::Git->new( dir => $repo )->load_task_ref(1)->title, $TITLE,
    'and it reads back as the same characters' );
};

subtest 'backup and restore preserve a non-ASCII board' => sub {
  my $repo = _init_repo();
  is( _run_karr( $repo, 'init', '--name', 'Snap 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' );

  my $file = path($repo)->child('snapshot.yml');
  is( _run_karr( $repo, 'backup', '--output', "$file" )->{exit}, 0, 'backup --output exits 0' );

  my $raw = do { open my $fh, '<:raw', "$file" or die $!; local $/; <$fh> };
  is_single_utf8( $raw, $TITLE, 'snapshot file title' );

  is( _run_karr( $repo, 'restore', '--yes', '--input', "$file" )->{exit}, 0, 'restore exits 0' );

  # Not a byte-for-byte comparison: Git::read_ref chomps the payload's trailing
  # newline to match the old `git cat-file` behaviour, so a backup/restore cycle
  # has always dropped exactly that one byte -- on ASCII boards too, and on
  # 0.402 as well. That is a separate defect; what this subtest is about is that
  # no character is mangled on the way through.
  my $after = _blob( $repo, 'refs/karr/tasks/1/data' );
  is( $after, ( $before =~ s/\n\z//r ), 'the restored ref is the original payload (less the chomped newline)' );
  is_single_utf8( $after, $TITLE, 'restored ref title' );
  is_single_utf8( $after, $BODY,  'restored ref body' );

  my $task = App::karr::Git->new( dir => $repo )->load_task_ref(1);
  is( $task->title, $TITLE, 'restored title reads back as characters' );
  is( $task->body,  $BODY,  'restored body reads back as characters' );
  is_deeply( $task->tags, [$TAG], 'restored tag reads back as characters' );
};

subtest 'the two entry points install the boundary' => sub {
  # The boundary only exists if the scripts set it up; a command body doing it
  # for itself is exactly the per-call-site encoding #53 removed. Pinning the
  # call sites keeps a future refactor from quietly dropping one. bin/karr's
  # own call site moved into App::karr::Dispatch (shared with the in-process
  # test runner, t/lib/TestKarr.pm); bin/karr-foundation still does it inline.
  my $dispatch_src = path($ROOT)->child(qw( lib App karr Dispatch.pm ))->slurp_utf8;
  like( $dispatch_src, qr/^\s*enable_std_utf8\(\);/m,
    'App::karr::Dispatch puts the UTF-8 layer on stdout/stderr' );
  like( $dispatch_src, qr/^\s*decode_argv\(\);/m, 'App::karr::Dispatch decodes @ARGV' );

  my $karr_src = path($ROOT)->child(qw( bin karr ))->slurp_utf8;
  like( $karr_src, qr/^dispatch\(\@ARGV\);/m, 'bin/karr calls into that dispatch path' );

  my $foundation_src = path($ROOT)->child(qw( bin karr-foundation ))->slurp_utf8;
  like( $foundation_src, qr/^enable_std_utf8\(\);/m,
    'bin/karr-foundation puts the UTF-8 layer on stdout/stderr' );
  like( $foundation_src, qr/^decode_argv\(\);/m, 'bin/karr-foundation decodes @ARGV' );
};

subtest 'repair_mojibake only touches what is unambiguously double-encoded' => sub {
  # The one heuristic in the encoding boundary, used for boards written by
  # 0.402 or earlier.
  # Its safety rests on these four cases.
  is( repair_mojibake('plain ascii'), 'plain ascii', 'ASCII is returned unchanged' );
  is( repair_mojibake($TITLE), $TITLE, 'text with a real wide character is left alone' );

  # Latin-1 that is not valid UTF-8 when read back as bytes: "\x{fc}ber" is
  # fc 62, an unfinished sequence. Nothing to undo, so nothing is undone.
  is( repair_mojibake("\x{fc}ber"), "\x{fc}ber", 'lone Latin-1 text is left alone' );

  # The actual corruption: the UTF-8 octets of $TITLE read as Latin-1.
  my $broken = decode( 'ISO-8859-1', encode_utf8($TITLE) );
  isnt( $broken, $TITLE, 'the fixture really is mojibake to begin with' );
  is( repair_mojibake($broken), $TITLE, 'double-encoded text is repaired' );

  is_deeply(
    repair_mojibake( { title => $broken, tags => [ decode( 'ISO-8859-1', encode_utf8($TAG) ) ], id => 4 } ),
    { title => $TITLE, tags => [$TAG], id => 4 },
    'hashes and arrays are walked, non-strings pass through'
  );
  is( repair_mojibake( repair_mojibake($broken) ), $TITLE, 'repairing an already-repaired string is a no-op' );
};

done_testing;