package DADA::Mail::Send;

=pod

=head1 NAME			

DADA::Mail::Send

=head1 SYNOPSIS

	use DADA::Mail::Send

	my $mh = DADA::Mail::Send->new;

Mail Routines for the Dada Mail MLM, UC?

=head1 DESCRIPTION


Cool name huh? You have found the heart of the beast, this is where ALL mailings will find 
themselves, one way or another, let's see if we can get this all straightened out so you 
can customize this to your heart's delight. Follow me...

First off, there are TWO different ways mailings happen, either by sending one e-mail, using 
the send() method, or when sending to a group, using the bulk_send() method. This is 
somewhat of a fib, since mailings called by bulk_send() actually use the send() method to 
do its dirty work. Well, that is, if you're not using a SMTP feature, then both the send() 
and bulk_send() have their own way of doing it... kinda. 

You create a single address object like so: 

	my $mh = DADA::Mail::Send->new(\%list_info); 
	my %mailing = (
	To       => 'justin@example.com', 
	From     => 'alex@example.com', 
	Subject  => 'party over here!', 
	Body     => 'yo yo yo, wheres the flava at? we need some action!', 
	); 
	$mh->bulk_send(%mailing);


Pretty fricken hard eh? 
Well, it can get a bit harder than that, but thats a pretty stripped down version, 
If you wanted, you could theoretically use this as a do all mail sender + all the features 
that are in the Guts.pm module. Its pretty easy to make some crazy... stuff once you've got a 
handle on it. 

=cut


use lib '.'; 
use lib '../'; 
use lib './'; 
use lib 'DADA';

use lib qw(../../ ../../DADA ../../perllib); 



use Fcntl qw(
LOCK_SH
O_RDONLY
O_CREAT
);
 
my $dbi_obj; 

use DADA::Config qw(!:DEFAULT);  
use DADA::App::Guts; 



use DADA::Logging::Usage;
my $log =  new DADA::Logging::Usage;;
		
		
		
use strict; 
use vars qw($AUTOLOAD); 
use Carp qw(croak carp);

use Fcntl qw(:DEFAULT :flock	O_WRONLY	O_TRUNC		O_CREAT	LOCK_EX	);




my %allowed = (

	list_info                     => {},
	list_type                     => 'list',
	bulk_test                     => 0,

	#bulk_start_email              => undef, 
	
	#bulk_send_sending_file        => undef, 
	
	bulk_start_num                => 0, 
	do_not_send_to                => [],
	ignore_schedule_bulk_mailings => 0, 
	saved_message                 => undef, 
	
	also_send_to                  => [], 
	im_bulk_sending               => 0, 
	
	num_subscribers               => undef, 
	
	restart_with                  => undef, 
	
	# This is some ninja stuff...
	test_send_file                => undef,  
); 

=pod

=head1 new

 my $mh = DADA::Mail::Send->new(-list => $list_info_hashref); 

=head1 Default Headers

DADA::Mail::Send has a wide variety of both e-mail headers you can send to it. you do this 
through either the B<send()> or B<bulksend()> methods

=over 4

=item * From 

This should hold where the e-mail is from. Tricky, eh? 

example: 

	 From =>  '"Alex Skazat" <alex@example.com>',

=item * To 

Mail Header, This should hold where the e-mail is going to, 

example: 

	To => '"Justin Simoni" <justin@example.com>',

=item * Bcc

This is used as a "Blank Carbon Copy", meaning a copygoes to whoever is 
specified in the Bcc header, without it showing up in the To's header. 
B<DO NOT USE THIS FOR BULK MAILING> Send one 100,000 emails, some poor fella 
is going to get 100,000 copies 

example: same as the To or From 

=item * Return-Path 

Specifies what address an e-mail will get sent to when someone replies to an e-mail address. 
Sometimes works, sometimes doesn't, very fluky, better to set with the sendmail '-f' flag 

example: 

	'Return-Path' => 'justin@example.com', 

=item * Reply-To

Very similar to the Return-Path, 

=item * Errors-To 

Mail Header, specifies where errors, like if the e-mail address you're trying to send 
isn't real, or their mailbox is full,  a message I<supposed> to  use this address 
to mail the error to. 

example: 

	'Errors-To' => 'errors@example.com',

=item * Precedence 

Mail Header, sets the so called 'precedence' of a bulk message, the valid values are
list, bulk and junk. Certain e-mail clients may use this to filter out spam, or 
list messages, 

example: 

	Precedence => 'junk', 

default is list. 


=item * Content-type 

sets the content type of the email message, something like text/plain or text/html, it tells the mail reader how to 
show the mail message. This is also where you can specify certain character sets, since not everyone uses english as their first language, 

like: 

	Content-type => 'text/html; charset=us-ascii';


=item * Content-Disposition 

(ah hem) "Whether a MIME body part is to be shown inline or is an attachment; can also indicate a suggested filename for use when saving an attachment to a file."

example: 

	'Content-Disposition =>  'inline; filename="index.html"',

=item * Content-transfer-encoding 

(ah hem) "Coding method used in a MIME message body."

example: 

	'Content-transfer-encoding' =>  7bit',

you could also say 'base64', '8bit' or 'quote-printable'

=item * MIME-Version

this specifies what MIME version your using, usually this is set as 1.0, without setting a MIMIE version HTML e-mails don't come out well, 

example: 

	'MIME-Version' => '1.0',

=item * List 

This can be a mail header, Dada Mail uses it internally to say what list is sending bulk messages, the list name is important to fetch all sorts of things, write temp files, etc, 

example List => 'my list', 

=item * Mailing List Headers 

Theres a whole slew of Mailing List related headers, that are pretty self-explainatory: 

List-Archive   

List-Digest 

List-Help

List-ID

List-Owner

List-Post

List-Subscribe

List-Unsubscribe

List-URL


=item * References 

this tag is used by popular Mail readers to figure out how different messages are related. 

This isn't used in Dada Mail, but it may one day for its archives, this usually holds a weird numerical value, 

=item * In-Reply-To 

Again, this is used by mail readers to keep track of e-mail messages.

=item * Subject 

The subject of your message 

example: 

	Subject => 'mail server is about to explode', 



=item * Body

This is the body message, usually I make the value before hand, and stick the variable in, like this: 

	my $Body = <<EOF 
	
	Help! 
	I'm trapped in a peanut butter factory, 
	The only way I can communicate with the 
	real world is by sending messages inside
	peanut butter containers. 
	
		Bob, 
	EOF
	; 

	Body => $Body, 


This really isn't a mail header, but this is how you get the Body of a message to Dada Mail

=back

B<Please Note>

In earlier versions of this module, certain key/value pairs were passed to this script to change the way mailings were done. No more. Settings that afect mailings are either passed in the hash ref you passed to new() or, by some handy dandy methods


=head1 Handy Dandy Methods 

These methods are used to change how Dada Mail sends mostly Bulk messages, these are the fun ones, 


=over 4

=item * do_not_send_to

This ones kinda cool, give it a reference to an array of addresses you do not want sent the email. 

you could also specify your entire black list. The possibilities, kids, are endless. 

example: $mh->do_not_send_to(['justin@example.com',  'alex@example.com']);

This array ref is then passed to MailingList::*::\ function that makes the actual list to send to. Basically create_bulk_sending_file weeds out the emails in a list we don't want to send to

=item * bulk_test          

This is a magical paramater that, when changed to one, will only send bulk messages to the list owner. "What's the point of that?" well, it'll set up DADA::Mail::Send as I<if> it was sending a bulk message, instread of being in "send one message mode" This makes sure all your configs are peachy keen. 1 for test, nothing for no test, 

=back

=cut


# these are all the headers Dada Mail understands. 
# if you don't WANT a header shown, in ANY 
# message, simple take it outta here. 

my %defaults        = %DADA::Config::EMAIL_HEADERS;
my @default_headers = @DADA::Config::EMAIL_HEADERS_ORDER; 
			   

sub new { 
	my $that = shift; 
	my $class = ref($that) || $that; 
	my $self = {
		_permitted => \%allowed, 
		%allowed,
	};
	bless $self, $class;
	my $list_info = shift; 
	$self->{list_info} = $list_info;
	
	$self->_init; 
	
	return $self; 
}




