#!/usr/bin/perl
use strict;
use warnings;
sub processReplacements {
my $regexM = shift @_; #TERM(S) TO MATCH
my $regexR = shift @_; #REPLACEMENT TERM
my $regexI = shift @_; #FLAG FOR CASE-INSENSITVE SUBSTITUTION
my $sv = shift @_; # $sv => START, E.G. /^(.*)/;
my $ev = shift @_; # $ev => END, E.G. /(.*)$/;
my $ww = shift @_; # $ww => WHOLE-WORD, E.G. /\b(.*)\b/;
my $ch = shift @_; # $ch => DELIMIT CHARS,
# E.G. /[.,:;!?'"](.*)[.,:;!?'"]/;
my @data = @_; # INCOMING ARRAY
my @changed = (); # OUTGOING ARRAY
my $line = '';
my $linehead = '';
my $sourceline = '';
my $m = $regexI ? qr{(?i:$regexM)} : qr($regexM);
my $s = $sv ? qr(^) : qr();
my $e = $ev ? qr($) : qr();
my $b = $ww ? qr(\b) : qr();
my $c = $ch ? qr([.,:;!?'"]) : qr();
foreach my $line (@data) {
push @changed, $line =~ s{$s$c$b\K$m(?=$b$c$e)}{$regexR}r;
}
return @changed;
}
foreach my $parm (qw(0:0:0:0:0 1:0:0:0:0 0:1:0:0:0 0:0:1:0:0 0:0:0:1:0
+ 0:0:0:0:1)) {
my @opts = split /:/, $parm;
print "parm: $parm\n";
my @r = processReplacements('xxx', 'yyy', @opts,
'aaaxxxbbb', 'aaa xxx bbb', 'aaa:xxx:bbb', 'xxxbbb', 'aaa:XXX', 'a
+aaxxx');
print "$_\n" foreach @r;
print "\n";
}
which gives:
parm: 0:0:0:0:0
aaayyybbb
aaa yyy bbb
aaa:yyy:bbb
yyybbb
aaa:XXX
aaayyy
parm: 1:0:0:0:0
aaayyybbb
aaa yyy bbb
aaa:yyy:bbb
yyybbb
aaa:yyy
aaayyy
parm: 0:1:0:0:0
aaaxxxbbb
aaa xxx bbb
aaa:xxx:bbb
yyybbb
aaa:XXX
aaaxxx
parm: 0:0:1:0:0
aaaxxxbbb
aaa xxx bbb
aaa:xxx:bbb
xxxbbb
aaa:XXX
aaayyy
parm: 0:0:0:1:0
aaaxxxbbb
aaa yyy bbb
aaa:yyy:bbb
xxxbbb
aaa:XXX
aaaxxx
parm: 0:0:0:0:1
aaaxxxbbb
aaa xxx bbb
aaa:yyy:bbb
xxxbbb
aaa:XXX
aaaxxx
-jo
|