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;