sub {

my $in = $_[0];
my $strings = q|
~032
&~038
+~043
-~045
.~046
0~048
1~049
2~050
3~051
4~052
5~053
6~054
7~055
8~056
9~057
:~058
;~059
@~064
A~065
B~066
C~067
D~068
E~069
F~070
G~071
H~072
I~073
J~074
K~075
L~076
M~077
N~078
O~079
P~080
Q~081
R~082
S~083
T~084
U~085
V~086
W~087
X~088
Y~089
Z~090
^~094
_~095
a~097
b~098
c~099
d~100
e~101
f~102
g~103
h~104
i~105
j~106
k~107
l~108
m~109
n~110
o~111
p~112
q~113
r~114
s~115
t~116
u~117
v~118
w~119
x~120
y~121
z~122
?~127
‚~130
„~132
Š~138
‹~139
Ž~142
‘~145
’~146
“~147
”~148
•~149
–~150
—~151
˜~152
š~154
›~155
ž~158
Ÿ~159
~160
¡~161
¨~168
¯~175
°~176
´~180
·~183
À~192
Á~193
Â~194
Ã~195
Ä~196
Å~197
Æ~198
Ç~199
È~200
É~201
?~202
Ë~203
Ì~204
Í~205
Î~206
Ï~207
Ð~208
Ñ~209
Ò~210
Ó~211
Ô~212
Õ~213
Ö~214
×~215
Ø~216
Ù~217
Ú~218
Û~219
Ü~220
Ý~221
Þ~222
ß~223
à~224
á~225
â~226
ã~227
ä~228
å~229
æ~230
ç~231
è~232
é~233
ê~234
ë~235
ì~236
í~237
î~238
ï~239
ð~240
ñ~241
ò~242
ó~243
ô~244
õ~245
ö~246
÷~247
ø~248
ù~249
ú~250
û~251
ü~252
ý~253
þ~254
ÿ~255
|;

my $back;
my @address = split //, $in; # cut the email address up into each charachter...
my @strings = split /\n/, $strings;

foreach (@address) {

my $next;

foreach my $s (@strings) {

$s =~ s/\s$//g;

next if $next == 1;

my ($char,$equiv) = split /~/, $s; # get the charachter, and its numerical equiv

if ($char eq $_) {
$char =~ s/\Q$char/$equiv/i;
$char = '&#' . $char . ';';
$back .= $char; # add the new replacement to $back
$next = 1;
}

}

}

return \$back;

}