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

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;
    }
  }
[download]

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 <="
[download]

Comment on Re^6: Immediately writing the results of search-and-replace Select or Download Code

Replies are listed 'Best First'.
Re^7: Immediately writing the results of search-and-replace by tybalt89 (Monsignor) on Aug 08, 2022 at 18:13 UTC
You have a old perl, change `0 <= $pick <= @choices or $pick = 0;` [download] to `0 <= $pick && $pick <= @choices or $pick = 0;` [download]	[reply] [d/l] [select]
Re^8: Immediately writing the results of search-and-replace by elemkeh (Acolyte) on Aug 08, 2022 at 19:05 UTC
Great, that worked. Thank you! (Using Perl 5.30, apparently) Now I'm getting the following error: `Can't locate object method "edit" via package "IO::File" at searchandreplace.pl line 65 (#1) (F) You called a method correctly, and it correctly indicated a packag +e functioning as a class, but that package doesn't define that particula +r method, nor does any of its base classes. See perlobj.` [download] Which pertains to the subroutine beginning with `$target_file->edit( sub` I am currently updating my CPAN modules (which is taking quite a long time) in hopes that will resolve the issue. EDIT: Updating CPAN modules did not resolve this issue. EDIT 2: After doing some more digging, it looks like the `edit` method comes from Path::Tiny, so I tried changing the start of the subroutine like so: sub search_and_replace { open my $target_file, "<", $_; my $filename = path($_); my $pos = 0; my $more = 1; while( $more ) { $filename->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 + testing } close $target_file; } [download] Which gets me a `Use of uninitialized value $_ in scalar assignment at searchandreplace.pl line 54 (#1)` error. Line 54 is `pos($_) = $pos;`.	[reply] [d/l] [select]
Re^9: Immediately writing the results of search-and-replace by tybalt89 (Monsignor) on Aug 08, 2022 at 19:54 UTC
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; } } [download]	[reply] [d/l]
Re^10: Immediately writing the results of search-and-replace by tybalt89 (Monsignor) on Aug 08, 2022 at 20:14 UTC
Re^11: Immediately writing the results of search-and-replace by elemkeh (Acolyte) on Aug 09, 2022 at 14:33 UTC
Re^11: Immediately writing the results of search-and-replace by elemkeh (Acolyte) on Aug 12, 2022 at 03:56 UTC
Some notes below your chosen depth have not been shown here


We don't bite newbies here... much
	PerlMonks