view release on metacpan or  search on metacpan

lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm  view on Meta::CPAN

                ( $used_names, $all_sr_groups ) = @{pop @bu};
                next ADD_SEARCH_AND_REPLACE;
            }
            return;
        }
        if ( $sf->{o}{G}{menu_memory} ) {
            if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
                $old_idx = 1;
                next ADD_SEARCH_AND_REPLACE;
            }
            $old_idx = $idx;
        }
        my $choice = $menu->[$idx];
        if ( $choice eq $hidden ) {
            $sf->__saved_search_and_replace();
            $saved = $ax->read_json( $sf->{i}{f_search_and_replace} ) // {};
            $available = [ sort { $a cmp $b } keys %$saved  ];
            next ADD_SEARCH_AND_REPLACE;
        }
        elsif ( $choice eq $sf->{i}{_confirm} ) {
            if ( ! @$all_sr_groups ) {
                return;
            }
            $info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
            my $col_idxs = $sf->__choose_column_indexes( $header, $info, 'Apply to: ' );
            if ( ! defined $col_idxs ) {
                next ADD_SEARCH_AND_REPLACE;
            }
            if ( ! eval {
                $sf->__execute_substitutions( $aoa, $col_idxs, $all_sr_groups ); # modifies $aoa
                1 }
            ) {
                $ax->print_error_message( $@ );
                next ADD_SEARCH_AND_REPLACE;
            }
            $sql->{insert_args} = $aoa;
            my $header_changed = 0;
            if ( $sf->{d}{stmt_types}[0] eq 'Create_Table' ) {
                for my $i ( @$col_idxs ) {
                    if ( ! defined $sql->{insert_args}[0][$i] ) {
                        next;
                    }
                    if ( $header->[$i] ne $sql->{insert_args}[0][$i] ) {
                        $header_changed = 1;
                        last;
                    }
                }
            }
            if ( $header_changed ) {
                my ( $yes, $no ) = ( '- YES', '- NO' );
                my $menu = [ undef, $yes, $no ];
                my @tmp_info_addition = ( 'Header: ' . join( ', ', map { $_ // '' } @{$sql->{insert_args}[0]} ), ' ' );
                $info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info, @tmp_info_addition ) );
                # Choose
                my $idx = $tc->choose(
                    $menu,
                    { %{$sf->{i}{lyt_v}}, info => $info, prompt => 'Restore header?', index => 1, undef => $sf->{i}{s_back} }
                );
                if ( ! defined $idx || ! defined $menu->[$idx] ) {
                    if ( @$aoa * @$col_idxs > 500_000 ) {
                        $cf->__print_busy_string( 'Working ...' );
                    }
                    $sql->{insert_args} = [ map { [ @$_ ] } @{$bu_insert_args} ];
                    return;
                }
                my $choice = $menu->[$idx];
                if ( $choice eq $yes ) {
                    $sql->{insert_args}[0] = $header;
                }
            }
            return 1;
        }
        elsif ( $choice eq $add ) {
            my $prompt = 'Build s///;';
            my $skip = ' ';
            my $fields = [];
            for my $nr ( 1 .. 5 ) {
                push @$fields,
                    [ $skip ],
                    [ $nr . ' Pattern',     ],
                    [ $nr . ' Replacement', ],
                    [ $nr . ' Modifiers',   ];
            }
            my $back = $sf->{i}{back} . '   ';

            SUBSTITUTION: while ( 1 ) {
                $info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
                # Fill_form
                my $form = $tf->fill_form(
                    $fields,
                    { info => $info, prompt => $prompt, confirm => $sf->{i}{confirm}, back => $back }
                );
                if ( ! defined $form ) {
                    next ADD_SEARCH_AND_REPLACE;
                }
                my $sr_group = [ $sf->__from_form_to_sr_group_data( $form ) ];
                if ( ! @$sr_group ) {
                    next ADD_SEARCH_AND_REPLACE;
                }
                if ( ! eval {
                    $sf->__execute_substitutions( [ [ 'test_string' ] ], [ 0 ], [ $sr_group ] );
                    1 }
                ) {
                    $ax->print_error_message( $@ );
                    $fields = $form;
                    next SUBSTITUTION;
                }
                push @bu, [ [ @$used_names ], [ @$all_sr_groups ] ];
                push @$all_sr_groups, $sr_group;
                last SUBSTITUTION;
            }
        }
        else {
            my $name = $available->[$idx-@pre];
            my $sr_group = $saved->{$name};
            push @bu, [ [ @$used_names ], [ @$all_sr_groups ] ];
            push @$used_names, $name;
            push @$all_sr_groups, $sr_group;
        }
    }
}


