view release on metacpan or  search on metacpan

t/amberdb-field_matching_without_index.t  view on Meta::CPAN

#!/usr/bin/perl

# t/amberdb-field_matching_without_index.t - Tests for AmberDB field_fetch & field matching without index (Table Scan)

use 5.016000;
use strict;
use warnings;
use utf8;
use open ':std', ':utf8';
use Test::More;
binmode Test::More->builder->output,         ':utf8';
binmode Test::More->builder->failure_output, ':utf8';
binmode Test::More->builder->todo_output,    ':utf8';
use File::Temp qw(tempdir);
use File::Spec;
use Encode qw(encode);

use_ok('AmberDB') or BAIL_OUT('Cannot load AmberDB');

my $tmpdir = tempdir( CLEANUP => 1 );

my $adb = AmberDB->new(
    path => { dbase_dir => $tmpdir },
    cfg  => { language  => 'tr' },
);

# ==============================================================================
# SUBTEST 1: Unindexed Schema & Verification of No Index Files on Disk
# ==============================================================================
subtest '1. Unindexed Schema & Verification of No Index Files on Disk' => sub {
    plan tests => 5;

    my $tbl = 'catalog_fld_unidx';
    my $table_info = {
        record_index => 0,
        # No match_block defined (unindexed table scan mode)
    };
    $adb->table_attr( $tbl, $table_info );

    # Sample records:
    # [ ID, SKU (blk 1), Title (blk 2), Desc (blk 3), Category (blk 4), Price (blk 5), Brand (blk 6) ]
    my @records = (
        [ 1, 'SKU1', 'Sony Kulaklık',     'Kablosuz kulaklık',    '10, 20', '150', '12' ],
        [ 2, 'SKU2', 'Philips Kulaklık',  'Mikrofonlu kulaklık',  '10',     '120', '12' ],
        [ 3, 'SKU3', 'JBL Hoparlör',      'Taşınabilir hoparlör', '20',     '200', '14' ],
        [ 4, 'SKU4', 'Sony Hoparlör',     'Stereo hoparlör',      '20',     '180', '12' ],
        [ 5, 'SKU5', 'Apple Kulaklık',    'Gürültü önleyici',     '10',     '300', '16' ],
        [ 6, 'SKU6', 'Sennheiser Pro',    'Profesyonel kulaklık', '10',     '400', '14' ],
    );

    for my $r (@records) {
        $adb->insert_id( $tbl, $r->[0], @$r[ 1 .. $#$r ] );
    }

    my $table_path = $adb->table_path($tbl);
    my $fld_path   = "${table_path}.fld";
    my $unq_path   = "${table_path}.unq";
    my $db_file    = "$table_path.db";

    # Confirm raw .db file exists, but NO .fld or .unq files exist on disk
    ok( -e $db_file, "Data file ${tbl}.db created on disk" );
    ok( !-e $fld_path, "No .fld index file created" );
    ok( !-e $unq_path, "No .unq dictionary file created on disk" );
    ok( !-e "${table_path}_4.unq", "No legacy per-block _4.unq created" );

    # Initial scan check
    my @res = $adb->field_fetch( $tbl, 4, '10' );
    is( scalar @res, 4, "Unindexed field_fetch finds 4 records for Category 10" );
};

# ==============================================================================
# SUBTEST 2: Genel field_fetch (Tümü & Tek Değer Eşleşmesi - Unindexed)
# ==============================================================================