Rather than using transliteration you could employ look-ups and a GRT sort.

use strict;
use warnings;

use feature qw{ say };

my $intended = <<'EOF';
 .,-;:!?"'`_#$%&*+/|=@\^~()<>[]{}0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmN
+nOoPpQqRrSsTtUuVvWwXxYyZz
EOF
chomp $intended;

my $seq = 0;
my %sortLU = map { $_ => sprintf q{%02d}, $seq ++ } split m{}, $intend
+ed;

my %revLU = reverse %sortLU;

my @list = qw{
   "Hello"
   Abel
   (hello)
   {adieu}
   @adieu
   [goodbye]
   Charlie
   ^Charlie
   ~Adieu
   zebra
   21708
   baker
   .
   -
   ;
   :
   !
   ?
   "
   '
   `
   _
   };
push @list, q{ first};

say for
   map { join q{}, map { $revLU{ $_ } } unpack q{(a2)*}, $_ }
   sort
   map { join q{}, map { $sortLU{ $_ } } split m{}, $_ }
   @list;
[download]

The output

 first
.
-
;
:
!
?
"
"Hello"
'
`
_
@adieu
^Charlie
~Adieu
(hello)
[goodbye]
{adieu}
21708
Abel
baker
Charlie
zebra
[download]

I hope this is useful.

Update: I mistakenly omitted the space character from the start of the sort order string. Now corrected with an additional item " first" to check that spaces are sorted correctly.