AmberDB
view release on metacpan or search on metacpan
lib/AmberDB.pm view on Meta::CPAN
Time::HiRes::usleep(5000);
}
unless ($db_handle) {
$self->transact_error( $tableid, "Could not open file to write" );
return;
}
# check record id.
my $has_manual_id = ( defined $rid && $rid ne '' && $rid ne '0' );
$rid = $self->table_autoid( $tableid, ( $has_manual_id ? $rid : undef ) );
unless ($rid) {
$self->table_close($file_path);
return;
}
if ($has_manual_id) {
my $value = $self->recs_get( $file_path, $rid );
if ( $value->{$rid} ) {
$self->transact_error( $tableid, "Duplicate ID: $rid" );
$self->table_close($file_path);
return;
}
}
else {
while ( $self->recs_get( $file_path, $rid )->{$rid} ) {
$rid = $self->table_autoid( $tableid );
}
}
# Transaction journal & record locking (Lock before write - Strict 2PL)
my $is_txn = ( $self->{_txn} && $self->{_txn}->{active} ) ? 1 : 0;
$self->flock_open( $tableid, "write", $rid );
if ($is_txn) {
$self->{_txn}->{locks}->{"${tableid}_${rid}"} = 1;
}
# Validate and normalize field values according to schema blocks
@record = $self->enc_validate( $tableid, \@record );
# Validate unique constraints across blocks
my ( $unq_ok, $unq_err ) = $self->unique_check( $table_path, $table_info, $rid, \@record );
if ( !$unq_ok ) {
$self->table_close($file_path);
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
$self->transact_error( $tableid, $unq_err // "Unique constraint violation" );
return;
}
# add new record and close table.
$self->recs_put( $file_path, [ $rid, @record ] );
if ($is_txn) {
my $new_raw;
$self->{_db}->{$file_path}->get( $rid, $new_raw );
$self->_txn_log( $tableid, "add", $rid, $new_raw, "" );
}
$self->table_close($file_path);
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
# for index actions and backup
@record = ( $rid, @record );
# text backup record.
$self->recs_back( "add", $tableid, \@record );
( $self->config('simple') || ( $table_info && $table_info->{use_simple} ) ) and return $rid;
# update .inx / .jinx and secondary indexes
my @batch = ( \@record );
if ( $table_info->{use_junk} && $self->junk_rules( $table_info, @record ) ) {
$self->junk_records_add( $table_path, $table_info, $tableid, [$rid] );
$self->junk_search_add( $table_path, $table_info, $tableid, \@batch );
$self->junk_match_add( $table_path, $table_info, \@batch );
}
else {
$self->records_add( $table_path, $table_info, $tableid, [$rid] );
$self->search_add( $table_path, $table_info, $tableid, \@batch );
$self->match_add( $table_path, $table_info, \@batch );
$self->facet_add( $table_path, $table_info, \@batch );
}
$self->sort_add( $table_path, $table_info, \@batch );
$self->unique_add( $table_path, $table_info, \@batch );
# to create the url rewrite link
$self->set_slug( $tableid, \@record, 1 );
# authorization
$self->auth_write( $tableid, $table_path, "add", $rid );
return $rid;
}
# for bulk record inserting
# Note: Bulk operations (insert_list, modify_list, delete_list) do NOT use transactions (_txn_log).
# my $statu_hash = $adb->insert_list($tableid, @records);
# ------------------------------------------------
sub insert_list {
my ( $self, $tableid, @records ) = @_;
$tableid or return {};
scalar @records or return {};
# Write authority cancelled.
$self->config('no_write')
and do { cluck "[DB_TIE] No authority to write to the file.\n"; return; };
my $table_info = $self->table_info($tableid);
my $is_simple = $self->config('simple') || ( $table_info && $table_info->{use_simple} );
# Continue with the individual method in simple mode
if ($is_simple) {
my %statu;
foreach my $record (@records) {
my $rid = $self->insert_id( $tableid, @$record );
$rid or next;
$statu{$rid} = 1;
}
return \%statu;
}
my $table_path = $self->table_path($tableid);
my $file_path = "$table_path.$self->{db_ext}";
lib/AmberDB.pm view on Meta::CPAN
if ( !$unq_ok ) {
cluck "[DB_UNIQUE] $unq_err\n";
next;
}
$record = [ $rid, @fields ];
$record = [ $self->repeat_fields( $table_info, @$record ) ];
if ( $self->recs_get( $file_path, $rid )->{$rid} ) {
cluck "[DB_TIE] Duplicate ID: $tableid-$rid\n";
next;
}
$self->recs_put( $file_path, $record );
$statu{$rid} = 1;
push @new_rids, $rid;
push @batch, $record; # for indexing: $rid at [0]
}
$self->table_close($file_path);
return \%statu unless @batch;
if ( $table_info->{use_junk} ) {
my ( @active_batch, @junk_batch, @active_rids, @junk_rids );
for my $rec (@batch) {
if ( $self->junk_rules( $table_info, @$rec ) ) {
push @junk_batch, $rec;
push @junk_rids, $rec->[0];
}
else {
push @active_batch, $rec;
push @active_rids, $rec->[0];
}
}
if (@active_batch) {
$self->records_add( $table_path, $table_info, $tableid, \@active_rids );
$self->search_add( $table_path, $table_info, $tableid, \@active_batch );
$self->match_add( $table_path, $table_info, \@active_batch );
$self->facet_add( $table_path, $table_info, \@active_batch );
}
if (@junk_batch) {
$self->junk_records_add( $table_path, $table_info, $tableid, \@junk_rids );
$self->junk_search_add( $table_path, $table_info, $tableid, \@junk_batch );
$self->junk_match_add( $table_path, $table_info, \@junk_batch );
}
$self->sort_add( $table_path, $table_info, \@batch );
}
else {
# .inx update (at once)
$self->records_add( $table_path, $table_info, $tableid, \@new_rids );
# Phase 2: bulk index updates (each file is opened once)
$self->search_add( $table_path, $table_info, $tableid, \@batch );
$self->match_add( $table_path, $table_info, \@batch );
$self->facet_add( $table_path, $table_info, \@batch );
$self->sort_add( $table_path, $table_info, \@batch );
}
$self->unique_add( $table_path, $table_info, \@batch );
# Per-record operations: slug, auth, backup
foreach my $rec (@batch) {
$self->set_slug( $tableid, $rec, 1 );
$self->auth_write( $tableid, $table_path, "add", $rec->[0] );
$self->recs_back( "add", $tableid, $rec );
}
return \%statu;
}
# Replace the DB record with new data.
# ------------------------------------------------
sub modify_id {
my ( $self, $tableid, $rid, @record ) = @_;
# Write authority cancelled.
$self->config('no_write')
and do { $self->transact_error( $tableid, "No authority to write to the file" ); return; };
# Perform the checks.
#$rid ||= shift @record;
$tableid or do { $self->transact_error( "system", "No table defined" ); return; };
$rid = $self->id_check( $tableid, $rid );
$rid or do { $self->transact_error( $tableid, "No valid ID defined" ); return; };
my $table_info = $self->table_info($tableid);
(undef, @record) = $self->repeat_fields( $table_info, $rid, @record );
my $table_path = $self->table_path($tableid);
my $file_path = "$table_path.$self->{db_ext}";
# Transaction journal & record locking (Lock BEFORE reading/modifying - Strict 2PL)
my $is_txn = ( $self->{_txn} && $self->{_txn}->{active} ) ? 1 : 0;
$self->flock_open( $tableid, "write", $rid );
if ($is_txn) {
$self->{_txn}->{locks}->{"${tableid}_${rid}"} = 1;
}
my ( $new_record, $old_record, $value );
# Open the data file.
$self->table_write($file_path)
or do {
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
$self->transact_error( $tableid, "$file_path can't open" );
return;
};
# Perform the record check. (exists or not)
$old_record = $self->recs_get( $file_path, $rid )->{$rid};
if ( !$table_info->{force} ) {
if ( !$old_record ) {
$self->table_close($file_path);
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
$self->transact_error( $tableid, "Record not exist: $rid" );
return;
}
}
# Validate and normalize field values according to schema blocks
@record = $self->enc_validate( $tableid, \@record );
# Validate unique constraints across blocks
my ( $unq_ok, $unq_err ) = $self->unique_check( $table_path, $table_info, $rid, \@record );
if ( !$unq_ok ) {
$self->table_close($file_path);
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
$self->transact_error( $tableid, $unq_err // "Unique constraint violation" );
return;
}
# Perform the record operation and close the file.
$self->recs_put( $file_path, [ $rid, @record ] );
if ($is_txn) {
my $new_raw;
$self->{_db}->{$file_path}->get( $rid, $new_raw );
$self->_txn_log( $tableid, "edit", $rid, $new_raw, $old_record // "" );
}
$self->table_close($file_path);
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
# Cache invalidate
$self->cache_delete($tableid, $rid);
my @new_rec = ( $rid, @record );
# text backup record.
$self->recs_back( "edit", $tableid, \@new_rec )
or cluck "[DB_TIE] Backup error (edit). $tableid\n";
( $self->config('simple') || ( $table_info && $table_info->{use_simple} ) ) and return $rid;
my @old_rec = ( $rid, $self->db_decode($old_record) );
# Index update (search, match, facet, sort)
my @pairs = ( [ $rid, \@old_rec, \@new_rec ] );
if ( $table_info->{use_junk} ) {
$self->junk_transition( $table_path, $table_info, $tableid, \@pairs );
}
else {
$self->search_modify( $table_path, $table_info, $tableid, \@pairs );
$self->match_modify( $table_path, $table_info, \@pairs );
$self->facet_modify( $table_path, $table_info, \@pairs );
}
$self->sort_modify( $table_path, $table_info, \@pairs );
$self->unique_modify( $table_path, $table_info, \@pairs );
# Update URL slug
if ( $table_info->{slug_block} ) {
my $slug_map = $self->get_slug( $tableid, 0, $rid );
my $old_slug = $slug_map->{$rid};
my $new_slug = $self->set_slug( $tableid, \@new_rec, 1 );
if ( $old_slug && $new_slug && $old_slug ne $new_slug ) {
if ( $self->table_write("${table_path}_1.slg") ) {
$self->recs_del( "${table_path}_1.slg", $old_slug );
$self->table_close("${table_path}_1.slg");
}
}
}
# Authorization
$self->auth_write( $tableid, $table_path, "edit", $rid );
return 1;
}
# List record modify.
# Note: Bulk operations (insert_list, modify_list, delete_list) do NOT use transactions (_txn_log).
# ------------------------------------------------
sub modify_list {
my ( $self, $tableid, @records ) = @_;
$tableid or return {};
scalar @records or return {};
# Write authority cancelled.
$self->config('no_write')
and do { cluck "[DB_TIE] No authority to write to the file.\n"; return; };
my $table_info = $self->table_info($tableid);
my $is_simple = $self->config('simple') || ( $table_info && $table_info->{use_simple} );
# Continue with the individual method in simple mode
if ($is_simple) {
my %statu;
foreach my $record (@records) {
my $rid = $self->modify_id( $tableid, @$record );
$rid or next;
$statu{$rid} = 1;
}
return \%statu;
}
my $table_path = $self->table_path($tableid);
my $file_path = "$table_path.$self->{db_ext}";
# Phase 1: raw writings
$self->table_write($file_path) or return {};
my ( %statu, @pairs );
foreach my $record (@records) {
my ( $rid, @data ) = @$record;
$rid or next;
@data = $self->enc_validate( $tableid, \@data );
my ( $unq_ok, $unq_err ) = $self->unique_check( $table_path, $table_info, $rid, \@data );
if ( !$unq_ok ) {
cluck "[DB_UNIQUE] $unq_err\n";
next;
}
$record = [ $rid, @data ];
$record = [ $self->repeat_fields( $table_info, @$record ) ];
my $old_raw = $self->recs_get( $file_path, $rid )->{$rid};
unless ( $table_info->{force} ) {
unless ($old_raw) {
cluck "[DB_TIE] Not exist: $rid\n";
next;
}
}
$self->recs_put( $file_path, $record );
$self->cache_delete( $tableid, $rid );
$statu{$rid} = 1;
my @old_rec = ( $rid, $self->db_decode($old_raw) );
my @new_rec = @$record;
push @pairs, [ $rid, \@old_rec, \@new_rec ];
}
$self->table_close($file_path);
return \%statu unless @pairs;
# Phase 2: bulk index updates
if ( $table_info->{use_junk} ) {
$self->junk_transition( $table_path, $table_info, $tableid, \@pairs );
}
else {
$self->search_modify( $table_path, $table_info, $tableid, \@pairs );
$self->match_modify( $table_path, $table_info, \@pairs );
$self->facet_modify( $table_path, $table_info, \@pairs );
}
$self->sort_modify( $table_path, $table_info, \@pairs );
$self->unique_modify( $table_path, $table_info, \@pairs );
# Per-record operations: slug, auth, backup
foreach my $pair (@pairs) {
my ( $rid, $old_rec, $new_rec ) = @$pair;
if ( $table_info->{slug_block} ) {
my $slug_map = $self->get_slug( $tableid, 0, $rid );
my $old_slug = $slug_map->{$rid};
my $new_slug = $self->set_slug( $tableid, $new_rec, 1 );
if ( $old_slug && $new_slug && $old_slug ne $new_slug ) {
if ( $self->table_write("${table_path}_1.slg") ) {
$self->recs_del( "${table_path}_1.slg", $old_slug );
$self->table_close("${table_path}_1.slg");
}
}
}
$self->auth_write( $tableid, $table_path, "edit", $rid );
$self->recs_back( "edit", $tableid, $new_rec );
}
return \%statu;
}
# Delete a record in the DB.
# ------------------------------------------------
sub delete_id {
my ( $self, $tableid, $rid ) = @_;
# Write authority cancelled.
$self->config('no_write')
and do { $self->transact_error( $tableid, "No authority to write to the file" ); return; };
# If no ID, return error.
$tableid or do { $self->transact_error( "system", "Not found table" ); return; };
$rid = $self->id_check( $tableid, $rid );
$rid or do { $self->transact_error( $tableid, "Not found record ID" ); return; };
my $table_info = $self->table_info($tableid);
my $table_path = $self->table_path($tableid);
my $file_path = "$table_path.$self->{db_ext}";
my $del_path = "$table_path.del";
# Transaction journal & record locking (Lock BEFORE reading/deleting - Strict 2PL)
my $is_txn = ( $self->{_txn} && $self->{_txn}->{active} ) ? 1 : 0;
$self->flock_open( $tableid, "write", $rid );
if ($is_txn) {
$self->{_txn}->{locks}->{"${tableid}_${rid}"} = 1;
}
# Replace record
# Check writability
$self->table_write($file_path)
or do {
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
$self->transact_error( $tableid, "Could not open $file_path to write" );
return;
};
# If no record, return
my $record = $self->recs_get( $file_path, $rid )->{$rid};
if ( !$record ) {
$self->table_close($file_path);
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
return;
}
# Delete the record
$self->recs_del( $file_path, $rid );
if ($is_txn) {
$self->_txn_log( $tableid, "del", $rid, "", $record );
}
$self->table_close($file_path);
unless ($is_txn) { $self->flock_close( $tableid, $rid ); }
# Cache invalidate
$self->cache_delete($tableid, $rid);
# Text backup record
$self->recs_back( "del", $tableid, [ $rid, "" ] )
or cluck "[DB_TIE] Backup error (del). $tableid\n";
# Move to archive if keep_deleted enabled
if ( $table_info->{keep_deleted} ) {
( $self->table_write($del_path)
and $self->recs_put( $del_path, [ $rid, $record ] )
and $self->table_close($del_path) )
or cluck "[DB_TIE] $del_path can't open.\n";
}
( $self->config('simple') || ( $table_info && $table_info->{use_simple} ) ) and return $rid;
my @record = ( $rid, $self->db_decode($record) );
# Clear Index (search, match, facet, sort)
my @batch = ( \@record );
if ( $table_info->{use_junk} && $self->junk_rules( $table_info, @record ) ) {
$self->junk_records_del( $table_path, $table_info, [$rid], $tableid );
$self->junk_search_del( $table_path, $table_info, $tableid, \@batch );
$self->junk_match_del( $table_path, $table_info, \@batch );
}
else {
$self->records_del( $table_path, $table_info, [$rid], $tableid );
$self->search_del( $table_path, $table_info, $tableid, \@batch );
$self->match_del( $table_path, $table_info, \@batch );
$self->facet_del( $table_path, $table_info, \@batch );
}
$self->sort_del( $table_path, $table_info, \@batch );
$self->unique_del( $table_path, $table_info, \@batch );
# Clear URL slug
if ( $table_info->{slug_block} ) {
my $slug_map = $self->get_slug( $tableid, 0, $rid );
my $slug = $slug_map->{$rid};
if ($slug) {
if ( $self->table_write("${table_path}_0.slg") ) {
$self->recs_del( "${table_path}_0.slg", $rid );
$self->table_close("${table_path}_0.slg");
}
if ( $self->table_write("${table_path}_1.slg") ) {
$self->recs_del( "${table_path}_1.slg", $slug );
$self->table_close("${table_path}_1.slg");
}
}
}
# Authorization
$self->auth_write( $tableid, $table_path, "del", $rid );
return 1;
}
# Deletes list of records from table...
# Note: Bulk operations (insert_list, modify_list, delete_list) do NOT use transactions (_txn_log).
# ------------------------------------------------
sub delete_list {
my ( $self, $tableid, @records ) = @_;
lib/AmberDB.pm view on Meta::CPAN
my $rid = ref($record) ? $record->[0] : $record;
my $raw = $self->recs_get( $file_path, $rid )->{$rid};
next unless $raw;
$self->recs_del( $file_path, $rid );
$self->cache_delete( $tableid, $rid );
$statu{$rid} = 1;
push @del_rids, $rid;
push @batch, [ $rid, $self->db_decode($raw) ];
}
$self->table_close($file_path);
return \%statu unless @batch;
# Archive
if ( $table_info->{keep_deleted} ) {
if ( $self->table_write($del_path) ) {
foreach my $rec (@batch) {
$self->recs_put( $del_path, [ $rec->[0], $self->db_encode( @{$rec}[1..$#$rec] ) ] );
}
$self->table_close($del_path);
}
}
# Phase 2: bulk index clearing
if ( $table_info->{use_junk} ) {
my ( @active_batch, @junk_batch, @active_rids, @junk_rids );
for my $rec (@batch) {
if ( $self->junk_rules( $table_info, @$rec ) ) {
push @junk_batch, $rec;
push @junk_rids, $rec->[0];
}
else {
push @active_batch, $rec;
push @active_rids, $rec->[0];
}
}
if (@active_batch) {
$self->records_del( $table_path, $table_info, \@active_rids, $tableid );
$self->search_del( $table_path, $table_info, $tableid, \@active_batch );
$self->match_del( $table_path, $table_info, \@active_batch );
$self->facet_del( $table_path, $table_info, \@active_batch );
}
if (@junk_batch) {
$self->junk_records_del( $table_path, $table_info, \@junk_rids, $tableid );
$self->junk_search_del( $table_path, $table_info, $tableid, \@junk_batch );
$self->junk_match_del( $table_path, $table_info, \@junk_batch );
}
$self->sort_del( $table_path, $table_info, \@batch );
}
else {
$self->records_del( $table_path, $table_info, \@del_rids, $tableid );
$self->search_del( $table_path, $table_info, $tableid, \@batch );
$self->match_del( $table_path, $table_info, \@batch );
$self->facet_del( $table_path, $table_info, \@batch );
$self->sort_del( $table_path, $table_info, \@batch );
}
$self->unique_del( $table_path, $table_info, \@batch );
# Per-record operations: slug, auth, backup
foreach my $rec (@batch) {
my $rid = $rec->[0];
if ( $table_info->{slug_block} ) {
my $slug_map = $self->get_slug( $tableid, 0, $rid );
my $slug = $slug_map->{$rid};
if ($slug) {
if ( $self->table_write("${table_path}_0.slg") ) {
$self->recs_del( "${table_path}_0.slg", $rid );
$self->table_close("${table_path}_0.slg");
}
if ( $self->table_write("${table_path}_1.slg") ) {
$self->recs_del( "${table_path}_1.slg", $slug );
$self->table_close("${table_path}_1.slg");
}
}
}
$self->auth_write( $tableid, $table_path, "del", $rid );
$self->recs_back( "del", $tableid, [ $rid, "" ] );
}
return \%statu;
}
# my $ok = $adb->insert_links($tableid, [rid1, lnk1], [rid2, lnk2]);
# Writes alias link bindings into .lnk file.
# ------------------------------------------------
sub insert_links {
my ( $self, $tableid, @records ) = @_;
$tableid or return;
@records or return;
my $table_info = $self->table_info($tableid);
$table_info->{use_alias} or return;
# Yazma yetkisi iptal edildi.
$self->config('no_write')
and do { cluck "[DB_TIE] No authority to write to the file.\n"; return; };
my $table_path = $self->table_path($tableid);
my $link_path = "$table_path.lnk";
$self->table_write($link_path)
or do { cluck "[DB_TIE] $link_path can't open. insert_links. $tableid\n"; return; };
foreach my $rec (@records) {
( $rec->[0] and $rec->[1] ) or next;
$self->recs_put( $link_path, [ $rec->[0], $rec->[1] ] );
}
$self->table_close($link_path);
return 1;
}
# my $ok = $adb->insert_strs($tableid, $blk, [str1a, str1b], [str2a, str2b]);
# Updates synonym mapping tables (.unq); appends new values to existing list.
# ------------------------------------------------
sub insert_strs {
my ( $self, $tableid, $blk, @records ) = @_;
lib/AmberDB.pm view on Meta::CPAN
# if not opened for write, open table in write mode
if ( !$self->{_db}->{$table_path} || !$self->{_dbm}->{$table_path} ) {
$self->table_write($table_path)
or do { cluck "[DB_TIE] $table_path can't open for index_put.\n"; return; };
}
my $db = $self->{_db}->{$table_path};
return unless $db;
my $k = $self->utf_encode("$key");
$type = lc( $type // '' );
# Raw scalar files (.slg URL slugs, .unq unique/dictionary, scalar values) bypass binary encoding
if ( $type eq 'raw' || $type eq 'scalar' || $type eq 'text' || $table_path =~ /\.slg$/ || $table_path =~ /\.unq$/ ) {
$val = $self->utf_encode($val);
}
elsif ( $type eq 'ids' || $type eq 'bin' || ref($val) eq 'ARRAY' ) {
return unless ref($val) eq 'ARRAY' && @$val;
$val = $self->bin_encode($val);
}
else {
$val = $self->utf_encode($val);
}
return unless defined $val && $val ne '';
my $ret = $db->put( $k, $val );
warn "[DB_TIE] $table_path can't put key $k.\n" if $ret < 0;
return $ret == 0 ? 1 : 0;
}
# Deletes a single index key using direct DB_File C object methods ($db->del).
# Usage:
# $adb->index_del($table_path, $key);
# ------------------------------------------------
sub index_del {
my ( $self, $table_path, $key ) = @_;
return unless $table_path && defined $key && $key ne '';
# if not opened for write, open table in write mode
if ( !$self->{_db}->{$table_path} || !$self->{_dbm}->{$table_path} ) {
$self->table_write($table_path)
or do { cluck "[DB_TIE] $table_path can't open for index_del.\n"; return; };
}
my $db = $self->{_db}->{$table_path};
return unless $db;
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');
# Table schema check: no_backup => 1 in table schema
my $table_info = $self->table_info($tableid);
return if $table_info->{no_backup};
my $user = $self->config('user') || 'system';
$tableid =~ s/[:\/\\]/--/g;
my $backup_base = $self->path('backup_dir')
|| ( $self->path('dbase_dir') ? $self->path('dbase_dir') . "/backup" : "backup" );
my $year = ( $self->{date} && $self->{date}->{year} ) ? $self->{date}->{year} : (localtime)[5] + 1900;
my $month = ( $self->{date} && $self->{date}->{month} ) ? $self->{date}->{month} : sprintf( "%02d", (localtime)[4] + 1 );
my $day = ( $self->{date} && $self->{date}->{day} ) ? $self->{date}->{day} : sprintf( "%02d", (localtime)[3] );
my $date_iso = "$year-$month-$day";
my $time_str = ( $self->{date} && $self->{date}->{str} ) ? $self->{date}->{str} : "$date_iso " . sprintf( "%02d:%02d:%02d", (localtime)[2], (localtime)[1], (localtime)[0] );
my $backup_file;
if ( $self->config('simple') ) {
$backup_file = "$backup_base/$date_iso.csv";
}
else {
my $year_dir = "$backup_base/$year";
unless ( -d $year_dir ) {
require File::Path;
File::Path::make_path($year_dir);
}
$backup_file = "$year_dir/$date_iso.csv";
}
open my $YAZ, ">>:encoding(UTF-8)", $backup_file
or do {
cluck "[DB_BACKUP] Cannot open backup file $backup_file: $!\n";
return;
};
foreach my $record (@records) {
ref($record) eq "ARRAY" or $record = [$record];
my $rid = $record->[0];
my $bac_val = $self->db_encode( @{$record}[ 1 .. $#$record ] );
print $YAZ "$time_str\t$user\t$action\t$tableid\t$rid\t$bac_val\n";
}
close $YAZ;
return 1;
}
# my $view_pre = $adb->auth_view($tableid, $rid);
# Returns add/edit/del audit history on record as HTML <pre>.
# ------------------------------------------------
sub auth_view {
my ( $self, $tableid, $rid ) = @_;
return unless $rid;
return unless $tableid;
return unless ref $self->{_auth}->{$tableid}->{$rid} eq "ARRAY";
my $string;
foreach my $line ( @{ $self->{_auth}->{$tableid}->{$rid} } ) {
if ( ref $line eq "ARRAY" ) {
my $date = $self->dateid2str( $line->[2] );
if ( $line->[1] ne "edit" ) { $line->[1] .= " " }
$string .= " $line->[1]\t$date\t$line->[0]\n";
}
else {
$string .= "--> $line\n";
$string .= "----------------\n";
}
}
return $string;
}
# Loads record ownership audit trail into memory (_auth) from .aut file.
# AUTH called internally only from read_list and read_id.
# my $ok = $adb->auth_read($tableid, $table_path, @record_ids);
# ------------------------------------------------
sub auth_read {
my ( $self, $tableid, $table_path, @record_ids ) = @_;
return unless $tableid;
return unless -e "$table_path.$self->{db_ext}";
return unless -e "$table_path.aut";
return unless scalar @record_ids;
my $table_info = $self->table_info($tableid);
return unless $table_info->{log_owner};
my @lookup_keys;
my %esc_map;
lib/AmberDB.pm view on Meta::CPAN
# Repeating line items:
{ id => "item_id", name => "Item ID", type => "text" },
{ id => "item_title", name => "Product Title",type => "text" },
{ id => "item_qty", name => "Quantity", type => "num" },
{ id => "item_price", name => "Unit Price", type => "num" },
],
}
=head1 TRANSACTIONS
Transactions provide multi-table atomic updates backed by undo-log journals (C<.txn> files).
If a database error occurs (e.g. file lock failure, duplicate ID), or if custom business validation fails (e.g. insufficient stock),
all base records and indexes across all affected tables are restored to their exact pre-transaction state.
=head2 Checkout / Stock Deduction Example
$adb->transact_start();
# 1. Check & update stock
my @product = $adb->read_id("product", $product_id);
my $current_stock = $product[4];
if ($current_stock < $quantity) {
# Custom business logic rollback (e.g. stock insufficient)
$adb->transact_rollback();
return { success => 0, error => "Out of stock" };
}
$product[4] -= $quantity;
$adb->modify_id("product", $product_id, @product);
# 2. Insert order record
my $order_id = $adb->insert_id("orders", 0, $user_id, $product_id, $quantity, time());
# 3. Finalize transaction (auto-rollbacks if base error occurred)
my $txn = $adb->transact_end();
if ($txn->{status} eq 'commit') {
return { success => 1, order_id => $order_id };
} else {
return { success => 0, error => "The operation failed, the changes were reverted." };
}
B<Note / Limitations:> Bulk/list operations (C<insert_list>, C<modify_list>, C<delete_list>) do not support the transact operation. There is a fundamental reason for this. Junk operations are designed for loading, editing, or deleting a list containi...
Furthermore, if the user truly wants to perform an operation on the list using transact, they can put it in a loop and use the individual C<insert_id>, C<modify_id>, C<delete_id> operations.
=head1 SIMPLE MODE (SCHEMA-LESS FLAT STORE)
In addition to its schema-driven enterprise mode, AmberDB provides a lightweight B<Simple Mode> (C<simple =E<gt> 1>). In Simple Mode, the database operates as an ultra-fast, schemaless NoSQL key-value/document store directly on flat C<.db> (or custom...
=head2 Key Characteristics of Simple Mode
=over 4
=item * B<Arbitrary & Flexible Keys:> The 8-byte ASCII limit and numeric constraints are bypassed. Keys can be emails (C<user@example.com>), UUIDs, long tokens, or Unicode/multilingual strings.
=item * B<Flat Directory Structure:> All tables reside directly under C<dbase_dir> (e.g. C<$dbase_dir/table.db>). No C<tables/> or C<schema/> subfolders are required.
=item * B<Rich Nested Structures:> Records can store nested array and hash references (ARRAY/HASH) directly.
=item * B<Continuous Daily Backup Logs:> Text-based continuous daily WAL/CSV logs (C<recs_back>) automatically record all C<add>, C<edit>, and C<del> operations directly into C<$dbase_dir/YYYY-MM-DD.csv> alongside database tables (can be silenced wit...
=item * B<ACID Transactions:> Full multi-table transaction support with atomic rollback (restoring raw records in the C<.db> file).
=item * B<Streaming Queries & Sorting:> Methods like C<read_all>, C<field_fetch>, and C<search_table> operate via direct sequential streaming scans with full support for pagination (C<start>/C<limit>), C<keys_only>, and in-memory sorting.
=item * B<Zero-Latency RAM-Disk Caching:> Simple mode instances can be initialized directly on RAM-disk / tmpfs mount points (e.g. C</dev/shm/cache>) to provide nanosecond-speed transient session and cache stores.
=back
=head2 Simple Mode Example
# 1. Initialize simple mode
my $adb = AmberDB->new(
path => { dbase_dir => "/var/data/sessions" },
cfg => { simple => 1, user => 'admin' },
);
# 2. Insert with arbitrary key
$adb->insert_id('sessions', 'user@example.com', 'Active', 'Chrome', time());
# 3. Read record (O(1))
my @sess = $adb->read_id('sessions', 'user@example.com');
# 4. Search and filter without indexes
my ($count, @active) = $adb->field_fetch('sessions', 1, 'Active', 0, 10);
# 5. Dual-instance RAM-Disk architecture
my $ram_db = AmberDB->new(
path => { dbase_dir => "/dev/shm/amber_cache" },
cfg => { simple => 1, no_backup => 1 },
);
$ram_db->insert_id('tokens', $token_id, $user_id, time());
=head1 METHODS
=head2 new(%options)
Instantiates a new C<AmberDB> object.
=head2 config([$key], [%options])
Gets or sets runtime configuration flags deterministically with automatic hook/side-effect dispatching (e.g. locale reloading, table path invalidation):
# Single scalar getter
my $lang = $adb->config('language');
# Bulk getter (returns a safe shallow copy)
my $cfg = $adb->config();
# Key-value setter with method chaining
$adb->config( language => 'en', no_write => 1 );
# Hashref setter
$adb->config({ simple => 1, cache_size => '1024M' });
=head2 insert_id($table_id, [$record_id], @record)
Inserts a new record into specified table. It automatically generates search, match, slug, and facet indexes if they are defined in the table schema. It supports transact operations. In normal records, there is no need to enter an ID value. It can be...
=head2 insert_list($table_id, @records)
Inserts multiple records in a single bulk operation. Aside from Transact, it processes records, search, match, slug, and facet indexes all at once with high performance.
=head2 modify_id($table_id, $record_id, @record)
Updates existing record data. It automatically updates the search, match, slug, and facet indexes if they are defined in the table schema. It supports transact operations.
=head2 modify_list($table_id, @records)
Modifies multiple records in a single bulk operation. Aside from Transact, it processes records, search, match, slug, and facet indexes all at once with high performance.
=head2 delete_id($table_id, $record_id)
Deletes specified record from table. Supports transaction logging.
=head2 delete_list($table_id, @records)
Deletes multiple records in a single bulk operation. Aside from Transact, it processes records, search, match, slug, and facet indexes all at once with high performance.
=head2 read_id($table_id, $record_id)
Reads single record by primary key ID.
=head2 read_all($table_id, [$start], [$limit], [%options])
Reads active records from table. Supports pagination, binary index optimization (C<.inx>, C<.srt>), sorting, and C<keys_only>.
B<IMPORTANT (Return Signature Convention):>
When C<$limit> is passed and C<E<gt> 0> (paginated), C<read_all> returns C<($total_count, @records)> where the first scalar is the total matching count integer. When C<$limit> is omitted or C<0> (unpaginated), it returns C<@records> directly. Unpacki...
lib/AmberDB.pm view on Meta::CPAN
Tiered query mode: 'A' (Active only), 'B' (Junk only), 'AB' (Active first, then Junk)
my @active_only = $adb->read_all("catalog_product", jnktype => 'A');
my ($total_count, @all_tiered) = $adb->read_all("catalog_product", 0, 20, jnktype => 'AB');
Return only scalar record IDs (memory-efficient pipeline)
my ($count, @ids) = $adb->read_all("catalog_product", 0, 50, keys_only => 1);
my @all_ids = $adb->read_all("catalog_product", keys_only => 1);
Forcing non-indexed reading (no_index)
my @all_ids = $adb->read_all("catalog_product", 0, 0, no_index => 1);
=head2 read_list($table_id, \@id_list)
Reads multiple records matching provided ID list while preserving exact list ordering.
# Read the entire active order list.
my @records = $adb->read_all("order_active");
# Extract customer IDs from block 1 using the map.
my %customer_ids = map { $_->[1] => 1 } @records;
# You've found the customer ID keys, now read them using read_list.
my @customers = $adb->read_list("customers", [ keys %customer_ids ]);
=head2 field_fetch($table_id, $block, $value, [$start], [$limit], [%options])
Fetches records matching one or more block values using the C<.fld> match index (or sequential table scan fallback if unindexed). Supports multi-value queries, automatic deduplication, sorting, pagination, and C<keys_only>.
B<IMPORTANT (Return Signature Convention):>
When C<$limit> is passed and C<E<gt> 0> (paginated), C<field_fetch> returns C<($total_count, @records)> where the first scalar is the total matching count integer. When C<$limit> is omitted or C<0> (unpaginated), it returns C<@records> directly. Unpa...
# 1. Unpaginated (returns array of record arrayrefs directly)
my @records = $adb->field_fetch("products", 1, "5");
my @sorted_asc = $adb->field_fetch("products", 1, "5", 0, 0, sort => -10);
# 2. Paginated (first element is total matching count integer)
my ($total_count, @records) = $adb->field_fetch(
"products", 1, "5",
0, 20,
sort => { blk => 10, reverse => 1 } # Or shorthand: sort => -10 (ascending)
);
# Multi-value matching (comma string, semicolon, or ARRAY ref)
my @records = $adb->field_fetch("products", 1, ["5", "8"]);
my @records = $adb->field_fetch("products", 1, "5, 8");
# Return only record IDs: keys_only flag
my @all_ids = $adb->field_fetch("products", 1, "5", keys_only => 1);
my ($total_count, @ids) = $adb->field_fetch("products", 1, "5", 0, 20, keys_only => 1);
# Tiered Junk query mode
my @active = $adb->field_fetch("products", 1, "5", jnkmode => 'A'); # Only Active records
C<field_fetch> uses the C<match_block> definition in the schema and accesses inverted match index files (C<.fld>), providing $O(1)$ average-time lookup per indexed key (total retrieval cost scales with the number of requested values and matching reco...
=head2 search_table($table_id, $query, [$start], [$limit], [$mode], [%options])
It performs searches matching query terms using the full-text C<.src> index (or a sorted table scan backup method if unindexed). C<search_table> uses the C<AmberDB::Locale> module. It features advanced language normalization according to the selected...
B<IMPORTANT (Return Signature Convention):>
When C<$limit> is passed and C<E<gt> 0> (paginated), C<search_table> returns C<($total_count, @records)> where the first scalar is the total matching count integer. When C<$limit> is omitted or C<0> (unpaginated), it returns C<@records> directly. Unp...
# 1. Unpaginated (returns array of record arrayrefs directly)
my @records = $adb->search_table("catalog_product", "kablosuz kulaklık");
my @sorted_records = $adb->search_table("catalog_product", "kulaklık", 0, 0, sort => -5);
# 2. Paginated (first element is total matching count integer)
my ($total_count, @search) = $adb->search_table( "catalog_product", "kulaklık", 0, 20 );
my ($total_count, @search) = $adb->search_table(
"catalog_product", "kulaklık",
start => 0,
limit => 20,
sort => -5,
filter => { field => 6, value => 12 },
jnktype => 'AB',
);
# Return only scalar record IDs
my @all_ids = $adb->search_table("catalog_product", "kulaklık", keys_only => 1);
my ($total_count, @ids) = $adb->search_table("catalog_product", "kulaklık", 0, 50, keys_only => 1);
=head2 field_filter($table_id, \%filter_options)
Performs multi-block filtered queries (AND / OR) with support for multi-value filters, tier mode selection (C<jnktype>), sorting, and pagination:
my $res = $adb->field_filter("catalog_product", {
type => "and",
filter => { 1 => "5", 6 => ["12", "14"] },
sort => { blk => 5, reverse => 1 },
jnktype => "AB",
start => 0,
limit => 20,
});
# Returns: { count => $total, ids => \@matching_ids }
=head2 exist_id($table_id, $record_id)
Checks if a single record exists in the specified table. Returns 1 if present, 0 otherwise:
my $exists = $adb->exist_id("catalog_product", 101);
=head2 exist_list($table_id, @record_ids)
Queries the presence of multiple record IDs in a single pass. Returns a hash reference C<{ id =E<gt> 1/0 }>:
my $map = $adb->exist_list("catalog_product", 101, 102, 103);
=head2 exist_table($table_id, [$ext])
Checks whether the physical database table or index file exists on disk. C<$ext> defaults to C<$self-E<gt>{db_ext}> (C<'db'>):
my $has_table = $adb->exist_table("catalog_product");
my $has_index = $adb->exist_table("catalog_product", "inx");
=head2 table_count($table_id)
Returns the total number of records in the specified table. Reads from the primary C<.inx> index if enabled, or scans the main table:
( run in 0.447 second using v1.01-cache-2.11-cpan-4ef0a570458 )