use strict; use warnings; my @email = ( 'someone@example.co.uk', 'andrew.test@some.company.co.uk', 'jo@abc.com', ); foreach my $em(@email) { print "$em - "; $em =~ /^(\w[\w.])(.*)(\@\w\w)(.*)(\.\w+)$/; $em = $1 . '.' x length($2) . $3 . '.' x length($4) . $5; print "$em\n"; } #### use strict; use warnings; my @email = ( 'someone@example.co.uk', 'andrew.test@some.company.co.uk', 'jo@abc.com', ); for my $em ( @email ) { print "$em - "; ( my $at_pos = rindex $em, '@' ) > 0 or die "$em: invalid email address.\n"; ( my $dot_pos = rindex $em, '.' ) > $at_pos or die "$em: invalid email address.\n"; tr//./c for substr( $em, 2, $at_pos - 2 ), substr( $em, $at_pos + 3, -( length( $em ) - $dot_pos ) ); print "$em\n"; }