view release on metacpan or  search on metacpan

t/amberdb_encapsulation.t  view on Meta::CPAN

};

subtest "2. config() shallow copy immutability" => sub {
    plan tests => 3;

    my $cfg_copy = $adb->config();
    ok( ref($cfg_copy) eq 'HASH', "config() without args returns HASH ref" );
    is( $cfg_copy->{user}, "test_user", "config copy has correct values" );

    # Mutate copy
    $cfg_copy->{user} = "hacked_user";
    $cfg_copy->{new_external_key} = 999;

    is( $adb->config('user'), "test_user", "Internal config user is NOT affected by mutating returned copy" );
};

subtest "3. table_attr() getter and setter tests" => sub {
    plan tests => 6;

    # 3.1 Set attributes via key-value
    my $ok = $adb->table_attr("demo_table", id_type => "ascii", keep_deleted => 1);
    ok( $ok, "table_attr set via key-value succeeded" );

    # 3.2 Get single attribute
    is( $adb->table_attr("demo_table", "id_type"), "ascii", "table_attr single getter returns correct value" );
    is( $adb->table_attr("demo_table", "keep_deleted"), 1, "table_attr single getter returns keep_deleted" );

    # 3.3 Set attributes via hashref
    $adb->table_attr("demo_table", { force => 1, custom_attr => "amber" });
    is( $adb->table_attr("demo_table", "force"), 1, "table_attr set via hashref succeeded" );
    is( $adb->table_attr("demo_table", "custom_attr"), "amber", "custom_attr is set" );

    # 3.4 Non-existent attribute
    is( $adb->table_attr("demo_table", "non_existent"), undef, "Non-existent attribute returns undef" );
};

subtest "4. table_attr() shallow copy immutability" => sub {
    plan tests => 3;

    my $attrs_copy = $adb->table_attr("demo_table");
    ok( ref($attrs_copy) eq 'HASH', "table_attr('demo_table') returns HASH ref" );
    is( $attrs_copy->{id_type}, "ascii", "attrs copy has correct value" );

    # Mutate copy
    $attrs_copy->{id_type} = "num";
    $attrs_copy->{injected_key} = "bad";

    is( $adb->table_attr("demo_table", "id_type"), "ascii", "Internal table_attr is NOT affected by mutating returned copy" );
};

subtest "5. table_attr() path invalidation on path-affecting attributes" => sub {
    plan tests => 3;

    $adb->config( simple => 0, db_ext => 'db', use_section => 1 );
    my $path1 = $adb->table_path("demo_table");
    ok( length($path1) > 0, "Initial table path resolved: $path1" );

    # Ensure target section directory exists before switching section
    mkdir "$tmpdir/tables_north" unless -d "$tmpdir/tables_north";

    # Change section -> should invalidate cached path and recalculate
    $adb->table_attr("demo_table", section => "north");
    my $path2 = $adb->table_path("demo_table");
    ok( length($path2) > 0, "Updated table path resolved: $path2" );
    isnt( $path1, $path2, "Path was refreshed after section attribute changed" );
};

subtest "6. table_info() shallow copy protection" => sub {
    plan tests => 3;

    my $info = $adb->table_info("demo_table");
    ok( ref($info) eq 'HASH', "table_info returns HASH ref" );

    # Mutate returned info
    $info->{external_mutation} = "corrupted";
    $info->{id_type} = "modified";

    my $info_fresh = $adb->table_info("demo_table");
    ok( !exists $info_fresh->{external_mutation}, "Internal table_info does NOT have external mutations" );
    is( $adb->table_attr("demo_table", "id_type"), "ascii", "Internal id_type remains intact" );
};

subtest "7. Hash::Util protection: Disallowed typo and public keys" => sub {
    plan tests => 3;

    eval {
        $adb->{disallowed_random_key} = "illegal";
    };
    like( $@, qr/disallowed key/i, "Attempting to assign an unauthorized key throws disallowed key error" );

    eval {
        $adb->{cfg} = { user => "hacker" };
    };
    like( $@, qr/disallowed key/i, "Direct assignment to \$adb->{cfg} is strictly disallowed" );

    eval {
        $adb->{path} = { dbase_dir => "/tmp" };
    };
    like( $@, qr/disallowed key/i, "Direct assignment to \$adb->{path} is strictly disallowed" );
};

subtest "8. Hash::Util protection: Locked core container references" => sub {
    plan tests => 3;

    eval {
        $adb->{_table} = {};
    };
    like( $@, qr/read-only/i, "Attempting to overwrite \$adb->{_table} throws read-only error" );

    eval {
        $adb->{_cfg} = {};
    };
    like( $@, qr/read-only/i, "Attempting to overwrite \$adb->{_cfg} throws read-only error" );

    eval {
        $adb->{_path} = {};
    };
    like( $@, qr/read-only/i, "Attempting to overwrite \$adb->{_path} throws read-only error" );
};

subtest "9. Full CRUD operation under encapsulated object" => sub {