sub AUTOLOAD { 
    my $self = shift; 
    my $type = ref($self) 
    	or croak "$self is not an object"; 
    	
    my $name = $AUTOLOAD;
    $name =~ s/.*://; #strip fully qualifies portion 
    
    unless (exists  $self -> {_permitted} -> {$name}) { 
    	croak "Can't access '$name' field in object of class $type"; 
    }    
    if(@_) { 
        return $self->{$name} = shift; 
    } else { 
        return $self->{$name}; 
    }
}




sub _init { 
	my $self = shift; 
	
	$self->{mj_log} = $log;
	
    if($self->{list_info}->{use_domain_sending_tunings} == 1) { 
    
        if($self->{list_info}->{domain_sending_tunings}) { 
        
            my $tunings = eval($self->{list_info}->{domain_sending_tunings}); 
            my $lookup_tunings = {}; 
            
            # let's make this into an easier-to-look-up-format: 
            
            foreach my $tune(@$tunings){ 
                if($tune->{domain}){ # only real thingy needed...
                    $lookup_tunings->{$tune->{domain}} = {};
                    foreach my $in_tune(keys %$tune){ 
                       # next if $in_tune eq 'domain'; 
                        $lookup_tunings->{$tune->{domain}}->{$in_tune} = $tune->{$in_tune}; 
                    }
                }
            }
            
            $self->{domain_specific_tunings} = $lookup_tunings; 
        }
    }

 }




=pod

=head2 return_headers


	my %headers = $mh->return_headers($string); 

This is a funky little subroutine that'll take a string that holds the 
header of a mail message, and gives you back a hash of all the headers 
separated, each key in the hash holds a different header, so if I say

	my $mh = DADA::Mail::Send -> new(); 
	my %headers = $mh -> return_headers($header_glob); 


I can then say: 

	my $to = $headers{To}; 

This subroutine is used quite a bit to take out put from the MIME::Lite 
module, which allows you to get the whole header with its header_to_string() 
subroutine and hack it up into something Dada Mail can use. 

=cut


 
sub return_headers { 
my $self = shift; 

#get the blob
my $header_blob = shift || "";

#init a new %hash
my %new_header;

# split.. logically
my @logical_lines = split /\n(?!\s)/, $header_blob;
 
    # make the hash
    foreach my $line(@logical_lines) {
          my ($label, $value) = split(/:\s*/, $line, 2);
          $new_header{$label} = $value;
        }
return %new_header; 

}




=pod 

=head2 clean_headers

	%squeaky_clean_headers = $mh->clean_headers(%these_be_the_heaers);

this method does a little munging to the mail headers for better absorbtion; basically, it changes the case of some of the mail headers so everyone's on the same page

=cut

sub clean_headers { 
	my $self = shift; 
	my %mail_headers = @_; 
	

	#warn q{$mail_headers{'Content-Type'} } . $mail_headers{'Content-Type'}; 
	#warn q{ $mail_headers{'Content-type'} } . $mail_headers{'Content-type'};
	
	
    if((exists($mail_headers{'Content-Type'})) && (strip($mail_headers{'Content-Type'}) ne "")){ 
        $mail_headers{'Content-type'} = $mail_headers{'Content-Type'};  
        delete($mail_headers{'Content-Type'});
    }
	
	if( defined($mail_headers{'Content-transfer-encoding'}) &&  strip($mail_headers{'Content-transfer-encoding'}) ne ''){ 
        $mail_headers{'Content-Transfer-Encoding'} = $mail_headers{'Content-transfer-encoding'};
	    delete($mail_headers{'Content-transfer-encoding'});
    } 
    
    
	
	$mail_headers{'Content-Base'} = $mail_headers{'Content-base'} 
		if defined $mail_headers{'Content-base'};
	$mail_headers{'Cc'} = $mail_headers{'CC'} 
		if defined $mail_headers{'CC'};
	foreach(keys %mail_headers){ 
		my $tmp_h = $mail_headers{$_};
		   if($tmp_h){ 
			   $tmp_h =~ s/\n$//;
			   $mail_headers{$_} = $tmp_h;
		   }
	}
	
	delete($mail_headers{'X-Mailer}'})
		if exists $mail_headers{'X-Mailer}'};
	
	return %mail_headers; 
}




=pod

=head2 send

This method sends an email, it takes a hash of the mail headers, plus the body of the message: 

$mh->send(To      => 'justin@example.com', 
		  From    => 'secret@admirer.com', 
		  Subject => 'smooch!', 
		  Body    => 'you are so cute, you little Perl Coder you'
	); 

=cut

