{ my $x = 'abc; my $s = 'edcba'; eval '$s =~ tr/$x/123/'; } { my $x = 'ABC'; } #### #!/usr/bin/perl use strict; use warnings; ### Internal only package String::Compile::Tr::Overload; use overload; sub _ovl_tr { our ($search, $replace); return $_[1] unless $_[2] eq 'tr'; return "$search" if $_[1] eq ':search:'; return "$replace" if $_[1] eq ':replace:'; $_[1]; } sub import { overload::constant q => \&_ovl_tr; } sub unimport { overload::remove_constant q => \&_ovl_tr; } ### The module itself package String::Compile::Tr; *search = *String::Compile::Tr::Overload::search; *replace = *String::Compile::Tr::Overload::replace; BEGIN { String::Compile::Tr::Overload->import; } sub trgen { local our ($search, $replace); my $options; ($search, $replace, $options) = @_; $options = '' unless defined $options; my ($opt) = $options =~ /^([cdsr]*)$/; $opt = '' unless defined $opt; my $template = <<'EOS'; sub { local *_ = \$_[0] if @_; tr/:search:/:replace:/%s; } EOS my $code = sprintf $template, $opt; eval $code; } BEGIN { String::Compile::Tr::Overload->unimport; } ### main package main; use feature 'say'; *trgen = *String::Compile::Tr::trgen; my $x = 'abc'; my $y = '123'; # compile a sub my $tr = trgen($x, $y); my $str = 'fedcba'; # like $str =~ tr/abc/123/: $tr->($str); say $str; # fed321 my @list = qw(axy bxy cxy); # like tr/abc/123/ $tr->() for @list; say "(@list)"; # (1xy 2xy 3xy);