AmberDB
view release on metacpan or search on metacpan
t/amberdb_backup.t view on Meta::CPAN
use strict;
use warnings;
use Test::More tests => 5;
use File::Temp qw(tempdir);
use File::Spec;
use Archive::Tar;
use JSON::PP;
use AmberDB;
use AmberDB::Tools;
my $tmpdir = tempdir( CLEANUP => 1 );
$tmpdir =~ s{\\}{/}g;
my $adb = AmberDB->new(
path => { dbase_dir => $tmpdir },
cfg => { user => "admin", language => "tr" },
);
ok( defined $adb, "AmberDB instance created for backup tests" );
# =========================================================================
# SUBTEST 1: recs_back Daily WAL CSV Stream (backup/YYYY/YYYY-MM-DD.csv)
# =========================================================================
subtest "1. Continuous Recovery Stream (recs_back -> YYYY-MM-DD.csv)" => sub {
plan tests => 6;
# Create a test table
my $schema = {
name => 'audit_items',
record_index => 1,
search_block => [ 1 ],
log_owner => 1,
};
$adb->table_attr( 'audit_items', $schema );
# Insert a record
my $rid = $adb->insert_id( 'audit_items', undef, 'Keyboard', 450 );
ok( $rid > 0, "Record inserted with ID $rid" );
# Edit record
$adb->modify_id( 'audit_items', $rid, 'Mechanical Keyboard', 550 );
# Delete record
$adb->delete_id( 'audit_items', $rid );
# Verify backup directory structure
my $year = $adb->{date}->{year};
my $date_iso = "$adb->{date}->{year}-$adb->{date}->{month}-$adb->{date}->{day}";
my $csv_file = "$tmpdir/backup/$year/$date_iso.csv";
ok( -d "$tmpdir/backup/$year", "Year directory backup/$year created" );
ok( -e $csv_file, "Daily CSV stream file $csv_file created" );
# Read CSV lines
open my $fh, "<:encoding(UTF-8)", $csv_file or die "Cannot open $csv_file: $!";
my @lines = <$fh>;
close $fh;
ok( scalar(@lines) >= 3, "CSV contains at least 3 log entries (add, edit, del)" );
# Check line format: timestamp \t user \t action \t table \t rid \t values
my $last_line = $lines[-1];
chomp $last_line;
my @cols = split /\t/, $last_line;
is( $cols[1], 'admin', "Col 1 is username 'admin'" );
is( $cols[2], 'del', "Col 2 is action 'del'" );
};
# =========================================================================
# SUBTEST 2: Tools->dump() Native .amberdb Archive Creation
# =========================================================================
subtest "2. Native Database Archive Dump (.amberdb)" => sub {
plan tests => 10;
# Set up test database with 2 tables and a .dbase group schema
my $tools = AmberDB::Tools->new($adb);
# Create schema/catalog.dbase
my $schema_dir = $adb->path('schema_dir') || "$tmpdir/schema";
unless ( -d $schema_dir ) {
require File::Path;
File::Path::make_path($schema_dir);
}
open my $dbfh, ">", "$schema_dir/catalog.dbase" or die "Cannot create catalog.dbase: $!";
print $dbfh "{\n\tname => \"Product Catalog Group\",\n\ttype => 0,\n\tyear => 0,\n\tsection => 0,\n}\n";
close $dbfh;
open my $tblfh, ">", "$schema_dir/catalog_products.table" or die "Cannot create catalog_products.table: $!";
print $tblfh "{\n\tname => \"catalog_products\",\n\trecord_index => 1,\n\tsearch_block => [ 1, 2 ],\n\tmatch_block => [ 2 ],\n}\n";
close $tblfh;
open my $ordfh, ">", "$schema_dir/orders.table" or die "Cannot create orders.table: $!";
print $ordfh "{\n\tname => \"orders\",\n\trecord_index => 1,\n}\n";
close $ordfh;
$adb->insert_id( 'catalog_products', undef, 'Laptop Pro', 'Electronics', 15000 );
$adb->insert_id( 'catalog_products', undef, 'Desk Lamp', 'Furniture', 350 );
$adb->insert_id( 'catalog_products', undef, 'Office Chair', 'Furniture', 1200 );
# Create a unique/dictionary index (.unq) for block 2
$adb->insert_strs( 'catalog_products', 2, [ 10, 'Electronics' ], [ 20, 'Furniture' ] );
$adb->insert_id( 'orders', undef, 'Alice', 15350 );
$adb->insert_id( 'orders', undef, 'Bob', 1200 );
# Run full dump
my $dump_file = "$tmpdir/backup/test_dump.amberdb";
my ($outfile, $manifest) = $tools->dump( file => $dump_file );
ok( defined $outfile, "dump() returned output path" );
is( $outfile, $dump_file, "dump() created requested archive path" );
ok( -e $dump_file, "Archive file exists on disk" );
ok( -s $dump_file > 0, "Archive file is non-empty" );
# Validate returned in-memory manifest structure
ok( defined $manifest, "dump() returned manifest hashref" );
is( $manifest->{format}, 'AmberDB Archive', "Manifest format is 'AmberDB Archive'" );
is( $manifest->{format_version}, 1, "Format version is 1" );
is( $manifest->{dbases}->{catalog}, 'schema/catalog.dbase', "Manifest records catalog.dbase" );
ok( exists $manifest->{tables}->{catalog_products}, "Manifest contains catalog_products table metadata" );
is( $manifest->{tables}->{catalog_products}->{records}, 3, "Manifest records 3 records for catalog_products" );
};
# =========================================================================
# SUBTEST 3: Archive Package Inspection (.tar Extraction & Index Exclusion)
# =========================================================================
subtest "3. Archive Package Inspection & Integrity" => sub {
plan tests => 8;
my $dump_file = "$tmpdir/backup/test_dump.amberdb";
my $tar = Archive::Tar->new();
ok( $tar->read($dump_file), "Archive is a valid tar archive" );
my @files = $tar->list_files();
ok( grep { $_ eq 'manifest.json' } @files, "Archive contains manifest.json" );
ok( grep { $_ eq 'schema/catalog.dbase' } @files, "Archive contains schema/catalog.dbase" );
ok( grep { $_ eq 'schema/catalog_products.table' } @files, "Archive contains schema/catalog_products.table" );
ok( grep { $_ eq 'tables/catalog_products.db' } @files, "Archive contains tables/catalog_products.db" );
ok( grep { $_ eq 'tables/catalog_products_2.unq' } @files, "Archive contains tables/catalog_products_2.unq" );
# Verify that derived index files are NOT packaged in the archive
my @inx_files = grep { /\.inx$|\.src$|\.fac$|\.fld$|\.srt$/ } @files;
is( scalar(@inx_files), 0, "Derived index files (.inx, .src, .fac, .srt) are NOT in archive" );
# Validate embedded manifest checksum
my $manifest_content = $tar->get_content('manifest.json');
my $manifest = JSON::PP::decode_json($manifest_content);
my $sha = $manifest->{tables}->{catalog_products}->{sha256}->{'tables/catalog_products.db'};
ok( defined $sha && length($sha) == 64, "Manifest contains valid 64-character SHA-256 hash" );
};
# =========================================================================
# SUBTEST 4: Tools->restore() and Deterministic Index Rebuilding
# =========================================================================
subtest "4. Database Restore and Index Reconstruction" => sub {
plan tests => 17;
my $dump_file = "$tmpdir/backup/test_dump.amberdb";
# 4.1 Safety check: Restore into non-empty database without force should fail
my $tools = AmberDB::Tools->new($adb);
my $blocked_res = $tools->restore( file => $dump_file, force => 0 );
ok( !defined $blocked_res, "restore() without force on non-empty database returns undef" );
# 4.2 Create a completely clean staging database directory
my $stagedir = tempdir( CLEANUP => 1 );
$stagedir =~ s{\\}{/}g;
my $stage_adb = AmberDB->new(
path => { dbase_dir => $stagedir },
cfg => { user => "admin", language => "tr" },
);
my $stage_tools = AmberDB::Tools->new($stage_adb);
# 4.3 Restore archive with automatic reindexing into staging DB
my $res = $stage_tools->restore( file => $dump_file, reindex => 1 );
ok( defined $res, "restore() succeeded on clean database directory" );
is( $res->{ok}, 1, "Result ok is 1" );
is( $res->{reindexed}, 1, "Reindexing completed successfully" );
# 4.4 Verify .dbase, .table, and .unq files were restored
my $stage_schema_dir = $stage_adb->path('schema_dir') || "$stagedir/schema";
ok( -e "$stage_schema_dir/catalog.dbase", "catalog.dbase restored to schema directory" );
ok( -e "$stagedir/tables/catalog_products_2.unq", "catalog_products_2.unq restored to tables directory" );
my $restored_dbase = $stage_adb->dbase_info('catalog');
ok( defined $restored_dbase, "catalog dbase_info loaded" );
is( $restored_dbase->{name}, 'Product Catalog Group', "dbase name matches original" );
my $restored_schema = $stage_adb->table_info('catalog_products');
ok( defined $restored_schema, "catalog_products schema restored" );
is( $restored_schema->{name}, 'catalog_products', "Schema name is 'catalog_products'" );
# 4.5 Verify record count and read_id
is( scalar( $stage_adb->table_keys('catalog_products') ), 3, "catalog_products table count is 3" );
my @rec1 = $stage_adb->read_id( 'catalog_products', 1 );
is( $rec1[1], 'Laptop Pro', "Record 1 name is 'Laptop Pro'" );
is( $rec1[2], 'Electronics', "Record 1 category is 'Electronics'" );
# 4.6 Verify match index (.fld) was reconstructed and works
my @matched = $stage_adb->field_fetch( 'catalog_products', 2, 'Furniture' );
is( scalar(@matched), 2, "field_fetch('Furniture') returns 2 records after restore" );
# 4.7 Verify full-text search index (.src) was reconstructed and works
my @search_results = $stage_adb->search_table( 'catalog_products', 'Laptop' );
is( scalar(@search_results), 1, "search_table('Laptop') returns 1 result" );
is( $search_results[0]->[0], 1, "search_table returned record ID 1" );
is( $search_results[0]->[1], 'Laptop Pro', "search_table returned matching product name" );
};
( run in 0.546 second using v1.01-cache-2.11-cpan-4ef0a570458 )