sub send {
 
 
    require Email::Address;
    
	my $self = shift; 
	my %fields = (
				  %defaults,  
				  $self->_make_general_headers, 
				  $self->_make_list_headers, 
				  @_
				  ); 
				  
	# Here's the thing - 
    # If there's no Content-Transfer-Encoding header, 
    # We should *really* make one, since it's what we 
    # say we do. 

         %fields = $self->clean_headers(%fields); 

  
  #

    #    croak "Content-type: '" . $fields{'Content-type'} . "'";

    # I don't like this, but, eh.
    if(! exists($fields{'Content-type'}) || strip($fields{'Content-type'}) eq ''){
    
     #  croak "no content-type!"; 
        
        
         $fields{'Content-type'} = 'text/plain'; 
    } 
    else {
    
      #  croak "Content-type: '" . $fields{'Content-type'} . "'";
    }
    
    
    if(
        (
         ! exists ($fields{'Content-Transfer-Encoding'}) ||
         ! defined($fields{'Content-Transfer-Encoding'}) 
        )   &&
       
        $fields{'Content-type'} =~ m/(text\/plain|text\/html)/i 
    ){ 
    
        %fields = $self->_content_transfer_encode(
            -fields => \%fields, 
        ); 
 
    }
    
    
     %fields = $self->clean_headers(%fields); 

    # This makes a local copy of the list settings.
	my $local_li = {};
	foreach(keys %{$self->{list_info}}){ 
	    $local_li->{$_} = $self->{list_info}->{$_}; 
	}
	
	
	# This copies over domain-specific tunings for sending...
	my ($email_address, $email_domain) = split('@', $fields{To});
	# damn that's weird.
	
	if($self->{list_info}->{use_domain_sending_tunings} == 1) { 
	
        if($self->{domain_specific_tunings}->{$email_domain}->{domain} eq $email_domain){  
            foreach(keys %{$self->{domain_specific_tunings}->{$email_domain}}){
                $local_li->{$_} = $self->{domain_specific_tunings}->{$email_domain}->{$_};
            }
        }
        
	}
    
    
    
    

    # and back to your regularly scheduled send() subroutine...



	
	# TODO I don't know what $tmp_body is!
	my $tmp_body       = $defaults{Body};
	   $tmp_body       =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g; 
	   
	# or this!
	$defaults{Body} = $tmp_body; 
	
	unless($self->im_bulk_sending == 1){ 
		$fields{Body} =~ s/\[list\]/$local_li->{list}/g;
		$fields{Body} =~ s/\[list_name\]/$local_li->{list_name}/g;
	}
	
	
	%fields = $self->_strip_fields(%fields) 
		if ($local_li->{strip_message_headers} == 1); 	   
	
	
	my $recipient_for_log = $fields{To}; 
	
	
    # write the header, if its set.
    $fields{'Content-type'} .= '; charset='. $local_li->{charset_value} 
        if( 
          (defined($local_li->{charset_value}))  && 
          (defined($fields{'Content-type'}))              && 
          ($fields{'Content-type'} !~ /charset\=/)         #ie, wasn't set before. 
          );
    
    if($local_li->{print_return_path_header} == 1){
        if($local_li->{verp_return_path} == 1){ 
            $fields{'Return-Path'} = '<'. $self->_verp($fields{To}) .'>'; 
        }else{
 
            $fields{'Return-Path'} =  '<'. $local_li->{admin_email} . '>'; 

        }
    }	
    
    
	if($local_li->{smtp_server}   ne ""   &&
	   $local_li->{send_via_smtp} == 1    &&
	   $local_li->{smtp_engine}   eq      "net_smtp" 
	){ 
	
         $self->_pop_before_smtp;
         
              
            
     
            my $host; 
            if($local_li->{set_smtp_sender} == 1){ 
                $host = $local_li->{admin_email};
            } else { 
                $host = $local_li->{list_owner_email};
            }
            $host =~ s/(.*?)\@//;
                  
            eval { 
            
                my $mailer; 
                my %mailer_params = (
                    Hello   =>  $host,
                    Host    =>  $local_li->{smtp_server},
                    Timeout => 60,
                    Port    =>  $local_li->{smtp_port},
                    (
                        ($DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP} == 1) ? 
                            (
                            Debug => 1, 
                            
                            ) :
                            ()
                    ), 
                    
                ); 
                
               if($local_li->{use_smtp_ssl} == 1){ 
                   #     require Net::SMTP_auth_SSL;
                   #     $mailer = new Net::SMTP_auth_SSL(%mailer_params);
    
    
                     require  Net::SMTP::SSL;
                     $mailer = Net::SMTP::SSL->new(%mailer_params);
                  
                     # authing can fail, although the message may still go through 
                     # to the SMTP server, since sometimes SASL AUTH isn't required, but is 
                     # attempted anyways. 
                     if($local_li->{use_sasl_smtp_auth} == 1){ 
                         $mailer->auth(
                           # $local_li->{sasl_auth_mechanism}, 
                            $local_li->{sasl_smtp_username}, 
                            $self->_cipher_decrypt($local_li->{sasl_smtp_password})
                         ) or carp 'Problems sending SASL authorization to SMTP server, make sure your credentials (username, password) are correct.'; 
                     }
                 
                 
                 }else { 

                    
                    require Net::SMTP_auth; 
                     $mailer = new Net::SMTP_auth(%mailer_params);
                        
                     # authing can fail, although the message may still go through 
                     # to the SMTP server, since sometimes SASL AUTH isn't required, but is 
                     # attempted anyways. 
                     if($local_li->{use_sasl_smtp_auth} == 1){ 
                         $mailer->auth(
                            $local_li->{sasl_auth_mechanism}, 
                            $local_li->{sasl_smtp_username}, 
                            $self->_cipher_decrypt($local_li->{sasl_smtp_password})
                         ) or carp 'Problems sending SASL authorization to SMTP server, make sure your credentials (username, password) are correct.'; 
                     }                 
                 
                }
                
                 
               
               
               
               my $to;
               if( $local_li->{set_to_header_to_list_address} == 1 && 
                   $local_li->{group_list}                    == 1 && 
                   # Don't understand this: 
                   $fields{from_bulk_send}                    == 1 &&
                   defined($local_li->{discussion_pop_email}
                   
                   ) # safegaurd?
                   
                 ){  
                    # This is who it's going to. 
                    $to = $fields{To}; 
                    
                    # This is what we're going to say we are...
                    $fields{To} = $local_li->{discussion_pop_email}; 
                    
               } else { 
                    # um, nevermind. 
                    $to = $fields{To}; 
               }
                
                # why wouldn't it be defined?
                if (defined($to)){; 
                    eval { $to = (Email::Address->parse($to))[0]->address; }
                }
                #if(!$to){  
                #    $to = $fields{To};   
                #}                    
                
                my $smtp_msg = '';
                foreach my $field (@default_headers){
                        $smtp_msg .= "$field: $fields{$field}\n" 
                            if( (defined $fields{$field}) && 
                                ($fields{$field} ne "")
                             );
                }
                $smtp_msg .= "\n"; 
                $smtp_msg .=  $fields{Body} . "\n";

                my $FROM_error_flag = 0; 
                my $FROM_error =  "problems sending FROM:<> command to SMTP server."; 
                if($local_li->{set_smtp_sender} == 1){ 
                    if($local_li->{verp_return_path}){ 
                        if(!$mailer->mail($self->_verp($to))){                         
                             carp $FROM_error; 
                             $FROM_error_flag++; 
                        }
                     }else{ 
                        if(!$mailer->mail($local_li->{admin_email})){ 
                            carp $FROM_error; 
                            $FROM_error_flag++; 
                        }    
                     }
                } else { 
                    if($local_li->{verp_return_path}){ 
                        if(!$mailer->mail($self->_verp($to))){ 
                            carp $FROM_error; 
                            $FROM_error_flag++; 
                        }
                     }else{ 
                        if(!$mailer->mail($local_li->{list_owner_email})){ 
                            carp $FROM_error; 
                            $FROM_error_flag++; 
                        }
                     }
                }
            
                if(! $FROM_error_flag){ 
                     if($mailer->to($to)){ 
                        if($mailer->data){ 
                             if($mailer->datasend($smtp_msg)){ 
                                 if($mailer->dataend){ 
                                    # oh hey, everything worked!
                                 }else{ 
                                    carp "problems completing sending message to SMTP server.";
                                 }
                                
                            }else{ 
                                carp "problems sending message to SMTP server.";
                            }
                        }else{ 
                            carp "problems sending DATA command to SMTP server.";
                        }
                    } else{ 
                        carp "problems sending '" . $to . "' in 'RCPT TO:<>' command to SMTP server."; 
                    }
                } else{ 
                    carp $FROM_error;
                }

                 $mailer->reset()
                    or carp 'problems sending, "RSET" command to SMTP server.'; 
                 $mailer->quit
                    or carp "problems 'QUIT'ing SMTP server."; 
            }; # end of the eval block. 
            
            if($@){ # Something went wrong when trying to send...
                carp "Problems sending via SMTP: $@"; 
            }
         
         }else{ 
    

            my $live_mailing_settings; 
            # carp ' $fields{To} ' . $fields{To}; 
            
            my $plain_to_address = $fields{To}; #holds something like, me@you.com 
            if (defined($plain_to_address)){; 
                    eval { $plain_to_address = (Email::Address->parse($plain_to_address))[0]->address; }
            } else { 
                carp "couldn't strip, 'to' address! - $plain_to_address"; 
            }
                
            
           
            if($DADA::Config::MAIL_SETTINGS =~ /\-f/){ 
            
                carp "$DADA::Config::PROGRAM_NAME $DADA::Config::VER, \$DADA::Config::MAIL_SETTINGS variable already has the -f flag set ($DADA::Config::MAIL_SETTINGS), not setting again $!";
                $live_mailing_settings = $DADA::Config::MAIL_SETTINGS;
            
            }elsif($local_li->{add_sendmail_f_flag} == 1){	    
            
                if($local_li->{verp_return_path} == 1){ 
                    $live_mailing_settings = $DADA::Config::MAIL_SETTINGS . ' -f'. $self->_verp($plain_to_address);
                }else{
                    $live_mailing_settings = $DADA::Config::MAIL_SETTINGS . ' -f'. $local_li->{admin_email};
                }
                
            }else{ 
            
                $live_mailing_settings = $DADA::Config::MAIL_SETTINGS;
            
            }
            
           if( $local_li->{set_to_header_to_list_address} == 1 && 
               $local_li->{group_list}                    == 1 && 
                $fields{from_bulk_send}                 == 1 &&
               defined($local_li->{discussion_pop_email}) # safegaurd?
             ){
               
               $live_mailing_settings  =~ s/\-t//; # remove any, "-t" flags... 
               $live_mailing_settings .= ' ' . $plain_to_address;  
               $fields{To} =  $local_li->{discussion_pop_email};
            }
            
            $live_mailing_settings = make_safer($live_mailing_settings);
            
            # pipe it to sendmail.. $DADA::Config::MAIL_SETTINGS is set in the Config.pm file... worth a good look.  
            
            carp "MAIL is already open....?" 
                if (defined fileno *FH);
            # The above line makes no sense, shouldn't it say: 
            #  if (defined fileno *MAIL);
            # ?!?!?!?!
            
            if($self->test_send_file){ 
            
                # warn "NOT SENDING - sending message to test file: '" . $self->test_send_file . "'"; 
                open(MAIL, '>' . $self->test_send_file) or die "couldn't open test file: $!"; 	
                
            }
            else { 
            
                open(MAIL,$live_mailing_settings) or $self->_send_die($fields{Debug});		
            
            }
            
            print MAIL 'Return-Path: ' . $fields{'Return-Path'} . "\n"
                if $fields{'Return-Path'}; 
            
            foreach my $field (@default_headers){
                    print MAIL "$field: $fields{$field}\n" 
                        if( (defined $fields{$field}) && 
                            ($fields{$field} ne "")   && 
                            ($field ne 'Return-Path')
                         );
            }
            print MAIL "\n"; 
            print MAIL $fields{Body} . "\n";
            
            close(MAIL) 
                or carp "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Warning: didn't close pipe to '$live_mailing_settings' - $!";  

        }
        
        
       
		$self->{mj_log}->mj_log($local_li->{list}, 'Mail Sent', "Recipient:$recipient_for_log, Subject:$fields{Subject}") 
			if $DADA::Config::LOG{mailings};     
   		return 1; 

	
	$local_li = $self->{list_info};
}




