Here's my code
sorry its long!
its for trouble ticket express
package TTXMail;
use strict;
use TTXData;
use TTXMarkup;
my $hasb64 = 1;
$hasb64 = 0 unless eval "require MIME::Base64";
my $mailer;
my $smtphost;
my $usesmtp;
my $CRLF = "\015\012";
my $doemailfix = 0;
#
=======================================================================
encode
sub encode {
return $_[0] if $_[0] !~ /[^a-zA-Z0-9 ()[\]_!\/\\{}"';:?<>@#\$%&*\n
\r.,-]/;
return "=?ISO-8859-1?B?".base64($_[0], "")."?=" if !$_[1];
my $adr = $_[0];
$adr =~ s/"[^"]*"//;
$adr =~ s/^[^<]*<//g;
$adr =~ s/>[^>]*$//g;
$adr =~ s/^\s+//;
$adr =~ s/\s+$//;
my $name = $_[0];
$name =~ s/<[^>]*>//g;
$name =~ s/"//g;
$name =~ s/[EMAIL PROTECTED]//g;
$name =~ s/^\s+//;
$name =~ s/\s+$//;
$name =~ s/\s\s+/ /;
$name = "=?ISO-8859-1?B?".base64($name, "")."?=" if $name ne undef;
$name =~ s/\r?\n\r?\s+/ /g;
my $str;
if ($name ne undef) {
$str = "\"$name\" ";
}
$str .= "<$adr>";
return $str;
}
#
=========================================================================
smtp
sub smtp {
if ($usesmtp eq undef) {
if ($mailer ne undef && -x $mailer) {
$usesmtp = 0;
} else {
$usesmtp = 1;
unless (eval "require Net::SMTP") { $usesmtp = 0; }
}
}
return $usesmtp;
}
#
=====================================================================
sendmail
sub sendmail {
my $cfg = TTXData::get('CONFIG');
$doemailfix = $cfg->get('emailfix');
if ($cfg->get('broadcast') ne undef) {
$_[0]->{bcc} = $cfg->get('broadcast');
}
$mailer = $cfg->get('mailer');
$smtphost = $cfg->get('smtp');
my $msg = $_[0]->{msg};
$msg = TTXMarkup::strip($msg);
my $contenttype = "MIME-Version: 1.0\nContent-Type: text/plain;
charset=\"ISO-8859-1\"\nContent-Transfer-Encoding: quoted-printable";
if (!smtp()) {
return 0 if !open(MAIL, "|$mailer -t");
my $bcc = "Bcc: ".$_[0]->{bcc}."\n" if $_[0]->{bcc} ne undef;
print MAIL "To: ".$_[0]->{to}."\nFrom: ".encode($_[0]->{from},
1)."\n".$bcc.
"Subject: ".encode($_[0]->{subject}, 0).
"\n$contenttype\n\n".
quoteit($msg)."\n\n";
close MAIL;
} else {
my $to = $_[0]->{to};
$to =~ s/"[^"]*"//;
$to =~ s/^[^<]*<//g;
$to =~ s/>[^>]*$//g;
$to =~ s/^\s+//;
$to =~ s/\s+$//;
my $from = $_[0]->{from};
$from =~ s/"[^"]*"//;
$from =~ s/^[^<]*<//g;
$from =~ s/>[^>]*$//g;
$from =~ s/^\s+//;
$from =~ s/\s+$//;
if ($cfg->get('smtptrace')) {
# save original STDERR destination
open SAVERR, ">&STDERR";
# redirect STDERR handle to a file
open STDERR, '>>'.$cfg->get('basedir').'/smtptrace.txt';
my $oldfh = select STDERR; $| = 1; select($oldfh); # make
unbuffered
}
my $s = Net::SMTP->new($smtphost, Debug => $cfg-
>get('smtptrace') ? 1:0);
if ($s ne undef) {
if ($cfg->get('smtplogin') ne undef && $s->can('auth')) {
eval "\$s->auth(\$cfg->get('smtplogin'), \$cfg-
>get('smtppwd'));";
if ($@ ne undef) {
if ($cfg->get('smtptrace')) {
warn $@;
warn 'Trying Net::POP3';
}
eval "use Net::POP3;";
if ($@ ne undef) {
if ($cfg->get('smtptrace')) {
warn $@;
}
} else {
my $pop = Net::POP3->new($smtphost);
if (!$pop) { warn "Can't open connection to pop3 server:
$!"; }
elsif (!defined ($pop->login($cfg->get('smtplogin'), $cfg-
>get('smtppwd')))) {
warn "Can't authenticate: $!";
} else {
my $messages = $pop->list();
$pop->quit();
}
}
}
}
$s->mail($from);
if ($_[0]->{bcc} ne undef) {
$s->to($to, $_[0]->{bcc});
} else {
$s->to($to);
}
$s->data();
$s->datasend("To: ".$_[0]->{to}."\n");
$s->datasend("From: ".encode($_[0]->{from}, 1)."\n");
$s->datasend("Subject: ".encode($_[0]->{subject}, 0).
"\n$contenttype\n\n");
$s->datasend(quoteit($msg));
$s->datasend("\n\n");
$s->dataend();
$s->quit();
if ($cfg->get('smtptrace')) {
# restore original STDERR destination
open STDERR, ">&SAVERR";
}
}
}
return 1;
}
#
======================================================================
quoteit
sub quoteit {
my $in = shift;
my $out;
local $_;
$in =~ s/\015?\012/\n/g;
while (1) {
$in =~ s/^(.*?(?:(?:\n)|\Z))//m;
$_ = $1;
(defined and length) or last;
s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
s/([ \t]+)$/join('', map { sprintf("=%02X", ord($_)) } split('',
$1))/egm;
my $brokenlines = "";
$brokenlines .= "$1=\n"
while s/(.*?^[^\n]{73} (?:
[^=\n]{2} (?! [^=\n]{0,1} $)
|[^=\n] (?! [^=\n]{0,2} $)
| (?! [^=\n]{0,3} $)
))//xsm;
$_ = "$brokenlines$_";
if (length($_) < 74) {
s/^\.$/=2E/g;
s/^From /=46rom /g;
}
s/\015?\012/$CRLF/g;
$out .= $_;
(defined($in) and length($in)) or last;
}
$out =~ s/\015//g if $doemailfix;
return $out;
}
#
=======================================================================
base64
sub base64 {
my $in = $_[0];
my $out;
my $eol = $_[1];
$eol = "\n" unless defined $eol;
while (1) {
my ($buf, $b64);
last unless length $in;
$buf = substr($in, 0, 45);
substr($in, 0, 45) = '';
if ($hasb64) {
$b64 = MIME::Base64::encode_base64($buf, $eol);
} else {
$b64 = _b64($buf, $eol);
}
$b64 =~ s/\015?\012/$CRLF/g;
$b64 .= $CRLF if length $eol && $b64 !~ /$CRLF\Z/;
$out .= $b64;
}
return $out;
}
#
=========================================================================
_b64
sub _b64 {
my $out = "";
my $eol = $_[1];
$eol = "\n" unless defined $eol;
pos($_[0]) = 0;
while ($_[0] =~ /(.{1,45})/gs) {
$out .= substr(pack('u', $1), 1);
chop($out);
}
$out =~ tr|` -_|AA-Za-z0-9+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$out =~ s/.{$padding}$/'=' x $padding/e if $padding;
if (length $eol) {
$out =~ s/(.{1,76})/$1$eol/g;
}
return $out;
}
1;
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
