in reply to Re^8: Immediately writing the results of search-and-replace
in thread Immediately writing the results of search-and-replace
EDIT: do not use, overwrites a csv file
That ->edit is in Path::Tiny. Your use of $target_file is wrong, also the open() and close()
are not needed. Here's a version of mine combined with yours to do what I think you want to do.
#!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11145971 use warnings; use List::AllUtils qw( nsort_by uniq ); use Path::Tiny; use Text::CSV qw( csv ); my $dir = path( '/tmp/dir.1114597' ); mkdir $dir; my $csv = path( $ARGV[0] // "$dir/11145971,csv" ); path( $csv )->spew( <<END ); whitelist entries,Noun,access list entries IP whitelist,Noun,IP access list IP whitelist entries,Noun,IP access list entries whitelist,Adjective,allow whitelist,Noun,access list whitelist,Noun,access-list whitelist,Verb,allow your whitelist,Noun,your access list your whitelist,Noun,my permission list your whitelist,Noun,thy permission list your whitelist,Noun,his permission list your whitelist,Noun,her permission list your whitelist,Noun,its permission list your whitelist,Noun,our permission list your whitelist,Noun,your permission list your whitelist,Noun,their permission list END my $testfile = path( "$dir/something.txt"); $testfile->spew( <<END ); a. this is some whitelist test b. for IP whitelist testing and your whitelist c. line with no replacement d. with whitelist and IP whitelist entries and IP whitelist entries ag +ain. e. this is another whitelist test END my ($old, $new, $reset) = map "\e[${_}m", 91, 92, 0; my %table; push @{ $table{ lc $_->[0] } }, $_->[2] for @{ csv( in => "$csv" ) }; my $match = qr/(@{[ join '|', map quotemeta($_), nsort_by { -length } keys %table ]})/i; use Data::Dump 'dd'; dd \%table, $match; path( $ARGV[1] // $dir )->visit( sub # NOTE replaces Find::File { /\.(?:txt|rst|yaml)$/ and search_and_replace($_); }, { recurse => 1 } ); print "\n", $testfile->slurp; # FIXME for debugging sub search_and_replace { my ($target_file) = @_; my $pos = 0; # NOTE replaces whole file for each change my $more = 1; while( $more ) { $target_file->edit( sub { pos($_) = $pos; if( /$match/g ) { my ( $was, $where, $pre, $post ) = ( $1, $-[1], $`, $'); print "\n", $pre =~ s/^.*\n(?=.*\n)//sr, "$old$was$reset", $post =~ s/\n.*?\n\K.*//sr, "\n"; my $replace = ask( $was ); $was eq $replace or substr $_, $where, length $was, $replace; $pos = $where + length $replace; } else { $more = 0 } } ); } } sub ask { my ($was) = @_; my @choices = uniq @{ $table{ lc $was } }; local $| = 1; if( @choices > 1 ) { my $n = 1; printf "%8d. $new%s$reset\n", $n++, $_ for @choices; print " replace '$old$was$reset' with ${new}above pick$reset ( +or 0 to not change) : "; my $pick = <STDIN> =~ tr/0-9//cdr || 0; 0 <= $pick && $pick <= @choices or $pick = 0; return ($was, @choices)[$pick]; } else { print " replace '$old$was$reset' with '$new@choices$reset' ? y +es/no : "; return <STDIN> =~ /y/i ? $choices[0] : $was; } }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^10: Immediately writing the results of search-and-replace
by tybalt89 (Monsignor) on Aug 08, 2022 at 20:14 UTC | |
by elemkeh (Acolyte) on Aug 09, 2022 at 14:33 UTC | |
by elemkeh (Acolyte) on Aug 12, 2022 at 03:56 UTC | |
by afoken (Chancellor) on Aug 12, 2022 at 07:12 UTC | |
by AnomalousMonk (Archbishop) on Aug 12, 2022 at 07:49 UTC | |
by elemkeh (Acolyte) on Aug 12, 2022 at 13:40 UTC | |
by hippo (Archbishop) on Aug 12, 2022 at 13:52 UTC |