sub smtp_test { 

    my $self = shift; 

    require DADA::Security::Password; 
    
    my $filename = time . '_' . DADA::Security::Password::generate_rand_string(); 
    
    open(SMTPTEST, ">$DADA::Config::TMP/$filename") or die "That didn't work."; 
    
    *STDERR = *SMTPTEST; 
    
    my $orig_debug_smtp = $DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP}; 
    $DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP} = 1; 
    my $orig_debug_pop3 = $DADA::Config::CPAN_DEBUG_SETTINGS{NET_POP3}; 
    $DADA::Config::CPAN_DEBUG_SETTINGS{NET_POP3} = 1; 
    
    
        $self->send(
                
            To => $self->{list_info}->{list_owner_email}, 
            From => $self->{list_info}->{list_owner_email}, 
            Subject => "SMTP Test Email", 
            Body    => "This message is sent out to test SMTP mailing...",  

        ); 
    
    
    close(SMTPTEST); 
    $DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP} = $orig_debug_smtp; 
    $DADA::Config::CPAN_DEBUG_SETTINGS{NET_POP3} = $orig_debug_pop3;     
    open(RESULTS, "<$DADA::Config::TMP/$filename")
        or die "that didn't work $!"; 
    my $msg = do { local $/; <RESULTS> };

    close(RESULTS); 

    my @r_l = split("\n", $msg); 
   
   my $report =  []; 
   
	foreach my $l(@r_l){ 
		if($l =~ m/502 unimplemented/i){ 
			push (@$report, {line => $l, message => 'SASL Authentication may not be available on this SMTP server - try POP-before-SMTP Authentication.'}); 
		}elsif($l =~ m/250\-AUTH PLAIN LOGIN|250 AUTH LOGIN PLAIN|250\-AUTH\=LOGIN PLAIN/i){ 
			push (@$report, {line => $l, message => 'Looks like Plain SASL Authentication is Supported!'}); 
		}elsif($l =~ m/535 Incorrect authentication data|535 authorization failed/i){ 
			push (@$report, {line => $l, message => 'Looks like there\'s something wrong with your username/password - double check that you entered them right.'}); 
		}elsif($l =~ m/Authentication succeeded|OK Authenticated/i){ 
			push (@$report, {line => $l, message => 'Looks like we logged in OK!'});
		}elsif($l =~ m/235 ok\, go ahead/i){ 
			push (@$report, {line => $l, message =>'Looks like we logged in OK!'});  
		}elsif($l =~ m/auth not available/i){ 
			push (@$report, {line => $l, message =>'Looks like we tried to log in, but our login was rejected for some reason.!'});  
		}
		
    }
 
    return ($msg, \@r_l, $report);  


}

=pod

=head2 bulk_send

Sends a message to everyone on your list, (that you specified, by passing a hash ref with the list settings.. right?) 

Takes the same arguments as send()

returns (for now) the Message-ID of the message being sent. 

