use
version;
our
$VERSION
= qv(
sprintf
'0.5.%d'
,
q$Rev: 1139 $
=~ /\d+/gmx );
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
);
}
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;