view release on metacpan or  search on metacpan

t/51-json-output.t  view on Meta::CPAN

    $@;
  };
  return ( $err, $out );
}

subtest 'Task->to_json_hash: frontmatter plus body only when body is set' => sub {
  my $with = App::karr::Task->new( id => 1, title => 'Alpha', body => 'hello' );
  my $h    = $with->to_json_hash;
  is( $h->{id},    1,       'id carried through from frontmatter' );
  is( $h->{title}, 'Alpha', 'title carried through from frontmatter' );
  is( $h->{body},  'hello', 'body key present when body is non-empty' );

  my $without = App::karr::Task->new( id => 2, title => 'Beta' );
  my $h2      = $without->to_json_hash;
  is( $h2->{id}, 2, 'frontmatter still built when body is empty' );
  ok( !exists $h2->{body}, 'body key absent when body is empty' );
};

subtest 'move --json: single id is a bare object, batch is an array' => sub {
  my $store = _fresh_store();
  _save( $store, id => 1, title => 'Alpha', status => 'todo' );

  my $cmd = App::karr::Cmd::Move->new( store => $store, json => 1 );
  my ( $err, $out ) = _run_execute( $cmd, '1', 'done' );
  is( $err, '', 'move 1 done --json does not die' ) or diag $err;

  my $data = eval { decode_json($out) };
  is( ref $data, 'HASH', 'single move --json emits a bare JSON object' ) or diag $out;
  is( $data->{id},         1,      'object carries the moved id' );
  is( $data->{old_status}, 'todo', 'old_status reported' );
  is( $data->{new_status}, 'done', 'new_status reported' );

  my $store2 = _fresh_store();
  _save( $store2, id => 1, title => 'Alpha', status => 'todo' );
  _save( $store2, id => 2, title => 'Beta',  status => 'todo' );

  my $cmd2 = App::karr::Cmd::Move->new( store => $store2, json => 1 );
  my ( $err2, $out2 ) = _run_execute( $cmd2, '1,2', 'done' );
  is( $err2, '', 'move 1,2 done --json does not die' ) or diag $err2;

  my $arr = eval { decode_json($out2) };
  is( ref $arr,       'ARRAY', 'batch move --json emits a JSON array' ) or diag $out2;
  is( scalar @$arr,   2,       'one array entry per moved task' );
  is( $arr->[0]{id},  1,       'first entry is task 1' );
  is( $arr->[1]{id},  2,       'second entry is task 2' );
};

subtest 'move without --json: print_json_results is a no-op (guard)' => sub {
  my $store = _fresh_store();
  _save( $store, id => 1, title => 'Alpha', status => 'todo' );

  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,
  );
  my ( $err, $out ) = _run_execute( $cmd, '1' );
  is( $err, '', 'edit 1 --json does not die' ) or diag $err;

  my $data = eval { decode_json($out) };
  is( ref $data,     'HASH', 'single edit --json emits a bare JSON object' ) or diag $out;
  is( $data->{id},    1,     'object carries the edited id' );
  is( $data->{title}, $TITLE, 'edited title reflected in the payload' );
};

subtest 'show --json: explicit id renders frontmatter + body via to_json_hash' => sub {
  my $store = _fresh_store();
  _save( $store, id => 1, title => $TITLE, status => 'todo', body => $BODY );

  my $cmd = App::karr::Cmd::Show->new( store => $store, json => 1 );
  my ( $err, $out ) = _run_execute( $cmd, '1' );
  is( $err, '', 'show 1 --json does not die' ) or diag $err;

  my $data = eval { decode_json($out) };
  is( ref $data,      'HASH',  'explicit id --json stays a bare object' ) or diag $out;
  is( $data->{id},     1,      'id present' );
  is( $data->{title},  $TITLE, 'title present' );
  is( $data->{status}, 'todo', 'status present' );
  is( $data->{body},   $BODY,  'body included when present' );
};

subtest 'pick --json: picked task payload built via to_json_hash' => sub {
  my $store = _fresh_store();
  _save( $store, id => 1, title => 'Alpha', status => 'todo', priority => 'high', body => 'Alpha body' );

  my $cmd = App::karr::Cmd::Pick->new(
    store => $store,
    claim => 'agent-test',
    json  => 1,
  );
  my ( $err, $out ) = _run_execute($cmd);
  is( $err, '', 'pick --json does not die' ) or diag $err;

  my $data = eval { decode_json($out) };
  is( ref $data,          'HASH',       'pick --json emits a bare JSON object' ) or diag $out;
  is( $data->{id},         1,           'picked id present' );
  is( $data->{claimed_by}, 'agent-test', 'claim reflected in payload' );
  is( $data->{body},       'Alpha body', 'body included' );
};

subtest 'handoff --json: review payload built via to_json_hash' => sub {
  my $store = _fresh_store();
  _save( $store, id => 1, title => 'Alpha', status => 'in-progress', body => 'Alpha body' );

  my $cmd = App::karr::Cmd::Handoff->new(
    store => $store,
    claim => 'agent-test',
    json  => 1,
  );
  my ( $err, $out ) = _run_execute( $cmd, '1' );
  is( $err, '', 'handoff --json does not die' ) or diag $err;

  my $data = eval { decode_json($out) };
  is( ref $data,          'HASH',       'handoff --json emits a bare JSON object' ) or diag $out;
  is( $data->{id},         1,           'handoff id present' );
  is( $data->{status},     'review',    'status moved to review' );
  is( $data->{claimed_by}, 'agent-test', 'claim reflected in payload' );
  is( $data->{body},       'Alpha body', 'body included' );
};

subtest 'print_json writes UTF-8 to stdout encoded exactly once' => sub {
  my $store = _fresh_store();
  _save( $store, id => 1, title => $TITLE, status => 'todo', body => $BODY );

  my $cmd = App::karr::Cmd::Show->new( store => $store, json => 1 );
  my ( $err, $out ) = _run_execute( $cmd, '1' );
  is( $err, '', 'show 1 --json does not die' ) or diag $err;

  # 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;