The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package MooX::Types::MooseLike::Email;
use strict;
use warnings;
our $VERSION = '0.01';

use MooX::Types::MooseLike qw/exception_message/;
use MooX::Types::MooseLike::Base;
use Email::Valid;
use Email::Valid::Loose;
use Email::Abstract;
use Exporter qw/import/;
our @EXPORT_OK = ();

my $type_definitions = [
    {
        name       => 'EmailAddress',
        subtype_of => 'Str',
        from       => 'MooX::Types::MooseLike::Base',
        test       => sub { Email::Valid->address($_[0]) },
        message    => sub { return exception_message( $_[0], 'a valid e-mail address' ) },
    },
    {
        name       => 'EmailAddressLoose',
        subtype_of => 'Str',
        from       => 'MooX::Types::MooseLike::Base',
        test       => sub { Email::Valid::Loose->address($_[0]) },
        message    => sub { return exception_message( $_[0], 'a valid e-mail address' ) },
    },
    {
        name       => 'EmailMessage',
        subtype_of => 'Object',
        from       => 'MooX::Types::MooseLike::Base',
        test       => sub { Email::Abstract->new($_[0]) },
        message    => sub { return exception_message( $_[0], 'recognized by Email::Abstract' ) },
    },
];

MooX::Types::MooseLike::register_types($type_definitions, __PACKAGE__, 'MooseX::Types::Email::Loose');
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

1;
__END__

=head1 NAME

MooX::Types::MooseLike::Email - Email address validation type constraint for Moo.

=head1 SYNOPSIS

  package MyClass;
  use Moo;
  use MooX::Types::MooseLike::Email qw/:all/;

  has 'email'   => ( isa => EmailAddress, is => 'ro', required => 1 );
  has 'message' => ( isa => EmailMessage, is => 'ro', required => 1 );

=head1 DESCRIPTION

MooX::Types::MooseLike::Email is Moo type constraints which uses Email::Valid, Email::Valid::Loose and Email::Abstract to check for valid email addresses and messages.

=head1 TYPES

=head2 EmailAddress

An email address

=head2 EmailAddressLoose

An email address, which allows . (dot) before @ (at-mark)

=head2 EmailMessage

An object, which is a Mail::Internet, MIME::Entity, Mail::Message, Email::Simple or Email::MIME

=head1 TIPS

=over 2

=item * coerce the attribute

  use Scalar::Util qw(blessed);

  has 'message' => (
      is       => 'ro',
      isa      => EmailMessage,
      required => 1,
      coerce   => sub {
          return ( $_[0] and blessed( $_[0] ) and blessed( $_[0] ) ne 'Regexp' )
              ? $_[0]
              : Email::Simple->new( $_[0] );
      },
  );

=back

=head1 AUTHOR

hayajo E<lt>hayajo@cpan.orgE<gt>

=head1 SEE ALSO

L<MooX::Types::MooseLike>, L<MooseX::Types::Email>, L<MooseX::Types::Email::Loose>

=head1 LICENSE

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

=cut