package Mailer::Simple;
use strict;
$Mailer::Simple::VERSION = 3.08_1; # 9/23/02, 6:00 pm
use Text::Wrap;
=pod
AUTHOR
-Tommy Butler, professional contractor and open source proponent
Atrixnet™, for Internet Business Software®
http://atrixnet.com
6711 Forest Park Dr
Dallas, TX
76001
COPYRIGHT
Copyright Tommy Butler. All rights reserved
LISCENCE
This software is free, and you may use and distribute it under the
GNU GPL liscence. If you modify the code for your own purposes
please acknowledge its original author.
BUGS
Please report any of the following to me
- bugs
- interface inconsistencies
- suggestions
- comments
- complaints
- smart remarks
=cut
# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new { bless({ }, shift(@_)) }
# --------------------------------------------------------
# Mailer::Simple::validate()
# --------------------------------------------------------
sub validate {
my($this) = shift(@_);
my($received) = shift||{};
my(@required) = @_;
my($error) = '';
my($bullet) = '<strong>·</strong>';
foreach (@required) {
my($arg) = $received->{$_}||'';
if (length($arg) == 0) {
$error .= qq[<div style="padding: 0 0 0 15px;">$bullet $_</div>];
}
}
if (length($error) > 0) {
$this->error(<<__err__);
<p>The following required fields were left blank in the form.</p>
<p>Please go back and fill them out in order to proceed.</p>
<p>-Thank you</p>
<p>$error</p>
__err__
}
return(1);
}
# --------------------------------------------------------
# Mailer::Simple::mail()
# --------------------------------------------------------
sub email {
my($this) = shift(@_);
my($args) = $this->coerce_array(@_);
my($email) = '';
unless ($args->{'raw'}) {
foreach (keys(%$args)) { delete($$args{$_}) unless (length($$args{$_})) }
$this->validate($args,'to','from','message')
}
$args->{'sendmail'} = '/usr/sbin/sendmail' unless ($args->{'sendmail'});
$args->{'contype'} = 'text/plain' unless ($args->{'contype'});
my($headers) = $this->headers($args) unless ($args->{'raw'});
$email = $args->{'message'};
$email = $args->{'raw'} if ($args->{'raw'});
$$args{'wrap'} ||= 80; $Text::Wrap::columns = int($$args{'wrap at'}||0);
$email = &Text::Wrap::wrap('','',$email)
if
($args->{'contype'} eq 'text/plain') and $Text::Wrap::columns;
$this->sendit($args->{'sendmail'}, $headers . $email);
return($headers,$email);
}
# --------------------------------------------------------
# Mailer::Simple::sendit
# --------------------------------------------------------
sub sendit {
my($this,$app,$email) = @_;
# begin conversation with the server's sendmail program through a pipe.
# open sendmail with arguments instructing it to send our message
# immediately rather than place it in que
local(*MAIL);
open(MAIL, qq[|$app -oi -t ])
or $this->error( qq[couldn't pipe to sendmail $!] );
# give our email over to sendmail program which will handle sending
# it to the recipient(s) for us
print(MAIL $email);
# we end our conversion with sendmail by closing the pipe
close(MAIL) or warn(qq[couldn't close pipe to $app $!]);
return($email);
}
# --------------------------------------------------------
# Mailer::Simple::headers()
# --------------------------------------------------------
sub headers {
my($this) = shift(@_);
my($args) = shift(@_);
my($headers) = '';
my($defaults) =
{
'contype' => 'text/plain',
'charset' => 'ISO-8859-1',
'x-mailer' => 'Mailer::Simple v. ' . $Mailer::Simple::VERSION,
'status' => 'RO',
};
=pod
NOTES ON 'X-Priority' AND OTHER LIKE HEADERS
'X-Priority'
Legal values for this header are the numbers 1 to 5, where 1 denotes the
highest priority and 5 reflects the lowest amount of priority. These
numbers are usually followed by a keyword in parenthesis which describes
the meaning of the number for the recipient's mail client. Used as
demonstrated below.
X-Priority: 1 (highest)
X-Priority: 2 (high)
X-Priority: 3 (normal)
X-Priority: 4 (low)
X-Priority: 5 (lowest)
'Importance'
Legal values are as follows, usually all lowercase, but sometimes the
first letter of the value assigned to this header appears in uppercase.
Importance: high
Importance: normal
Importance: low
'X-MSMail-Priority'
Legal values are one of these three, used in the context shown below.
X-MSMail-Priority: High
Importance: Normal
Importance: Low
=cut
my($header_objects) =
[
['to' => 'To: '],
['cc' => 'Cc: '],
['bcc' => 'Bcc: '],
['news' => 'Newsgroups: '],
['from' => 'From: '],
['reply to' => 'Reply-To: '],
['follow up to' => 'Followup-To: '],
['subject' => 'Subject: '],
['sender' => 'Sender: '],
['in reply to' => 'In-Reply-To: '],
['contype' => 'Content-type: '],
['charset' => 'MIME-Version: 1.0; charset='],
['x-mailer' => 'X-Mailer: '],
['summary' => 'Summary: '],
['keywords' => 'Keywords: '],
['organization' => 'Organization: '],
['precedence' => 'Precedence: '],
['importance' => 'Importance: '],
['priority' => 'X-Priority: '],
['ms-priority' => 'X-MSMail-Priority: '],
['class' => 'Class: '],
['status' => 'Status: '],
['reciept to' => 'Disposition-Notification-To: '],
];
foreach (@{$header_objects}) {
my($property,$syntax) = @{$_};
$property ||= '';
$syntax ||= '';
my($spec) = $args->{$property}||'';
my($line) = '';
$spec ||= $defaults->{$property};
$spec ||= '';
$line = $syntax.$spec.qq[\n] if (length($spec) > 0);
$headers .= $line;
}
return($headers.qq[\n]);
}
# --------------------------------------------------------
# Mailer::Simple::coerce_array()
# --------------------------------------------------------
sub coerce_array {
my($hashref) = {};
my($i) = 0;
my(@shadow) = @_;
shift(@shadow); # don't need package reference this time
while (@shadow) {
my($name,$val) = splice(@shadow,0,2);
if (defined($name)) {
$hashref->{$name} = (defined($val)) ? $val : '';
}
else {
++$i;
$hashref->{qq[un-named key no. $i]} = (defined($val)) ? $val : '';
}
}
return($hashref);
}
# --------------------------------------------------------
# Mailer::Simple::error()
# --------------------------------------------------------
sub error {
my($this,$error) = @_;
my($block) = <<'__err__';
<?xml version="1.0" encoding='ISO-8859-1'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Loose//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-loose.dtd">
<html
xmlns="http://www.w3.org/1999/xhtml"
xml:lang="en"
lang="en">
<head>
<title>Error</title>
<meta
http-equiv="Content-Type"
content="text/html; charset=iso-8859-1" />
</head>
<body
style="
font-family: verdana,arial;
font-size: 10pt;
color: #000000;
background-color: #FFFFFF;
padding: 10px;">
<p> </p>
<div
style="
padding: 0px 0px 0px 15px;
font-family: verdana,arial;
font-size: 16pt;
color: #A00000;">
<strong>An error has occurred.</strong>
</div>
<div
style="
padding: 0px 0px 0px 30px;
font-family: verdana,arial;
font-size: 10pt;">%%%error%%%</div>
<p> </p>
</body>
</html>
__err__
$block =~ s/\%\%\%error\%\%\%/$error/;
print(<<__fail__) and exit if ($ENV{'REQUEST_METHOD'});
MIME-Version: 1.0'; charset=iso-8859-1
Content-Type: text/html
$block
__fail__
die(qq[\nError occurred while trying to process this request.\n$error\n\n]);
}
# --------------------------------------------------------
# Mailer::Simple::DESTROY()
# --------------------------------------------------------
sub DESTROY {}
# --------------------------------------------------------
# end Mailer::Simple Class, return true on import
# --------------------------------------------------------
1;