AmberDB

 view release on metacpan or  search on metacpan

bin/convert_dbstore.pl  view on Meta::CPAN

# Discover tables across all database directories
my @table_list = $tools->all_tables();

my %side_files = ( del => 0, aut => 0, cnt => 0, str => 0 );
foreach my $tid (@table_list) {
    my $tpath = $adb->table_path($tid);
    $side_files{del}++ if -e "$tpath.del";
    $side_files{aut}++ if -e "$tpath.aut";
    $side_files{cnt}++ if -e "$tpath.cnt";
    my @strs = glob "${tpath}_*.str";
    $side_files{str} += scalar(@strs);
}

print "Found " . scalar(@table_list) . " main tables (.db) to re-index.\n";
print "Detected side files: " . $side_files{del} . " .del (archived deleted), "
    . $side_files{aut} . " .aut (audit logs), "
    . $side_files{cnt} . " .cnt (view counters), "
    . $side_files{str} . " .str (string dictionaries).\n";
print "-----------------------------------------------------------------\n";

lib/AmberDB.pm  view on Meta::CPAN

    my $k = $self->utf_encode("$key");

    my $ret = $db->del($k);
    warn "[DB_TIE] $table_path can't del key $k.\n" if $ret > 0;

    return $ret == 0 ? 1 : 0;
}

# Writes add|edit|del operation to daily CSV backup audit stream (backup/YYYY/YYYY-MM-DD.csv).
# Exits silently if no_backup is set (globally or in table schema).
# my $ok = $adb->recs_back("add|edit|del", $tableid, @records);
# ------------------------------------------------
sub recs_back {

    my ( $self, $action, $tableid, @records ) = @_;

    ( $action and $tableid and scalar @records ) or return;

    # Global config check: disables backup for all tables
    return if $self->config('no_backup');

lib/AmberDB/Base.pm  view on Meta::CPAN

    my %pairs = ( @args == 1 && ref( $args[0] ) eq 'HASH' ) ? %{ $args[0] } : @args;

    for my $key ( keys %pairs ) {
        $self->{_path}->{$key} = $pairs{$key};
    }
    $self->_invalidate_table_paths();

    return $self;
}

