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>&#183;</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>&#160;</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>&#160;</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;