Current Path : /usr/local/lib/perl5/site_perl/5.8.9/Mail/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/local/lib/perl5/site_perl/5.8.9/Mail/Util.pm |
# Copyrights 1995-2008 by Mark Overmeer <perl@overmeer.net>. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 1.05. use strict; package Mail::Util; use vars '$VERSION'; $VERSION = '2.04'; use base 'Exporter'; our @EXPORT_OK = qw(read_mbox maildomain mailaddress); use Carp; sub Version { our $VERSION } my ($domain, $mailaddress); my @sendmailcf = qw(/etc /etc/sendmail /etc/ucblib /etc/mail /usr/lib /var/adm/sendmail); sub read_mbox($) { my $file = shift; local *FH; open FH,'<', $file or croak "cannot open '$file': $!\n"; local $_; my @mbox; my $mail = []; my $blank = 1; while(<FH>) { if($blank && /^From .*\d{4}/) { push @mbox, $mail if @$mail; $mail = [ $_ ]; $blank = 0; } else { $blank = m/^$/ ? 1 : 0; push @$mail, $_; } } push @mbox, $mail if @$mail; close FH; wantarray ? @mbox : \@mbox; } sub maildomain() { return $domain if defined $domain; $domain = $ENV{MAILDOMAIN} and return $domain; # Try sendmail configuration file my $config = (grep -r, map {"$_/sendmail.cf"} @sendmailcf)[0]; local *CF; local $_; if(defined $config && open CF, '<', $config) { my %var; while(<CF>) { if(my ($v, $arg) = /^D([a-zA-Z])([\w.\$\-]+)/) { $arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$'.$1/eg; $var{$v} = $arg; } } close CF; $domain = $var{j} if defined $var{j}; $domain = $var{M} if defined $var{M}; $domain = $1 if $domain && $domain =~ m/([A-Za-z0-9](?:[\.\-A-Za-z0-9]+))/; return $domain if defined $domain && $domain !~ /\$/; } # Try smail config file if exists if(open CF, '<', "/usr/lib/smail/config") { while(<CF>) { if( /\A\s*hostnames?\s*=\s*(\S+)/ ) { $domain = (split /\:/,$1)[0]; last; } } close CF; return $domain if defined $domain; } # Try a SMTP connection to 'mailhost' if(eval {require Net::SMTP}) { foreach my $host (qw(mailhost localhost)) { # hosts are local, so short timeout my $smtp = eval { Net::SMTP->new($host, Timeout => 5) }; if(defined $smtp) { $domain = $smtp->domain; $smtp->quit; last; } } } # Use internet(DNS) domain name, if it can be found $domain = Net::Domain::domainname() if !defined $domain && eval {require Net::Domain}; $domain ||= "localhost"; } sub mailaddress() { return $mailaddress if defined $mailaddress; # Get user name from environment $mailaddress = $ENV{MAILADDRESS}; unless($mailaddress || $^O ne 'MacOS') { require Mac::InternetConfig; no strict; Mac::InternetConfig->import; $mailaddress = $InternetConfig{kICEmail()}; } $mailaddress ||= $ENV{USER} || $ENV{LOGNAME} || eval {getpwuid $>} || "postmaster"; # Add domain if it does not exist $mailaddress .= '@' . maildomain if $mailaddress !~ /\@/; $mailaddress =~ s/(^.*<|>.*$)//g; $mailaddress; } 1;