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;