/usr/share/perl5/Mail/Util.pm

# Copyrights 1995-2011 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 2.00.
use strict;

package Mail::Util;
use vars '$VERSION';
$VERSION = '2.08';

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;
libmailtools-perl 2.08-1 / usr / share / perl5 / Mail / Util.pm
