# @(#)$Id: Email.pm 1139 2012-03-28 23:49:18Z pjf $
use strict;
use version; our $VERSION = qv( sprintf '0.5.%d', q$Rev: 1139 $ =~ /\d+/gmx );
use Encode;
# requires qw(basename ensure_class_loaded io);
sub send_email {
my ($self, $args) = @_;
$args or throw 'Email parameters not specified';
ref $args eq HASH or throw 'Email parameters not a hash ref';
$args->{email} = $self->_create_email( $args );
return $self->_transport_email( $args );
}
# Private methods
sub _add_attachments {
my ($self, $args, $email) = @_; $args ||= {}; $email ||= {};
my $types = MIME::Types->new( only_complete => TRUE );
my $part = Email::MIME->create( attributes => $email->{attributes},
body => delete $email->{body} );
$email->{parts} = [ $part ];
while (my ($attachment, $path) = each %{ $args->{attachments} }) {
my $body = $self->io( $path )->lock->all;
my $file = $self->basename( $path );
my $mime = $types->mimeTypeOf( $file );
my $attrs = { content_type => $mime->type,
encoding => $mime->encoding,
filename => $file,
name => $attachment };
$part = Email::MIME->create( attributes => $attrs, body => $body );
push @{ $email->{parts} }, $part;
}
return;
}
sub _create_email {
my ($self, $args) = @_; $args ||= {};
my $email = { attributes => $args->{attributes} || {} };
my $from = $args->{from} or throw 'No email from attribute';
my $to = $args->{to } or throw 'No email to attribute';
my $subject = encode( 'MIME-Header', $args->{subject} || 'No subject' );
my $encoding = $email->{attributes}->{charset};
$email->{header} = [ From => $from, To => $to, Subject => $subject ];
$email->{body } = $self->_get_email_body( $args );
$encoding and $email->{body} = encode( $encoding, $email->{body} );
exists $args->{attachments} and $self->_add_attachments( $args, $email );
return Email::MIME->create( %{ $email } );
}
sub _get_email_body {
my ($self, $args) = @_; $args ||= {}; my $text;
exists $args->{body} and defined $args->{body} and return $args->{body};
$args->{template} or throw 'Message body not specified';
my $conf = $args->{template_attrs} || {};
my $tmplt = Template->new( $conf ) or throw $Template::ERROR;
$tmplt->process( $args->{template}, $args->{stash}, \$text )
or throw $tmplt->error();
return $text;
}
sub _transport_email {
my ($self, $args) = @_; $args ||= {};
$args->{email} or throw 'No email object specified';
my $class = $args->{mailer} || q(SMTP);
substr $class, 0, 1 eq q(+)
or $class = q(Email::Sender::Transport::).$class;
$self->ensure_class_loaded( $class );
my $mailer_args = { %{ $args->{mailer_args} || {} } };
exists $args->{mailer_host} and $mailer_args->{host} = $args->{mailer_host};
my $mailer = $class->new( $mailer_args );
my $send_args = { from => $args->{from}, to => $args->{to} };
my $result = $mailer->send( $args->{email}, $send_args );
$result->can( q(failure) ) and throw $result->message;
return 'Message accepted for delivery';
}
1;
__END__
=pod
=head1 Name
CatalystX::Usul::Email - Domain model for sending emails
=head1 Version
0.5.$Revision: 1139 $
=head1 Synopsis
package YourApp::Model::YourModel;
use parent qw(CatalystX::Usul::Model CatalystX::Usul::Email);
sub your_method {
my $self = shift; $result = $self->send_email( $args ); return;
}
=head1 Description
Provides utility methods to the model and program base classes
=head1 Subroutines/Methods
=head2 send_email
$result = $self->send_email( $args );
Sends emails. The C<$args> hash ref uses these keys:
=over 3
=item attachments
A hash ref whose key/value pairs are the attachment name and path
name. Encoding and content type are derived from the file name
extension
=item attributes
A hash ref that is applied to email when it is created. Typical keys are;
I<content_type> and I<charset>
=item body
Text for the body of the email message
=item from
Email address of the sender
=item mailer
Which mailer should be used to send the email. Defaults to I<SMTP>
=item mailer_host
Which host should send the email. Defaults to I<localhost>
=item stash
Hash ref used by the template rendering to supply values for variable
replacement
=item subject
Subject string
=item template
If it exists then the template is rendered and used as the body contents
=item to
Email address of the recipient
=back
=head1 Diagnostics
None
=head1 Configuration and Environment
None
=head1 Dependencies
=over 3
=item L<CatalystX::Usul::Constants>
=item L<Email::Sender::Transport::SMTP>
=item L<Email::MIME>
=item L<MIME::Types>
=item L<Template>
=back
=head1 Incompatibilities
There are no known incompatibilities in this module
=head1 Bugs and Limitations
There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome
=head1 Author
Peter Flanigan, C<< <Support at RoxSoft.co.uk> >>
=head1 License and Copyright
Copyright (c) 2011 Peter Flanigan. All rights reserved
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>
This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
=cut
# Local Variables:
# mode: perl
# tab-width: 3
# End: