package LIMS::Model::Email;
use Moose;
extends 'LIMS::Model::Base';
with (
'LIMS::Model::Roles::SessionData', # provides $self->user_profile
'LIMS::Model::Roles::HistoryAction',
);
use namespace::clean -except => 'meta';
has form_data => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
__PACKAGE__->meta->make_immutable;
use LIMS::Local::Mail qw(dispatch);
use Data::Dumper;
#-------------------------------------------------------------------------------
sub diagnosis_status_alert {
my ($self, $data) = @_; # hashref of: recipients (arrayref), message (str),
# subject (str), settings (hashref)
my $recipients = $data->{all_recipients}; # arrayref
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
$self->reset_actions; # clear previous addresses (if using cron for multiple records)
for my $contact (@$recipients) {
$data->{recipient} = $contact;
# forward $data to send_messsage() - will ignore $data->{all_recipients}:
my $result = $self->send_message($data); # warn Dumper $result; Return::Value object
if ( $result->type eq 'success' ) {
my $msg = 'e-mailed diagnosis status alert to ' . $contact;
$self->add_to_actions($msg); # warn $msg;
}
else {
return $result->string; # contains error msg
}
}
$self->do_request_history();
return 0;
}
#-------------------------------------------------------------------------------
sub send_message {
my ($self, $data) = @_; # hashref of: recipient (str), config (hashref),
# subject (str), message (str - optional for attachment), filename (optional),
# attachment (optional - binary), sender (str - optional)
my $message = $self->_generate_message($data); # adds common fields
my $result = LIMS::Local::Mail::dispatch($message); # Return::Value object
return $result;
}
#-------------------------------------------------------------------------------
sub add_new_address {
my ($self, $recipient) = @_;
# add address if not exists:
my $o = LIMS::DB::EmailAddress->new(address => $recipient)->load_or_insert;
}
#-------------------------------------------------------------------------------
sub delete_email_address {
my ($self, $recipient) = @_;
eval { LIMS::DB::EmailAddress->new(address => $recipient)->delete };
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub set_request_id {
my ($self, $request_id) = @_;
# set form_data params for do_request_history():
$self->form_data({ _request_id => $request_id });
}
#-------------------------------------------------------------------------------
sub _generate_message {
my ($self, $data) = @_;
my $cfg = $data->{config};
my %mail = (
to => $data->{recipient},
from => $data->{sender} || $cfg->{email_from},
subject => $data->{subject},
message => $data->{message},
smtp => $cfg->{smtp},
_app_cfg => $cfg, # ignored by mailer agent
); # $self->debug(\%mail);
if ( $cfg->{smtp_user} && $cfg->{smtp_pwd} ) {
my %auth = (
user => $cfg->{smtp_user},
pass => $cfg->{smtp_pwd}, # alias for password
# method => 'DIGEST-MD5', # let it try all methods
# required => 1, # let it try without
);
$mail{auth} = \%auth;
}
# add attachment if supplied:
if ( $data->{attachment} && $data->{filename} ) {
@mail{ qw(file filename) } = @{$data}{ qw(attachment filename) };
}
# override default text/plain content-type headers if required:
if ( my $content = $data->{content} ) {
$mail{content_type} = _get_content_type($content);
}
return \%mail;
}
#-------------------------------------------------------------------------------
sub _get_content_type {
my $content_type = shift;
my $h = { # only using html so far:
html => 'text/html; charset=ISO-8859-1',
};
my $type = $h->{$content_type};
if (! $type) { warn "no entry for $content_type found" } # don't need fatal - will send anyway
return $type;
}
1;