The trim_addr subroutine reduces an email address to its minimum
expression, based on the local host name. This assumes that if
your host name is "host.sub.domain.edu", then "user@sub.domain.edu"
is a local host, so the whole "@domain.edu" part can be eliminated
(that is our local setup). For example, given the same hostname,
the following addresses are reduced as shown:
zamboni@host zamboni
zamboni@sub.domain.edu zamboni
zamboni@sub2.domain.edu zamboni@sub2
zamboni@something.else.com zamboni@something.else.com
use Net::Domain qw(hostfqdn);
sub trim_addr {
# Get the host domain
my $sbHostname=hostfqdn();
my @addrs=@_;
my ($sbHost, $sbSubdomain, $sbDomain)=
($sbHostname=~/^([^.]+\.((?:[^.]+\.)?([^.]+\.[^.]+)))$/);
unless ($sbDomain) {
die "Could not obtain the local domain from hostname '$sbHostname'
+\n";
}
$sbSubdomain=$sbDomain unless $sbSubdomain;
($sub=$sbSubdomain)=~s/\.?$sbDomain$//;
($host=$sbHost)=~s/\.?$sbSubdomain//;
foreach (@addrs) {
s/[@]$sbHost// ||
s/[@.]$sbSubdomain$// ||
s/[.]$sbDomain$// ||
s/[@.]$sub$// ||
s/[@]$host$//
;
}
return @addrs;
}