# @(#)$Id: Email.pm 1139 2012-03-28 23:49:18Z pjf $

package CatalystX::Usul::Email;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.5.%d', q$Rev: 1139 $ =~ /\d+/gmx );

use CatalystX::Usul::Constants;
use CatalystX::Usul::Functions qw(throw);
use Email::MIME;
use Encode;
use MIME::Types;
use Template;

# 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: