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"