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 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 ); # add file & filename required if eitehr 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; } =begin #------------------------------------------------------------------------ # returns only on send failure: sub dispatch { old version 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: if ( my @missing = grep { ! $mail->{$_} } qw/to from smtp/ ) { return 'missing elements: ' . join ', ', @missing; } my $result = _sendmail($mail); # Email::Stuff returns Return::Value object return $result; # return $result->string if $result->type ne 'success'; # for compatibility with Mail::Sendmail # return $^O =~ /MSWin32/ ? _win32($mail) : _sendmail($mail); # Win32 uses Mail::Outlook } # return hashref containing keys 'success' (1 or 0) & 'message': sub send_attachment { # discontinued 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: if ( my @missing = grep { ! $mail->{$_} } qw/to from smtp file filename/ ) { my %msg = ( message => 'missing elements: ' . join ', ', @missing ); return \%msg; # caller expects hashref containing key 'message' on failure } # set defaults: $mail->{subject} ||= '[no subject]'; $mail->{message} ||= 'Attached file:'; my $result = _sendmail($mail); # Email::Stuff returns Return::Value object ###################################################################### # TODO: return $result object, sync with dispatch (maybe combine with) ###################################################################### my %rtn; if ( $result->type eq 'success' ) { $rtn{success} = 1; $rtn{message} = $result->string; } else { my @caller = caller(0); # warn Dumper \@caller; $rtn{success} = 0; # not really required !! $rtn{message} = "$caller[3] returned: " . $result->string; # ie name of this script } return \%rtn; } =cut #------------------------------------------------------------------------------- # 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); if ( $mail->{file} && $mail->{filename} ) { $msg->attach($mail->{file}, filename => $mail->{filename}); # or use 'attach_file' for filesystem file } 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}; 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;