blob: a268b2cfac1b426bf6cd9d33bfe1d1cb3a7bfa5a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
package Iurt::Mail;
use strict;
use MIME::Words qw(encode_mimewords);
use base qw(Exporter);
our @EXPORT = qw(
sendmail
);
sub expand_email {
my ($email, $config) = @_;
return $email unless $config->{email_domain};
my $name = "";
my $addr = $email;
if ($email =~ /^(.*)<(.*)>$/) {
$name = $1;
$addr = $2;
}
if ($addr =~ /@/) {
return $email;
}
return "$name<$addr\@$config->{email_domain}>";
}
sub sendmail {
my ($to, $cc, $subject, $text, $from, $debug, $config) = @_;
do { print "Cannot find sender-email-address [$to]\n"; return } unless defined($to);
my $MAIL;
if (!$debug) { open $MAIL, "| /usr/sbin/sendmail -t" or return } else { open $MAIL, ">&STDOUT" or return }
$to = expand_email($to, $config);
my $sender = encode_mimewords($to);
$subject = encode_mimewords($subject);
print $MAIL "To: $sender\n";
if ($cc) {
$cc = expand_email($cc, $config);
$cc = encode_mimewords($cc);
print $MAIL "Cc: $cc\n";
}
print $MAIL "From: $from\n";
print $MAIL "Subject: $subject\n";
print $MAIL "\n";
print $MAIL $text;
close($MAIL);
}
1
|
