Dear Nuns and Monks,

while playing with tr/// inside a string eval, I came across a strange feature in overload: It is possible to overload the arguments of a tr/// operator.

This feature can be used to have variable operands in tr/// without eval'ing them.

Here is a module (kind of) that overloads the arguments of tr///. If any of these starts with a $, it is taken as
a symbolic reference to an (unqualified) package variable
an identifier of a lexical scoped variable
that will act as the operand instead. A string eval is still required to compile the expression at runtime but in this case on a constant string that is not prone to code injection. It is even possible to have tr's delimiter inside the the referenced values.

What is your opinion on this? Is it secure? Is it useful?

Update: Incorporated ikegami's advice.

#!/usr/bin/perl -T

package Syntax::Tr::Ref;

use v5.26;
use warnings;
use overload;
use Carp;
use PadWalker qw(peek_my peek_our);
use experimental 'signatures';

sub ovl_tr ($,$str,$context) {
    # pass everything unmodified that is not an operand of tr///
    return $str unless $context eq 'tr';

    # <original>  
    ## get symbol table entry name
    #my ($name) = $str =~ /^\$(.*)/;
    ## pass regular operands
    #return $str unless defined $name;

    ## dereference the name
    #my $caller = caller(1);
    #no strict 'refs';
    #my $ret = ${"${caller}::$name"};
    # </original>

    # <update>
    # pass regular operands
    return $str unless $str =~ /^\$/;

    # search for a variable named $str defined as "my" or "our" in the
    # caller
    my $my = peek_my(1);
    my $our = peek_our(1);
    my $ret =
        exists $my->{$str} ? $my->{$str}->$* :
        exists $our->{$str} ? $our->{$str}->$* : undef;
    # </update>

    # illegal argument
    croak qq(symbolic reference "\$${caller}::$name" not found)
        unless defined $ret;

    $ret;
}

sub import {
    overload::constant q => \&ovl_tr;
}

sub unimport {
    overload::remove_constant q => \&ovl_tr;
}

1;

package Foo;

use v5.26;
use warnings;
use Carp::Always;

# emulate "use Syntax::Tr::Ref;"
BEGIN {
    Syntax::Tr::Ref->import;
}

# create a tainted empty string
my $tainted = substr $ENV{PATH}, 0, 0;

# a "bad" searchlist: tainted and contains the tr///-delimiter

# <original>
## must be an alias to a package variable
#local our $abc = '%/cde' . $tainted;
# </original>

# <update>
my $abc = '%/cde' . $tainted;
# </update>

# the tr/// subject
my $s = '%abcde/';
# eval on fixed string at runtime
# almost equivalent to tr{%/cde}{@|fgh}
eval 'tr/$abc/@|fgh/; 1' or warn $@ for $s;
say $s;

__DATA__
@abfgh|
[download]