view release on metacpan or  search on metacpan

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

            $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('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";

    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 {

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

    my $status = {};
    ref($files) eq "HASH"   or return $status;
    ref($replace) eq "HASH" or return $status;

    while ( my ( $file, $block ) = each %{$files} ) {
        my @datas = $adb->read_all($file);
        foreach my $record (@datas) {
            my $change = 0;
            if ( $block =~ /^[0-9]+$/ ) {
                if ( exists( $replace->{ $record->[$block] } ) ) {
                    $record->[$block] = $replace->{ $record->[$block] };
                    $change = 1;
                }
            }
            elsif ( ref($block) eq "HASH" ) {
                if ( $block->{BLOCK} ) {
                    my $b = $block->{BLOCK};
                    if ( exists( $replace->{ $record->[$b] } ) ) {
                        $record->[$b] = $replace->{ $record->[$b] };
                        $change = 1;
                    }
                }

                if ( $block->{START} && $block->{STARTBLOCK} ) {
                    my $s = $block->{START};
                    my $b = $block->{STARTBLOCK};
                    foreach my $line ( @{$record}[ $s .. $#$record ] ) {
                        if ( exists( $replace->{ $line->[$b] } ) ) {
                            $line->[$b] = $replace->{ $line->[$b] };