lib/Mojolicious/Plugin/Mail.pm

package Mojolicious::Plugin::Mail;
use Mojo::Base 'Mojolicious::Plugin';

use MIME::Lite;
use MIME::EncWords ();
use Mojo::ByteStream 'b';

use constant TEST     => $ENV{MOJO_MAIL_TEST} || 0;
use constant FROM     => 'test-mail-plugin@mojolicio.us';
use constant CHARSET  => 'UTF-8';
use constant ENCODING => 'base64';

our $VERSION = '1.3';

has conf => sub { +{} };

sub register {
	my ($plugin, $app, $conf) = @_;
	
	# default values
	$conf->{from    } ||= FROM;
	$conf->{charset } ||= CHARSET;
	$conf->{encoding} ||= ENCODING;
	
	$plugin->conf( $conf ) if $conf;
	
	$app->helper(
		mail => sub {
			my $self = shift;
			my $args = @_ ? { @_ } : return;
			
			# simple interface
			unless (exists $args->{mail}) {
				$args->{mail}->{ $_->[1] } = delete $args->{ $_->[0] }
					for grep $args->{ $_->[0] },
						[to   => 'To'  ], [from => 'From'], [reply_to => 'Reply-To'],
						[cc   => 'Cc'  ], [bcc  => 'Bcc' ], [subject  => 'Subject' ],
						[data => 'Data'], [type => 'Type'],
				;
			}
			
			# hidden data and subject
			
			my @stash =
				map  { $_ => $args->{$_} }
				grep { !/^(to|from|reply_to|cc|bcc|subject|data|type|test|mail|attach|headers|attr|charset|mimeword|nomailer)$/ }
				keys %$args
			;
			
			$args->{mail}->{Data   } ||= $self->render_mail(@stash);
			$args->{mail}->{Subject} ||= $self->stash ('subject');
			
			my $msg  = $plugin->build( %$args );
			my $test = $args->{test} || TEST;
			$msg->send( $conf->{'how'}, @{$conf->{'howargs'}||[]} ) unless $test;
			
			$msg->as_string;
		},
	);
	
	$app->helper(
		render_mail => sub {
			my $self = shift;
			my $data = $self->render_to_string(@_, format => 'mail');
			
			# delete @{$self->stash}{ qw(cb format mojo.captures mojo.started mojo.content mojo.routed) };
			$data;
		},
	);
}