# Invalidate cached table paths if global path-affecting configurations change
# ------------------------------------------------
sub _invalidate_table_paths {

    my ($self) = @_;

    if ( $self->{_table} && ref( $self->{_table} ) eq 'HASH' ) {
        for my $tbl ( keys %{ $self->{_table} } ) {
            delete $self->{_table}->{$tbl}->{_path}
              if ref( $self->{_table}->{$tbl} ) eq 'HASH';
        }

lib/AmberDB/Locale.pm  view on Meta::CPAN

    return 0 unless defined $cond && length $cond;

    my $n = abs( $count // 0 );

    # Whitelist strictly only digits, 'n', whitespace, arithmetic and logical operators
    return 0 unless $cond =~ /^[n0-9+\-*\/%&|!=<>()\s]+$/;

    # Replace 'n' variable token with actual numeric value
    ( my $expr = $cond ) =~ s/\bn\b/$n/g;

    # Safely evaluate numeric expression isolated from global DIE handlers
    my $res = eval {
        local $SIG{__DIE__} = sub {};
        eval $expr; ## no critic
    };
    return $res ? 1 : 0;
}

# -------------------------------------------------------
# Evaluate CLDR plural rule and select template.
#

lib/AmberDB/Tools.pm  view on Meta::CPAN

# my @tables = $tools->dir_tables();
# ------------------------------------------------
sub dir_tables {

    my ( $self, $dir ) = @_;
    my $adb = $self->{_adb} or return;

    $dir or return;
    my $dbase_dir = $adb->path('dbase_dir') || ".";
    my @all_tables =
      ( glob "$dbase_dir/$dir/*.$adb->{db_ext}" );

    my %all_tables =
      map { /([^\/]+)\.$adb->{db_ext}$/; $1 => 1 } @all_tables;

    return sort { $a cmp $b } keys %all_tables;
}

# my @tables = $tools->vacuum($tableid, 1);
# ------------------------------------------------
sub vacuum {

lib/AmberDB/Tools.pm  view on Meta::CPAN

    my @all_tables;
    my %all_tables;

    my $dbase_dir  = $adb->path('dbase_dir')  || ".";
    my $year_dir   = $adb->path('year_dir')   || "";
    my $schema_dir = $adb->path('schema_dir') || "";

    # 1. Simple Mode: Single flat directory scan for files matching configured db_ext
    if ( $adb->config('simple') ) {
        my $ext = $adb->{db_ext} || "db";
        push @all_tables, ( glob "$dbase_dir/*.$ext" );
        @all_tables = map { /([a-z0-9_]+)\.\Q$ext\E$/i; $1 } @all_tables;
    }
    # 2. Standard Structured Mode: Multi-directory scan (tables/ and year directories) for .db files
    else {
        push @all_tables, ( glob "$dbase_dir/tables/*.db" );

        my %seen_dirs = ( "tables" => 1, "schema" => 1, "backup" => 1 );
        if ($year_dir) {
            push @all_tables, ( glob "$dbase_dir/$year_dir/*.db" );
            $seen_dirs{$year_dir} = 1;
        }

        # Auto-discover any 4-digit year directories under $dbase_dir (e.g. 2024, 2025, 2026)
        if ( -d $dbase_dir ) {
            opendir( my $dh, $dbase_dir );
            my @year_candidates = grep { /^\d{4}$/ && -d "$dbase_dir/$_" && !$seen_dirs{$_} } readdir($dh);
            closedir $dh;

            foreach my $yd (@year_candidates) {
                push @all_tables, ( glob "$dbase_dir/$yd/*.db" );
            }
        }

        @all_tables = map { /([a-z0-9_]+)\.db$/i; $1 } @all_tables;
    }

    foreach my $record (@all_tables) {
        next unless $record;
        next if $record =~ /^_/; # skip internal / temp files

lib/AmberDB/Tools.pm  view on Meta::CPAN

sub replace_tablename {

    my ( $self, $find, $replace ) = @_;
    my $adb = $self->{_adb} or return;

    my @tables;
    my $dbase_dir = $adb->path('dbase_dir') || ".";
    my $year_dir  = $adb->path('year_dir') || "";

    if ( $adb->config('simple') ) {
        @tables = glob "$dbase_dir/$find.*";
        push @tables, ( glob "$dbase_dir/${find}_*" );
    }
    else {
        @tables = glob "$dbase_dir/tables/$find.*";
        push @tables, ( glob "$dbase_dir/tables/${find}_*" );
        if ( $adb->config('use_section') ) {
            my @sections = glob "$dbase_dir/section_*";
            foreach my $sec_file (@sections) {
                push @tables, ( glob "$sec_file/$find.*" );
                push @tables, ( glob "$sec_file/${find}_*" );
            }
        }

        if ( $adb->config('use_year') && $year_dir ) {
            @tables = glob "$dbase_dir/$year_dir/$find.*";
            push @tables, ( glob "$dbase_dir/$year_dir/${find}_*" );
            if ( $adb->config('use_section') ) {
                my @sections = glob "$dbase_dir/$year_dir/section_*";
                foreach my $sec_file (@sections) {
                    push @tables, ( glob "$sec_file/${find}.*" );
                    push @tables, ( glob "$sec_file/${find}_*" );
                }
            }
        }
    }

    foreach my $old_file (@tables) {
        my $new_file = "$old_file";
        $new_file =~ s/\/$find([\.\_])/$replace$1/;
        rename( $old_file, $new_file );
    }

lib/AmberDB/Tools.pm  view on Meta::CPAN

    my ( $self, $tableid ) = @_;
    my $adb = $self->{_adb} or return;

    $tableid or return;

    $adb->config('no_write') and return;

    my $table_path = $adb->table_path($tableid);
    return unless $table_path && -e "$table_path.$adb->{db_ext}";

    my @files  = glob "$table_path*";
    my @files1 = grep { /^\Q$table_path\E(?:\.[a-z0-9]+|_[0-9]+\.[a-z0-9]+)$/i } @files;

    foreach my $file (@files1) {
        unlink($file);
        $self->{say} .= "          * $file deleted.\n";
    }

    $self->{say} .= "    - Table $tableid deleted.\n";

    return 1;

lib/AmberDB/Tools.pm  view on Meta::CPAN

                $tar->add_data( $arch_path, $dcontent );
                push @{ $table_manifest->{files} }, $arch_path;

                my $sha256 = Digest::SHA::sha256_hex($dcontent);
                $table_manifest->{sha256}->{$arch_path} = $sha256;
            }
        }

        # D. Collect Authoritative String Dictionaries (_*.str)
        my @str_files = glob "${tpath}_*.str";
        foreach my $fpath (@str_files) {
            next unless -e $fpath;
            open my $dfh, "<:raw", $fpath or next;
            local $/ = undef;
            my $dcontent = <$dfh>;
            close $dfh;

            my $norm_fpath = $fpath;
            $norm_fpath =~ s{\\}{/}g;
            my $arch_path = $norm_fpath;

lib/AmberDB/Transact.pm  view on Meta::CPAN

# Uses non-blocking exclusive flock to safely claim ownership without race conditions.
# Rolls back and removes confirmed orphaned journals.
# Called automatically at the start of each new transaction.
# ------------------------------------------------
sub transact_recover {
    my ( $self ) = @_;

    my $txn_dir = ( $self->path('dbase_dir') || "." ) . "/txn";
    return unless -d $txn_dir;

    my @orphans = glob "$txn_dir/txn_*.txn";
    return unless @orphans;

    foreach my $orphan ( sort @orphans ) {
        my ($pid) = $orphan =~ /\-(\d+)\.txn$/;
        next unless $pid;

        # Skip our own active transaction file
        next if $self->{_txn} && $self->{_txn}->{file} && $orphan eq $self->{_txn}->{file};

        # Open candidate orphan journal file

t/amberdb_simple_mode.t  view on Meta::CPAN

        my @read = $adb->read_id( 'sessions', $id );
        is( $read[0], $id, "read_id returned exact ID: $id" );
        is( $read[1], 'Active', "read_id field 1 matches for $id" );

        my $exists = $adb->exist_id( 'sessions', $id );
        is( $exists, 1, "exist_id confirms key exists: $id" );
    }

    # Verify that ONLY sessions.db was created, NO index files (.inx, .fld, .src, .srt)
    my @created_files = glob("$db_dir/*");
    my @index_files   = grep { /\.(inx|fld|src|srt|fac|rwt)$/ } @created_files;
    is_deeply( \@index_files, [], 'No index files (.inx, .fld, .src, .srt, .fac, .rwt) generated' );
};

# ============================================================
# 2. CRUD Operations with Arbitrary IDs
# ============================================================
subtest '2. CRUD Lifecycle & Bulk Operations in Simple Mode' => sub {
    my $db_dir = "$tmp_dir/simple_db2";
    mkdir($db_dir);