Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re^3: Immediately writing the results of search-and-replace

by tybalt89 (Monsignor)
on Aug 08, 2022 at 09:40 UTC ( [id://11146022]=note: print w/replies, xml ) Need Help??


in reply to Re^2: Immediately writing the results of search-and-replace
in thread Immediately writing the results of search-and-replace

Ok, I'm confused. Do you want to rewrite the entire file after each change (of course with the changed text) and then reload the file to do the next replace?
Or do you just want to do a replace at a time (holding the text in memory) and only rewrite the entire file when you are done?

  • Comment on Re^3: Immediately writing the results of search-and-replace

Replies are listed 'Best First'.
Re^4: Immediately writing the results of search-and-replace
by elemkeh (Acolyte) on Aug 08, 2022 at 16:16 UTC
    What I am chiefly concerned with is that after matching on and replacing an instance of, say, 'IP whitelist', the user is not prompted to replace that same instance of the word 'whitelist' because it hasn't actually been edited yet. The impression I get from reading some of what's written here is that this might require write-and-reload, but I must admit that I don't know enough about Perl yet to feel confident in my interpretations. Sorry I can't clarify more than that.

      Fun with pos()

      This rewrites the file after each change, then reloads from that file for the next change. The current position in the file is kept in the variable $pos. This stops the overlapping problem you were having.
      I'm using Path::Tiny because I get yelled at when I use File::Slurp.

      #!/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 $csv = <<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 $target_file = path( '/tmp/d.11145971' ); $target_file->spew( <<END ); # FIXME for testing 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 %patterns; push @{ $patterns{ lc $_->[0] } }, $_->[2] for @{ csv( in => \$csv ) } +; my $match = qr/(@{[ join '|', nsort_by { -length } keys %patterns ]})/ +i; #use Data::Dump 'dd'; dd \%patterns, $match; #$target_file->edit_lines( sub # NOTE line at a time # { # s/$match/$old$&$reset/g ? print "\n" : return; # 1 while s/\Q$old\E$match\Q$reset\E/ print; ask( $1 ) /e; # print "$new$_$reset"; # } ); 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 } } ); # print "\e[33m", $target_file->slurp, "\e[0m"; # FIXME here for testi +ng } print "\nresult:\n\n", $target_file->slurp; # FIXME here for testing sub ask { my ($was) = @_; my @choices = uniq @{ $patterns{ 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 <= @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; } }

      Sample run (in glorious color which of course is not seen here)

      a. this is some whitelist test b. for IP whitelist testing and your whitelist 1. allow 2. access list 3. access-list replace 'whitelist' with above pick (or 0 to not change) : a. this is some whitelist test b. for IP whitelist testing and your whitelist c. line with no replacement replace 'IP whitelist' with 'IP access list' ? yes/no : a. this is some whitelist test b. for IP whitelist testing and your whitelist c. line with no replacement 1. your access list 2. my permission list 3. thy permission list 4. his permission list 5. her permission list 6. its permission list 7. our permission list 8. your permission list 9. their permission list replace 'your whitelist' with above pick (or 0 to not change) : c. line with no replacement d. with whitelist and IP whitelist entries and IP whitelist entries ag +ain. e. this is another whitelist test 1. allow 2. access list 3. access-list replace 'whitelist' with above pick (or 0 to not change) : c. line with no replacement d. with whitelist and IP whitelist entries and IP whitelist entries ag +ain. e. this is another whitelist test replace 'IP whitelist entries' with 'IP access list entries' ? ye +s/no : c. line with no replacement d. with whitelist and IP whitelist entries and IP whitelist entries ag +ain. e. this is another whitelist test replace 'IP whitelist entries' with 'IP access list entries' ? ye +s/no : d. with whitelist and IP whitelist entries and IP whitelist entries ag +ain. e. this is another whitelist test 1. allow 2. access list 3. access-list replace 'whitelist' with above pick (or 0 to not change) : result: 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

      The above output is in color, using red for the existing string and green for new ones.
      This should be run in a terminal that takes ANSI color codes.

      Is this the kind of thing you are looking for, or have I gone overboard ?

        Yes, this looks like what I'm looking for as far as the results are concerned, though there is a lot here that I will need time to read and really understand. I've tried dropping this code in with some minor modifications like so, such that it can be applied to the recursive traversal of directories. I've also adopted some things from other posts:
        use strict; use warnings; use diagnostics; use autodie; use feature qw/fc/; use Text::CSV_XS; use File::Find; use File::Replace 'replace3'; use List::AllUtils qw( nsort_by uniq ); use Path::Tiny; my ($old, $new, $reset) = map "\e[${_}m", 91, 92, 0; my $csvfile = $ARGV[0]; my %table; open my $fh, '<', $csvfile; my $csv = Text::CSV_XS->new({binary=>1, auto_diag=>2}); while ( my $row = $csv->getline($fh) ) { push @{$table{ fc($row->[0]) }}, $row->[2]; } $csv->eof or $csv->error_diag; close $fh; my $match = qr/(@{[ join '|', nsort_by { -length } keys %table ]})/i; find({ preprocess => \&filter, wanted => \&search_and_replace }, $ARGV[1] ); sub filter { return grep { -d or (-f and ( /\.txt$/ or /\.rst$/ or /\.yaml$/))} @ +_; } sub search_and_replace { open 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 } } ); # print "\e[33m", $target_file->slurp, "\e[0m"; # FIXME here f +or testing } close $target_file; } 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 <= @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; } }
        In this form, I try running it and get an error:
        perl searchandreplace.pl ~/spreadsheet.csv ~/targetRepo syntax error at deprecatus3.pl line 81, near "$pick <="

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11146022]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (6)
As of 2024-04-18 02:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found