sub build {
	my $self = shift;
	my $conf = $self->conf;
	my $p    = { @_ };
	
	my $mail     = $p->{mail};
	my $charset  = $p->{charset } || $conf->{charset };
	my $encoding = $p->{encoding} || $conf->{encoding};
	my $encode   = $encoding eq 'base64' ? 'B' : 'Q';
	my $mimeword = defined $p->{mimeword} ? $p->{mimeword} : !$encoding ? 0 : 1;
	
	# tuning
	
	$mail->{From} ||= $conf->{from} || '';
	$mail->{Type} ||= $conf->{type} || '';
	
	if ($mail->{Data} && $mail->{Type} !~ /multipart/) {
		$mail->{Encoding} ||= $encoding;
		_enc($mail->{Data} => $charset);
	}
	
	if ($mimeword) {
		$_ = MIME::EncWords::encode_mimeword($_, $encode, $charset)
			for grep { _enc($_ => $charset); 1 } $mail->{Subject}
		;
		
		for (grep $mail->{$_}, qw(From To Cc Bcc)) {
			$mail->{$_} = join ", ",
				grep {
					_enc($_ => $charset);
					{
						next unless /(.*) \s+ (\S+ @ .*)/x;
						
						my($name, $email) = ($1, $2);
						$email =~ s/(^<+|>+$)//sg;
						
						$_ = $name =~ /^[\w\s"'.,]+$/
							? "$name <$email>"
							: MIME::EncWords::encode_mimeword($name, $encode, $charset) . " <$email>"
						;
					}
					1;
				}
				split /\s*,\s*/, $mail->{$_}
			;
		}
	}
	
	# year, baby!
	
	my $msg = MIME::Lite->new( %$mail );
	
	# header
	$msg->delete('X-Mailer'); # remove default MIME::Lite header
	
	$msg->add   ( %$_ ) for @{$p->{headers} || []}; # XXX: add From|To|Cc|Bcc => ... (mimeword)
	$msg->add   ('X-Mailer' => join ' ', 'Mojolicious',  $Mojolicious::VERSION, __PACKAGE__, $VERSION, '(Perl)')
		unless $msg->get('X-Mailer') || $p->{nomailer};
	
	# attr
	$msg->attr( %$_ ) for @{$p->{attr   } || []};
	$msg->attr('content-type.charset' => $charset) if $charset;
	
	# attach
	$msg->attach( %$_ ) for
		grep {
			if (!$_->{Type} || $_->{Type} =~ /text/i) {
				$_->{Encoding} ||= $encoding;
				_enc($_->{Data} => $charset);
			}
			1;
		}
		grep { $_->{Data} || $_->{Path} }
		@{$p->{attach} || []}
	;
	
	$msg;
}

sub _enc($$) {
	my $charset = $_[1] || CHARSET;
	$_[0] = b($_[0])->encode('UTF-8')->to_string if $_[0] && $charset && $charset =~ /utf-8/i;
	$_[0];
}

1;

__END__

=encoding UTF-8

=head1 NAME

Mojolicious::Plugin::Mail - Mojolicious Plugin for send mail

=head1 SYNOPSIS

  # Mojolicious::Lite
  plugin 'mail';

  # Mojolicious with config
  $self->plugin(mail => {
    from => 'sharifulin@gmail.com',
    type => 'text/html',
  });

  # in controller
  $self->mail(
    to      => 'sharifulin@gmail.com',
    subject => 'Test',
    data    => 'use Perl or die;',
  );

  # in controller, using render
  $self->mail(to => 'sharifulin@gmail.com', template => 'controller/action', format => 'mail');

  # template: controller/action.mail.ep
  % stash subject => 'Test';
  use Perl or die;


=head1 DESCRIPTION

L<Mojolicous::Plugin::Mail> is a plugin for Mojolicious apps to send mail using L<MIME::Lite>.

=head1 HELPERS

L<Mojolicious::Plugin::Mail> contains two helpers: I<mail> and I<render_mail>.

=head2 C<mail>

  # simple interface
  $self->mail(
      to       => 'sharifulin@gmail.com',
      from     => 'sharifulin@gmail.com',
      
      reply_to => 'reply_to+sharifulin@gmail.com',
      
      cc       => '..',
      bcc      => '..',
      
      type     => 'text/plain',

      subject  => 'Test',
      data     => 'use Perl or die;',
  );

  # interface as MIME::Lite
  $self->mail(
      # test mode
      test   => 1,
      
      # as MIME::Lite->new( ... )
      mail   => {
        To       => 'sharifulin@gmail.com',
        Subject  => 'Test',
        Data     => 'use Perl or die;',
        
        # add credentials parameters
        AuthUser => 'username',
        AuthPass => 'password',
      },

      attach => [
        # as MIME::Lite->attach( .. )
        { ... },
        ...
      },

      headers => [
        # as MIME::Lite->add( .. )
        { ... },
        ...
      },

      attr => [
        # as MIME::Lite->attr( .. )
        { ... },
        ...
      },
  );

Build and send email, return mail as string.

Supported parameters:

=over 16

=item * to

Header 'To' of mail.

=item * from

Header 'From' of mail.

=item * reply_to

Header 'Reply-To' of mail.

=item * cc

Header 'Cc' of mail.

=item * bcc

Header 'Bcc' of mail.

=item * type

Content type of mail, default is conf's type.

=item * subject

Header 'Subject' of mail.

=item * data

Content of mail

=item * mail

Hashref, containts parameters as I<new(PARAMHASH)>. See L<MIME::Lite>.

=item * attach 

Arrayref of hashref, hashref containts parameters as I<attach(PARAMHASH)>. See L<MIME::Lite>.

=item * headers

Arrayref of hashref, hashref containts parameters as I<add(TAG, VALUE)>. See L<MIME::Lite>.

=item * attr

Arrayref of hashref, hashref containts parameters as I<attr(ATTR, VALUE)>. See L<MIME::Lite>.

=item * test

Test mode, don't send mail.

=item * charset

Charset of mail, default charset is UTF-8.

=item * mimeword

Using mimeword or not, default value is 1.

=item * nomailer

No using 'X-Mailer' header of mail, default value is 1.

=back

If no subject, uses value of stash parameter 'subject'.

If no data, call I<render_mail> helper with all stash parameters.

=head2 C<render_mail>

  my $data = $self->render_mail('user/signup');

  # or use stash params
  my $data = $self->render_mail(template => 'user/signup', user => $user);

Render mail template and return data, mail template format is I<mail>, i.e. I<user/signup.mail.ep>.

=head1 ATTRIBUTES

L<Mojolicious::Plugin::Mail> contains one attribute - conf.

=head2 C<conf>

  $plugin->conf;

Config of mail plugin, hashref.

Keys of conf:

=over 6

=item * from

From address, default value is I<test-mail-plugin@mojolicio.us>.

=item * encoding 

Encoding of Subject and any Data, value is MIME::Lite content transfer encoding L<http://search.cpan.org/~rjbs/MIME-Lite-3.027/lib/MIME/Lite.pm#Content_transfer_encodings>
Default value is I<base64>.

=item * charset

Default charset of Subject and any Data, default value is I<UTF-8>.

=item * type

Default type of Data, default value is I<text/plain>.

=item * how

HOW parameter of MIME::Lite::send: I<sendmail> or I<smtp>.

=item * howargs 

HOWARGS parameter of MIME::Lite::send (arrayref).

=back

  my $conf = {
    from     => 'sharifulin@gmail.com,
    encoding => 'base64',
    type     => 'text/html',
    how      => 'sendmail',
    howargs  => [ '/usr/sbin/sendmail -t' ],
  };

  # in Mojolicious app
  $self->plugin(mail => $conf);
  
  # in Mojolicious::Lite app
  plugin mail => $conf;


=head1 METHODS

L<Mojolicious::Plugin::Mail> inherits all methods from
L<Mojolicious::Plugin> and implements the following new ones.

=head2 C<register>

  $plugin->register($app, $conf);

Register plugin hooks in L<Mojolicious> application.

=head2 C<build>

  $plugin->build( mail => { ... }, ... );

Build mail using L<MIME::Lite> and L<MIME::EncWords> and return MIME::Lite object.

=head1 TEST MODE

L<Mojolicious::Plugin::Mail> has test mode, no send mail.

  # all mail don't send mail
  BEGIN { $ENV{MOJO_MAIL_TEST} = 1 };

  # or only once
  $self->mail(
    test => 1,
    to   => '...',
  );

=head1 EXAMPLES

The Mojolicious::Lite example you can see in I<example/test.pl>.

Simple interface for send plain mail:

  get '/simple' => sub {
    my $self = shift;
    
    $self->mail(
      to      => 'sharifulin@gmail.com',
      type    => 'text/plain',
      subject => 'Тест письмо',
      data    => 'Привет!',
    );
  };

Simple send mail:

  get '/simple' => sub {
    my $self = shift;
    
    $self->mail(
      mail => {
        To      => 'sharifulin@gmail.com',
        Subject => 'Тест письмо',
        Data    => "<p>Привет!</p>",
      },
    );
  };

Simple send mail with test mode:

  get '/simple2' => sub {
    my $self = shift;
    
    my $mail = $self->mail(
      test => 1,
      mail => {
        To      => '"Анатолий Шарифулин" sharifulin@gmail.com',
        Cc      => '"Анатолий Шарифулин" <sharifulin@gmail.com>, Anatoly Sharifulin sharifulin@gmail.com',
        Bcc     => 'sharifulin@gmail.com',
        Subject => 'Тест письмо',
        Type    => 'text/plain',
        Data    => "<p>Привет!</p>",
      },
    );
    
    warn $mail;
  };

Mail with binary attachcment, charset is windows-1251, mimewords off and mail has custom header:

  get '/attach' => sub {
    my $self = shift;
    
    my $mail = $self->mail(
      charset  => 'windows-1251',
      mimeword => 0,

      mail => {
        To      => 'sharifulin@gmail.com',
        Subject => 'Test attach',
        Type    => 'multipart/mixed'
      },
      attach => [
        {
          Data => 'Any data',
        },
        {
          Type        => 'BINARY',
          Filename    => 'crash.data',
          Disposition => 'attachment',
          Data        => 'binary data binary data binary data binary data binary data',
        },
      ],
      headers => [ { 'X-My-Header' => 'Mojolicious' } ],
    );
  };

Multipart mixed mail:

  get '/multi' => sub {
    my $self = shift;
    
    $self->mail(
      mail => {
        To      => 'sharifulin@gmail.com',
        Subject => 'Мульти',
        Type    => 'multipart/mixed'
      },

      attach => [
        {
          Type     => 'TEXT',
          Encoding => '7bit',
          Data     => "Just a quick note to say hi!"
        },
        {
          Type     => 'image/gif',
          Path     => $0
        },
        {
          Type     => 'x-gzip',
          Path     => "gzip < $0 |",
          ReadNow  => 1,
          Filename => "somefile.zip"
        },
      ],
    );
  };

Render mail using simple interface and Reply-To header:

  get '/render_simple' => sub {
    my $self = shift;
    my $mail = $self->mail(to => 'sharifulin@gmail.com', reply_to => 'reply_to+sharifulin@gmail.com');

    $self->render(ok => 1, mail => $mail);
} => 'render';

Mail with render data and subject from stash param:

  get '/render' => sub {
    my $self = shift;

    my $data = $self->render_mail('render');
    $self->mail(
      mail => {
        To      => 'sharifulin@gmail.com',
        Subject => $self->stash('subject'),
        Data    => $data,
      },
    );
  } => 'render';

  __DATA__

  @@ render.html.ep
  <p>Hello render!</p>
  
  @@ render.mail.ep
  % stash 'subject' => 'Привет render';
  
  <p>Привет mail render!</p>

Send email via remote SMTP server.

  # in main
  $self->plugin(
    mail => {
      from    => 'info@host.example',
      type    => 'text/html',
      how     => 'smtp',
      howargs => [ 'mail.host.example',
                      AuthUser => 'me@host.example',
                      AuthPass => '123xyz',
                 ],
    }
  );
  
  # in controller
  $self->mail(
    to      => 'friend@hishost.example',
    subject => 'Test',
    data    => 'use Perl or die;',
  );

=head1 SEE ALSO

L<MIME::Lite> L<MIME::EncWords> L<Mojolicious> L<Mojolicious::Guides> L<http://mojolicious.org>.

=head1 AUTHOR

Anatoly Sharifulin <sharifulin@gmail.com>

=head1 THANKS

Alex Kapranoff <kapranoff@gmail.com>

=head1 BUGS

Please report any bugs or feature requests to C<bug-mojolicious-plugin-mail at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.htMail?Queue=Mojolicious-Plugin-Mail>.  We will be notified, and then you'll
automatically be notified of progress on your bug as we make changes.

=over 5

=item * Github

L<http://github.com/sharifulin/mojolicious-plugin-mail/tree/master>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.htMail?Dist=Mojolicious-Plugin-Mail>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Mojolicious-Plugin-Mail>

=item * CPANTS: CPAN Testing Service

L<http://cpants.perl.org/dist/overview/Mojolicious-Plugin-Mail>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Mojolicious-Plugin-Mail>

=item * Search CPAN

L<http://search.cpan.org/dist/Mojolicious-Plugin-Mail>

=back

=head1 COPYRIGHT & LICENSE

Copyright (C) 2010-2013 by Anatoly Sharifulin.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)