view release on metacpan or  search on metacpan

t/amberdb_cli.t  view on Meta::CPAN

ok(-f $cli_path, "amberdb_cli.pl exists at $cli_path");

my $test_tmpdir = tempdir(CLEANUP => 1);
my $test_dbdir  = File::Spec->catdir($test_tmpdir, "dbstore");
mkdir $test_dbdir unless -d $test_dbdir;
$test_dbdir = eval { abs_path($test_dbdir) } // $test_dbdir;

sub norm_path {
    my ($p) = @_;
    return '' unless defined $p;
    $p = eval { abs_path($p) } // $p;
    $p = File::Spec->canonpath($p);
    $p =~ s{\\}{/}g;
    $p =~ s{/+$}{};
    return lc($p);
}

# ---------------------------------------------------------------------------
subtest '1. Help screen & default table overview' => sub {
    plan tests => 4;

    my $out_help = `"$perl_bin" -Ilib "$cli_path" usage`;
    like($out_help, qr/AmberDB CLI/, "Help screen shows CLI title");
    like($out_help, qr/Usage:/, "Usage screen shows English usage section");

    my $out_tr = `"$perl_bin" -Ilib "$cli_path" usage.tr`;
    like($out_tr, qr/Kullanım:/, "usage.tr shows Turkish usage section");

    my $out_list = `"$perl_bin" -Ilib "$cli_path" path-dbase_dir="$test_dbdir" format=json`;
    my $data = eval { decode_json($out_list) };
    is(ref $data, 'HASH', "Default action outputs valid JSON with format=json");
};

# ---------------------------------------------------------------------------
subtest '2. Connect lifecycle & token generation' => sub {
    plan tests => 5;

    my $out_conn = `"$perl_bin" -Ilib "$cli_path" connect path-dbase_dir="$test_dbdir" cfg-language=tr format=json`;
    my $conn = eval { decode_json($out_conn) };
    is(ref $conn, 'HASH', "Connect returned valid JSON");
    is($conn->{status}, 'connected', "Status is connected");
    ok(defined $conn->{token} && $conn->{token} =~ /^\d{4}$/, "4-digit token generated: $conn->{token}");

    my $token = $conn->{token};

    # Verify session file exists
    my $sess_file = $conn->{session_file} || File::Spec->catfile($test_dbdir, "session", "cli_$token");
    ok(-f $sess_file, "Session file exists on disk: $sess_file");

    # Read session file content
    open my $fh, '<', $sess_file;
    local $/;
    my $sess_json = <$fh>;
    close $fh;
    my $sess_data = decode_json($sess_json);
    is($sess_data->{cfg}->{language}, 'tr', "Config language 'tr' saved in session");
};

# ---------------------------------------------------------------------------
subtest '3. Dash tolerance & global config update' => sub {
    plan tests => 4;

    # Connect to get token
    my $out_conn = `"$perl_bin" -Ilib "$cli_path" connect path-dbase_dir="$test_dbdir" format=json`;
    my $conn = eval { decode_json($out_conn) };
    my $token = $conn ? $conn->{token} : '';

    # Update with --cfg-no_write=1 (double dash)
    my $upd1 = `"$perl_bin" -Ilib "$cli_path" --token=$token --cfg-no_write=1 format=json 2>&1`;
    my $data1 = eval { decode_json($upd1) };
    is(eval { $data1->{cfg}->{no_write} }, 1, "Double dash --cfg-no_write=1 updated") or diag("upd1 output: $upd1");

    # Update with -cfg-no_write=0 (single dash)
    my $upd2 = `"$perl_bin" -Ilib "$cli_path" -token=$token -cfg-no_write=0 format=json 2>&1`;
    my $data2 = eval { decode_json($upd2) };
    is(eval { $data2->{cfg}->{no_write} }, 0, "Single dash -cfg-no_write=0 updated") or diag("upd2 output: $upd2");

    # Update with cfg-no_write=1 (no dash)
    my $upd3 = `"$perl_bin" -Ilib "$cli_path" token=$token cfg-no_write=1 format=json 2>&1`;
    my $data3 = eval { decode_json($upd3) };
    is(eval { $data3->{cfg}->{no_write} }, 1, "No dash cfg-no_write=1 updated") or diag("upd3 output: $upd3");

    # Clean disconnect
    my $disc = `"$perl_bin" -Ilib "$cli_path" token=$token disconnect format=json 2>&1`;
    my $ddata = eval { decode_json($disc) };
    is(eval { $ddata->{status} }, 'disconnected', "Disconnected successfully") or diag("disc output: $disc");
};

# ---------------------------------------------------------------------------
subtest '4. Table attributes with deep nested parsing and session persistence' => sub {
    plan tests => 6;

    my $out_conn = `"$perl_bin" -Ilib "$cli_path" connect path-dbase_dir="$test_dbdir" format=json`;
    my $token = decode_json($out_conn)->{token};

    # table_attr with deep keys: blocks-1-rdbm and search_block=[1]
    my $cmd = qq{"$perl_bin" -Ilib "$cli_path" token=$token action=table_attr table=cli_test_prod search_block=[1] keep_deleted=1 blocks-1-rdbm=cat,1 format=json};
    my $out_attr = `$cmd`;
    my $attr_data = decode_json($out_attr);
    is($attr_data->{status}, 'ok', "table_attr executed successfully");
    is($attr_data->{attributes}->{keep_deleted}, 1, "keep_deleted attribute set to 1");
    is_deeply($attr_data->{attributes}->{search_block}, [1], "search_block parsed as JSON array [1]");
    is(ref $attr_data->{attributes}->{blocks}->{1}->{rdbm}, 'HASH', "rdbm normalized to HASH");
    is($attr_data->{attributes}->{blocks}->{1}->{rdbm}->{table}, 'cat', "Deep nested blocks-1-rdbm table parsed");

    # Disconnect
    `"$perl_bin" -Ilib "$cli_path" token=$token disconnect`;
    my $sess_file = File::Spec->catfile($test_dbdir, "session", "cli_$token");
    ok(!-f $sess_file, "Session file deleted on disconnect");
};

# ---------------------------------------------------------------------------
subtest '5. CRUD operations & no_write protection' => sub {
    plan tests => 8;

    my $out_conn = `"$perl_bin" -Ilib "$cli_path" connect path-dbase_dir="$test_dbdir" cfg-no_write=1 format=json`;
    my $token = decode_json($out_conn)->{token};

    # Attempt insert when no_write is 1
    my $ins_blocked = `"$perl_bin" -Ilib "$cli_path" token=$token action=insert_id table=cli_items id=1 data='["Book",15]' 2>&1`;