view release on metacpan or  search on metacpan

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

        next if $record =~ /^_/; # skip internal / temp files

        if ( my ( $dbs, $tbl ) = ( $record =~ /^([a-z0-9]+)_(.+)$/i ) ) {
            $all_tables{$dbs}->{$record} = 1;
            if ( $schema_dir && !-e "$schema_dir/$dbs.dbase" ) {
                $all_tables{__NO_DBASE__}->{$dbs} = 1;
            }
            if ( $schema_dir && !-e "$schema_dir/$record.table" ) {
                $all_tables{__NO_TABLE__}->{$record} = 1;
            }
        }
        else {
            # Single-token table name without underscore
            $all_tables{_main}->{$record} = 1;
            if ( $schema_dir && !-e "$schema_dir/$record.table" ) {
                $all_tables{__NO_TABLE__}->{$record} = 1;
            }
        }
    }

    if (wantarray) {
        my @flat_list;
        foreach my $dbs ( sort keys %all_tables ) {
            next if $dbs =~ /^__/;
            push @flat_list, sort keys %{ $all_tables{$dbs} };
        }
        return @flat_list;
    }

    return \%all_tables;
}

# =====================================================================
# TABLE MIGRATION & HISTORICAL FORMAT CONVERSION ENGINE
# =====================================================================


# 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->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_record_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.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->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 $ok = $tools->table_exist("tableid");
# ------------------------------------------------
sub table_exist {

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

    my $table_path = $adb->table_path($table);
    my $ok         = -e "$table_path.$adb->{db_ext}" ? 1 : 0;

    return $ok;
}

# 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('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}.*" );