—
—

              
use 5.010;
use strict;
use warnings;
package String::Compile::Tr;
HideShow 12 lines of Pod
=encoding UTF-8
=head1 NAME
String::Compile::Tr - compile tr/// expressions
=head1 VERSION
Version 0.06
=cut
our
$VERSION = '0.06';
HideShow 102 lines of Pod
=head1 SYNOPSIS
    use String::Compile::Tr;
     
    my $search = '/+=';
    my $replace = '-_';
    my $s = 'De/0xv5y3w8BpLF8ubOo+w==';
    trgen($search, $replace, 'd')->($s);
    # $s = 'De-0xv5y3w8BpLF8ubOo_w'
=head1 DESCRIPTION
The usual approach when operands of a C<tr///> operator shall be
variables is to apply C<eval> on a string to interpolate the operands.
The drawback of this approach are possible unwanted side effects induced
by the variables' content, e.g.
    $search = '//,warn-trapped,$@=~tr/';
    eval "tr/$search//d";
C<String::Compile::Tr> offers an alternative where the content of a
variable can be used as operand without C<eval>'ing it. 
Instead the operands of a C<tr///> operator are overloaded at runtime
inside a constant C<eval '...'>.
C<trgen(*SEARCH*, *REPLACE*, *OPT*)> compiles an anonymous sub that
performs almost the same operation as C<tr/*SEARCH*/*REPLACE*/*OPT*>,
but allows variable operands.
C<trgen> is imported by default by C<use String::Compile::Tr>.
=head1 FUNCTIONS
=head2 trgen
    trgen(search, replace, [options])
C<trgen> returns an anonymous subroutine that performs an almost identical 
operation as C<tr/search/replace/options>.
The C<tr> target may be given as an argument to the generated sub
or is the default input C<$_> otherwise.
=head1 ERRORS
C<trgen> will throw an exception if an invalid option is specified
or the C<tr> operation cannot be compiled.
=head1 EXAMPLES
Proposed usages of this module are:
    use String::Compile::Tr;
    my $search = 'abc';
    my $replace = '123';
    my $tr = trgen($search, $replace);
    my $s = 'fedcba';
    $tr->($s);
    # $s is 'fed321' now
    my @list = qw(axy bxy cxy);
    $tr->() for @list;
    # @list is now ('1xy', '2xy', '3xy');
    print trgen($search, $replace, 'r')->('fedcba'); # 'fed321'
=head1 RESTRICTIONS
Character ranges are not supported in the search and replace lists.
All characters are interpreted literally.
This is caused by the fact that C<tr> does not support these neither.
It's the compiler that expands character ranges in C<tr>'s operands
before handing them over.
Overloading constants in C<eval '...'> requires perl v5.10.
=head1 AUTHOR
Jörg Sommrey, C<< <git at sommrey.de> >>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2025 by Jörg Sommrey.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 SEE ALSO
L<perlop/"tr/*SEARCHLIST*/*REPLACEMENTLIST*/cdsr">
L<perlfunc/eval>
L<Exporter::Tiny::Manual::Importing>
L<Regexp::Tr> provides a similar functionality, though this C<eval>'s
its oprands.
=cut
use Carp;
use String::Compile::Tr::Overload;
use Exporter::Shiny our @EXPORT = qw(trgen);
*search = *String::Compile::Tr::Overload::search;
*replace = *String::Compile::Tr::Overload::replace;
sub trgen {
    local our ($search, $replace);
    my $options;
    ($search, $replace, $options) = @_;
    $replace = '' unless defined $replace;
    $options = '' unless defined $options;
    my ($opt) = $options =~ /^([cdsr]*)$/;
    $opt = '' unless defined $opt;
    croak "options invalid: $options" if $options && $options ne $opt;
    my $ret;
    my $template = <<'EOS';
    $ret = sub {
        local *_ = \$_[0] if @_;
        tr/:search:/:replace:/%s;
    }; 1
EOS
    my $code = sprintf $template, $opt;
    eval $code or croak $@;
    $ret;
}
1;