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;