RSS Git Download  Clone
Raw Blame History
package LIMS::Local::Mail;

use Exporter;

@ISA = ('Exporter');

@EXPORT_OK = ('dispatch');

use strict;

use Data::Dumper;
use Email::Stuff;
use Mail::Sendmail;
use LIMS::Local::Utils;

#-------------------------------------------------------------------------------
# returns only on send failure:
sub dispatch {
    my $mail = shift; # warn Dumper $mail;

	# make sure we're in production mode, otherwise set 'to' address to safe:
	_verify_service_status($mail); # warn Dumper $mail;
	
	# require 'to', 'from' & 'smtp' or return:
	return 'missing one or more mail elements (to, from, smtp)'
		if grep { ! $mail->{$_} } qw(to from smtp);

    # set 'Return-Path' so undeliverable message notices don't return to sender:
    $mail->{'return-path'} = $mail->{to}; # same as addressee :))

	# doesn't generate $@ so use M::S::error() instead
	eval { Mail::Sendmail::sendmail(%$mail) };
	
	return $Mail::Sendmail::error || 0;  # empty if mail sent OK

=begin # not needed anymore
	return $^O =~ /MSWin32/
		? _win32($mail)		# uses Mail::Outlook
		: _sendmail($mail); # uses Mail::Sendmail
=cut
}

#-------------------------------------------------------------------------------
# return hashref containing keys 'success' (1 or 0) & 'message':
sub send_attachment {
    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' or return:
	return { # caller expects hashref containing key 'message' on failure:
		message => 'missing one or more mail elements (to, from, smtp, file, filename)'
	} if grep { ! $mail->{$_} } qw(to from smtp file filename);

    # set defaults:
    $mail->{subject} ||= '[no subject]';
    $mail->{message} ||= 'Attached file:';

	# need error return from this:
    my $result = Email::Stuff
        ->to($mail->{to})
        ->from($mail->{from})
        ->subject($mail->{subject})
        ->text_body($mail->{message})
		# or use 'attach_file' for filesystem file:
        ->attach($mail->{file}, filename => $mail->{filename}) 
		->using('SMTP', Host => $mail->{smtp})
        ->send; # warn 'Email::Stuff says:'  . $result;

	# Email::Stuff returns 'Message sent' if ok:
	return {
		success => ( $result eq 'Message sent' ),
		message => $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:
    unless ( grep $ENV{ROSEDB_DEVINIT} =~ /$_/, qw/prod devel/ ) { # don't rely on 'test' flag
        $mail->{to} = undef; # ensures message can't be sent
        return 0;
    }
    
	# 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;

        # 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 _sendmail { 
	my $mail = shift; # warn Dumper $mail; return 0;

	# doesn't generate $@ so use M::S::error() instead
	eval { Mail::Sendmail::sendmail(%$mail) };
	
	return $Mail::Sendmail::error || 0;  # empty if mail sent OK
}

#-------------------------------------------------------------------------------
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;