view release on metacpan or  search on metacpan

MailBot/Sendable.pm  view on Meta::CPAN

package MailBot::Sendable;

use Net::Domain qw( hostfqdn hostname );
use Mail::Util qw(mailaddress);
use MIME::IO;
use MIME::Entity;
use Carp;

@ISA = qw( MIME::Entity );

$gPreamble = "This is a multi-part message in MIME format.";
my $pgPreamble = \$gPreamble;
$gBase64Preamble = "A binary file was encoded in Base64.\n You need a MIME-capable mailer to read it.";
my $pgBase64Preamble = \$gBase64Preamble;

use strict;

my @MOVE_OUTSIDE = qw( To Cc Bcc );

# smtpsend:  adapted from Barr's Mail::Internet::smtpsend.

# changes:
#  works correctly with file-attaches
#  does not delete 'Received' lines (or even misspelled 'Recieved' lines)
#  does not insert 'Sender', 'Mailer' fields
#  allows you to specify envelope from-field

 sub smtpsend 
{
 my $src  = shift;
 my $envelopeFrom = shift;
 my($mail,$smtp,@hosts);

 $envelopeFrom = mailaddress()
     unless defined $envelopeFrom;

 require Net::SMTP;

 @hosts = qw(mailhost localhost);
 unshift(@hosts, split(/:/, $ENV{SMTPHOSTS})) if(defined $ENV{SMTPHOSTS});

 my $host;
 foreach $host (@hosts) {
  $smtp = eval { Net::SMTP->new($host) };
  last if(defined $smtp);
 }

 croak "Cannot initiate a SMTP connection" unless(defined $smtp);

 $smtp->hello( hostname() );
 # only dups the headers, alas
 $mail = $src->dup;

 $mail->delete('From '); # Just in case :-)

 # Ensure the mail has the following headers
 # From, Reply-To

 my($from,$name,$tag);

 $name = (getpwuid($>))[6] || $ENV{NAME} || "";
 while($name =~ s/\([^\(]*\)//) { 1; }

 $from = sprintf "%s <%s>", $name, mailaddress();
 $from =~ s/\s{2,}/ /g;

 foreach $tag (qw(From Reply-To))
  {
   $mail->add($tag,$from) unless($mail->get($tag));
  }

 # Who is it to

 my @rcpt = ($mail->get('To', 'Cc', 'Bcc'));
 chomp(@rcpt);
 my @addr = map($_->address, Mail::Address->parse(@rcpt));

 return () unless(@addr);

 $mail->delete('Bcc'); # Remove blind Cc's
 $mail->clean_header;

 # Send it

 my @fullBody = $src -> body_to_array;

 my $ok = $smtp->mail( $envelopeFrom ) &&
            $smtp->to(@addr) &&
            $smtp->data(join("", $mail -> head_to_array, "\n", @fullBody));

 $smtp->quit;

 $ok ? @addr : ();
}

sub split_into_array
{
    my $entity = shift;
    my ($chunkSize, $maxSize) = @_;

    defined $maxSize or
	$maxSize = $chunkSize;

    my $length = &get_length($entity);
    return [$entity] if $length <= $maxSize;

    my $id = ".$$." . time . '@' . hostfqdn;
    # pad id to 40 characters for more consistency
    while (length($id) < 40)
    {
	$id = "a" . $id;
    }
    
    $entity -> head -> add("Message-Id",'<'.$id.'>');
    my @body = &entity_to_array($entity);

    my @apaPartial = ();
    while (@body)
    {
	my @aPartial = ();
	my $left = $chunkSize;