#!/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|