view release on metacpan or  search on metacpan

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

        while ( -e $cnt_backup_file ) {
            $cnt_backup_file = "$backup_base-$cnt_cnt.cnt";
            $cnt_cnt++;
        }
        $self->_copy_file( $cnt_file, $cnt_backup_file );
    }

    $self->{say} .= "Table '$tableid' updated to ABR v1: $total records migrated ($legacy_count converted, backup: $backup_file).\n";

    return {
        status          => 'updated',
        table           => $tableid,
        total           => $total,
        updated         => $legacy_count,
        already_current => $already_current,
        dominant_format => $dom_ver,
        backup_file     => $backup_file,
        del_migrated    => $del_migrated,
        del_backup      => $del_backup_file,
        aut_migrated    => $aut_migrated,
        aut_backup      => $aut_backup_file,
        has_unq         => $has_unq ? 1 : 0,
        unq_backup      => $unq_backup_file,
        has_cnt         => $has_cnt ? 1 : 0,
        cnt_backup      => $cnt_backup_file,
    };
}

# ---------------------------------------------------------------------
# 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/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 );
    }
    $self->{say} .= "    - database table $find renamed to $replace.\n";

    return 1;
}

# my %files = (
# "dbase_table1" => 0,
# "dbase_table2" => 2,
# "dbase_table3" => { BLOCK => 1, START => 2, STARTBLOCK => 3 },
# );
# my %replace = (
# "fields1" => "new_fields1",
# "fields2" => "new_fields2",
# );
# my $status = $tools->replace_blockdata(\%files, \%replace);
# ------------------------------------------------
sub replace_blockdata {