sub __from_form_to_sr_group_data {
    my ( $sf, $form ) = @_;
    my @sr_group_data;
    my @copy = @$form;
    while ( @copy ) {
        my ( $section_separator, $pattern, $replacement, $modifiers ) = map { $_->[1] // '' } splice @copy, 0, 4;
        if ( length $pattern ) {
            push @sr_group_data, { pattern => $pattern, replacement => $replacement, modifiers => $modifiers };
        }
    }
    return @sr_group_data;
}


sub __choose_column_indexes {
    my ( $sf, $columns, $info, $prompt ) = @_;
    my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
    # Choose
    my $col_idxs = $tu->choose_a_subset(
        $columns,
        { cs_label => $prompt, info => $info, layout => 0, all_by_default => 1, index => 1, keep_chosen => 0 }
    );
    if ( ! defined $col_idxs ) {
        return;
    }
    return $col_idxs;
}


sub __execute_substitutions {
    my ( $sf, $aoa, $col_idxs, $all_sr_groups ) = @_;
    my $cf = App::DBBrowser::GetContent::Filter->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $busy_string = 'Search and replace: ';
    my $col_count = @$col_idxs;
    my $cell_count = @$aoa * $col_count;
    my $threshold_busy = 25_000;
    if ( $cell_count > $threshold_busy ) {
        $cf->__print_busy_string( $busy_string . '...' );
    }
    my $threshold_progress = 500_000;
    my ( $show_progress, $step, $total, $fmt );
    if ( $cell_count > $threshold_progress ) {
        $show_progress = $cell_count > ( $threshold_progress * 3 ) ? 2 : 1;
        $step = 1_000;
        $total = int $cell_count / $step;
        $fmt = $busy_string . $total . '/%' . length( $total ) . 'd';
    }
    else {
        $show_progress = 0;
    }
    my $c;

    for my $sr_group ( @$all_sr_groups ) {
        for my $sr_single ( @$sr_group ) {
            my ( $pattern, $replacement_str, $modifiers ) = @$sr_single{qw(pattern replacement modifiers)};
            my $global = $modifiers =~ tr/g//;
            my $count_e = $modifiers =~ tr/e//;
            my $replacement;
            if ( $count_e ) {
                my $replacement_code = sub { $replacement_str };
                for ( 1 .. $count_e ) {
                    my $recurse = $replacement_code;
                    $replacement_code = sub { eval $recurse->() }; # execute (e) substitution
                }
                $replacement = $replacement_code;
            }
            else {
                # with no `e`: the replacement has to be passed as a string
                $replacement = $replacement_str;
            }
            $modifiers =~ tr/imnsxa//dc             if length $modifiers; # tr/imnsxadlup//dc
            $pattern = "(?${modifiers}:${pattern})" if length $modifiers;
            if ( $count_e || $replacement_str =~ tr/$// ) {
                for my $row ( 0 .. $#$aoa ) {
                    for my $col ( @$col_idxs ) {
                        $c = 0; ##
                        if ( ! defined $aoa->[$row][$col] ) {
                            next;
                        }
                        elsif ( $global ) {
                            gsub_modify( $aoa->[$row][$col], $pattern, $replacement );   # modifies $aoa
                        }
                        else {
                            sub_modify( $aoa->[$row][$col], $pattern, $replacement );    # modifies $aoa
                        }
                    }
                    if ( $show_progress && ! ( $row * $col_count % $step ) ) {
                        $cf->__print_busy_string( sprintf $fmt, $row * $col_count / $step );
                    }
                }
            }
            else {
                if ( $show_progress == 1 ) {
                    $cf->__print_busy_string( $busy_string . '...' );
                }
                for my $row ( 0 .. $#$aoa ) {
                    for my $col ( @$col_idxs ) {
                        $c = 0;
                        if ( ! defined $aoa->[$row][$col] ) {
                            next;
                        }
                        elsif ( $global ) {
                            $aoa->[$row][$col] =~ s/$pattern/$replacement/g;   # modifies $aoa
                        }
                        else {
                            $aoa->[$row][$col] =~ s/$pattern/$replacement/;    # modifies $aoa
                        }
                    }
                    if ( $show_progress == 2 && ! ( $row * $col_count % $step ) ) {
                        $cf->__print_busy_string( sprintf $fmt, $row * $col_count / $step );
                    }
                }
            }
        }
    }
}


sub _stringified_sr_group {
    my ( $sr_group ) = @_;
    return map { sprintf 's/%s/%s/%s;', @$_{qw(pattern replacement modifiers)} } @$sr_group;
}


sub __saved_search_and_replace {
    my ( $sf ) = @_;
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $saved = $ax->read_json( $sf->{i}{f_search_and_replace} ) // {};
    my $save_data = 0;
    my $old_idx_history = 0;

    HISTORY: while ( 1 ) {
        my $info = 'Saved "search & replace":';
        $info = join "\n", $info, map( '  ' . $_, sort { $a cmp $b } keys %$saved ), ' ';
        my ( $add, $edit, $remove ) = ( '- Add ', '- Edit', '- Remove' );
        my $menu = [ undef, $add, $edit, $remove ];
        # Choose
        my $idx = $tc->choose(
            $menu,
            { %{$sf->{i}{lyt_v}}, info => $info, undef => '  <=', index => 1, default => $old_idx_history }
        );
        if ( ! defined $idx || ! defined $menu->[$idx] ) {
            if ( $save_data ) {
                $ax->write_json( $sf->{i}{f_search_and_replace}, $saved );
            }
            return;
        }
        if ( $sf->{o}{G}{menu_memory} ) {
            if ( $old_idx_history == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
                $old_idx_history = 0;
                next HISTORY;
            }
            $old_idx_history = $idx;
        }
        my $choice = $menu->[$idx];
        my $changed;
        if ( $choice eq $add ) {
            $changed = $sf->__add_saved( $saved );
        }
        elsif ( $choice eq $edit ) {
            $changed = $sf->__edit_saved( $saved );
        }
        elsif ( $choice eq $remove ) {
            $changed = $sf->__remove_saved( $saved );
        }
        if ( $changed && ! $save_data ) {
            $save_data = 1;
        }
    }