You can use this as the key for an archived message (let's say)


=cut



sub restart_bulk_send { 

    my $self = shift; 
    my $id   = shift; 
    my $type = shift; 
    
    croak "no id!" if ! $id; 
    croak "no type!" if ! $type; 
    
    $self->list_type($type); # that should take care of the type... 
    
    $self->{mj_log}->mj_log(
                                $self->{list_info}->{list}, 
							    "Restarting List Sending", 
							     "Internal ID: " . $id, 
							     "Tupe: " . $type, 
							     
							   )   if $DADA::Config::LOG{mass_mailings};   
							    
 	    $self->{mj_log}->close_log if $DADA::Config::LOG{mass_mailings};
 	    
 	    
    
    
    $self->restart_with($id); 
    $self->bulk_send(); 
    
}




sub bulk_send { 

	my $self = shift; 
	my %fields = (
				  %defaults, 
				  $self->_make_general_headers, 
				  $self->_make_list_headers, 
				  @_); 
	
	$self->im_bulk_sending(1); 

	%fields = $self->clean_headers(%fields); 

	$defaults{Body} =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g; 	 

	require DADA::MailingList::Subscribers;
	       $DADA::MailingList::Subscribers::dbi_obj = $dbi_obj; 
	
	
	my $lh = DADA::MailingList::Subscribers->new(-List => $self->{list_info}->{list});
	
	
	my $path_to_list          = undef; 
	my $total_sending_out_num = undef; 
	my $bsf_errors            = {};

    require DADA::Mail::MailOut; 
        
    my $mailout = DADA::Mail::MailOut->new( { -List => $self->{list_info}->{list} } ); 
    
    if($self->restart_with){ 
    
        # Shazzam!
        $mailout->associate($self->restart_with, $self->list_type);
        
        # Seems like we should still be able to do this if basically if the lock is unlocked...
        
        if($mailout->should_be_restarted){ 
                        
            my $raw_msg = $mailout->reload(); 
            
            my ($raw_header, $raw_body) = split(/\n\n/, $raw_msg, 2); 
            %fields = $self->return_headers($raw_header); 
            $fields{Body} = $raw_body;   
        
        } else { 
        
        croak "Attempt to reload a message which does not have a stalled process - check before attempting!"; 
        
        }
    
    }else { 
       
        $mailout->create({
                        -fields   => {%fields},
                        -list_type => $self->list_type,
                        -mh_obj    => $self,  
                   }); 
    
    
    }													 				
	
	
    # This is so awkwardly placed...	
	if($self->list_type eq 'invitelist'){ 
		my $lh = DADA::MailingList::Subscribers->new(-List => $self->{list_info}->{list});
		   $lh->remove_this_listtype(-Type=> 'invitelist');
	}




    # I don't know why this is here...
	my $num_subscribers = $lh->num_subscribers;
	   $self->num_subscribers($num_subscribers); 
	

    my $status = $mailout->status; 
    
    if($status->{percent_done} >= 100){ 
        carp "dude, status says >= 100% - am I missing something?!"; 
        return; 
    }
    
    if($status->{is_batch_locked} == 1){ 
        carp "Sending process is currently locked, not resending message until lock is unlock or seen as stale..."; 
        return; 
    }



	# how many messages get sent between batches? 
	my $letters = 1; 
	if(defined($self->{list_info}->{bulk_send_amount})){ 
		$letters = $self->{list_info}->{bulk_send_amount};  # why am I making this its own variable?!
	}
	
		# we need to create a new file that has the subscribers and their pin 
		# number. Those two things will be separated with a '::' so we can split 
		# it apart later.

	   undef $lh;

	my $pid; 
	
	FORK: {
		if ($pid = fork) {
			
			$self->{mj_log}->mj_log(
								
								$self->{list_info}->{list}, 
							    'Message pid: ' . $pid, 
							    "Subject:".$fields{Subject}
							   
							   )   if $DADA::Config::LOG{mass_mailings};   
							    
            $self->{mj_log}->close_log 
                if $DADA::Config::LOG{mass_mailings};
            
            
            $self->_log_sub_count(
                                   -msg_id          => $fields{'Message-ID'}, 
                                   -num_subscribers => $num_subscribers,
                                ); 
                    
            # save a copy of the message for later pickup.
            $self->saved_message($self->_massaged_for_archive(\%fields)); 
            return $fields{'Message-ID'};
                
        } elsif (defined $pid) { # $pid is zero here if defined
            
            if($DADA::Config::NULL_DEVICE){ 
                open(STDIN,  ">>$DADA::Config::NULL_DEVICE") or carp "couldn't open '$DADA::Config::NULL_DEVICE' - $!"; 
                open(STDOUT, ">>$DADA::Config::NULL_DEVICE") or carp "couldn't open '$DADA::Config::NULL_DEVICE' - $!"; 
            }
            
            
            setpgrp;                        
				
		    #warn "starting the sending process."; 
		    
			# child here
			# parent process pid is available with getppid
					
			my $mailing; 
			my $n_letters = $letters; 
			my $n_people  = 0; 
			#my $sleep_num = 0; 
			my $send_body = $fields{Body}; 
			#my $batch_num = 1; 
						
			# this is annoyingly complicated											
			my $mail_info;
			my $list_pin;		
			my $mailing_count; 									
			my $stop_email;
			my $mailing_amount;
			
			# let's take count of the start time
			
			# DEV: The below line is being replaced, since the starting of the entire mailing, 
			# MAY be different then the starting of this part of the mailing. 
			# Sneeky, eh? 
			#
			# my $mail_start_time = time; 
			#
			# Here's what we're replacing it with: 
			#
			 my $mail_start_time = $status->{first_access};  
			#
			# pretty sure $status is still in affect...
			
			my ($ssec, $smin, $shour, $sday, $smonth, $syear) = (localtime($mail_start_time))[0,1,2,3,4,5];
			my $log_mail_start_time = sprintf("Mailing Started: %02d/%02d/%02d %02d:%02d:%02d",  $smonth+1, $sday, $syear+1900, $shour, $smin, $ssec);	
	        # $log_mail_start_time isn't used until about 200 lines. Perchance we should move this?!
	
	
	
	
	
			# ok, now lets open that list up
			
			#warn ' $mailout->subscriber_list ' . $mailout->subscriber_list; 
			
			my $somethings_wrong = 0;
			
			
			sysopen(MAILLIST, $mailout->subscriber_list,  O_RDONLY|O_CREAT, $DADA::Config::FILE_CHMOD ) or 
				croak "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: can't open mailing list to send a Mailing List Message: $!"; 
			
			if($^O =~ /solaris/g){ 
			    # DEV For whatever reason (anyone?) Solaris DOES NOT like this type of locking. More research has be done..
			
			    flock(MAILLIST, LOCK_SH) or $somethings_wrong = 1;
			}
			else { 
                flock(MAILLIST, LOCK_EX) or $somethings_wrong = 1; 
			}
			
			
            if($somethings_wrong == 1){ 
                carp "temporary sending file is locked - another process sending the message?! exiting sending process..."; 
                exit(0); 
            }
                    
			my $check_restart_state = 0; 
			# only check the state IF we need to, otherwise, skip the check and save some cycles. 
			if($self->restart_with){ 
                $check_restart_state = 1; 
            }
            
            #warn "locking batch..."; 
            $mailout->batch_lock;

			# while we have people on the list.. 
			while(defined($mail_info = <MAILLIST>)){ 	
			
			
				chomp($mail_info);		
				
				# get the email, and its pin...
				my @ml_info      = split('::', $mail_info); 
				my $mailing      = $ml_info[0];
														
				# keep count of how many people we have
				$mailing_count++;
				# $mailing_count is used exactly one place. WTF?
				# only start sending at a point where we're supposed to...
				# so wait - mailing count starts at 1?
				
				if($check_restart_state == 1){ 
                    if($self->restart_with){ 
                        my $mo_counter_at = $mailout->counter_at; 
                        
                        if($mo_counter_at > ($mailing_count - 1)){ 
                        
                           # warn "skipping $mailing_count..."; 
                            next; 
                        } else { 
                            $check_restart_state = 0;
                        }
                    
                    }
			    }
				



				
				
				# This is new - see the note in the 2nd if statement below. 
				$stop_email = $mailing;
							
							
                my $mailing_body = $send_body;
                # find the email, pin
                
                $mailing_body  = $self->_merge_fields(-body         => $mailing_body, 
								                      -merge_fields => \@ml_info,
								                      -mail_fields  => \%fields,
								                      );
											 
				$fields{Body}  = $mailing_body ;
				$fields{To}    = $mailing;
				
				# Debug Information, Always nice
                $fields{Debug} = {
                    -Messages_Sent    => $n_people, 
                    -Last_Email       => $mailing,
                    -Message_Subject  => $fields{Subject},
                    -List_File        => $path_to_list,
                    -List_File_Size   => -s"$path_to_list"
                };
                
				$self->send(%fields, from_bulk_send => 1); # The from_bulk_mail is a hack. 
                
                my $new_count = $mailout->countsubscriber; 
                 
               # warn '$new count: '      . $new_count; 
               # warn '$n_people: '       . $n_people; 
               # warn '$mailing_count: ' . $mailing_count; 
               
               if($mailing_count != $new_count){ 
                    carp("\$mailing_count ($mailing_count) is not the same as \$new_count ($new_count) - problems are likely to happen..."); 
               }
               
				$n_people++; 
				
				
				if($self->{list_info}->{enable_bulk_batching} == 1){ 
			
			    	if($n_people == $n_letters){   
				
				
		                my $batch_status = $mailout->status; 		
				        if($DADA::Config::LOG{mass_mailing_batches}){ 
                        
                            my $batch_log_message = "Subject:$fields{Subject}, Start Time: $log_mail_start_time"; 
                               foreach(keys %$batch_status){ 
                                    next if $_ eq 'email_fields';
                                    $batch_log_message .= ' ' . $_ . ': ' . $batch_status->{$_}; 
                               }
                            
                            $self->{mj_log}->mj_log(
                                $self->{list_info}->{list}, 
                                'Batch Successfully Completed', $batch_log_message 
                             ); 
                            $self->{mj_log}->close_log;
                            
                        }
                        
                        
                        if($self->{list_info}->{restart_mailings_after_each_batch} != 1) { 
                            
                            if(! $self->{list_info}->{bulk_sleep_amount}){ 
                                $self->{list_info}->{bulk_sleep_amount} = 1;
                            }
                            
                            sleep $self->{list_info}->{bulk_sleep_amount};
                            
                            # carp "unlocking batch...";
                            $mailout->unlock_batch_lock;
                            $mailout->batch_lock;
                            # carp "locking batch..."; 

                       
                       } else { 
                        
                            #warn "closing mail list, unlocking batching lock, exiting..."; 
                            
                            close(MAILLIST)
                                or carp "Problems closing the temporary sending file (" . $mailout->subscriber_list ."), Reason: $!";

                            
                            $mailout->unlock_batch_lock;
                            
                            # We only want to, exit(0) if we have more mailings to go. 
                            # If we don't have any more to do, we have to do all the 
                            # cleanup, so let's not go quite yet. 
                            
                            if($batch_status->{total_sent_out} < $batch_status->{total_sending_out_num}){ # We have more mailings to do. 
                                exit(0); 
                            }
                        
                        }  
                        
                        
                        # DEV NOTE: All these variables don't make any sense to me. 
                        # It's severily complicated and I'm certain I haven't a clue what's going on. 
                        # Honestly. 
                        #
                        
                        # keep a count on how many batches we had. 
                        # $batch_num++;
                        
                        # and figure out where we are in this batch. 
                        $n_letters+=$letters;
                        #$sleep_num++;
					  
					}
					
		        }	            
	            
			} # while(defined($mail_info = <MAILLIST>)){ 
			
			#warn "I'm still here!"; 
			
			my $ending_status = $mailout->status; # most likely safe to called status() as much as I'd like...
			
			
			# Old, crufty, complicated stuff...
			$mailing_amount   = $mailing_count; 
			my $mail_end_time = time;
			my ($dsec, $dmin, $dhour, $dday, $dmonth, $dyear) = (localtime($mail_end_time))[0,1,2,3,4,5];   
			# These sorts of lines need their own subroutine...
			my $log_mail_end_time = sprintf("Mailing Completed: %02d/%02d/%02d %02d:%02d:%02d",  $dmonth+1, $dday, $dyear+1900, $dhour, $dmin, $dsec);	
			
			if( $self->{list_info}->{get_finished_notification}  == 1){ 			
						    
                $self->_email_batched_finished_notification(
                    -fields       => \%fields, 
                    -start_time   => $mail_start_time, 
                    -end_time     => $mail_end_time, 
                    
                    -emails_sent  => $ending_status->{total_sent_out},
                    
                    -last_email   => $stop_email,
                ); 
                                                        
			}
			# End Old, Complicated, Crufty Stuff....
			 
				
			$self->{mj_log}->mj_log(
                $self->{list_info}->{list}, 
                'List Mailing Completed', 
                "subject:$fields{Subject}, $log_mail_start_time, $log_mail_end_time, Mailing Amount:$mailing_amount"
            ) if $DADA::Config::LOG{mass_mailings};
			
			$self->{mj_log}->close_log 
			    if $DADA::Config::LOG{mass_mailings};
            
            #warn "closing mailist."; 
			close(MAILLIST)
			    or carp "Problems closing the temporary sending file (" . $mailout->subscriber_list ."), Reason: $!";
			
			
			#warn "unlocking batch.."; 
		    $mailout->unlock_batch_lock; 

			#warn "Cleaning up my mess...";
            $mailout->clean_up; 
            
            #warn "exiting..."; 
           	exit(0);		 

		} elsif ($! =~ /No more process/) {     
			# EAGAIN, supposedly recoverable fork error
			sleep 5;
			redo FORK;
		} else {
			# weird fork error
			croak "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error in Mail.pm, Unable to Fork new process to mass e-mail list message: $!\n";
			}
		}
	} 






sub _content_transfer_encode { 

    my $self = shift; 
    my %args = (-fields => {}, @_); 
    
    my $fields = $args{-fields}; 
    
    my %new_fields; 
    
    my $msg = undef; 
    my $orig_body = $fields->{Body};
  
    $fields->{Body} = undef; 
    delete $fields->{Body};  
        
    require MIME::Parser; 
    my $parser = new MIME::Parser; 
       $parser = DADA::App::Guts::optimize_mime_parser($parser); 

    my $encoding = $self->{list_info}->{plaintext_encoding}; 
    if($fields->{'Content-type'} =~ m{html}){ 
        $encoding = $self->{list_info}->{html_encoding}; 
     }
        
    my $entity; 
	eval { 
	
	    
	    $entity  = MIME::Entity->build(
                       Encoding => $encoding,
                       Type     => $fields->{'Content-type'}, 
                       Data     => $orig_body,
        );
        
        
        
        foreach(keys %$fields){ 
            next if $_ eq 'Content-type'; # Yeah, Content-Type, no Content-type. Weird. Weeeeeeeird.
            next if $_ eq 'Content-Transfer-Encoding'; 
            $entity->head->add($_, $fields->{$_}); 
        }
        
        
        $entity->sync_headers('Length'      =>  'COMPUTE',
							  'Nonstandard' =>  'ERASE');
		

		
        my $head = $entity->head->as_string; 
        my $body = $entity->body_as_string; 
           %new_fields = $self->return_headers($head);
               
        $new_fields{Body} = $body; 
        
        
        
           
                               
	};
        
    if($@){ 
        carp "problem adding 'Content-Transfer-Encoding' to message! skipping. $@";
   
       return %{$args{-fields}}; 
    } else { 
    
        return %new_fields; 
    }
   
   

}



sub _domain_for_smtp { 

	my $self = shift; 
	my ($user, $domain) = split('@', $self->{list_info}->{list_owner_email});
	return $domain;

}




sub _strip_fields { 
	my $self = shift; 
	my %fields = @_; 
	require Mail::Address;
	
	if(my $to_temp = (Mail::Address->parse($fields{To}))[0]){ 
	   $fields{To} = $to_temp->address();  	
	}
	
	if(my $from_temp = (Mail::Address->parse($fields{From}))[0]){ 
	   $fields{From} = $from_temp->address();  
	 }
	 
	return %fields;
}

=pod

=head2 _make_general_headers

(private)

return a hash containing: 

=over

=item * From

Currently makes From: with only the list owner's address - should be changed in the future

=item * Reply-To

Set to whatever From: is set to

=item * Errors-To

Off, by default, gets set to the admin_email if print_errors_to_header is set to '1'

=item * Message-ID

This requires Net::Domain (included with the distro - I hope this doesn't break things...)

Format: 

# time  + random number + sender, woot!

'time' is whatever format is created by DADA::App::Guts::message_id() This is
done for backwards compatibility sake. Example:

	Message-ID: <20031227013306.20240243.user@domain.com>

It's easily seen that this was sent at 12/27/2003

=back





=cut

sub _make_general_headers { 
	my $self = shift; 
	my %gh; 
	
	# I don't understand why this check is here. 
	# Ah, I think there are some places where you can send, without actually have a list. 
	# Huh.
	if($self->{list_info}->{list}){ 
		# PHRASE, ADDRESS, [ COMMENT ]
		require Mail::Address;		
		
		#hack
		#Mail::Address should.. *Address* (pun) this, but it doesn't... why? why? why?
	 	# Why, it's a bug in Mail::Address, and it's not getting fixed... grr!
	 	
		my $ln = $self->{list_info}->{list_name}; 
		   $ln = DADA::App::Guts::escape_for_sending($ln);	   
		#/hack
		# NOTE: There is a module called, Email::Address that is supposed
		# to solve the problems of Mail::Address, althouigh more testing 
		# has to be done. 
		
		my $From_obj = Mail::Address->new($ln , $self->{list_info}->{list_owner_email});
		$gh{From}       = $From_obj->format;
		$gh{'Reply-To'} = $From_obj->format;
			
		# Deprecated.
		if($self->{list_info}->{print_errors_to_header} == 1){ 	
			my $Errors_To_obj = Mail::Address->new(undef, $self->{list_info}->{admin_email});
			$gh{'Errors-To'}   = $Errors_To_obj->format;
		} 
		
		# time  + random number + sender, woot!
		require DADA::Security::Password; 	
		my $ran_number = DADA::Security::Password::generate_rand_string('1234567890');
		
		$gh{'Message-ID'} = '<' .  DADA::App::Guts::message_id() . '.'. $ran_number . '@' . $From_obj->host . '>'; 
		
		if($self->{list_info}->{use_habeas_headers} == 1){ 
		     require DADA::Security::Password; 
			 $gh{'X-Habeas-SWE-1'} = DADA::Security::Password::rot13('jvagre vagb fcevat');
			 $gh{'X-Habeas-SWE-2'} = DADA::Security::Password::rot13('oevtugyl nagvpvcngrq');
			 $gh{'X-Habeas-SWE-3'} = DADA::Security::Password::rot13('yvxr Unornf FJR (gz)');
			 $gh{'X-Habeas-SWE-4'} = DADA::Security::Password::rot13('Pbclevtug 2002 Unornf (gz)');
			 $gh{'X-Habeas-SWE-5'} = DADA::Security::Password::rot13('Fraqre Jneenagrq Rznvy (FJR) (gz). Gur fraqre bs guvf');
			 $gh{'X-Habeas-SWE-6'} = DADA::Security::Password::rot13('rznvy va rkpunatr sbe n yvprafr sbe guvf Unornf');
			 $gh{'X-Habeas-SWE-7'} = DADA::Security::Password::rot13('jneenag znex jneenagf gung guvf vf n Unornf Pbzcyvnag');
			 $gh{'X-Habeas-SWE-8'} = DADA::Security::Password::rot13('Zrffntr (UPZ) naq abg fcnz. Cyrnfr ercbeg hfr bs guvf');
			 $gh{'X-Habeas-SWE-9'} = DADA::Security::Password::rot13('znex va fcnz gb <uggc://jjj.unornf.pbz/ercbeg/>.');
		}	
		
		
		if(exists($self->{list_info}->{precedence}) && defined($self->{list_info}->{precedence})) { 
		    $gh{'Precedence'}  = $self->{list_info}->{precedence};
		}
		
	    if(exists($self->{list_info}->{priority}) && defined($self->{list_info}->{priority})) { 
		    if($self->{list_info}->{priority} ne 'none'){ 
		        $gh{'X-Priority'}  = $self->{list_info}->{priority};
		    }
	    }
		
		require HTTP::Date; 
		$gh{Date} = HTTP::Date::time2str();
		
	}
	return %gh;
}


sub _make_list_headers { 
	my $self = shift; 
	my %lh;
	if($self->{list_info}->{list}){ 
		if($self->{list_info}->{print_list_headers} != 0){ 	
			$lh{List}               =   $self->{list_info}->{list};
			$lh{'List-URL'}         =   '<' . $DADA::Config::PROGRAM_URL . '/list/'.$self->{list_info}->{list}  . '/>';
			$lh{'List-Unsubscribe'} =   '<' . $DADA::Config::PROGRAM_URL . '/u/'   . $self->{list_info}->{list} . '/>'; 
			$lh{'List-Subscribe'}   =   '<' . $DADA::Config::PROGRAM_URL . '/s/'   . $self->{list_info}->{list} . '/>'; 
			
			$lh{'List-Owner'}       =   '<' . $self->{list_info}->{list_owner_email}.'>';

			if($self->{list_info}->{show_archives} ne "0"){
				$lh{'List-Archive'} =  '<' . $DADA::Config::PROGRAM_URL.'/archive/'. $self->{list_info}->{list} . '/>';   
			}
			
			# http://www.faqs.org/rfcs/rfc2369.html
			if($self->{list_info}->{group_list} == 1 && $self->{list_info}->{discussion_pop_email}){ 
				$lh{'List-Post'} = '<mailto:' . $self->{list_info}->{discussion_pop_email} . '>';
			}
			
			# http://www.faqs.org/rfcs/rfc2111.html
			eval "require Net::Domain";
			if(!$@){ 
				my $domain = undef; 
				
				$domain = Net::Domain::hostfqdn() || 
					carp "no domain found for: Net::Domain::hostfqdn()";
					
				$domain ||= 'localhost'; # not sure about this one, I believe if you use localhost, you need a random # as well...
				$lh{'List-ID'} = '<' . $self->{list_info}->{list} .'.'. $domain .'>';
			}else{ 
				carp "Net::Domain should be installed!";
			}
		}
	}
	
	return %lh;
}


sub _cipher_decrypt { 
	my $self = shift; 
	my $str  = shift; 
	require DADA::Security::Password; # why wasn't this here before?!
	return  DADA::Security::Password::cipher_decrypt($self->{list_info}->{cipher_key}, $str);
}




sub _pop_before_smtp { 
	my $self = shift; 
	require DADA::Security::Password; 
	
	my %args = (-pop3_server         => $self->{list_info}->{pop3_server},
	            -pop3_username       => $self->{list_info}->{pop3_username},
	            -pop3_password       => $self->_cipher_decrypt($self->{list_info}->{pop3_password}),
	            @_);          
	            		
	if(($self->{list_info}->{use_pop_before_smtp} == 1) &&
	   ($args{-pop3_server})                            &&
	   ($args{-pop3_username})                          &&
	   ($args{-pop3_password})){
		
		$args{-pop3_server}		= make_safer($args{-pop3_server}); 
		$args{-pop3_username}   = make_safer($args{-pop3_username});
		$args{-pop3_password}   = make_safer($args{-pop3_password});
		
		my $messagecount = undef; 
		my $pop          = undef; 
		
		return undef if ! $args{-pop3_server};
		return undef if ! $args{-pop3_username}; 
		return undef if ! $args{-pop3_password}; 
		
		eval {require Net::POP3};			
		if(!$@){
			$pop = Net::POP3->new($args{-pop3_server}, 
			
			(
                ($DADA::Config::CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ? 
                    (Debug => 1, ) :
                    ()
            ), 
			
			);
			if($pop){ 
				eval {require Digest::MD5};
				if(!$@){ 
					$messagecount = $pop->apop($args{-pop3_username},$args{-pop3_password});			
					if(!$messagecount){ 
						$pop = Net::POP3->new($args{-pop3_server},
                            (
                                ($DADA::Config::CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ? 
                                    (Debug => 1, ) :
                                    ()
                            ), 						
						);
						
						$messagecount = $pop->login($args{-pop3_username},$args{-pop3_password});
					}
				}else{ 
					$messagecount = $pop->login($args{-pop3_username},$args{-pop3_password});
				}	
				
				return $messagecount; 
			}else{ 
				return undef; 
			}		
		}else{ 
			carp("Cannot find Net::POP3, is it installed? - $!");
			return undef;
		}
	}
}




sub _email_batched_finished_notification { 

	my $self = shift; 
	
	my %args = (-fields      => {}, 
			    -start_time      => undef, 
			    -end_time        => undef, 
			    -emails_sent     => undef,
			    -last_email      => undef,
		 	                 @_);
		 	                   
	my $fields = $args{-fields}; 
	my %done_mailing          = $self->_make_general_headers; 
	   $done_mailing{To}      = $self->{list_info}->{list_owner_email};
   	   $done_mailing{Subject} = $self->{list_info}->{list_name}  . ' Mailing Complete. - ' . $fields->{Subject}; 	
	
	my $formatted_start_time; 
	my $formatted_end_time; 
	
	if($args{-start_time}){ 
		my ($s_sec, $s_min, $s_hour, $s_day, $s_month, $s_year) = (localtime($args{-start_time}))[0,1,2,3,4,5];
		   $formatted_start_time = sprintf("%02d/%02d/%02d %02d:%02d:%02d",  $s_month+1, $s_day, $s_year+1900, $s_hour, $s_min, $s_sec);		
	}

	if($args{-end_time}){ 
		my ($e_sec, $e_min, $e_hour, $e_day, $e_month, $e_year) = (localtime($args{-end_time}))[0,1,2,3,4,5];
		   $formatted_end_time = sprintf("%02d/%02d/%02d %02d:%02d:%02d",  $e_month+1, $e_day, $e_year+1900, $e_hour, $e_min, $e_sec);		
	}
	
	my $total_time =  $self->_formatted_runtime(($args{-end_time} - $args{-start_time}));
	
	my $done_body  = "Your List Mailing has been successful!\n";
	   $done_body .= '_' x 72 . "\n\n"; 
	   $done_body .= "Your mailing has reached: $args{-emails_sent} e-mail address(es)\n\n" 
			if $args{-emails_sent};
	   $done_body .= 'Mailing Started:    ' . $formatted_start_time . "\n"                              
	   		if $args{-start_time};
	   $done_body .= 'Mailing Ended:      ' . $formatted_end_time   . "\n"                                
	   		if $args{-end_time};
	   $done_body .= "Total Mailing Time: " . $total_time 			. "\n" 
	   		if defined($total_time) && defined($args{-start_time}) && defined($args{-end_time});
	   $done_body .= 'Last Email sent to: ' . $args{-last_email} 	. "\n"                                 
	   		if $args{-last_email}; 
	   $done_body .= "\nA copy of your Mailing List Message has been attached.\n"
		   	if $fields->{Body};
	   $done_body .= "\n-" . $DADA::Config::PROGRAM_NAME . "\n\n"; 
	  
	  require MIME::Lite; 
	  
	  my $msg = MIME::Lite->new(Type => 'multipart/mixed', 
	  							From => $done_mailing{From}, 
	  							To => $done_mailing{To}
	  						   ); 
	  						   
	     $msg->attach(Type        => 'TEXT', 
	     			  Data        => $done_body,
	     			  Disposition => 'inline',
	     			  );	     
	     
	   my $att; 
	   foreach(keys %$fields){
			next if $_ eq 'Body'; 
			$att .= $_ . ': ' . $fields->{$_} . "\n"
				if defined($fields->{$_}) && $fields->{$_} ne ""; 
	   }
	   $att .= "\n" . $fields->{Body}; 
	   
		   
	     $msg->attach(Type        => 'message/rfc822', 
					  Disposition => "inline",
		 			  Data        => $att); 
					  
	  	my %new_headers        = $self->return_headers($msg->header_as_string);
	  	   $done_mailing{Body} =  $msg->body_as_string; 
	
	   $self->send(%new_headers, %done_mailing);

}




sub _send_die { 
	
	my $self  = shift; 
	my $debug = shift; 
	my $report;
	
	if($debug){ 
		$report = "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Mass Mailing Error! INFORMATION: Messages Sent: $debug->{-Messages_Sent},  Mailing Failed At Address: $debug->{-Last_Email}, Message Subject: $debug->{-Message_Subject}, Using List File: $debug->{-List_File}, List File Size: $debug->{-List_File_Size} bytes, Details: $!";
		croak($report); 
	}else{
		croak("$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: can't pipe to mail program using settings: '$DADA::Config::MAIL_SETTINGS': $!\n");
	}
	
}


sub _merge_fields_string { 
	my $self = shift; 
	
	my @merge_fields = split(',',  $self->{list_info}->{merge_fields}); 
	my $merge_fields; 
	
	foreach(@merge_fields){ 
		$merge_fields .= '::' . '\['.$_.'\]';
	}	
	return $merge_fields;
}


sub _merge_fields_array_ref { 
	my $self = shift; 
	
	my @merge_fields = split(',',  $self->{list_info}->{merge_fields}); 
	my $merge_fields = []; 
	
	foreach(@merge_fields){ 
		push(@$merge_fields, '['.$_.']'); 
	}	
	return $merge_fields;

} 


sub _verp { 

	my $self = shift; 
	my $to   = shift; 
	
	croak "no email passed!" 
		if ! $to; 
		
	require Mail::Address;
	require Mail::Verp; 
	
	if(my $to_temp = (Mail::Address->parse($to))[0]){ 
	   $to = $to_temp->address();  	
	}
		
		my $mv = Mail::Verp->new;
		   $mv->separator($DADA::Config::MAIL_VERP_SEPARATOR );
		
		if($self->{list_info}->{set_smtp_sender} == 1){ 
            return $mv->encode( $self->{list_info}->{admin_email}, $to ); 
        }else{ 
            return $mv->encode( $self->{list_info}->{list_owner_email}, $to ); 
        }
        
}




sub _merge_fields { 
	my $self = shift; 
	my %args = (-body         => undef, 
				-merge_fields => [],
				-mail_fields  => {},
				@_);

	$args{-body} =~ s/\[email\]/$args{-merge_fields}->[0]/g;				
	
	$args{-body} =~ s/\[email_name\]/$args{-merge_fields}->[1]/g;		

	$args{-body} =~ s/\[email_domain\]/$args{-merge_fields}->[2]/g;		

	
	$args{-body} =~ s/\[pin\]/$args{-merge_fields}->[3]/g;
	
	$args{-body} =~ s/\[list\]/$args{-merge_fields}->[4]/g; # the list short name.

	
	$args{-body} =~ s/\[list_name\]/$args{-merge_fields}->[5]/g; # the list name.

	my @merge_fields = split(',',  $self->{list_info}->{merge_fields});
	my $i;
	
	
	my $message_id = $args{-mail_fields}->{'Message-ID'}; 
	   $message_id =~ s/\<|\>//g;
	   $message_id =~ s/\.(.*)//; #greedy
	
	
	$args{-body} =~ s/\[message_id\]/$message_id/g;
	# or, 
	#$args{-body} =~ s/\[message_id\]/$args{-merge_fields}->[6]/g; # the list name.
	# I guess...

	$args{-body} = $self->redirect_tags(-string => $args{-body}, -mid => $message_id) if $self->{list_info}->{clickthrough_tracking} == 1; 
	
	for($i=0;$i<=$#merge_fields;$i++){ 
		$args{-body} =~ s/\[$merge_fields[$i]\]/$args{-merge_fields}->[$i+2]/g;	
	}
	return $args{-body};
}

sub redirect_tags { 
	my $self = shift;	
	my %args = (-string => undef, 
				-mid    => undef,
				@_); 
	my $s   = $args{-string};			
	my $mid = $args{-mid}; 			 
       $mid =~ s/\<|\>//g;
       $mid =~ s/\.(.*)//; #greedy
       
	$s =~ s/\[redirect\=(.*?)\]/&DADA::Mail::Send::redirect_encode($self, $1, $mid)/eg; 
	return $s;
}

sub redirect_encode { 
	my ($self, $url, $mid) = @_; 
	   $mid =~ s/\<|\>//g;
       $mid =~ s/\.(.*)//; #greedy
       
       my $k = ''; 
       
       if($url =~ m/^http:\/\//){ 
       		$url =~ s/^http:\/\///; 
       		$k   = 'h'; 
       }elsif($url =~ m/^https:\/\//){ 
       		$url =~ s/^https:\/\///; 
       		$k   = 's';        
       }
       
    my $e_url; 
    
    eval {require URI::Escape}; 
	if(!$@){
		$e_url = URI::Escape::uri_escape($url, "\200-\377");		 
	}else{ 
		$e_url = DADA::App::Guts::uriescape($url); 
    }   
    
    $e_url =~ s/\?/%3F/g; 
     	  
	return $DADA::Config::PROGRAM_URL . '/r/' . $self->{list_info}->{list} . '/' . $k . '/' . $mid . '/' . $e_url . '/'; 
}




sub _formatted_runtime { 
	
	my $self = shift;
	my $d    = shift; 
	
	my @int = (
        [ 'second', 1                ],
        [ 'minute', 60               ],
        [ 'hour',   60*60            ],
        [ 'day',    60*60*24         ],
        [ 'week',   60*60*24*7       ],
        [ 'month',  60*60*24*30.5    ],
        [ 'year',   60*60*24*30.5*12 ]
    );
    my $i = $#int;
    my @r;
    while ( ($i>=0) && ($d) )
    {
        if ($d / $int[$i] -> [1] >= 1)
        {
            push @r, sprintf "%d %s%s",
                         $d / $int[$i] -> [1],
                         $int[$i]->[0],
                         ( sprintf "%d", $d / $int[$i] -> [1] ) > 1
                             ? 's'
                             : '';
        }
        $d %= $int[$i] -> [1];
        $i--;
    }

    my $runtime = join ", ", @r if @r;
    return $runtime; 
}




sub _massaged_for_archive { 

	my $self   = shift; 
	my $fields = shift; 
	
	my $msg; 
	
	foreach(@DADA::Config::EMAIL_HEADERS_ORDER){ 
		next if $_ eq 'Body'; 
		next if $_ eq 'Message'; # Do I need this?!
		$msg .= $_ . ': ' . $fields->{$_} . "\n"
		if((defined $fields->{$_}) && ($fields->{$_} ne ""));
	}
	
	$msg .= "\n" . $fields->{Body};
	
	return $msg; 
}




sub _log_sub_count { 

	my $self = shift; 
	
	my %args = (-msg_id          => undef, 
				-num_subscribers => undef, 
				@_
				);
	
	return 
	 	if $self->bulk_test; 
	 	
	return 
		if $self->{list_info}->{enable_subscriber_count_logging} != 1; 
	
	my $msg_id    = $args{-msg_id}; 
	   $msg_id    =~ s/\<|\>//g;
 	   $msg_id    =~ s/\.(.*)//; 
			
	my $num_subscribers = $args{-num_subscribers}; 
					
	require DADA::Logging::Clickthrough; 
	my $r = DADA::Logging::Clickthrough->new($self->{list_info}->{list}); 
	   $r->sc_log($msg_id, $num_subscribers); 

}




sub bulk_test_recipient { 

    my $self           = shift; 
    my $test_recipient = shift; 
        
    if(! $test_recipient){ 
        
        if(! $self->{test_recipient}){ 
        
            return $self->{list_info}->{list_owner_email};
            
            # warn "sending over the list owner as the test recipient..";
        
        }else{ 
        
            #warn "sending over " . $self->{test_recipient};
            return $self->{test_recipient}; 
        
        }
        
    }else{ 
        
        if(DADA::App::Guts::check_for_valid_email($test_recipient) == 0){ 
            
            $self->{test_recipient} = $test_recipient;
            
        }else{
            # warn "Test Recipient, '$test_recipient' is not a valid email address!";
       }
    }
}






sub DESTROY { 

	# DESTROY ALL ASTROMEN!
	my $self = shift; 

}


1;


=pod

=head1 COPYRIGHT

Copyright (c) 1999-2007 Justin Simoni 
me - justinsimoni.com
http://justinsimoni.com 
All rights reserved. 

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.



=cut
