Gecko [ theprintave.ca ]

Name	Size	Permission	Date
Field	[ DIR ]	drwxr-xr-x	2024-03-28 01:45
Mailer	[ DIR ]	drwxr-xr-x	2024-03-28 01:45
Address.pm	6.84 KB	-rw-r--r--	2019-05-21 14:26
Address.pod	4.07 KB	-rw-r--r--	2019-05-21 14:26
Cap.pm	6.42 KB	-rw-r--r--	2019-05-21 14:26
Cap.pod	3.78 KB	-rw-r--r--	2019-05-21 14:26
Field.pm	4.94 KB	-rw-r--r--	2019-05-21 14:26
Field.pod	4.91 KB	-rw-r--r--	2019-05-21 14:26
Filter.pm	1.44 KB	-rw-r--r--	2019-05-21 14:26
Filter.pod	2.82 KB	-rw-r--r--	2019-05-21 14:26
Header.pm	13.82 KB	-rw-r--r--	2019-05-21 14:26
Header.pod	7.76 KB	-rw-r--r--	2019-05-21 14:26
Internet.pm	12.26 KB	-rw-r--r--	2019-07-25 03:13
Internet.pod	10.24 KB	-rw-r--r--	2019-05-21 14:26
Mailer.pm	4.94 KB	-rw-r--r--	2019-07-25 03:13
Mailer.pod	4.1 KB	-rw-r--r--	2019-05-21 14:26
Send.pm	1.35 KB	-rw-r--r--	2019-05-21 14:26
Send.pod	3.17 KB	-rw-r--r--	2019-05-21 14:26
Util.pm	3.36 KB	-rw-r--r--	2019-05-21 14:26
Util.pod	3.09 KB	-rw-r--r--	2019-05-21 14:26

Rename

# Copyrights 1995-2019 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of the bundle MailTools.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md for Copyright.
# Licensed under the same terms as Perl itself.

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

use base 'Exporter';

use strict;
use Carp;

our @EXPORT_OK = qw(read_mbox maildomain mailaddress);

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(;$)
{   $mailaddress = shift if @_;

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;
}