view release on metacpan or  search on metacpan

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

    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;
        for my $cb (@cand_backups) {
            next unless -e $cb && -s $cb;
            my @b_records;
            my %b_counts;
            my $b_legacy = 0;
            $adb->recs_scan( $cb, sub {
            my ( $k, $v ) = @_;
                my $fmt = $adb->detect_tsv_format($v);
                $b_counts{$fmt}++;
                my @fields = ( $fmt eq 'v5' ) ? $adb->db_decode($v) : $adb->tsv_decode( $v, $k );
                $b_legacy++ if $fmt ne 'v5';
                push @b_records, [ $k, @fields ];
        } );
            $adb->table_close($cb);