source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Mail.pm @ 1950

package LATMOS::Accounts::Mail;

use strict;
use warnings;

use LATMOS::Accounts::Log;
use LATMOS::Accounts;
use Mail::Sendmail;
use Template;
use FindBin qw($Bin);
use Sys::Hostname;

=head1 NAME

    LATMOS::Accounts::Mail - Send mail using Template

=head1 SYNOPSIS

    use LATMOS::Accounts::Mail;
    # Prepare the mail
    my $mail = LATMOS::Accounts::Mail->new(
        $la,
        'foo.mail',
        {
            'Subject' => 'a mail',
        }
    );
    # Send it
    $mail->process({}, { to => 'dest@domain' });

=head1 FUNCTIONS

=cut

=head2 LATMOS::Accounts::Mail->new($la, $template, $header)

Create a new C<LATMOS::Accounts::Mail> object. C<$la> is a reference to
a C<LATMOS::Accounts> object, C<$template> is the name of the template to use,
C<$header> is a hashref containing default mail header to use when sending mail.

=cut

sub new {
    my ($class, $la, $template, $headers) = @_;

    bless {
        _la => $la,
        template => $template,
        headers => $headers,
        _template => Template->new(
            INCLUDE_PATH => [
                ($la->val('_default_', 'templatespath')
                    ? $la->val('_default_', 'templatespath') . '/mail'
                    : ()),
                "$FindBin::Bin/../templates" . '/mail',
                '/usr/share/latmos-accounts/templates/mail',
            ],
            POST_CHOMP   => 1,
            EXTENSION    => '.mail',
        ),
    }, $class;
}

=head2 $lamail->process($headers, $vars)

Process the template as mail body and send the mail.

C<$headers> is a hashref to header to use to send the mail (See
L<Mail::Sendmail>.

C<$var> is a hashref to be used by L<Template>.

=cut

sub process {
    my ($self, $headers, $vars) = @_;

    $vars ||= {};

    my $message;
    $self->{_template}->process($self->{template}, $vars, \$message)
    or do {
        la_log(LA_ERR,
            "Cannot send mail: %s, exiting",
            $self->{_template}->error()
        );
        return;;
    };

    my %mail = (
        %{ $self->{headers} || {}},
        %{ $headers || {}},
        'Content-Type' => 'text/plain; charset=utf-8',
        smtp => $self->{_la}->val('_default_', 'smtp', '127.0.0.1'),
        'X-LATMOS-Accounts' => $LATMOS::Accounts::VERSION,
        From => $self->{_la}->val('_default_', 'mailFrom', 'nomail@localhost'),
        'X-Mailer' => __PACKAGE__ . ' / ' . $LATMOS::Accounts::VERSION,
        'Auto-Submitted' => 'auto-generated',
    );
    {
        my $package = __PACKAGE__;
        $package =~ s/::/./g;
        $mail{'Message-ID'} = join(
            '',
            '<', (map { unpack('H', chr(rand(255))) } (0..12)), '@',
            hostname(), '>' );
    }

    if ($ENV{LA_NO_MAIL}) {
        printf STDERR "mail %s to %s not sent due to \$LA_NO_MAIL env\n",
            $mail{subject} || '', $mail{to};
    } else {
        if (Mail::Sendmail::sendmail(
                %mail,
                Message => $message,
            )) {
            la_log(LA_DEBUG, "Mail for id %s sent to %s",
                $mail{'Message-ID'},
                $mail{to},
            );
            return 1;
        } else {
            la_log(LA_ERR, "Cannot send mail: %s", $Mail::Sendmail::error);
            return;
        }
    }
}

=head1 SEE ALSO

L<Template>, L<Mail::Sendmail>

=head1 AUTHOR

Thauvin Olivier, E<lt>olivier.thauvin@latmos.ipsl.fr<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Thauvin Olivier

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;