• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Local::Mail;

=begin -------------------------------------------------------------------------
uses Email::Stuff to send messages; has single dispatch() method which handles
text msgs & attachments automatically; caller expects a Return::Value object,
so need to create one if method exits early; can run in test mode if SMTP_TEST
env param set, or config param is_in_production_mode is false - then msg content
dumped to logs/mail.test
=cut ---------------------------------------------------------------------------

use Exporter;

@ISA = ('Exporter');

@EXPORT_OK = ('dispatch');

use strict;

use Data::Dumper;
use Email::Stuff; # use Email::Stuffer; # drop-in replacement for deprecated Email:Stuff
use Mail::Sendmail;
use Tie::DataDumper;
use Email::Send::Test;
use LIMS::Local::Utils;

#-------------------------------------------------------------------------------
sub dispatch {
    my $mail = shift; 

	# make sure we're in production mode, otherwise set 'to' address to safe:
	_verify_service_status($mail); # warn Dumper $mail;

	# require 'to', 'from', 'smtp', + 'file' & 'filename' if attachment, or
	# return Return::Value object:
	my @required = qw( to from smtp );
	# file + filename required if either submitted:
	push @required, qw( file filename ) if grep $mail->{$_}, qw( file filename );
	
	if ( my @missing = grep { ! $mail->{$_} } @required ) {
		return Return::Value->new( # create Return::Value object
            string => 'missing elements: ' . ( join ', ', @missing ),
            type   => 'failure',
        );
	}

    # set defaults:
    $mail->{subject} ||= '[no subject]';
	if ($mail->{file}) { # only likely for attachment
		$mail->{message} ||= 'Attached file:';
	}
	
    my $result = _sendmail($mail); # Email::Stuff returns Return::Value object
	return $result;
}

#-------------------------------------------------------------------------------
# uses Email::Stuff to send simple and attachment mail - returns a Return::Value object
sub _sendmail {
    my $mail = shift; # warn Dumper $mail;
	
    # set driver to SMTP unless already set to 'Test' in _verify_service_status()
    $mail->{driver} ||= 'SMTP'; 
    
    my @smtp_args = ( Host => $mail->{smtp} );
    
    # add authentication data if available:
    if ( my $auth = $mail->{auth} ) {
        push @smtp_args, ( username => $auth->{user} );
        push @smtp_args, ( password => $auth->{pass} );        
    } # warn Dumper $mail;
    
    my $msg = Email::Stuff
        ->to($mail->{to})
        ->from($mail->{from})
        ->subject($mail->{subject})
        ->text_body($mail->{message})
        ->using($mail->{driver}, \@smtp_args);

    # add attachments if supplied:
    if ( $mail->{file} && $mail->{filename} ) {
        $msg->attach($mail->{file}, filename => $mail->{filename}); # or use 'attach_file' for filesystem file
    }
    # override default text/plain content-type if required:
    if ( my $content_type = $mail->{content_type} ) { # optional
		# *** THIS IS IGNORED IF 't' IN UPPERCASE eg 'Content-Type' - why ???
        $msg->header('content-type' => $content_type);
    }
    # set 'Return-Path' so undeliverable message notices don't return to sender:
    $msg->header('return-path' => $mail->{to}); # but will probably be ignored

    # send it:
    my $result = $msg->send; # warn Dumper $result; # Return::Value object (for SMTP driver)

    # if driver = 'Test':
    if ( $mail->{driver} eq 'Test' ) { # will have @emails array instead of sent msgs:
        my $path_to_app_root = $mail->{_app_cfg}->{path_to_app_root} # not always passed
        || LIMS::Local::Config->instance->{path_to_app_root}; # warn $path_to_app_root;
        tie my @emails => 'Tie::DataDumper', $path_to_app_root . '/logs/mail.test';
        @emails = Email::Send::Test->emails; # warn Dumper \@emails;

        $result = Return::Value->new( # create Return::Value object (as for SMTP driver)
            string => 'test message only (msg not sent)',
            type   => @emails ? 'success' : 'failure',
        );
        Email::Send::Test->clear; # always clear the email trap before each test
    } # warn Dumper $result;
    return $result;
}

#-------------------------------------------------------------------------------
sub _verify_service_status { # makes message 'safe' if not from production server:
	my $mail = shift; # warn Dumper $mail;

    # 1st ensure we NEVER send from test suite:
    if ( $ENV{HARNESS_ACTIVE} ) { # can't use ROSE_DEVINIT env setting (prevents crons & command-line)
        $mail->{to} = undef; # ensures message can't be sent
        return 0;
    }
    
    # set driver to 'Test' if SMTP_TEST env param set:
    $mail->{driver} = 'Test' if $ENV{SMTP_TEST};
    
	# check we're in production mode, return if so, otherwise set 'safe' params:
	return 0 if $mail->{_app_cfg}->{is_in_production_mode}; # rtn val not used	
	
    # unless flag to indicate message is always safe to send:
    unless ($mail->{_app_cfg}->{_safe_message}) {
=begin # replaced with 'just testing' message:
        # set mail 'to' address to service 'safe' address:
        $mail->{to} = $mail->{_app_cfg}->{email_from}
        || die "no 'email_from' address configured in config settings file";
        # delete any cc & bcc addresses:
        $mail->{cc} = $mail->{bcc} = undef;
=cut
        # add TEST label to subject line:
        my $subject = $mail->{subject};
        $mail->{subject} = '[TEST MESSAGE ONLY] ' . $subject;

        # set SMTP to 'Test' if not in production:
        $mail->{driver} = 'Test'; 
        
        # pre-fix message with 'just testing' display:
        my $message = $mail->{message};
        my $txt = q!
            ##############################################################
            #             TESTING :: TESTING :: TESTING                  #
            #                                                            #
            #      THIS IS JUST A TEST MESSAGE. PLEASE DISREGARD.        #
            ##############################################################            
        ! . "\n"; # add CR spacer
        $mail->{message} = LIMS::Local::Utils::deindent($txt) . $message;
    } # else { warn 'have _safe_message flag' }
}

=begin # not in use
#-------------------------------------------------------------------------------
sub _win32 {
	my $data = shift; # warn Dumper $data; return 0;
	
    require Mail::Outlook;

    my %mail = (
        To      => $data->{to},
        Body    => $data->{message},
        Subject => $data->{subject},
    );

    my $o = new Mail::Outlook('Outbox');
    my $msg = $o->create(%mail);
    $msg->send(%mail);
	
	return 0; # need error rtn from Mail::Outlook
}
=cut

1;