my $pchr = "KQRBNP";
my $w1 = "QRKPNBNBQRK";

my $ascii = join '', map chr $_, 0..length($pchr);
my $w2 = join '', sort split //, eval "\$w1 =~ y/\Q$pchr\E/\Q$ascii\E/
+r";
eval "\$w2 =~ y/\Q$ascii\E/\Q$pchr\E/";

print "$w1 --[$pchr]--> $w2\n"
[download]

sub mk_sort {
    my $pchr = shift;
    my $a = join '', map chr, 0..length(\$pchr);
    eval qq{sub { (join '', sort split //, (shift =~ y/\Q$pchr\E/\Q$a\
+E/r)) =~ y/\Q$a\E/\Q$pchr\E/r }};
}

my $sort = mk_sort "KQRBNP";

my $w1 = "QRKPNBNBQRK";
my $w2 = $sort->($w1);

print "$w1 --> $w2\n"
[download]