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->{service_email}, 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;