AmberDB
view release on metacpan or search on metacpan
lib/AmberDB/Tools/Update.pm view on Meta::CPAN
use File::Path qw(make_path);
use File::Copy qw(move);
use Cwd qw(abs_path getcwd);
use version;
our $VERSION = '5.26.6';
my $CREATED = '2018-10-08';
sub new {
my $class = shift;
my $self = {};
require AmberDB;
my ( $adb, %inputs );
if ( ref( $_[0] ) ) {
$adb = shift;
%inputs = @_;
}
else {
%inputs = @_;
$adb = AmberDB->new(%inputs);
}
$self->{_adb} = $adb;
foreach my $in ( keys %inputs ) {
$self->{ uc($in) } = $inputs{$in};
}
$self->{say} = "";
bless $self, $class;
return $self;
}
# Helper to binary copy a file safely without external modules
sub _copy_file {
my ( $self, $src, $dst ) = @_;
return 0 unless -e $src;
open my $in, '<:raw', $src or return 0;
open my $out, '>:raw', $dst or do { close $in; return 0; };
my $buf;
while ( read( $in, $buf, 65536 ) ) {
print $out $buf;
}
close $in;
close $out;
return 1;
}
# ---------------------------------------------------------------------
# update_table($tableid, %options)
# Scans an entire table record-by-record, detects any legacy formats (2003-2026),
# creates a timestamped backup with detected dominant version, and rewrites the table
# directly in ABR v1 format preserving original IDs.
# Rebuilds indexes using ($self->can('set_index') ? $self : do { require AmberDB::Tools::Index; AmberDB::Tools::Index->new($adb); })->set_index($tableid).
# Preserves companion data files ('del', 'aut').
# ---------------------------------------------------------------------
sub update_table {
my ( $self, $tableid, %opts ) = @_;
my $adb = $self->{_adb} or return;
$tableid or return;
my $table_path = $adb->table_path($tableid);
my $ext = $adb->{db_ext} || "db";
my $file_path = "$table_path.$ext";
# Use exist_table to verify primary table existence
return { status => 'not_found', table => $tableid }
unless $adb->exist_table( $tableid );
# Format modification timestamp: YYYY-MMDD
my @mtime_parts = localtime( ( stat($file_path) )[9] || time() );
my $mtime_str = sprintf( "%04d-%02d%02d", $mtime_parts[5] + 1900, $mtime_parts[4] + 1, $mtime_parts[3] );
# 1. Once mevcut tablodaki kayitlari tara
my %format_counts;
my $total = 0;
my $already_current = 0;
my $legacy_count = 0;
my @decoded_records;
my $recovered_from_backup = 0;
$adb->recs_scan( $file_path, sub {
my ( $k, $v ) = @_;
$total++;
my $fmt = $adb->detect_tsv_format($v);
$format_counts{$fmt}++;
my @fields;
if ( $fmt eq 'v5' ) {
@fields = $adb->db_decode($v);
$already_current++;
}
else {
@fields = $adb->tsv_decode( $v, $k );
$legacy_count++;
}
push @decoded_records, [ $k, @fields ];
} );
$adb->table_close($file_path);
# Eger aktif dosya bos ise (ornegin onceki basarisiz bir calismada yedeklenip bos kalmissa):
# Dizin icindeki yedek dosyasini bulup kayitlari oradan kurtar
my $backup_file;
if ( $total == 0 ) {
my ( $pdir ) = $file_path =~ m{^(.*)[/\\]};
$pdir //= ".";
my @cand_backups;
if ( opendir( my $dh, $pdir ) ) {
while ( my $f = readdir($dh) ) {
next if $f eq '.' || $f eq '..';
if ( $f =~ /^\Q$tableid\E-.*?\.\Q$ext\E$/i ) {
push @cand_backups, "$pdir/$f";
}
}
closedir($dh);
}
@cand_backups = sort { ( -s $b ) <=> ( -s $a ) } @cand_backups;
lib/AmberDB/Tools/Update.pm view on Meta::CPAN
}
# 7. Eslikci sozluk ve sayac (.unq, .cnt) dosyalarini koru ve yedekle
my $has_unq = $adb->exist_table($tableid, 'unq');
my $unq_backup;
if ($has_unq) {
my $unq_file = "$table_path.unq";
my $u_backup_base = "$table_path-$dom_ver-$mtime_str.unq";
$unq_backup = $u_backup_base;
my $cnt = 1;
while ( -e $unq_backup ) {
$unq_backup = "$table_path-$dom_ver-$mtime_str-$cnt.unq";
$cnt++;
}
require File::Copy;
File::Copy::copy( $unq_file, $unq_backup );
}
my $has_cnt = $adb->exist_table($tableid, 'cnt');
my $cnt_backup;
if ($has_cnt) {
my $cnt_file = "$table_path.cnt";
my $c_backup_base = "$table_path-$dom_ver-$mtime_str.cnt";
$cnt_backup = $c_backup_base;
my $cnt = 1;
while ( -e $cnt_backup ) {
$cnt_backup = "$table_path-$dom_ver-$mtime_str-$cnt.cnt";
$cnt++;
}
require File::Copy;
File::Copy::copy( $cnt_file, $cnt_backup );
}
$self->{say} .= "Table '$tableid' updated to ABR v1: $total records migrated ($legacy_count converted, backup: $backup_file).\n";
return {
status => ( ( $legacy_count > 0 || $companion_legacy_total > 0 || $recovered_from_backup || $opts{force} ) ? 'updated' : 'already_current' ),
table => $tableid,
total => $total,
updated => $legacy_count,
already_current => $already_current,
dominant_format => $dom_ver,
backup_file => $backup_file,
del_migrated => $companion_stats{del_migrated} // 0,
del_backup => $companion_stats{del_backup},
del_status => $companion_stats{del_status},
aut_migrated => $companion_stats{aut_migrated} // 0,
aut_backup => $companion_stats{aut_backup},
aut_status => $companion_stats{aut_status},
has_unq => $has_unq ? 1 : undef,
unq_backup => $unq_backup,
has_cnt => $has_cnt ? 1 : undef,
cnt_backup => $cnt_backup,
};
}
# ---------------------------------------------------------------------
# update_all(%options)
# Iterates through all discovered tables and runs update_table on each.
# ---------------------------------------------------------------------
sub update_all {
my ( $self, %opts ) = @_;
my $adb = $self->{_adb} or return;
my @tables = ($self->can('all_tables') ? $self->all_tables() : do { require AmberDB::Tools::Maintain; AmberDB::Tools::Maintain->new($self->{_adb})->all_tables(); });
my @results;
foreach my $table (@tables) {
my $res = $self->update_table( $table, %opts );
push @results, $res if $res;
}
return wantarray ? @results : \@results;
}
# my $status = dbase_tableold
# ------------------------------------------------
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('use_simple') ) {
@tables = glob "$dbase_dir/$find.*";
push @tables, ( glob "$dbase_dir/${find}_*" );
}
else {
@tables = glob "$dbase_dir/table/$find.*";
push @tables, ( glob "$dbase_dir/table/${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 );
}
$self->{say} .= " - database table $find renamed to $replace.\n";
lib/AmberDB/Tools/Update.pm view on Meta::CPAN
my $db_obje = AmberDB->new(
ext => { db => $ext },
path => { dbase_dir => $dir },
cfg => {
use_simple => 1,
}
);
return $db_obje;
}
# Rebuilds and converts binary indexes for all tables in database directory.
# my $status = $tools->convert_tables();
# ------------------------------------------------
sub convert_tables {
my ($self) = @_;
my $adb = $self->{_adb} or return;
my $db_dir = $adb->path('dbase_dir');
return unless $db_dir && -d $db_dir;
my @dirs = ($db_dir);
push @dirs, File::Spec->catdir( $db_dir, 'table' ) if -d File::Spec->catdir( $db_dir, 'table' );
my @db_files;
foreach my $d (@dirs) {
if ( opendir my $dh, $d ) {
push @db_files, map { File::Spec->catfile( $d, $_ ) }
grep { /\.\Q$adb->{db_ext}\E$/ }
readdir($dh);
closedir $dh;
}
}
my %converted;
foreach my $file (@db_files) {
my ($tableid) = $file =~ /([^\\\/]+)\.\w+$/;
next unless $tableid;
next if $tableid =~ /^\_/;
$self->{say} .= "Processing table $tableid...\n";
my $ok = ($self->can('set_index') ? $self : do { require AmberDB::Tools::Index; AmberDB::Tools::Index->new($adb); })->set_index($tableid);
if ($ok) {
$converted{$tableid} = 1;
$self->{say} .= " -> Rebuilt packed binary indexes (.inx, .fld, .src) for $tableid\n";
}
}
return \%converted;
}
# Creates a compressed, portable .amberdb archive containing table schemas,
# native data files (.db, .del, .aut, .cnt), and integrity manifest.
# my $archive = $tools->dump( [file => 'backup.amberdb'], [tables => ['t1', 't2']] );
# ---------------------------------------------------------------------
# ---------------------------------------------------------------------
# update_version(%opts)
# Checks MetaCPAN API for latest AmberDB release and optionally installs via cpanm.
# ---------------------------------------------------------------------
sub update_version {
my ( $self, %opts ) = @_;
my $opt_check = $opts{check} // 0;
my $opt_cpanm = $opts{cpanm} // '';
print "=================================================================\n";
print " AmberDB Core Engine Update Utility \n";
print "=================================================================\n";
print "Current Engine Version : v$AmberDB::VERSION\n";
my $api_url = "https://fastapi.metacpan.org/v1/release/AmberDB";
my $json_text;
require HTTP::Tiny;
require JSON::PP;
require version;
my $http = HTTP::Tiny->new( timeout => 5, verify_SSL => 1 );
my $res = $http->get($api_url);
if ( $res && $res->{success} ) {
$json_text = $res->{content};
}
else {
if ( $^O eq 'MSWin32' || $^O eq 'msys' || $^O eq 'cygwin' ) {
$json_text = `powershell -NoProfile -Command "try { (Invoke-WebRequest -Uri '$api_url' -UseBasicParsing).Content } catch {}"`;
}
else {
$json_text = `curl -s -L "$api_url" 2>/dev/null`;
}
}
my $latest_version;
if ( $json_text ) {
my $data = eval { JSON::PP::decode_json($json_text) };
$latest_version = $data->{version} if $data && ref($data) eq 'HASH';
}
if ( !defined $latest_version || $latest_version eq '' ) {
print "[WARNING] Could not retrieve release information from MetaCPAN (offline or API unavailable).\n";
print "You can manually verify or install via: cpanm AmberDB\n";
print "=================================================================\n";
return { status => 'warning', message => 'Could not retrieve release info from MetaCPAN' };
}
print "Latest MetaCPAN Version: $latest_version\n";
print "-----------------------------------------------------------------\n";
my $v_curr = eval { version->parse($AmberDB::VERSION) };
my $v_late = eval { version->parse($latest_version) };
if ( $v_curr && $v_late && $v_curr >= $v_late ) {
print "[OK] AmberDB engine is up to date (v$AmberDB::VERSION).\n";
print "=================================================================\n";
return { status => 'up_to_date', version => $AmberDB::VERSION, latest => $latest_version };
}
print "[UPDATE AVAILABLE] AmberDB can be updated from v$AmberDB::VERSION to v$latest_version.\n";
if ( $opt_check ) {
print "[CHECK MODE] Skipping package installation.\n";
print "=================================================================\n";
return { status => 'update_available', current => $AmberDB::VERSION, latest => $latest_version, check_mode => 1 };
}
my $cpanm_cmd = $opt_cpanm;
if ( !$cpanm_cmd ) {
my $has_cpanm = `where cpanm 2>nul` || `which cpanm 2>/dev/null`;
if ( $has_cpanm ) {
$cpanm_cmd = 'cpanm';
}
else {
my $has_cpan = `where cpan 2>nul` || `which cpan 2>/dev/null`;
$cpanm_cmd = 'cpan' if $has_cpan;
}
}
if ( $cpanm_cmd ) {
print "Launching installer via '$cpanm_cmd AmberDB'...\n";
my $exit_code = system( $cpanm_cmd, "AmberDB" );
if ( $exit_code == 0 ) {
print "[SUCCESS] AmberDB engine updated successfully to latest CPAN release.\n";
print "=================================================================\n";
return { status => 'updated', version => $latest_version };
}
else {
print "[WARNING] Installer exited with status $exit_code. You can run '$cpanm_cmd AmberDB' manually.\n";
print "=================================================================\n";
return { status => 'error', exit_code => $exit_code };
}
}
else {
print "[INFO] Neither 'cpanm' nor 'cpan' executable was detected in PATH.\n";
print "Please run the following command to update AmberDB:\n";
print " cpanm AmberDB\n";
print "=================================================================\n";
return { status => 'manual_required', latest => $latest_version };
}
}
# ---------------------------------------------------------------------
# update_storage(%opts)
# Migrates storage directory layout (scheme->schema, tables->table),
# upgrades table record formats to native ABR v5, rebuilds secondary indexes,
# and stamps config/storage_version.json.
# ---------------------------------------------------------------------
sub update_storage {
my ( $self, %opts ) = @_;
my $adb = $self->{_adb};
my $target_dir = $opts{target_dir}
|| ( $adb ? $adb->path('dbase_dir') : undef )
|| $opts{dbase_dir}
|| $opts{dbase};
if ( !defined $target_dir || $target_dir eq '' ) {
my $cwd = eval { Cwd::abs_path(Cwd::getcwd()) } // '.';
if ( -d File::Spec->catdir( $cwd, "dbstore" ) ) {
$target_dir = File::Spec->catdir( $cwd, "dbstore" );
}
elsif ( -d File::Spec->catdir( $cwd, "dbase" ) ) {
$target_dir = File::Spec->catdir( $cwd, "dbase" );
}
elsif ( -d File::Spec->catdir( $cwd, "tables" ) ) {
$target_dir = $cwd;
}
else {
$target_dir = $cwd;
}
}
$target_dir = eval { Cwd::abs_path($target_dir) } // $target_dir;
my $opt_force = $opts{force} // 0;
my $opt_check = $opts{check} // 0;
my $opt_no_backup = $opts{no_backup} // $opts{'no-backup'} // 0;
my $opt_tables = $opts{tables} // $opts{table} // '';
my $opt_manifest = $opts{manifest} // '';
print "=================================================================\n";
print " AmberDB Storage, Directory & Compatibility Migration Engine \n";
print "=================================================================\n";
print "Database Directory : $target_dir\n";
my $config_dir = File::Spec->catdir( $target_dir, "config" );
my $ver_file = File::Spec->catfile( $config_dir, "storage_version.json" );
require JSON::PP;
require version;
require HTTP::Tiny;
require File::Path;
require File::Copy;
# 1. Inspect existing storage version
my $current_storage_ver;
if ( -e $ver_file ) {
if ( open my $fh, '<', $ver_file ) {
local $/;
my $content = <$fh>;
close $fh;
my $data = eval { JSON::PP::decode_json($content) };
if ( $data && $data->{storage_version} ) {
$current_storage_ver = $data->{storage_version};
}
}
}
if ( !defined $current_storage_ver || $current_storage_ver eq '' ) {
( run in 0.610 second using v1.01-cache-2.11-cpan-145b269f2f3 )