in reply to Re^7: Immediately writing the results of search-and-replace in thread Immediately writing the results of search-and-replace
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.
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;
}
Which gets me a Use of uninitialized value $_ in scalar assignment at searchandreplace.pl line 54 (#1) error. Line 54 is pos($_) = $pos;.
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;
}
}
| [reply] [d/l] |
|
#!/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 = "$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
$csv = $ARGV[0] // $csv; # use ARG if present
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 File::Find
{
-f $_ && /\.(?: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;
}
}
| [reply] [d/l] |
|
Bloody brilliant!
Thank you for all your help. This whole thread has given me a lot of good material to study to evolve my Perl abilities. After I've had time to digest it, I think I will try to extend this tool to do similar work on filenames using what I've learned.
| [reply] |
|
After looking around for a while and poking at the code myself, I still don't understand just what is going on with this line:
my ($old, $new, $reset) = map "\e[${_}m", 91, 92, 0;
Beyond the fact that this is variable assignment, I don't know what to make of it. It doesn't appear to be a common Perl trick, or if it is I have yet to see another example of it to compare against. Can anyone explain?
Thank you.
| [reply] [d/l] |
|
|
|
|
|
|